diff -Nru mosml-2.01/bin/.gitignore mosml-2.10.1/bin/.gitignore --- mosml-2.01/bin/.gitignore 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/bin/.gitignore 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,5 @@ +camlrunm +mosml +mosmlc +mosmllex +mosmlyac diff -Nru mosml-2.01/config/alloc.h mosml-2.10.1/config/alloc.h --- mosml-2.01/config/alloc.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/alloc.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,19 +0,0 @@ -#ifndef _alloc_ -#define _alloc_ - - -#include "misc.h" -#include "mlvalues.h" - -EXTERN value alloc(mlsize_t, tag_t); -EXTERN value alloc_tuple(mlsize_t); -EXTERN value alloc_string(mlsize_t); -EXTERN value alloc_final(mlsize_t, final_fun, mlsize_t, mlsize_t); -EXTERN value copy_string(char *); -EXTERN value copy_string_array(char **); -EXTERN value copy_double(double); -EXTERN value alloc_array(value (*funct) (char *), char ** array); -EXTERN int convert_flag_list(value, int *); - - -#endif /* _alloc_ */ diff -Nru mosml-2.01/config/callback.h mosml-2.10.1/config/callback.h --- mosml-2.01/config/callback.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/callback.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,26 +0,0 @@ -/* callback.h */ - -#ifndef _callback_ -#define _callback_ - -#include "mlvalues.h" /* for Field, Reference_tag etc */ -#include "fail.h" /* for failwith */ -#include "memory.h" /* for alloc_shr */ -#include "alloc.h" /* for copy_string */ -#include "minor_gc.h" /* for minor_collection */ -#include "interp.h" /* for callback */ - -typedef value valueptr; /* An 'a option ref */ - -EXTERN valueptr get_valueptr(char* nam); -EXTERN value get_value(valueptr mvp); -EXTERN value callbackptr(valueptr closureptr, value arg1); -EXTERN value callbackptr2(valueptr closureptr, value arg1, value arg2); -EXTERN value callbackptr3(valueptr closureptr, value arg1, value arg2, - value arg3); -EXTERN void registervalue(char* nam, value mlval); -EXTERN void unregistervalue(char* nam); - -EXTERN void registercptr(char* nam, void* cptr); - -#endif /* _callback_ */ diff -Nru mosml-2.01/config/config.h mosml-2.10.1/config/config.h --- mosml-2.01/config/config.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/config.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,170 +0,0 @@ -#ifndef _config_ -#define _config_ - - -#if defined(__MWERKS__) || defined(THINK_C) -#include "m.h" -#include "s.h" -#else -#ifdef macintosh -#include ":::config:m.h" -#include ":::config:s.h" -#else -#if defined(msdos) -#include "../config.dos/m.h" -#include "../config.dos/s.h" -#elif defined(WIN32) -#include "../config.w32/m.h" -#include "../config.w32/s.h" -#else -#include "../config/m.h" -#include "../config/s.h" -#endif -#endif -#endif - -#ifdef WIN32 - -#ifdef CAMLRT -#define EXTERN __declspec(dllexport) -#else -#define EXTERN __declspec(dllimport) -#endif - -#else -#define EXTERN extern -#endif - -/* Library dependencies */ - -#ifdef HAS_MEMMOVE -#define bcopy(src,dst,len) memmove((dst), (src), (len)) -#else -#ifdef HAS_BCOPY -/* Nothing to do */ -#else -#ifdef HAS_MEMCPY -#define bcopy(src,dst,len) memcpy((dst), (src), (len)) -#else -#define bcopy(src,dst,len) memmov((dst), (src), (len)) -#define USING_MEMMOV -#endif -#endif -#endif - -#ifndef HAS__SETJMP -#define _setjmp setjmp -#define _longjmp longjmp -#endif - -/* Signed char type */ - -#if defined(__STDC__) || defined(SIGNED_CHAR_WORKS) || defined(WIN32) -typedef signed char schar; -#else -typedef char schar; -#endif - -/* Do not change this definition. */ -#define Page_size (1 << Page_log) - -/* Memory model parameters */ - -#if !defined(SMALL) && !defined(SIXTEEN) - -/* The size of a page for memory management (in bytes) is [1 << Page_log]. - It must be a multiple of [sizeof (long)]. */ -#define Page_log 12 /* A page is 4 kilobytes. */ - -/* Initial sizes of stacks (bytes). */ -#define Stack_size 32768 - -/* Minimum free size of stacks (bytes); below that, they are reallocated. */ -#define Stack_threshold 2048 - -/* Maximum sizes for the stacks (bytes). */ - -#ifdef MINIMIZE_MEMORY -#define Max_stack_size 262144 -#else -#define Max_stack_size 1048576 -#endif - -/* Maximum size of a block allocated in the young generation (words). */ -/* Must be > 4 */ -#define Max_young_wosize 256 - - -/* Minimum size of the minor zone (words). - This must be at least [Max_young_wosize + 1]. */ -#define Minor_heap_min 4096 - -/* Maximum size of the minor zone (words). - Must be greater than or equal to [Minor_heap_min]. -*/ -#define Minor_heap_max (1 << 28) - -/* Default size of the minor zone. (words) */ -#define Minor_heap_def 32768 - - -/* Minimum size increment when growing the heap (words). - Must be a multiple of [Page_size / sizeof (value)]. */ -#define Heap_chunk_min (2 * Page_size / sizeof (value)) - -/* Maximum size of a contiguous piece of the heap (words). - Must be greater than or equal to [Heap_chunk_min]. - Must be greater than or equal to [Bhsize_wosize (Max_wosize)]. */ -#define Heap_chunk_max (Bhsize_wosize (Max_wosize)) - -/* Default size increment when growing the heap. (bytes) - Must be a multiple of [Page_size / sizeof (value)]. */ -#define Heap_chunk_def (62 * Page_size / sizeof (value)) - - -/* Default speed setting for the major GC. The heap will grow until - the dead objects and the free list represent this percentage of the - heap size. The rest of the heap is live objects. */ -#define Percent_free_def 30 - - -#else -#ifdef SIXTEEN /* Scaled-down parameters for 16-bit machines */ - -#define Page_log 10 -#define Stack_size 32768 -#define Stack_threshold 2048 - -#define Max_stack_size 65532 -#define Max_young_wosize 256 -#define Minor_heap_min 512 -#define Minor_heap_max 0x3F00 -#define Minor_heap_def 8192 -#define Heap_chunk_min 0x400 -#define Heap_chunk_max 0x3C00 -#define Heap_chunk_def 0x2000 -#define Percent_free_def 15 - -#else -#ifdef SMALL /* Scaled-down parameters for small memory */ - -#define Page_log 10 -#define Stack_size 32768 -#define Stack_threshold 2048 -#define Max_stack_size 1048576 -#define Max_young_wosize 256 -#define Minor_heap_min 1024 -#define Minor_heap_max (1 << 28) -#define Minor_heap_def 16384 -#define Heap_chunk_min (2 * Page_size / sizeof (value)) -#define Heap_chunk_max (1 << 28) -#define Heap_chunk_def (126 * Page_size / sizeof (value)) -#define Percent_free_def 20 - -#endif /* SMALL */ -#endif /* SIXTEEN */ - -#endif /* !defined(SMALL) && !defined(SIXTEEN) */ - - -#endif /* _config_ */ diff -Nru mosml-2.01/config/debugger.h mosml-2.10.1/config/debugger.h --- mosml-2.01/config/debugger.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/debugger.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,53 +0,0 @@ -#ifndef _debugger_ -#define _debugger_ - -#include "misc.h" -#include "mlvalues.h" - -#ifdef DEBUG - -#define LOG_BUFFER_SIZE 100 -extern bytecode_t log_buffer[LOG_BUFFER_SIZE]; -extern bytecode_t * log_ptr; -extern int trace_flag; - -#define Debug(x) x - -#if defined(__STDC__) || defined(WIN32) -#define Assert(x) if (!(x)) failed_assert ( #x , __FILE__, __LINE__) -#define Dprintx(x) printf ("expression %s %ld\n", #x, (unsigned long) (x)) -#else -#ifndef __LINE__ -#define __LINE__ 0 -#endif -#ifndef __FILE__ -#define __FILE__ "(?)" -#endif -#define Assert(x) if (!(x)) failed_assert ("(?)" , __FILE__, __LINE__) -#define Dprintx(x) printf ("expression %ld\n", (unsigned long) (x)) -#endif /* __STDC__ */ - -void failed_assert (char *, char *, int); -void print_value (value); -bytecode_t disasm_instr (bytecode_t); -void post_mortem (int); -unsigned long not_random (void); - -#else /* DEBUG */ - -#define Debug(x) -#define Assert(x) -#define Dprintx(x) - -#endif /* DEBUG */ - -#define nTrace(msg, x, y) - -#ifdef TRACE -#define Trace(msg, x, y) printf (msg, x, y) -#else -#define Trace(msg, x, y) -#endif - - -#endif /* _debugger_ */ diff -Nru mosml-2.01/config/exec.h mosml-2.10.1/config/exec.h --- mosml-2.01/config/exec.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/exec.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,26 +0,0 @@ -/* exec.h : format of executable bytecode files */ - -/* offset 0 ---> initial junk - code block - data block - symbol table - debug infos - trailer - end of file ---> -*/ - -/* Structure of the trailer: five 32-bit, unsigned integers, big endian */ - -#define TRAILER_SIZE 20 - -struct exec_trailer { - unsigned long code_size; /* Size of the code block (in bytes) */ - unsigned long data_size; /* Size of the global data table (bytes) */ - unsigned long symbol_size; /* Size of the symbol table (bytes) */ - unsigned long debug_size; /* Size of the debug infos (bytes) */ - unsigned long magic; /* A magic number */ -}; - -/* Magic number for this release */ - -#define EXEC_MAGIC 0x4d4c3038 /* "ML08" */ diff -Nru mosml-2.01/config/expand.h mosml-2.10.1/config/expand.h --- mosml-2.01/config/expand.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/expand.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,4 +0,0 @@ -/* expand.h -- replace bytecode with threaded code */ - -realcode_t expandcode(bytecode_t byteprog, int code_size, void * jumptable[]); - diff -Nru mosml-2.01/config/fail.h mosml-2.10.1/config/fail.h --- mosml-2.01/config/fail.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/fail.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,27 +0,0 @@ -#ifndef _fail_ -#define _fail_ - -#include -#include "misc.h" -#include "mlvalues.h" - -struct longjmp_buffer { - jmp_buf buf; -}; - -extern struct longjmp_buffer * external_raise; -extern value exn_bucket; - -EXTERN Noreturn mlraise(value); -EXTERN Noreturn raiseprimitive0(int exnindex); -EXTERN Noreturn raiseprimitive1(int exnindex, value arg); -EXTERN Noreturn raise_with_string(int exnindex, char * msg); -EXTERN Noreturn failwith(char *); -EXTERN Noreturn invalid_argument(char *); -EXTERN Noreturn raise_overflow(void); -EXTERN Noreturn raise_out_of_memory(void); -extern volatile int float_exn; - -extern double maxdouble; - -#endif /* _fail_ */ diff -Nru mosml-2.01/config/freelist.h mosml-2.10.1/config/freelist.h --- mosml-2.01/config/freelist.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/freelist.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,16 +0,0 @@ -/* Free lists of heap blocks. */ - -#ifndef _freelist_ -#define _freelist_ - - -#include "misc.h" -#include "mlvalues.h" - -char *fl_allocate (mlsize_t); -void fl_init_merge (void); -char *fl_merge_block (char *); -void fl_add_block (char *); - - -#endif /* _freelist_ */ diff -Nru mosml-2.01/config/gc_ctrl.h mosml-2.10.1/config/gc_ctrl.h --- mosml-2.01/config/gc_ctrl.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/gc_ctrl.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,17 +0,0 @@ -#ifndef _gc_ctrl_ -#define _gc_ctrl_ - -#include "misc.h" - -extern long - stat_minor_words, - stat_promoted_words, - stat_major_words, - stat_minor_collections, - stat_major_collections, - stat_heap_size; - -void init_gc (long, long, int, int); - - -#endif /* _gc_ctrl_ */ diff -Nru mosml-2.01/config/gc.h mosml-2.10.1/config/gc.h --- mosml-2.01/config/gc.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/gc.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,42 +0,0 @@ -#ifndef _gc_ -#define _gc_ - - -#include "mlvalues.h" - -/* Defined in [major_gc.c]. */ -extern unsigned free_mem_percent_min, free_mem_percent_max; - -#define White (0 << 8) -#define Gray (1 << 8) -#define Blue (2 << 8) -#define Black (3 << 8) - -#define Color_hd(hd) ((color_t) ((hd) & Black)) -#define Color_hp(hp) Color_hd (Hd_hp (hp)) - -#define Is_white_hd(hd) (Color_hd (hd) == White) -#define Is_gray_hd(hd) (Color_hd (hd) == Gray) -#define Is_blue_hd(hd) (Color_hd (hd) == Blue) -#define Is_black_hd(hd) (Color_hd (hd) == Black) - -#define Whitehd_hd(hd) ((hd) & ~Black) -#define Grayhd_hd(hd) (((hd) & ~Black) | Gray) -#define Blackhd_hd(hd) ((hd) | Black) -#define Bluehd_hd(hd) (((hd) & ~Black) | Blue) - -/* This depends on the layout of the header. See [mlvalues.h]. */ -#define Make_header(wosize, tag, color) \ - ((header_t) (((header_t) (wosize) << 10) \ - + (color) \ - + (tag_t) (tag))) - -#define Color_val(val) (Color_hd (Hd_val (val))) - -#define Is_white_val(val) (Color_val(val) == White) -#define Is_gray_val(val) (Color_val(val) == Gray) -#define Is_blue_val(val) (Color_val(val) == Blue) -#define Is_black_val(val) (Color_val(val) == Black) - - -#endif /* _gc_ */ diff -Nru mosml-2.01/config/globals.h mosml-2.10.1/config/globals.h --- mosml-2.01/config/globals.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/globals.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,60 +0,0 @@ -/* ML global variables reachable from C. */ - -#ifndef _globals_ -#define _globals_ - - -#include "mlvalues.h" - -extern value global_data; - -#define GLOBAL_DATA 0 /* "meta","global_data" */ -#define SYS__S_IRUSR 1 /* "sys","s_irusr" */ -#define SYS__S_IWUSR 2 /* "sys","s_iwusr" */ -#define SYS__S_IXUSR 3 /* "sys","s_ixusr" */ -#define SYS__S_IRGRP 4 /* "sys","s_irgrp" */ -#define SYS__S_IWGRP 5 /* "sys","s_iwgrp" */ -#define SYS__S_IXGRP 6 /* "sys","s_ixgrp" */ -#define SYS__S_IROTH 7 /* "sys","s_iroth" */ -#define SYS__S_IWOTH 8 /* "sys","s_iwoth" */ -#define SYS__S_IXOTH 9 /* "sys","s_ixoth" */ -#define SYS__S_ISUID 10 /* "sys","s_isuid" */ -#define SYS__S_ISGID 11 /* "sys","s_isgid" */ -#define SYS__S_IRALL 12 /* "sys","s_irall" */ -#define SYS__S_IWALL 13 /* "sys","s_iwall" */ -#define SYS__S_IXALL 14 /* "sys","s_ixall" */ -#define SYS__COMMAND_LINE 15 /* "sys","command_line" */ -#define SYS__INTERACTIVE 16 /* "sys","interactive" */ -#define SYS__MAX_STRING_LENGTH 17 /* "sys","max_string_length" */ -#define SYS__MAX_VECT_LENGTH 18 /* "sys","max_vect_length" */ - -/* Exn indexes names for pervasive dynamic exceptions. The - corresponding exn names (string refs) are allocated by sys_init */ - -#define SYS__EXN_MEMORY 19 /* "sys","exn_memory" */ -#define SYS__EXN_ARGUMENT 20 /* "sys","exn_argument" */ -#define SYS__EXN_GRAPHIC 21 /* "sys","exn_graphic" */ -#define SYS__EXN_SYSERR 22 /* "sys","exn_syserr" */ -#define SYS__EXN_FAIL 23 /* "sys","exn_fail" */ -#define SYS__EXN_SIZE 24 /* "sys","exn_size" */ -#define SYS__EXN_INTERRUPT 25 /* "sys","exn_interrupt" */ -#define SYS__EXN_SUBSCRIPT 26 /* "sys","exn_subscript" */ -#define SYS__EXN_CHR 27 /* "sys","exn_chr" */ -#define SYS__EXN_DIV 28 /* "sys","exn_div" */ -#define SYS__EXN_DOMAIN 29 /* "sys","exn_domain" */ -#define SYS__EXN_ORD 30 /* "sys","exn_ord" */ -#define SYS__EXN_OVERFLOW 31 /* "sys","exn_overflow" */ -#define SYS__EXN_BIND 32 /* "sys","exn_bind" */ -#define SYS__EXN_MATCH 33 /* "sys","exn_match" */ -#define SYS__EXN_IO 34 /* "sys","exn_io" */ - -/* Frequently used exception values (NOT exn indexes); alloc by sys_init */ - -#define EXN_INTERRUPT 35 /* "sys","val_exn_interrupt" */ -#define EXN_DIV 36 /* "sys","val_exn_div" */ -#define EXN_OVERFLOW 37 /* "sys","val_exn_overflow" */ - -#define SYS__FIRST_EXN 19 -#define SYS__LAST_EXN 34 - -#endif /* _globals_ */ diff -Nru mosml-2.01/config/instruct.h mosml-2.10.1/config/instruct.h --- mosml-2.01/config/instruct.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/instruct.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,215 +0,0 @@ -/* The instruction set. */ - -/* --- The instruction set has been extended for Moscow ML! --- */ - -/* One instruction per line only. */ - -enum instructions { - CONSTBYTE, - CONSTSHORT, - SWITCH, - BRANCH, - BRANCHIF, - BRANCHIFNOT, - POPBRANCHIFNOT, - BRANCHIFNEQTAG, - BRANCHIFEQ, - BRANCHIFNEQ, - BRANCHIFLT, - BRANCHIFGT, - BRANCHIFLE, - BRANCHIFGE, - BRANCHINTERVAL, - C_CALL1, - C_CALL2, - C_CALL3, - C_CALL4, - C_CALL5, - C_CALLN, - MAKEBLOCK, - MAKEBLOCK1, - MAKEBLOCK2, - MAKEBLOCK3, - MAKEBLOCK4, - TAGOF, - ACCESS, - ACC0, - ACC1, - ACC2, - ACC3, - ACC4, - ACC5, - ACC6, - ACC7, - PUSHACC, - PUSHACC0, - PUSHACC1, - PUSHACC2, - PUSHACC3, - PUSHACC4, - PUSHACC5, - PUSHACC6, - PUSHACC7, - ENVACC, - ENV1, - ENV2, - ENV3, - ENV4, - ENV5, - ENV6, - ENV7, - PUSHENVACC, - PUSHENV1, - PUSHENV2, - PUSHENV3, - PUSHENV4, - PUSHENV5, - PUSHENV6, - PUSHENV7, - PUSH_ENV1_APPLY1, - PUSH_ENV1_APPLY2, - PUSH_ENV1_APPLY3, - PUSH_ENV1_APPLY4, - PUSH_ENV1_APPTERM1, - PUSH_ENV1_APPTERM2, - PUSH_ENV1_APPTERM3, - PUSH_ENV1_APPTERM4, - PUSHATOM, - ATOM, - PUSHATOM0, - ATOM0, - ATOM1, - ATOM2, - ATOM3, - ATOM4, - ATOM5, - ATOM6, - ATOM7, - ATOM8, - ATOM9, - CONSTINT, - PUSHCONSTINT, - CONST0, - CONST1, - CONST2, - CONST3, - PUSHCONST0, - PUSHCONST1, - PUSHCONST2, - PUSHCONST3, - GETFIELD, - GETFIELD0, - GETFIELD1, - GETFIELD2, - GETFIELD3, - GETFIELD0_0, - GETFIELD0_1, - GETFIELD1_0, - GETFIELD1_1, - SETFIELD, - SETFIELD0, - SETFIELD1, - SETFIELD2, - SETFIELD3, - GETGLOBAL, - PUSH_GETGLOBAL, - PUSH_GETGLOBAL_APPLY1, - PUSH_GETGLOBAL_APPLY2, - PUSH_GETGLOBAL_APPLY3, - PUSH_GETGLOBAL_APPLY4, - PUSH_GETGLOBAL_APPTERM1, - PUSH_GETGLOBAL_APPTERM2, - PUSH_GETGLOBAL_APPTERM3, - PUSH_GETGLOBAL_APPTERM4, - SETGLOBAL, - PUSH_RETADDR, - APPLY, - APPLY1, - APPLY2, - APPLY3, - APPLY4, - APPTERM, - APPTERM1, - APPTERM2, - APPTERM3, - APPTERM4, - RESTART, - GRAB, - RETURN1, - RETURN2, - RETURN, - CLOSURE, - CLOSREC, - DUMMY, - UPDATE, - PUSHTRAP, - RAISE, - POPTRAP, - SWAP, - PUSH, - POP, - ASSIGN, - BOOLNOT, - ADDINT, - SUBINT, - MULINT, - DIVINT, - MODINT, - ANDINT, - ORINT, - XORINT, - SHIFTLEFTINT, - SHIFTRIGHTINTSIGNED, - SHIFTRIGHTINTUNSIGNED, - EQ, - NEQ, - LTINT, - GTINT, - LEINT, - GEINT, - FLOATOFINT, - SMLNEGFLOAT, - SMLADDFLOAT, - SMLSUBFLOAT, - SMLMULFLOAT, - SMLDIVFLOAT, - INTOFFLOAT, - EQFLOAT, - NEQFLOAT, - LTFLOAT, - GTFLOAT, - LEFLOAT, - GEFLOAT, - STRINGLENGTH, - GETSTRINGCHAR, - SETSTRINGCHAR, - EQSTRING, - NEQSTRING, - LTSTRING, - GTSTRING, - LESTRING, - GESTRING, - MAKEVECTOR, - VECTLENGTH, - GETVECTITEM, - SETVECTITEM, - SMLNEGINT, - SMLSUCCINT, - SMLPREDINT, - SMLADDINT, - SMLSUBINT, - SMLMULINT, - SMLDIVINT, - SMLMODINT, - MAKEREFVECTOR, - SMLQUOTINT, - SMLREMINT, - CHECK_SIGNALS, - STOP, - EQUNSIGN, - NEQUNSIGN, - LTUNSIGN, - GTUNSIGN, - LEUNSIGN, - GEUNSIGN -}; diff -Nru mosml-2.01/config/interp.h mosml-2.10.1/config/interp.h --- mosml-2.01/config/interp.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/interp.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -#include "mlvalues.h" - -EXTERN value interprete(int mode, bytecode_t bprog, int code_size, CODE* rprog); -EXTERN value callback(value closure, value arg); -EXTERN value callback2(value closure, value arg1, value arg2); -EXTERN value callback3(value closure, value arg1, value arg2, value arg3); diff -Nru mosml-2.01/config/intext.h mosml-2.10.1/config/intext.h --- mosml-2.01/config/intext.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/intext.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,96 +0,0 @@ -/* Structured input/output */ - -#ifndef __intext__ -#define __intext__ - -#include "misc.h" -#include "mlvalues.h" -#include "io.h" - -/* Magic numbers used to discriminate between the extern formats */ - -#define Base_magic_number 0x8495A6B9 -#define Big_endian_32_magic_number Base_magic_number -#define Little_endian_32_magic_number (Base_magic_number + 1) -#define Big_endian_64_magic_number (Base_magic_number + 2) -#define Little_endian_64_magic_number (Base_magic_number + 3) -#define Compact_magic_number (Base_magic_number + 4) -#define First_valid_magic_number Base_magic_number -#define Last_valid_magic_number (Base_magic_number + 4) - -#ifdef SIXTYFOUR -# ifdef MOSML_BIG_ENDIAN -# define Extern_magic_number Big_endian_64_magic_number -# else -# define Extern_magic_number Little_endian_64_magic_number -# endif -#else -# ifdef MOSML_BIG_ENDIAN -# define Extern_magic_number Big_endian_32_magic_number -# else -# define Extern_magic_number Little_endian_32_magic_number -# endif -#endif - -/* Codes for the compact format */ - -#define PREFIX_SMALL_BLOCK 0x80 -#define PREFIX_SMALL_INT 0x40 -#define PREFIX_SMALL_STRING 0x20 -#define CODE_INT8 0x0 -#define CODE_INT16 0x1 -#define CODE_INT32 0x2 -#define CODE_INT64 0x3 -#define CODE_SHARED8 0x4 -#define CODE_SHARED16 0x5 -#define CODE_SHARED32 0x6 -#define CODE_BLOCK32 0x8 -#define CODE_STRING8 0x9 -#define CODE_STRING32 0xA -#define CODE_DOUBLE 0xB - -/* Initial sizes of data structures for extern */ - -#ifndef INITIAL_EXTERN_SIZE -#define INITIAL_EXTERN_SIZE 4096 -#endif -#ifndef INITIAL_EXTERN_TABLE_SIZE -#define INITIAL_EXTERN_TABLE_SIZE 2039 -#endif - -/* The hashtable of objects already emitted */ - -typedef unsigned long byteoffset_t; - -struct extern_obj { - value obj; - byteoffset_t ofs; -}; - -extern struct extern_obj * extern_table; -extern asize_t extern_table_size, extern_table_used; - -extern byteoffset_t * extern_block; -extern asize_t extern_size, extern_pos; - -#ifdef SIXTYFOUR -#define Hash(v) (((asize_t) ((v) >> 3)) % extern_table_size) -#else -#define Hash(v) (((asize_t) ((v) >> 2)) % extern_table_size) -#endif - -void alloc_extern_table (void); -void resize_extern_table (void); - -/* The entry points */ - -value extern_val (struct channel *, value); -value extern_compact_val (struct channel *, value); -value intern_val (struct channel *); -value intern_compact_val (struct channel *); - -byteoffset_t emit_all(value root); -void adjust_pointers(value * start, mlsize_t size, color_t color); - -#endif - diff -Nru mosml-2.01/config/io.h mosml-2.10.1/config/io.h --- mosml-2.01/config/io.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/io.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,52 +0,0 @@ -/* Buffered input/output */ - -#ifndef _io_ -#define _io_ - - -#include "misc.h" -#include "mlvalues.h" - -#ifndef IO_BUFFER_SIZE -#define IO_BUFFER_SIZE 4096 -#endif - -struct channel { - int fd; /* Unix file descriptor */ - long offset; /* Absolute position of fd in the file */ - char * curr; /* Current position in the buffer */ - char * max; /* Logical end of the buffer */ - char * end; /* Physical end of the buffer */ - char buff[IO_BUFFER_SIZE]; /* The buffer itself */ -}; - -/* For an output channel: - [offset] is the absolute position of the beginning of the buffer [buff]. - For an input channel: - [offset] is the absolute position of the logical end of the buffer [max]. -*/ - -#define putch(channel, ch) \ - { if ((channel)->curr >= (channel)->end) flush(channel); \ - *((channel)->curr)++ = (ch); \ - if ((channel)->curr > (channel)->max) (channel)->max = (channel)->curr; } - -#define getch(channel) \ - ((channel)->curr >= (channel)->max \ - ? refill(channel) \ - : (unsigned char) *((channel))->curr++) - -struct channel * open_descr (int); -value flush (struct channel *); -void putword (struct channel *, uint32); -void putblock (struct channel *, char *, unsigned); -unsigned char refill (struct channel *); -uint32 getword (struct channel *); -int getblock (struct channel *, char *, unsigned, int); -int really_getblock (struct channel *, char *, unsigned long); -value close_in (struct channel *); -void close_stdouterr(void); -void flush_stdouterr(void); -value pos_out(struct channel * channel); -value seek_out(struct channel * channel, value pos); -#endif /* _io_ */ diff -Nru mosml-2.01/config/jumptbl.h mosml-2.10.1/config/jumptbl.h --- mosml-2.01/config/jumptbl.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/jumptbl.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,256 +0,0 @@ - &&lbl_CONSTBYTE, - &&lbl_CONSTSHORT, - &&lbl_SWITCH, - &&lbl_BRANCH, - &&lbl_BRANCHIF, - &&lbl_BRANCHIFNOT, - &&lbl_POPBRANCHIFNOT, - &&lbl_BRANCHIFNEQTAG, - &&lbl_BRANCHIFEQ, - &&lbl_BRANCHIFNEQ, - &&lbl_BRANCHIFLT, - &&lbl_BRANCHIFGT, - &&lbl_BRANCHIFLE, - &&lbl_BRANCHIFGE, - &&lbl_BRANCHINTERVAL, - &&lbl_C_CALL1, - &&lbl_C_CALL2, - &&lbl_C_CALL3, - &&lbl_C_CALL4, - &&lbl_C_CALL5, - &&lbl_C_CALLN, - &&lbl_MAKEBLOCK, - &&lbl_MAKEBLOCK1, - &&lbl_MAKEBLOCK2, - &&lbl_MAKEBLOCK3, - &&lbl_MAKEBLOCK4, - &&lbl_TAGOF, - &&lbl_ACCESS, - &&lbl_ACC0, - &&lbl_ACC1, - &&lbl_ACC2, - &&lbl_ACC3, - &&lbl_ACC4, - &&lbl_ACC5, - &&lbl_ACC6, - &&lbl_ACC7, - &&lbl_PUSHACC, - &&lbl_PUSHACC0, - &&lbl_PUSHACC1, - &&lbl_PUSHACC2, - &&lbl_PUSHACC3, - &&lbl_PUSHACC4, - &&lbl_PUSHACC5, - &&lbl_PUSHACC6, - &&lbl_PUSHACC7, - &&lbl_ENVACC, - &&lbl_ENV1, - &&lbl_ENV2, - &&lbl_ENV3, - &&lbl_ENV4, - &&lbl_ENV5, - &&lbl_ENV6, - &&lbl_ENV7, - &&lbl_PUSHENVACC, - &&lbl_PUSHENV1, - &&lbl_PUSHENV2, - &&lbl_PUSHENV3, - &&lbl_PUSHENV4, - &&lbl_PUSHENV5, - &&lbl_PUSHENV6, - &&lbl_PUSHENV7, - &&lbl_PUSH_ENV1_APPLY1, - &&lbl_PUSH_ENV1_APPLY2, - &&lbl_PUSH_ENV1_APPLY3, - &&lbl_PUSH_ENV1_APPLY4, - &&lbl_PUSH_ENV1_APPTERM1, - &&lbl_PUSH_ENV1_APPTERM2, - &&lbl_PUSH_ENV1_APPTERM3, - &&lbl_PUSH_ENV1_APPTERM4, - &&lbl_PUSHATOM, - &&lbl_ATOM, - &&lbl_PUSHATOM0, - &&lbl_ATOM0, - &&lbl_ATOM1, - &&lbl_ATOM2, - &&lbl_ATOM3, - &&lbl_ATOM4, - &&lbl_ATOM5, - &&lbl_ATOM6, - &&lbl_ATOM7, - &&lbl_ATOM8, - &&lbl_ATOM9, - &&lbl_CONSTINT, - &&lbl_PUSHCONSTINT, - &&lbl_CONST0, - &&lbl_CONST1, - &&lbl_CONST2, - &&lbl_CONST3, - &&lbl_PUSHCONST0, - &&lbl_PUSHCONST1, - &&lbl_PUSHCONST2, - &&lbl_PUSHCONST3, - &&lbl_GETFIELD, - &&lbl_GETFIELD0, - &&lbl_GETFIELD1, - &&lbl_GETFIELD2, - &&lbl_GETFIELD3, - &&lbl_GETFIELD0_0, - &&lbl_GETFIELD0_1, - &&lbl_GETFIELD1_0, - &&lbl_GETFIELD1_1, - &&lbl_SETFIELD, - &&lbl_SETFIELD0, - &&lbl_SETFIELD1, - &&lbl_SETFIELD2, - &&lbl_SETFIELD3, - &&lbl_GETGLOBAL, - &&lbl_PUSH_GETGLOBAL, - &&lbl_PUSH_GETGLOBAL_APPLY1, - &&lbl_PUSH_GETGLOBAL_APPLY2, - &&lbl_PUSH_GETGLOBAL_APPLY3, - &&lbl_PUSH_GETGLOBAL_APPLY4, - &&lbl_PUSH_GETGLOBAL_APPTERM1, - &&lbl_PUSH_GETGLOBAL_APPTERM2, - &&lbl_PUSH_GETGLOBAL_APPTERM3, - &&lbl_PUSH_GETGLOBAL_APPTERM4, - &&lbl_SETGLOBAL, - &&lbl_PUSH_RETADDR, - &&lbl_APPLY, - &&lbl_APPLY1, - &&lbl_APPLY2, - &&lbl_APPLY3, - &&lbl_APPLY4, - &&lbl_APPTERM, - &&lbl_APPTERM1, - &&lbl_APPTERM2, - &&lbl_APPTERM3, - &&lbl_APPTERM4, - &&lbl_RESTART, - &&lbl_GRAB, - &&lbl_RETURN1, - &&lbl_RETURN2, - &&lbl_RETURN, - &&lbl_CLOSURE, - &&lbl_CLOSREC, - &&lbl_DUMMY, - &&lbl_UPDATE, - &&lbl_PUSHTRAP, - &&lbl_RAISE, - &&lbl_POPTRAP, - &&lbl_SWAP, - &&lbl_PUSH, - &&lbl_POP, - &&lbl_ASSIGN, - &&lbl_BOOLNOT, - &&lbl_ADDINT, - &&lbl_SUBINT, - &&lbl_MULINT, - &&lbl_DIVINT, - &&lbl_MODINT, - &&lbl_ANDINT, - &&lbl_ORINT, - &&lbl_XORINT, - &&lbl_SHIFTLEFTINT, - &&lbl_SHIFTRIGHTINTSIGNED, - &&lbl_SHIFTRIGHTINTUNSIGNED, - &&lbl_EQ, - &&lbl_NEQ, - &&lbl_LTINT, - &&lbl_GTINT, - &&lbl_LEINT, - &&lbl_GEINT, - &&lbl_FLOATOFINT, - &&lbl_SMLNEGFLOAT, - &&lbl_SMLADDFLOAT, - &&lbl_SMLSUBFLOAT, - &&lbl_SMLMULFLOAT, - &&lbl_SMLDIVFLOAT, - &&lbl_INTOFFLOAT, - &&lbl_EQFLOAT, - &&lbl_NEQFLOAT, - &&lbl_LTFLOAT, - &&lbl_GTFLOAT, - &&lbl_LEFLOAT, - &&lbl_GEFLOAT, - &&lbl_STRINGLENGTH, - &&lbl_GETSTRINGCHAR, - &&lbl_SETSTRINGCHAR, - &&lbl_EQSTRING, - &&lbl_NEQSTRING, - &&lbl_LTSTRING, - &&lbl_GTSTRING, - &&lbl_LESTRING, - &&lbl_GESTRING, - &&lbl_MAKEVECTOR, - &&lbl_VECTLENGTH, - &&lbl_GETVECTITEM, - &&lbl_SETVECTITEM, - &&lbl_SMLNEGINT, - &&lbl_SMLSUCCINT, - &&lbl_SMLPREDINT, - &&lbl_SMLADDINT, - &&lbl_SMLSUBINT, - &&lbl_SMLMULINT, - &&lbl_SMLDIVINT, - &&lbl_SMLMODINT, - &&lbl_MAKEREFVECTOR, - &&lbl_SMLQUOTINT, - &&lbl_SMLREMINT, - &&lbl_CHECK_SIGNALS, - &&lbl_STOP, - &&lbl_EQUNSIGN, - &&lbl_NEQUNSIGN, - &&lbl_LTUNSIGN, - &&lbl_GTUNSIGN, - &&lbl_LEUNSIGN, - &&lbl_GEUNSIGN -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT diff -Nru mosml-2.01/config/major_gc.h mosml-2.10.1/config/major_gc.h --- mosml-2.01/config/major_gc.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/major_gc.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,49 +0,0 @@ -#ifndef _major_gc_ -#define _major_gc_ - - -#include "freelist.h" -#include "misc.h" - -typedef struct { - asize_t size; - char *next; -} heap_chunk_head; - -extern int gc_phase; -extern unsigned long allocated_words; -extern unsigned long extra_heap_memory; - -#define Phase_mark 0 -#define Phase_weak 1 -#define Phase_sweep 2 - -extern char *heap_start; -extern char *heap_end; -extern unsigned long total_heap_size; -extern char *page_table; -extern asize_t page_table_size; -extern char *gc_sweep_hp; - -#define In_heap 1 -#define Not_in_heap 0 -#ifndef SIXTEEN -#define Page(p) (((addr) (p) - (addr) heap_start) >> Page_log) -#define Is_in_heap(p) \ - ((addr)(p) >= (addr)heap_start && (addr)(p) < (addr)heap_end \ - && page_table [Page (p)] == In_heap) -#else -#define Page(p) \ - (((unsigned long)(p) >> (16 + Page_log - 4)) + ((unsigned)(p) >> Page_log)) -#define Is_in_heap(p) (page_table [Page (p)] == In_heap) -#endif - -void init_major_heap (asize_t); -asize_t round_heap_chunk_size (asize_t); -void darken (value); -void major_collection_slice (void); -void major_collection (void); -void finish_major_cycle (void); - - -#endif /* _major_gc_ */ diff -Nru mosml-2.01/config/md5sum.h mosml-2.10.1/config/md5sum.h --- mosml-2.01/config/md5sum.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/md5sum.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -#ifdef __md5sum__ -#define __md5sum__ - -EXTERN value md5sum(value str); - -#endif diff -Nru mosml-2.01/config/memory.h mosml-2.10.1/config/memory.h --- mosml-2.01/config/memory.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/memory.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,82 +0,0 @@ -/* Allocation macros and functions */ - -#ifndef _memory_ -#define _memory_ - - -#include "config.h" -#include "gc.h" -#include "major_gc.h" -#include "minor_gc.h" -#include "misc.h" -#include "mlvalues.h" - -EXTERN value *c_roots_head; - -void init_c_roots (void); -EXTERN value alloc_shr (mlsize_t, tag_t); -void adjust_gc_speed (mlsize_t, mlsize_t); -EXTERN void modify (value *, value); -EXTERN void initialize (value *, value); -EXTERN char * stat_alloc (asize_t); /* Size in bytes. */ -EXTERN void stat_free (char *); -EXTERN char * stat_resize (char *, asize_t); /* Size in bytes. */ - - -#define Alloc_small(result, wosize, tag) { \ - char *_res_ = young_ptr; \ - young_ptr += Bhsize_wosize (wosize); \ - if (young_ptr > young_end){ \ - Setup_for_gc; \ - minor_collection (); \ - Restore_after_gc; \ - _res_ = young_ptr; \ - young_ptr += Bhsize_wosize (wosize); \ - } \ - Hd_hp (_res_) = Make_header ((wosize), (tag), Black); \ - (result) = Val_hp (_res_); \ -} - -/* You must use [Modify] to change a field of an existing shared block, - unless you are sure the value being overwritten is not a shared block and - the value being written is not a young block. */ -/* [Modify] never calls the GC. */ -#define Modify(fp, val) { \ - value _old_ = *(fp); \ - *(fp) = (val); \ - if (Is_in_heap (fp)){ \ - if (gc_phase == Phase_mark) darken (_old_); \ - if (Is_block (val) && Is_young (val) \ - && ! (Is_block (_old_) && Is_young (_old_))){ \ - *ref_table_ptr++ = (fp); \ - if (ref_table_ptr >= ref_table_limit){ \ - Assert (ref_table_ptr == ref_table_limit); \ - realloc_ref_table (); \ - } \ - } \ - } \ -} - -/* [Push_roots] and [Pop_roots] are used for C variables that are GC roots. - * It must contain all values in C local variables at the time the minor GC is - * called. - * Usage: - * At the end of the declarations of your C local variables, add - * [ Push_roots (variable_name, size); ] - * The size is the number of declared roots. They are accessed as - * [ variable_name [0] ... variable_name [size - 1] ]. - * The [variable_name] and the [size] must not be [ _ ]. - * Just before the function return, add a call to [Pop_roots]. - */ - -#define Push_roots(name, size) \ - value name [(size) + 2]; \ - { long _; for (_ = 0; _ < (size); name [_++] = Val_long (0)); } \ - name [(size)] = (value) (size); \ - name [(size) + 1] = (value) c_roots_head; \ - c_roots_head = &(name [(size)]); - -#define Pop_roots() {c_roots_head = (value *) c_roots_head [1]; } - - -#endif /* _memory_ */ diff -Nru mosml-2.01/config/m.h mosml-2.10.1/config/m.h --- mosml-2.01/config/m.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/m.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -#undef MOSML_BIG_ENDIAN -#undef ALIGNMENT diff -Nru mosml-2.01/config/minor_gc.h mosml-2.10.1/config/minor_gc.h --- mosml-2.01/config/minor_gc.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/minor_gc.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,19 +0,0 @@ -#ifndef _minor_gc_ -#define _minor_gc_ - - -#include "misc.h" - -extern char *young_start, *young_ptr, *young_end; -extern value **ref_table_ptr, **ref_table_limit; -extern asize_t minor_heap_size; - -#define Is_young(val) \ - ((addr)(val) > (addr)young_start && (addr)(val) < (addr)young_end) - -extern void set_minor_heap_size (asize_t); -extern void minor_collection (void); -extern void realloc_ref_table (void); - - -#endif /* _minor_gc_ */ diff -Nru mosml-2.01/config/misc.h mosml-2.10.1/config/misc.h --- mosml-2.01/config/misc.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/misc.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,51 +0,0 @@ -/* Miscellaneous macros and variables. */ - -#ifndef _misc_ -#define _misc_ - -#include "config.h" -#if defined(__STDC__) || defined(WIN32) -#include -#endif -#if defined(SIXTEEN) || defined (__MWERKS__) -#include -#include -#endif - -#if defined(__STDC__) || defined(WIN32) -typedef size_t asize_t; -#else -typedef int asize_t; -#endif - -#ifndef NULL -#define NULL 0 -#endif - -#ifdef SIXTEEN -typedef char huge * addr; -#else -typedef char * addr; -#endif - -#if defined(__STDC__) || defined(WIN32) -#define Volatile volatile -#else -#define Volatile -#endif - -#define Noreturn void - -extern int verb_gc; -extern int Volatile something_to_do; -extern int Volatile force_minor_flag; - -void force_minor_gc(void); -void gc_message(char *, unsigned long); -Noreturn fatal_error(char *); -Noreturn fatal_error_arg(char *, char *); -void memmov(char *, char *, unsigned long); -char * aligned_malloc(asize_t, int); - - -#endif /* _misc_ */ diff -Nru mosml-2.01/config/mlvalues.h mosml-2.10.1/config/mlvalues.h --- mosml-2.01/config/mlvalues.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/mlvalues.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,255 +0,0 @@ -#ifndef _mlvalues_ -#define _mlvalues_ - - -#include "config.h" -#include "misc.h" - -/* Definitions - - word: Four bytes on 32 and 16 bit architectures, - eight bytes on 64 bit architectures. - long: A C long integer. - val: The ML representation of something. A long or a block or a pointer - outside the heap. If it is a block, it is the (encoded) address - of an object. If it is a long, it is encoded as well. - object: Something allocated. It always has a header and some - fields or some number of bytes (a multiple of the word size). - field: A word-sized val which is part of an object. - bp: Pointer to the first byte of an object. (a char *) - op: Pointer to the first field of an object. (a value *) - hp: Pointer to the header of an object. (a char *) - int32: Four bytes on all architectures. - - Remark: An object size is always a multiple of the word size, and at least - one word plus the header. - - bosize: Size (in bytes) of the "bytes" part. - wosize: Size (in words) of the "fields" part. - bhsize: Size (in bytes) of the object with its header. - whsize: Size (in words) of the object with its header. - - hd: A header. - tag: The value of the tag field of the header. - color: The value of the color field of the header. - This is for use only by the GC. -*/ - -typedef long value; -typedef unsigned long header_t; -#ifdef SIXTEEN -typedef unsigned int mlsize_t; -#else -typedef unsigned long mlsize_t; -#endif -typedef unsigned int tag_t; /* Actually, an unsigned char */ -typedef unsigned long color_t; -typedef unsigned long mark_t; - -#ifdef SIXTYFOUR -typedef int int32; /* Not portable, but checked by autoconf. */ -typedef unsigned int uint32; /* Seems like a reasonable assumption anyway. */ -#else -typedef long int32; -typedef unsigned long uint32; -#endif - -/* Longs vs blocks. */ -#define Is_long(x) (((x) & 1) == 1) -#define Is_block(x) (((x) & 1) == 0) - -/* Conversion macro names are always of the form "to_from". */ -/* Example: Val_long as in "Val from long" or "Val of long". */ -#define Val_long(x) (((long)(x) << 1) + 1) -#define Long_val(x) ((x) >> 1) -#define Max_long ((long)((1L << (8 * sizeof(value) - 2)) - 1)) -#define Min_long ((long) -(1L << (8 * sizeof(value) - 2))) -#define Val_int Val_long -#define Int_val(x) ((int) Long_val(x)) - -/* Structure of the header: - -For 16-bit and 32-bit architectures: - +--------+-------+-----+ - | wosize | color | tag | - +--------+-------+-----+ -bits 31 10 9 8 7 0 - -For 64-bit architectures: - - +--------+-------+-----+ - | wosize | color | tag | - +--------+-------+-----+ -bits 63 10 9 8 7 0 - -*/ - -#define Tag_hd(hd) ((tag_t) ((hd) & 0xFF)) -#define Wosize_hd(hd) ((mlsize_t) ((hd) >> 10)) - -#define Hd_val(val) (((header_t *) (val)) [-1]) /* Also an l-value. */ -#define Hd_op(op) (Hd_val (op)) /* Also an l-value. */ -#define Hd_bp(bp) (Hd_val (bp)) /* Also an l-value. */ -#define Hd_hp(hp) (* ((header_t *) (hp))) /* Also an l-value. */ -#define Hp_val(val) ((char *) (((header_t *) (val)) - 1)) -#define Hp_op(op) (Hp_val (op)) -#define Hp_bp(bp) (Hp_val (bp)) -#define Val_op(op) ((value) (op)) -#define Val_hp(hp) ((value) (((header_t *) (hp)) + 1)) -#define Op_hp(hp) ((value *) Val_hp (hp)) -#define Bp_hp(hp) ((char *) Val_hp (hp)) - -#define Num_tags (1 << 8) -#ifdef SIXTYFOUR -#define Max_wosize ((1L << 54) - 1) -#else -#ifdef SIXTEEN -#define Max_wosize ((1 << 14) - 1) -#else -#define Max_wosize ((1 << 22) - 1) -#endif -#endif - -#define Wosize_val(val) (Wosize_hd (Hd_val (val))) -#define Wosize_op(op) (Wosize_val (op)) -#define Wosize_bp(bp) (Wosize_val (bp)) -#define Wosize_hp(hp) (Wosize_hd (Hd_hp (hp))) -#define Whsize_wosize(sz) ((sz) + 1) -#define Wosize_whsize(sz) ((sz) - 1) -#define Wosize_bhsize(sz) ((sz) / sizeof (value) - 1) -#define Bsize_wsize(sz) ((sz) * sizeof (value)) -#define Wsize_bsize(sz) ((sz) / sizeof (value)) -#define Bhsize_wosize(sz) (Bsize_wsize (Whsize_wosize (sz))) -#define Bhsize_bosize(sz) ((sz) + sizeof (header_t)) -#define Bosize_val(val) (Bsize_wsize (Wosize_val (val))) -#define Bosize_op(op) (Bosize_val (Val_op (op))) -#define Bosize_bp(bp) (Bosize_val (Val_bp (bp))) -#define Bosize_hd(hd) (Bsize_wsize (Wosize_hd (hd))) -#define Whsize_hp(hp) (Whsize_wosize (Wosize_hp (hp))) -#define Whsize_val(val) (Whsize_hp (Hp_val (val))) -#define Whsize_bp(bp) (Whsize_val (Val_bp (bp))) -#define Whsize_hd(hd) (Whsize_wosize (Wosize_hd (hd))) -#define Bhsize_hp(hp) (Bsize_wsize (Whsize_hp (hp))) -#define Bhsize_hd(hd) (Bsize_wsize (Whsize_hd (hd))) - -#ifdef MOSML_BIG_ENDIAN -#define Tag_val(val) (((unsigned char *) (val)) [-1]) - /* Also an l-value. */ -#define Tag_hp(hp) (((unsigned char *) (hp)) [sizeof(value)-1]) - /* Also an l-value. */ -#else -#define Tag_val(val) (((unsigned char *) (val)) [-sizeof(value)]) - /* Also an l-value. */ -#define Tag_hp(hp) (((unsigned char *) (hp)) [0]) - /* Also an l-value. */ -#endif - -/* The tag values MUST AGREE with compiler/Config.mlp: */ - -/* The Lowest tag for blocks containing no value. */ -#define No_scan_tag (Num_tags - 5) - - -/* 1- If tag < No_scan_tag : a tuple of fields. */ - -/* Pointer to the first field. */ -#define Op_val(x) ((value *) (x)) -/* Fields are numbered from 0. */ -#define Field(x, i) (((value *)(x)) [i]) /* Also an l-value. */ - -/* A sequence of bytecodes */ -typedef unsigned char * bytecode_t; - -/* A sequence of real machine instruction addresses */ -typedef void ** realcode_t; - -/* GCC 2.0 has labels as first-class values. We take advantage of that - to provide faster dispatch than the "switch" statement. */ - -#if defined(__GNUC__) && __GNUC__ >= 2 && !defined(DEBUG) -#define DIRECT_JUMP -#endif - -#if defined(DIRECT_JUMP) && defined(THREADED) -#define CODE realcode_t -#else -#define CODE bytecode_t -#endif - -#define Closure_wosize 2 -#define Closure_tag (No_scan_tag - 2) -#define Code_val(val) (((CODE *) (val)) [0]) /* Also an l-value. */ -#define Env_val(val) (Field(val, 1)) /* Also an l-value. */ - -/* --- Reference cells are used in Moscow SML --- */ - -#define Reference_tag (No_scan_tag - 1) - -/* --- --- */ - - -/* 2- If tag >= No_scan_tag : a sequence of bytes. */ - -/* Pointer to the first byte */ -#define Bp_val(v) ((char *) (v)) -#define Val_bp(p) ((value) (p)) -/* Bytes are numbered from 0. */ -#define Byte(x, i) (((char *) (x)) [i]) /* Also an l-value. */ -#define Byte_u(x, i) (((unsigned char *) (x)) [i]) /* Also an l-value. */ - -/* Arrays of weak pointers. Just like abstract things, but the GC will - reset each cell (during the weak phase, between marking and sweeping) - as the pointed-to object gets deallocated. -*/ -#define Weak_tag No_scan_tag - -/* Abstract things. Their contents is not traced by the GC; therefore they - must not contain any [value]. -*/ -#define Abstract_tag (No_scan_tag + 1) - -/* Strings. */ -#define String_tag (No_scan_tag + 2) -#define String_val(x) ((char *) Bp_val(x)) - -/* Floating-point numbers. */ -#define Double_tag (No_scan_tag + 3) -#define Double_wosize ((sizeof(double) / sizeof(value))) -#ifndef ALIGN_DOUBLE -#define Double_val(v) (* (double *) (v)) -#else -EXTERN double Double_val (value); -#endif -void Store_double_val (value,double); - -/* Finalized things. Just like abstract things, but the GC will call the - [Final_fun] before deallocation. -*/ -#define Final_tag (No_scan_tag + 4) -typedef void (*final_fun) (value); -#define Final_fun(val) (((final_fun *) (val)) [0]) /* Also an l-value. */ - - -/* 3- Atoms are 0-tuples. They are statically allocated once and for all. */ - -EXTERN header_t first_atoms[]; -#define Atom(tag) (Val_hp (&(first_atoms [tag]))) -#define Is_atom(v) (v >= Atom(0) && v <= Atom(255)) - -/* Booleans are atoms tagged 0 or 1 */ - -#define Val_bool(x) Atom((x) != 0) -#define Bool_val(x) Tag_val(x) -#define Val_false Atom(0) -#define Val_true Atom(1) - -/* The unit value is the atom tagged 0 */ - -#define Val_unit Atom(0) - -/* SML option values: Must match compiler/Types.sml: */ - -#define NONE Atom(0) -#define SOMEtag (1) - -#endif /* _mlvalues_ */ diff -Nru mosml-2.01/config/mosml.h mosml-2.10.1/config/mosml.h --- mosml-2.01/config/mosml.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/mosml.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,8 +0,0 @@ -#ifndef _mosml_ -#define _mosml_ - -#include "mlvalues.h" - -char* exnmessage_aux(value); - -#endif /* _mosml_ */ diff -Nru mosml-2.01/config/prims.h mosml-2.10.1/config/prims.h --- mosml-2.01/config/prims.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/prims.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,11 +0,0 @@ -/* Interface with C primitives. */ - -#ifndef _prims_ -#define _prims_ - -typedef value (*c_primitive)(); - -extern c_primitive cprim[]; -extern char * names_of_cprim[]; - -#endif /* _prims_ */ diff -Nru mosml-2.01/config/reverse.h mosml-2.10.1/config/reverse.h --- mosml-2.01/config/reverse.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/reverse.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,54 +0,0 @@ -/* Swap byte-order in 16-bit, 32-bit and 64-bit words */ - -#ifndef _reverse_ -#define _reverse_ - - -#define Reverse_short(s) { \ - char * _p; \ - int _a; \ - _p = (char *) (s); \ - _a = _p[0]; \ - _p[0] = _p[1]; \ - _p[1] = _a; \ -} - -#define Reverse_int32(w) { \ - char * _p; \ - int _a; \ - _p = (char *) (w); \ - _a = _p[0]; \ - _p[0] = _p[3]; \ - _p[3] = _a; \ - _a = _p[1]; \ - _p[1] = _p[2]; \ - _p[2] = _a; \ -} - -#define Reverse_int64(d) { \ - char * _p; \ - int _a; \ - _p = (char *) (d); \ - _a = _p[0]; \ - _p[0] = _p[7]; \ - _p[7] = _a; \ - _a = _p[1]; \ - _p[1] = _p[6]; \ - _p[6] = _a; \ - _a = _p[2]; \ - _p[2] = _p[5]; \ - _p[5] = _a; \ - _a = _p[3]; \ - _p[3] = _p[4]; \ - _p[4] = _a; \ -} - -#ifdef SIXTYFOUR -#define Reverse_word Reverse_int64 -#else -#define Reverse_word Reverse_int32 -#endif - -#define Reverse_double Reverse_int64 - -#endif /* _reverse_ */ diff -Nru mosml-2.01/config/roots.h mosml-2.10.1/config/roots.h --- mosml-2.01/config/roots.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/roots.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,9 +0,0 @@ -#ifndef _roots_ -#define _roots_ - -#include "misc.h" - -void local_roots (void (*copy_fn) (value *, value)); - - -#endif /* _roots_ */ diff -Nru mosml-2.01/config/runtime.h mosml-2.10.1/config/runtime.h --- mosml-2.01/config/runtime.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/runtime.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,30 +0,0 @@ -/* runtime.h */ - -#ifdef macintosh - -/* 23Nov93 e */ -/* 16Mar94 e */ - -void init_timers(void); -void beg_runtime(int); -void acc_runtime(int); - -#define beg_gc_time() beg_runtime(1) -#define end_gc_time() acc_runtime(1) - -#define beg_mf_time() beg_runtime(2) -#define end_mf_time() acc_runtime(2) - -#else - -void beg_gc_time(); -void end_gc_time(); - -struct mosml_timeval { - long tv_sec; /* seconds */ - long tv_usec; /* microseconds */ -}; - -extern struct mosml_timeval gc_time; - -#endif diff -Nru mosml-2.01/config/s.h mosml-2.10.1/config/s.h --- mosml-2.01/config/s.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/s.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,24 +0,0 @@ -#define HAS_MEMMOVE -#define HAS_BCOPY -#define HAS__SETJMP -#define sighandler_return_type void -#define BSD_SIGNALS -#define HAS_RENAME -#define HAS_STRERROR -#define HAS_SOCKETS -#define HAS_UNISTD -#define HAS_DIRENT -#define HAS_LOCKF -#define HAS_MKFIFO -#define HAS_GETPRIORITY -#define HAS_UTIME -#define HAS_UTIMES -#define HAS_DUP2 -#define HAS_FCHMOD -#define HAS_TRUNCATE -#define HAS_SELECT -#define HAS_SYMLINK -#define HAS_WAIT3 -#define HAS_WAITPID -#define HAS_GETGROUPS -#define HAS_TERMIOS diff -Nru mosml-2.01/config/signals.h mosml-2.10.1/config/signals.h --- mosml-2.01/config/signals.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/signals.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,26 +0,0 @@ -#ifndef _signals_ -#define _signals_ - -#include "misc.h" - -#if defined(__STDC__) || defined(WIN32) - -extern volatile int signal_is_pending; -extern volatile CODE signal_handler; -extern volatile int signal_number; -extern int in_blocking_section; - -#else - -extern int signal_is_pending; -extern CODE signal_handler; -extern int signal_number; -extern int in_blocking_section; - -#endif - -void execute_signal (void); -EXTERN void enter_blocking_section (void); -EXTERN void leave_blocking_section (void); -extern CODE raise_break_exn; -#endif /* _signals_ */ diff -Nru mosml-2.01/config/stacks.h mosml-2.10.1/config/stacks.h --- mosml-2.01/config/stacks.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/stacks.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,27 +0,0 @@ -/* structure of the stacks */ - -#ifndef _stacks_ -#define _stacks_ - - -#include "misc.h" -#include "mlvalues.h" -#include "memory.h" - -extern value * stack_low; -extern value * stack_high; -extern value * stack_threshold; -extern value * extern_sp; -extern value * trapsp; - -extern value global_data; - -#define Trap_pc(tp) (((CODE *)(tp))[0]) -#define Trap_link(tp) (((value **)(tp))[1]) - -void reset_roots (void); -void init_stack (void); -void realloc_stack (void); - - -#endif /* _stacks_ */ diff -Nru mosml-2.01/config/str.h mosml-2.10.1/config/str.h --- mosml-2.01/config/str.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/str.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,11 +0,0 @@ -#ifndef _str_ -#define _str_ - - -#include "misc.h" - -EXTERN mlsize_t string_length (value); -EXTERN value compare_strings (value, value); - - -#endif /* _str_ */ diff -Nru mosml-2.01/config/sys.h mosml-2.10.1/config/sys.h --- mosml-2.01/config/sys.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/sys.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,11 +0,0 @@ -#ifndef _sys_ -#define _sys_ - -#include "misc.h" - -void sys_error (char *); -void raise_pending_signal (void); -void sys_init (char **); -void sys_exit (value); - -#endif /* _sys_ */ diff -Nru mosml-2.01/config/unalignd.h mosml-2.10.1/config/unalignd.h --- mosml-2.01/config/unalignd.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/unalignd.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,31 +0,0 @@ -/* To read 16 bit and 32 bit words when they are not aligned */ - -#ifndef _unaligned_ -#define _unaligned_ - - -#ifdef ALIGNMENT - -#define s16(p) (int) ((((schar *) (p))[1] << 8) + ((unsigned char *) (p))[0]) -#define u16(p) (unsigned int) ((((unsigned char *) (p))[1] << 8) \ - + ((unsigned char *) (p))[0]) -#define s32(p) (int32) ((((schar *) (p))[3] << 24) \ - + (((unsigned char *) (p))[2] << 16) \ - + (((unsigned char *) (p))[1] << 8) \ - + ((unsigned char *) (p))[0]) -#define u32(p) (uint32) ((((unsigned char *) (p))[3] << 24) \ - + (((unsigned char *) (p))[2] << 16) \ - + (((unsigned char *) (p))[1] << 8) \ - + ((unsigned char *) (p))[0]) - -#else - -#define s16(p) (* (short *) (p)) -#define u16(p) (* (unsigned short *) (p)) -#define s32(p) (* (int32 *) (p)) -#define u32(p) (* (uint32 *) (p)) - -#endif - - -#endif /* _unaligned_ */ diff -Nru mosml-2.01/config/version.h mosml-2.10.1/config/version.h --- mosml-2.01/config/version.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/config/version.h 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -#define VERSION "0.8e for Moscow ML" diff -Nru mosml-2.01/debian/camlrunm.install mosml-2.10.1/debian/camlrunm.install --- mosml-2.01/debian/camlrunm.install 2014-08-28 10:14:13.000000000 +0000 +++ mosml-2.10.1/debian/camlrunm.install 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -debian/tmp/usr/bin/camlrunm /usr/bin diff -Nru mosml-2.01/debian/changelog mosml-2.10.1/debian/changelog --- mosml-2.01/debian/changelog 2014-08-28 10:14:13.000000000 +0000 +++ mosml-2.10.1/debian/changelog 2014-08-28 08:51:12.000000000 +0000 @@ -1,12 +1,5 @@ -mosml (2.01-0ubuntu2) breezy; urgency=low +mosml (2.10.1-0ubuntu0) trusty; urgency=low - * Corrected the description of the camlrunm binary package - - -- Sebastian Dröge Sat, 1 Oct 2005 18:49:41 +0200 - -mosml (2.01-0ubuntu1) breezy; urgency=low - - * Initial Revision - - -- Sebastian Dröge Sun, 21 Aug 2005 16:12:31 +0200 + * Initial release + -- Ken Friis Larsen Thu, 28 Aug 2014 07:41:21 +0000 diff -Nru mosml-2.01/debian/compat mosml-2.10.1/debian/compat --- mosml-2.01/debian/compat 2014-08-28 10:14:13.000000000 +0000 +++ mosml-2.10.1/debian/compat 2014-08-28 08:50:24.000000000 +0000 @@ -1 +1 @@ -4 +9 diff -Nru mosml-2.01/debian/control mosml-2.10.1/debian/control --- mosml-2.01/debian/control 2014-08-28 10:14:13.000000000 +0000 +++ mosml-2.10.1/debian/control 2014-08-28 08:50:24.000000000 +0000 @@ -1,48 +1,22 @@ Source: mosml -Section: multiverse/devel +Section: devel Priority: optional -Maintainer: Sebastian Dröge -Build-Depends: cdbs (>= 0.4.20), debhelper (>= 4.1.0) -Standards-Version: 3.6.2 +Maintainer: Ken Friis Larsen +Build-Depends: debhelper (>= 9), libgmp-dev +Standards-Version: 3.9.5 +Homepage: http://mosml.org +Vcs-Git: git://github.com/kfl/mosml -Package: mosml -Architecture: any -Section: devel -Depends: ${shlibs:Depends}, camlrunm (= ${Source-Version}) -Description: a light-weight implementation of Standard ML (SML) - Moscow ML is a light-weight implementation of Standard ML (SML), - a strict functional language widely used in teaching and research. - Version 2.01 implements the full SML language, including SML Modules, - and much of the SML Basis Library. - . - http://www.dina.kvl.dk/~sestoft/mosml.html -Package: mosml-doc -Architecture: any -Section: doc -Recommends: mosml (= ${Source-Version}) -Description: a light-weight implementation of Standard ML (SML) (Documentation) - Moscow ML is a light-weight implementation of Standard ML (SML), - a strict functional language widely used in teaching and research. - Version 2.01 implements the full SML language, including SML Modules, - and much of the SML Basis Library. - . - http://www.dina.kvl.dk/~sestoft/mosml.html - . - This package contains the documentation for the mosml library - -Package: camlrunm +Package: mosml Architecture: any -Section: devel -Depends: ${shlibs:Depends} -Description: runtime environment for running Caml Light bytecode - Moscow ML is a light-weight implementation of Standard ML (SML), - a strict functional language widely used in teaching and research. - Version 2.01 implements the full SML language, including SML Modules, - and much of the SML Basis Library. - . - http://www.dina.kvl.dk/~sestoft/mosml.html - . - This package contains the INRIA licensed camlrunm runtime for running - Caml Light bytecode. - +Depends: ${shlibs:Depends}, ${misc:Depends}, libgmp10 +Description: light-weight implementation of Standard ML (SML). + Moscow ML: + * implements the full Standard ML language, as revised 1997, + including Modules and some extensions + * yet is backwards compatible with Moscow ML versions prior to 2.00 + * implements large parts of the new SML Basis Library + * implements separate compilation + * can produce compact stand-alone executables (a la Caml Light) + * supports quotations and antiquotations, useful for metaprogramming diff -Nru mosml-2.01/debian/copyright mosml-2.10.1/debian/copyright --- mosml-2.01/debian/copyright 2014-08-28 10:14:13.000000000 +0000 +++ mosml-2.10.1/debian/copyright 2014-08-28 08:50:24.000000000 +0000 @@ -1,115 +1,48 @@ -This package was debianized by Sebastian Dröge on -Sun, 21 Aug 2005 15:58:31 +0200. - -It was downloaded from http://www.dina.kvl.dk/~sestoft/mosml.html - -Upstream Authors: - -Sergei Romanenko -Peter Sestoft - -Copyright: - -########################################## -for everything not noted explicitly below: -########################################## - - Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000 - Sergei Romanenko, Moscow, Russia and Peter Sestoft, Copenhagen, Denmark - +Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Upstream-Name: mosml +Source: http://mosml.org + +Files: * +Copyright: 1994, 1995, 1996, 1997, 1998, 1999, 2000 Sergei Romanenko, Moscow, Russia and Peter Sestoft, Copenhagen, Denmark + 2000-2014 Peter Sestoft, Claudio Russo, Ken Friis Larsen +License: GPL-2+ This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. - + . This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License in copyrght/gpl2 for more details. + . + You should have received a copy of the GNU General Public License + along with this program. If not, see + . + Note that a number of source files are derived from the Caml Light + distribution, copyright (C) 1993 INRIA, Rocquencourt, France. Thus + charging money for redistributing Moscow ML may require prior + permission from INRIA; see the INRIA copyright notice in file + copyrght/copyrght.cl. The Caml Light system itself can be obtained + from ftp.inria.fr:lang/caml-light. + +# If you want to use GPL v2 or later for the /debian/* files use +# the following clauses, or change it to suit. Delete these two lines +Files: debian/* +Copyright: 2014 Ken Friis Larsen +License: GPL-2+ + This package is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + . + This package is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. - - On Debian systems, the complete text of the GNU General Public - License, version 2, can be found in /usr/share/common-licenses/GPL-2. - -##################################### -for mosml/lib and mosml/src/mosmllib: -##################################### - - Copyright 1993 by AT&T Bell Laboratories - - Permission to use, copy, modify, and distribute this software and its - documentation for any purpose and without fee is hereby granted, - provided that the above copyright notice appear in all copies and that - both the copyright notice and this permission notice and warranty - disclaimer appear in supporting documentation, and that the name of - AT&T Bell Laboratories or any AT&T entity not be used in advertising - or publicity pertaining to distribution of the software without - specific, written prior permission. - - AT&T disclaims all warranties with regard to this software, including - all implied warranties of merchantability and fitness. In no event - shall AT&T be liable for any special, indirect or consequential - damages or any damages whatsoever resulting from loss of use, data or - profits, whether in an action of contract, negligence or other - tortious action, arising out of or in connection with the use or - performance of this software. - -######################################## -for mosml/src/runtime: - -all code under this license is linked -to the camlrunm binary which is shipped -in a separate binary package. It is in -no way linked to GPLed code! -######################################## - - LEGAL NOTICE - - Software: Caml Light, version 0.7 of January 1995, hereinafter - referred to as "the software". - - The software has been designed and produced by Xavier Leroy, - Damien Doligez, Francois Rouaix, Jerome Vouillon and Pierre Weis. - research workers for the Institut National de Recherche en Informatique et - en Automatique (INRIA) - Domaine de Voluceau - Rocquencourt - 78153 Le - Chesnay Cedex - France. - - INRIA holds all ownership rights to Caml Light version 0.7. - - The software has been registered at Agence pour la Protection - des Programmes (APP). - - Preamble: - - The software is currently being developed and INRIA desires - that it be used by the scientific community so as to test, evaluate - and develop it. To this end, INRIA has decided to have a prototype of - the software distributed by FTP. - - a- Extent of the rights granted by the INRIA to the user of the software: - - INRIA freely grants the right to use, modify and integrate the - software in another software, provided that all derivative works are - distributed under the same conditions as the software. - - b- Reproduction of the software: - - INRIA grants any user of the software the right to reproduce it so as - to circulate it in accordance with the same purposes and conditions as - those defined at point a- above. Any copy of the software and/or relevant - documentation must comprise reference to the ownership of INRIA and - the present file. - - The user undertakes not to carry out any paying distribution of the - software. However, he is authorized to bill any person or body for the - cost of reproduction of said software. As regards any other type of - distribution, the user undertakes to apply to obtain the express - approval of INRIA. - - c- Guarantees: - - Please note that the software is a product currently being developed. - INRIA shall not be responsible in any way concerning conformity, and in - particular shall not be liable should the software not comply with the - requirements of the user, INRIA not being obliged to repair any - possible direct or indirect damage. - + . + You should have received a copy of the GNU General Public License + along with this program. If not, see + . + On Debian systems, the complete text of the GNU General + Public License version 2 can be found in "/usr/share/common-licenses/GPL-2". diff -Nru mosml-2.01/debian/docs mosml-2.10.1/debian/docs --- mosml-2.01/debian/docs 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/debian/docs 2014-08-28 09:02:14.000000000 +0000 @@ -0,0 +1 @@ +README diff -Nru mosml-2.01/debian/mosml-doc.install mosml-2.10.1/debian/mosml-doc.install --- mosml-2.01/debian/mosml-doc.install 2014-08-28 10:14:13.000000000 +0000 +++ mosml-2.10.1/debian/mosml-doc.install 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -debian/tmp/usr/share/doc/mosml-doc /usr/share/doc diff -Nru mosml-2.01/debian/mosml.examples mosml-2.10.1/debian/mosml.examples --- mosml-2.01/debian/mosml.examples 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/debian/mosml.examples 2014-08-28 09:24:19.000000000 +0000 @@ -0,0 +1 @@ +examples \ No newline at end of file diff -Nru mosml-2.01/debian/mosml.install mosml-2.10.1/debian/mosml.install --- mosml-2.01/debian/mosml.install 2014-08-28 10:14:13.000000000 +0000 +++ mosml-2.10.1/debian/mosml.install 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -debian/tmp/usr/bin/mosml /usr/bin -debian/tmp/usr/bin/mosmlc /usr/bin -debian/tmp/usr/bin/mosmllex /usr/bin -debian/tmp/usr/bin/mosmlyac /usr/bin -debian/tmp/usr/lib /usr -debian/tmp/usr/share/doc/mosml /usr/share/doc diff -Nru mosml-2.01/debian/mosml-lintian-override mosml-2.10.1/debian/mosml-lintian-override --- mosml-2.01/debian/mosml-lintian-override 2014-08-28 10:14:13.000000000 +0000 +++ mosml-2.10.1/debian/mosml-lintian-override 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -# this is no script but how the header of scripts has to look like -mosml binary: script-not-executable ./usr/lib/mosml/header -mosml binary: unusual-interpreter ./usr/lib/mosml/header #!/usr/bin/camlrunm diff -Nru mosml-2.01/debian/mosml.manpages mosml-2.10.1/debian/mosml.manpages --- mosml-2.01/debian/mosml.manpages 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/debian/mosml.manpages 2014-08-28 08:50:24.000000000 +0000 @@ -0,0 +1,4 @@ +man/mosml.1 +man/mosmlc.1 +man/mosmllex.1 +man/mosmlyac.1 \ No newline at end of file diff -Nru mosml-2.01/debian/patches/01_Makefile.inc.diff mosml-2.10.1/debian/patches/01_Makefile.inc.diff --- mosml-2.01/debian/patches/01_Makefile.inc.diff 2014-08-28 10:14:13.000000000 +0000 +++ mosml-2.10.1/debian/patches/01_Makefile.inc.diff 1970-01-01 00:00:00.000000000 +0000 @@ -1,26 +0,0 @@ ---- mosml/src/Makefile.inc.old 2005-08-21 16:27:42.917430904 +0200 -+++ mosml/src/Makefile.inc 2005-08-21 16:32:52.999291296 +0200 -@@ -2,7 +2,7 @@ - - # Where to install stuff - --MOSMLHOME=${HOME}/mosml -+MOSMLHOME=/usr - - # Various utility programs - INSTALL_PROGRAM=cp -@@ -114,10 +114,10 @@ - # DOCDIR contains documentation - - BINDIR=${MOSMLHOME}/bin --LIBDIR=${MOSMLHOME}/lib --INCDIR=${MOSMLHOME}/include --DOCDIR=${MOSMLHOME}/doc --TOOLDIR=${MOSMLHOME}/tools -+LIBDIR=${MOSMLHOME}/lib/mosml -+INCDIR=${MOSMLHOME}/include/mosml -+DOCDIR=${MOSMLHOME}/share/doc/mosml-doc -+TOOLDIR=${MOSMLHOME}/lib/mosml/tools - # LIBDIR=${MOSMLHOME}/lib/moscow_ml - # TOOLDIR=${MOSMLHOME}/libexec/moscow_ml - diff -Nru mosml-2.01/debian/rules mosml-2.10.1/debian/rules --- mosml-2.01/debian/rules 2014-08-28 10:14:13.000000000 +0000 +++ mosml-2.10.1/debian/rules 2014-08-28 08:50:24.000000000 +0000 @@ -1,31 +1,14 @@ #!/usr/bin/make -f +# -*- makefile -*- -include /usr/share/cdbs/1/rules/debhelper.mk -include /usr/share/cdbs/1/rules/simple-patchsys.mk -include /usr/share/cdbs/1/class/makefile.mk +# Uncomment this to turn on verbose mode. +export DH_VERBOSE=1 -DEB_SRCDIR = $(CURDIR)/src -DEB_MAKE_CLEAN_TARGET := clean -DEB_MAKE_BUILD_TARGET := world -DEB_MAKE_INSTALL_TARGET := MOSMLHOME=$(CURDIR)/debian/tmp/usr install -DEB_MAKE_CHECK_TARGET := +%: + dh $@ -Dsrc -install/mosml:: - # bad symlink - rm -f debian/tmp/usr/lib/mosml/camlrunm - dh_link usr/bin/camlrunm usr/lib/mosml/camlrunm - - # use the correct paths - echo "#!/usr/bin/camlrunm" > debian/tmp/usr/lib/mosml/header - - # remove broken link - rm -f debian/tmp/usr/include/config - - # move README where it belongs - mkdir -p $(CURDIR)/debian/tmp/usr/share/doc/mosml - mv $(CURDIR)/debian/tmp/usr/lib/mosml/README $(CURDIR)/debian/tmp/usr/share/doc/mosml - - # install lintian override - mkdir -p $(CURDIR)/debian/mosml/usr/share/lintian/overrides - install -m 644 $(CURDIR)/debian/mosml-lintian-override $(CURDIR)/debian/mosml/usr/share/lintian/overrides/mosml +override_dh_auto_build: + dh_auto_build -- PREFIX=/usr +override_dh_auto_install: + dh_auto_install -- PREFIX=/usr diff -Nru mosml-2.01/debian/source/format mosml-2.10.1/debian/source/format --- mosml-2.01/debian/source/format 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/debian/source/format 2014-08-28 08:50:24.000000000 +0000 @@ -0,0 +1 @@ +3.0 (quilt) diff -Nru mosml-2.01/doc/bugs mosml-2.10.1/doc/bugs --- mosml-2.01/doc/bugs 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/doc/bugs 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,56 @@ +Known bugs and peculiarities in Moscow ML 1.40 (1 July 1995) + +* Under MS DOS and MS Windows, timezone information is missing. Hence +(Date.fmt "%Z" dt) raises an exception under Windows; and returns +nonsense under DOS. This is a DOS oddity and is unlikely to be fixed. + +* Under MS DOS, floating point operations use a different precision or +rounding mode than under Linux, so 1.0 / ~1E80 <> ~1E~80 under DOS, +but not under Linux. + +* Under MS DOS, the FileSys.readDir family of operations sometimes get +confused if other operations are performed on directory dir between +the initial call to FileSys.openDir "dir" and subsequent +FileSys.readDir operations. Hence one should open, read, and close +the entire directory before performing other file operations on the +same directory. This is a DOS oddity and is unlikely to be fixed. + +* The evaluation order in curried function applications is wrong, +leading to wrong results if the applied function may cause side +effects `between the arguments' of the application (reported by +Carsten Mueller, Berlin). For example, if + + exception Right and Wrong + fun f y = (raise Right; fn x => x) + +then + + f 7 (raise Wrong); + +should raise exception Right, since f is applied to 7 before the +second argument is evaluated, but it raises exception Wrong instead. + +The bug can be circumvented by splitting the application: + + let val f1 = f 7 + in f1 (raise Wrong) end +or + let fun g f1 = f1 (raise Wrong) + in g (f 7) end + +The problem is that, in Moscow ML, the expression + + f e1 ... en + +is evaluated by evaluating all argument expressions e1 ... en from +left to right before f is applied to any of them. Hence if the +function bound to f takes m < n arguments, it gets applied too late. +This causes a problem *only* if evaluation of f causes a side effect, +*and* some of the arguments e(m+1) ... en rely on the state or cause +side effects themselves. + +Since (1) fixing this bug in a straightforward manner would impose a +considerable performance penalty on all curried function applications, +and (2) a programming style exhibiting this bug is pretty rare (it has +not shown up in a real program so far), we have left it in Moscow ML. + diff -Nru mosml-2.01/doc/garbagecollector.txt mosml-2.10.1/doc/garbagecollector.txt --- mosml-2.01/doc/garbagecollector.txt 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/doc/garbagecollector.txt 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,155 @@ +The garbage collector used in Caml Light Peter Sestoft +---------------------------------------- 1994-10-06 + +The Caml Light garbage collector as actually implemented, at least in +version 0.6 and 0.61, is different from that described in (Leroy 1990) +or (Doligez 1989). It is a generational garbage collector which +combines stop-and-copy collection of the young generation with +incremental mark-sweep collection of the old generation, but in +contrast to (Doligez 1989), there is no compaction in the old +generation. + Hence it can use a very large proportion (90 per cent) of the +available memory without undue runtime costs, and it gives good +real-time response, but may suffer from two drawbacks: fragmentation, +and bad locality of reference. The latter is unimportant as long as +virtual memory isn't used, and it may be argued that if virtual memory +is ever used, a considerable runtime overhead is incurred anyway: +waste of memory translates to waste of time. + +A value is an object in the heap (young or old). It has a header with +a given colour (see below). + +The heap is divided into two generations +---------------------------------------- + +1. The young generation. Once allocated, this is a fixed area of +memory between young_start and young_end, plus the reftable which +lists the pointers from the old generation into the new one. + +2. The old generation. This is a linked list of chunks, in order of +increasing memory addresses. Each chunk consists of a chunk header +(giving its length and a pointer to the next chunk) and an integral +number of memory pages of 4 KB each. Chunks are added (by calling +malloc) as necessary, and a page table is used to distinguish memory +pages belonging to a chunk in the old generation from other memory +(such as the young generation, the argument or return stacks, the +reftable, the grayvals, the bytecode, etc.). + + +Allocation +---------- + +Allocation in the young generation is done linearly; in the old +generation from a freelist. + + +Collection +---------- + +A minor garbage collection (gc), that is, a gc of the young +generation, copies the live values from the young generation into the +old generation, using free memory obtained from the freelist. The +live values are those reachable from the globals, the stacks, the +C-roots, or the reftable. The space used for the young generation is +recycled after a minor gc, and the ref table becomes empty. + +A major gc, that is, a gc of the old generation, is done by +incremental mark-sweep, in a number of slices. One slice of major gc +is executed after every minor gc. There are two kinds of gc slices: +mark slices and sweep slices. A sequence of mark slices (called the +mark phase) followed by a sequence of sweep slices (the sweep phase) +constitute one `cycle' of major gc. The amount of marking (resp. +sweeping) to do in a mark (resp. sweep) slice is determined by the +total size of the live values being promoted from the young generation +in the preceding minor collection: the more promotion, the more gc +work must be done. This is an attempt to distribute the gc work over +computation in a fair manner, ideally ensuring that the mutator never +has to wait for the collector to free memory. + +During the mark phase, values are divided into three classes, +represented by colours: not yet visited (white); visited but children +have not been visited (gray); visited and immediate children have been +visited (black). A stack `grayvals' of references to gray values is +used to speed up marking, so that one marking pass over the old +generation will usually suffice. The heap is `pure' if all gray +values below the marking pointer `markhp' are also in the grayvals +stack. If the grayvals stack overflows, and cannot be extended, then +the heap becomes `impure' and a second marking pass is needed. The +mark phase is complete when there are no more gray values in the heap. +This is the case when the grayvals stack is empty, the heap pure, and +the marking pointer has reached the end of the heap. + +During the sweep phase, the chunks of the heap are swept sequentially, +and every white (unvisited) value is made blue and put on the free +list; every black (live) value is made white; and blue `values' (which +are on the freelist) are left alone. No gray values can remain after +the mark phase. After a number of sweep slices, the sweep pointer is +at the end of the heap, and gc cycle is complete. Then the mark phase +is entered again after graying all values reachable from globals, the +stacks, and the C-roots. + +Colours used in the heap: +------------------------- + +Blue on the free list +White not (yet) visited by the mark phase +Gray visited by the mark phase, but children have not been visited +Black visited by the mark phase, and immediate children have been visited + +During the marking phase, + White -> Gray -> Black for every live value + +During the sweeping phase, + Black -> White + White -> Blue + +When allocating from the free list, + Blue -> White, if in the sweep phase, + and the location has been swept already, + Blue -> Black, otherwise +Since the chunks constituting the old generation appear in order of +increasing memory addresses, and are swept sequentially, it can easily +be determined whether a given location has been swept already. + + +Data structures in the runtime system: +-------------------------------------- + +There are three dynamically sized components of the abstract machine: + +* The argument stack: argument pointers, and markers + +* The return stack: continuations, and the environment caches. + +* The heap, which is represented by + * The young generation: memory addresses in [young_start, young_end-1] + * The reftable: all references from the old into the new generation + * The old generation: a linked list of chunks of memory + * The page table: which parts of memory belong to the old generation + * The grayvals: a stack of pointers to gray values, used for + mostly-depth-first marking of the old generation + +Relevant files in the runtime system +------------------------------------ + +freelist.{c,h} allocating from the freelist, and + returning garbage to the freelist + +gc.h defining the colours + +major_gc.{c,h} initializing and collecting the old generation, + including the grayvals stack and the page table + +memory.{c,h} extending the old generation by a new chunk, + allocation in the old generation (using the freelist), + allocation in the young generation, + initializing and modifying the values in the heap + (including updates to the reftable when necessary) + +minor_gc.{c,h} initializing and collecting the young generation, + including the reftable + +mlvalues.h the lay-out and tags of heap-allocated values + +roots.{c,h} traverse argument and return stacks, and C roots (used + in major_gc.c and minor_gc.c to grayen reachable values) diff -Nru mosml-2.01/doc/.gitignore mosml-2.10.1/doc/.gitignore --- mosml-2.01/doc/.gitignore 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/doc/.gitignore 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,6 @@ +.gitignore~ +mosmllib +manual.pdf +mosmllib.pdf +mosmllib2up.pdf +mosmlref.pdf diff -Nru mosml-2.01/doc/memory.txt mosml-2.10.1/doc/memory.txt --- mosml-2.01/doc/memory.txt 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/doc/memory.txt 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,84 @@ +The garbage collector is Damien Doligez's garbage collector for Caml +Light. It is generational with stop-and-copy collection of the minor +(young) generation and incremental mark-sweep collection of the +(major) old generation. It is described in the document +garbagecollector.txt. + +To see the current settings of the garbage collector, you can set the +environment variable CAMLRUNPARAM: + + sestoft@ellemose:/tmp$ export CAMLRUNPARAM="v=1" + sestoft@ellemose:/tmp$ mosml + Initial space overhead: 30% + Initial heap increment: 256k + Initial minor heap size: 128k + Growing heap to 512k + <>!<>.<>$<>$Moscow ML version 2.00 (June 2000) + Enter `quit();' to quit. + <>$<>!Growing heap to 768k + <>Growing gray_vals to 16k + !<>.- + +The sizes of the young and old heap are reported in kilobytes (k). + +The funny symbols explain the garbage collection cycles: + + < signals the start of a minor collection + > signals the end of a minor collection + ! signals one slice of a mark phase + . signals one slice of a weak phase + $ signals one slice of a sweep phase + +To speed up the garbage collector, increase the size of the young +generation from 128k, and increase the space overhead from 30%; for +instance: + + sestoft@ellemose:/tmp$ export CAMLRUNPARAM="o=60 s=4096 v=1" + sestoft@ellemose:/tmp$ mosml + Initial space overhead: 60% + Initial heap increment: 256k + Initial minor heap size: 16k + Growing heap to 512k + <>!<>.<>$<>$<>$<>$<>$<>$<>$<>$ref_table threshold crossed + <>$<>Growing gray_vals to 16k + !<>!<>!<>!<>!Moscow ML version 2.00 (June 2000) + Enter `quit();' to quit. + <>!<>!<>.<>$<>$<>$<>$<>$<>$<>$<>!<>!<>!<>!<>!<>!<>!<>!<>!<>!<>.<>$<>$<>$<>$<>$<>$<>$<>$<>$- + +Apparently the initial minor heap size (s=4096) needs to be specified +in kilobits (byt why?) + +It is suspicious for a program to spends more than 5 per cent of its +time in garbage collection: in that case, it allocates too much in the +heap. The most frequent causes are: + +(A) Aggressive string concatenation: + + fun g 0 = "" + | g n = "abc" ^ g (n-1); + + This has runtime \theta(n^2), and causes fragmentation in the heap + because ever longer strings are created. + + Better build a list of strings and then use String.concat, or even + better, use the Msp.wseq type + +(B) Aggressive list concatenation: + + fun h 0 = [] + | h n = h(n-1) @ [n]; + + Again runtime \theta(n^2), heavy allocation and load on the + garbage collector (but no fragmentation because all cons cells + have the same size). The length of the left-hand argument to (@) + determines the time and space consumption, so building the list in + a different order would remove the problem. Even building a list + in the wrong order and then reversing it using List.rev would be + vastly better. Or a tree structure similar to Msp.wseq could be + used. + +(C) Deep recursion (> 1000 calls) gives a deep stack and a large root + set that must be scanned at each minor garbage collection, hence + slow garbage collection. + +sestoft@dina.kvl.dk * 2003-08-18 diff -Nru mosml-2.01/doc/recomp mosml-2.10.1/doc/recomp --- mosml-2.01/doc/recomp 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/doc/recomp 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,197 @@ +How to compile the Moscow ML compiler for Win32: + +(1) Edit mosml/src/Makefile.inc, and compile the Linux version without +support for dynamically loadable libraries. + +(2) In mosml/src/Makefile.inc, uncomment: + +# For cross-compiling to Win 32 (from Linux) (development only) +CPP=/lib/cpp -P -traditional -Umsdos -Uunix -Dwin32 + +(3) Recompile libraries, lexer, compiler and tools: + + (cd mosmllib; make clean all) + (cd lex; make clean all) + (cd compiler; make clean all) + (cd toolssrc; make clean all) + +Now Win32 compatible executables are found in compiler/mosmlcmp, +compiler/mosmllnk, compiler/mosmltop, lex/mosmllex, toolssrc/mosmldep, +and toolssrc/cutdeps. + +---------------------------------------------------------------------- + +How to compile the Moscow ML compiler for DOS (assuming the runtime +system is unmodified): + +You will need: + * the Moscow ML sources + * the djgpp compiler + * the perl utility + * a working runtime system (camlrun) version 0.7m1 for Moscow ML + + +Initial compilation: + +(1) To initially compile the entire system (except the runtime + system), execute + make world + in directory mosml/src. + +(2) If you DO NOT have the binaries, then execute + make install + in directory mosml/src. This installs mosmltop, mosmlcmp, and mosmllnk + in directory mosml/lib, and the small C executables mosml and mosmlc + in directory mosml/bin. These executables invoke the runtime system + (camlrun) to read and execute the bytecode files mosmltop etc. + +Recompilation: + +(1) To recompile just the compiler (the top-level system mosmltop, the + batch compiler mosmlcmp, and the batch linker mosmllnk), execute + make clean all + in mosml/src/compiler. + +(2) [Do this only if you are quite certain that the new version works] + To make the newly compiled version the current one, execute + make install + in mosml/src/compiler. This copies the fresh mosmltop, mosmllnk, and + mosmlcmp to mosml/lib. It leaves the bytecode files in mosml/src + unchanged. This intentional. + + +There are two binding times in the making of the batch compiler: + + compilation mosmlc -c (bytecode) + linking mosmlc -o (C primitives and libraries) + + When compiling user source code, the compiler reads and uses + the current libraries, not those that existed when the + compiler itself was built. + +There are three binding times in the making of the interactive system: + + compilation mosmlc -c (bytecode) + linking mosmlc -o (C primitives, libraries used inside mosml) + + When compiling code entered at top-level, or compiling via + function compile, the interactive system reads and uses the + current libraries, not those that existed when the top-level + system itself was built. + +Bytecode instructions: The set of bytecode instructions is defined in +runtime/interp.c and runtime/instruct.h, which must agree. File +compiler/Opcodes.sml is derived automatically from runtime/instruct.h. +The bytecode generated by the compiler (mosmlcmp and mosmltop) depends +on Opcodes.sml. The bytecode can run only on the runtime system for +which it is generated. + +C primitives: The set of C primitives is defined by the collection of +runtime/ files listed in variable PRIMS in runtime/Makefile; the C +primitives are the functions annotated with /* ML */ in those files. +File runtime/primitives is derived automatically from PRIMS and those +files. File compiler/Prim_c.sml is derived automatically from +runtime/primitives. The linking performed by the linker mosmllnk and +the load function in mosmltop depends on Prim_c.sml. A file linked +for a given runtime system can run only on that system. + +Libraries: The batch compiler (mosmlcmp and mosmllnk) and the lexer +generator (mosmllex) are fully linked and independent of the libraries +at runtime. + +The interactive system (mosmltop) depends on the libraries present at +runtime, not for its internal operation, but for the initial +environment seen by the user. File compiler/Config.mlp determines +which libraries are loaded and which are open in the initial +environment in the interactive system. + + + +Bytecode, exceptions and global arguments: + +In src/runtime, files interp.c and instruct.h must agree on the +defined bytecode instructions; compiler/Opcodes.sml is derived from the +latter. + + +The compiler back-end's internal representation of bytecode +instructions is defined in src/compiler/Prim.sml. When adding a new +instruction, file src/compiler/Emitcode.sml must be updated to emit +code if the new primitive takes an argument; whereas file +src/compiler/Prim_opc.sml must be updated if the new primitive is +argumentless. File src/compiler/Pr_lam.sml must be updated to print +the new primitive. Finally, file src/compiler/Primdec.sml, which maps +string names to the internal representation, may be updated if the new +primitive needs to be externally visible (that is, usable in prim_val +declarations). + +The compiler front-end's internal representation of SML primitives is +defined in src/compiler/Smlprim.sml; for binary primitives there are +usually two versions: MLPxxx and MLPxxx_c, where the latter is for a +fully applied version, which can be evaluated more efficiently. The +mapping to the bytecode primitives is done in file +src/compiler/Front.sml, which also takes care of the optimization for +fully applied primitives. The front-end primitives are usually used +when defining SML pervasives in src/compiler/Smlperv.sml. + +Files src/compiler/Smlexc.sml and src/runtime/fail.h must agree on the +exceptions they define, since the latter is used to generate +src/compiler/Predef.sml, which is read by Symtable.sml and hence used +in the compiler. + + +Bootstrapping, after extending the set of C primitives +------------------------------------------------------ + +(1) Compile everything + and make a backup of camlrunm, mosmllnk, mosmlcmp, mosmllex +(2) Extend the set of primitives +(3) Recompile runtime +(4) Relink mosmllnk +(5) Promote mosmllnk to src/ +(6) Relink mosmllnk, mosmlcmp, mosmllex +(7) Promote mosmllnk, mosmlcmp, mosmllex to src/ +(8) Promote camlrunm to src/ +(9) Recompile everything again + + +Cross-compiling from Linux to DOS +--------------------------------- + +0. In mosml/src, + make clean world + +1. In mosml/src/runtime, edit Makefile to have + PRIMS=$(DOSPRIMS) + +2. Do + rm primitives prims.c + make prims.c + +3. In mosml/src/compiler, + make mosmllnk + mv mosmllnk ../mosmllnk.dos + +4. Edit mosml/src/Makefile.inc to have + CPP=/lib/cpp -P -traditional -Uunix -Dmsdos + +5. In mosml/src/mosmllib + make clean all + +6. In mosml/src/compiler + make clean dos + +7. Move files mosmllnk and mosmlcmp to DOS (/cdisk/mosml/src). + These are now compatible with the DOS version of the runtime. + +8. To bootstrap the DOS version, copy all sources to DOS, + copy compile/Lexer.{sig.sml} to DOS, + and do + make + in mosmllib and compiler. + Recompile mosmllex and toolssrc. + Then promote the generated mosmllnk and mosmlcmp, + and do + make clean world + in mosml/src. + diff -Nru mosml-2.01/doc/releases.txt mosml-2.10.1/doc/releases.txt --- mosml-2.01/doc/releases.txt 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/doc/releases.txt 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,300 @@ +Moscow ML release history + +1.00 (1 September 1994) + * First public release, supposed to be reliable. + +1.01 (2 September 1994) + * Fixed the bewildering error message from test R021B-FL. + +1.02 (6 September 1994) + * Removed `Internal error: domPatAcc' from the function of that name in + asynt.ml, which was reported upon elaborating + val ref (x as (y, z)) = ref (1, 2) + * Made the compiler reject unbalanced comments: (op *) (2,3); + and record labels starting with 0: {02 = true}; + +1.03 (12 September 1994) + * In the implementation of `use', open_in replaced with + open_in_bin, to avoid wrong calculation of file positions + when reporting errors. + +1.10 (28 September 1994) + * Exceptions in integer and real arithmetic operations are raised + correctly. (Including floor.) The real arithmetic exceptions work + under DOS, Windows, Linux, Ultrix, OSF/1, HP/UX, Sun OS. + * The representation of top-level exceptions has been changed + to enable SML programs to handle the exceptions raised by + the Caml Light run-time system. + As a consequence, the exception Interrupt can now be + handled by SML programs. (The Caml Light name of that + exception is sys__Break.) + Evaluating expressions like 10 div 0 no longer causes + Moscow ML to crash. + * datatype X = A | B of unit; B (); now accepted. + * Now ~100 div 10 = ~10. (Previously it was ~11!). + * Too large integer or real constants now give rise to error reports. + * Error reports produced by the type-checker for the + expressions like 0 = [1,2,3] have been made more + understandable. + * Unbound variables are identified before type-checking. (To + avoid strange error reports in expressions like 2*~2.) + * As required by the Definition, inexhaustive patterns in + valbinds at the top level are no longer reported. (For + example, in val nil = [].) + +1.20 (1 December 1994) + * Supports separate compilation and type-safe linking, using a simple + module system which has Standard ML's signatures and structures, but + no functors. Includes extensible basis libraries Array, List, and + Vector (and Graphics in the MS DOS version). Cannot create + stand-alone executables yet. + * Fixed the two bugs found in version 1.10: + * Illegal string escapes, such as "\256", caused the system to crash. + * Certain illegal infix patterns, as in fn + => (), were accepted. + +1.30 (15 June 1995) + + * Now reports `hidden' types t in a less ambiguous manner: ?{t} + * New type char, and character constants #"a". + * Supports vector expressions #[7, 9, 13] and vector patterns #[x,y,z]. + * Permits quotations `a b c` and antiquotations `a ^var c`. + * Provides a batch compiler which can generate stand-alone executables. + * Provides a lexer generator and a parser generator (from Caml Light). + * New runtime system with better garbage collector (from Caml Light 0.7). + * Moscow ML has been rewritten in Moscow ML and can recompile itself, + which simplifies installation on Unix systems. + * Supports a large part of the new SML Standard Library, but not yet + the new I/O primitives. + * Fixed bugs found in version 1.20: + * The Match exception wasn't handled properly. + * Static argumentless exception constructors in data structures at + top-level caused evaluation to crash. + * Now considers ctrl-Z to mean end of file when reading source programs + with `use' and `compile', under DOS as well as Unix. This simplifies + moving source files from DOS to Unix, and prevents ctrl-Z characters + in source files from crashing the top-level under DOS. + +1.31 (15 October 1995) + + * Added prettyprinter library PP (from SML/NJ library version 0.2) + * Added installable prettyprinters + * Now works for the Macintosh, thanks to Doug Currie (e@flavors.com) + * The timer functions now report garbage-collection time + * Avoid excess flushing: output to std_out no longer flushes immediately; + function BasicIO.say still does. + * Make sure that std_out is flushed when (stand-alone) program terminates. + * Standard Library: Added getOpt etc. at top-level; changed the types + of the word shift operations; ... + * Now accepts ctrl-L in source files. + * Bugs fixed: + * input_line now works properly with pipes, DOS, and Mac + * Array2 (and mosmllib/Makefile) were wrong + * missing -q/-quotation option in mosmlc (under Unix) + * Added test cases for Array2, Arraysort, and Listsort + * FileSys.chDir now changes volume under DOS + * mosmlyac now requires the types of non-terminals to be declared + for type safety + +1.40 (1 July 1996) + + * Changes in compiler (many of which to reflect the 1996 revised SML): + * New match compiler properly detects inexhaustive matches etc. + * Better type error messages + * Made value polymorphism default; introduced command-line options + -valuepoly and -imptypes, and added a ref variable Meta.valuepoly + * Added hexadecimal integer constants, word type, word special + constants, and word printing + * Made +, *, -, <, >, <=, >=, div, mod, and makestring overloaded + on word and word8 also + * Overloading defaults to type int by default + * Made quot and rem nonfix + * Permitted 'e' as well as 'E' in real constants + * Added trunc, ceil, round at top-level + * Removed sqrt, ln, exp, sin, cos, arctan, quot, rem from top-level + * Permitted new escape sequences in char and string constants + * Forbade rebinding and respecification (as constructors) of the + identifiers true, false, it, nil, ::, ref + * Made the -P unitset option case insensitive + * Permit keywords `structure' and `signature' etc. in compilation units + * Changes concerning SML Basis Library: + * New structures TextIO and BinIO + * Renamed Integer to Int, String.maxLen to String.maxSize + * Added String.isPrefix, Substring.isPrefix, FileSys.fileSize, + Char.{fromCString, toCString}, StringCvt.scanList, hyperbolic + functions in Math, exnName, exnMessage, FileSys.file_id etc., + FileSys.{fullPath, realPath}, exception Domain + * Changed {Int, Word, Word8}.{scan, fromString} to accept various + combinations of prefixes: 0x, 0X, and 0w, 0wx, 0wX; and {Char, + String}.fromString to permit new escape sequences; + FileSys.tmpName; built-in exception Io; General.ordering to + General.order + * Fixed Real.fmt, Real.toString, Real.fromString on "1.E" + * Bugs fixed: + * mosmllex handled character set concatenation wrongly + * Exceptions SysErr and Io didn't print properly + * Missing check for duplicate labels in record types in signatures + +1.41 (1 October 1996) + * Better type error message for tuples. + * New option `-P parsing' for linking mosmlyac- and mosmllex-generated + programs. + * Bugs fixed: + * Overloaded type variables were incorrectly generalized at top-level. + * mosmlyac now permits immediate tuple and record types in + %tokens; permits function types; and correctly binds $s in semantic + actions even inside closures. + +1.42 (July 1997) + * The linker now automatically includes all (and only) referred-to + bytecode files. Option -i makes the linker report which files. + Option -noautolink disables the autolinker. Option -P parsing + has been removed. + * Now doesn't print imperative tyvars for library functions. + * Now accepts explicit type variable parameters in val and fun. + * Basis Library: Added structures Array2, CommandLine, and Option. + Added Substring.span and {Vector, CharVector, Word8Vector}.{map, mapi}. + Renamed Old to SML90. Fixed FileSys.closeDir, Path.joinBaseExt, + Word8.~>>. FileSys.tmpName now creates absolute pathnames, using + POSIX tmpnam. + * Support for writing CGI scripts (Mosmlcgi, thanks to Jonas Barklund). + * Signature stamps now are standard MD5 checksums rather than CRC128 + * Several internal improvements to the compiler; faster compilation + * Faster and more compact bytecode, thanks to Doug Currie + * Bugs fixed: + * compilation of certain patterns with irrefutable subpatterns failed + * mosmllex-generated lexers now typesafe + * Polyhash.hash now is more useful on ref values + * signature stamps now unaffected by gc phenomena; hence stable + +1.43 (April 1998) + * Added weak pointers and arrays of weak pointers (structure Weak). + * The load paths can be set from the interactive system. + * The interactive system's prompts and responses can be turned off + (option -quietdec, variable Meta.quietdec). + * Prettyprinters can be installed also on base types and abstract types. + * The Help facility can be adapted to other uses. + * Mosmllex now supports abbreviations for regular expressions. + * Added dynamic linking of external functions under Linux, Solaris, + OSF/1, Win32 and MacOS (structure Dynlib). + * Access to GNU gdbm persistent hashtables (structures Gdbm, + Polygdbm); requires Dynlib. + * Added interface to Boutell's GD image package (structure Gdimage) + * Basis Library: changes to structures Array2, Date, and Option. + * Bugs fixed: + * bogus error message for overloaded variables in local declarations + * when a unit cannot load successfully, references to it must fail + * the internal representation of ~0.0 was different from ~ 0.0 + * error in code emission for 63-bit integer constants + * mosmllex now reports correct number of actions generated + * mosmlyac now implements %nonassoc correctly + +1.44 (August 1999) + * Added interface to the PostgreSQL database server (structure Postgres) + * Added interface to the MySQL database server (structure Mysql) + * Added interface to POSIX 1003.2 regular expressions (structure Regex) + * Added interface to Internet and file sockets (structure Socket) + * String escapes of the form \uxxxx are now accepted + * Dynamic linking now also under HP-UX + * Faster bytecode execution: bytecode threading at load-time + * Minor changes to simplify compilation under NetBSD + * Datatypes and abstypes now retain the given explicit tyvar names + * New linker option -standalone + * Basis Library changes: + * Real.fmt and Real.toString now emit no leading zeroes in the exponent + * Real.fmt and Substring.trim{l,r} may raise exceptions at partial appl. + * FileSys.readDir returns NONE instead of "" + * String.map added + * Word.toInt now raises Overflow on would-be negative results + * Bugs fixed: + * mosmllex-generated lexers now handle illegal symbols gracefully + * mosmlyac can now use precedence to resolve reduce/reduce conflicts + * mosmlyac now discovers missing %type for start symbols + * constructors and excons can now be rebound in recursive valbinds + * Real.round didn't round to nearest even on HP-UX and MS DOS/Win + * some Word comparisons were wrong on DEC Alpha + * Mosml.run didn't work on e.g. Solaris (pointed out by Anders Öhrt) + * Date.offset was wrong + +2.00 (June 2000) + * Full SML'97 Modules language (thanks to Claudio Russo) + * First-order, higher-order, and recursive modules (thanks to Claudio Russo) + * Improved memory handling in Intinf (by Doug Currie) + * Improved prettyprinting of record and function types + * Identical literals inside a topdec are shared (in RAM and .uo files) + * Runtime system now permits longer bytecode jumps and more local variables + * Constructor ordering in datatype specifications no longer matters + * The exception representation has become simpler and more uniform + * The Gdimage library now creates PNG files (not proprietary GIF files) + * New SML Basis Library structures Unix and Signal for using subprocesses + * New structure Msp for efficient functional generation of HTML code + * New structure Mosmlcookie for using cookies in CGI scripts (by Hans Molin) + * Experimental ML Server Pages implementation in mosml/examples/msp + * Experimental parser combinator library in mosml/examples/parsercomb + * More print-friendly documentation of the Moscow ML Library + * Bugs fixed: + * Binding a static excon in a local exbind failed + * More sensible failure value from Mosml.run under MS Windows + * A failing installed prettyprinter no longer terminates the system + * A case returning an empty tuple () was implemented wrongly + * More redundant excon matches are discovered by the compiler + * Removed severe inefficiency in Mysql.getdyntuples + * Socket.select timeout was wrong + * Moved exnName and exnMessage to General (where they belong) + +2.01 (January 2004) + * Bugs fixed: + * Y2004 Overflow in Time.toString(Time.now()), Time.+(now(), zeroTime()) + * Moscow ML 2.00 for Windows failed when loading structure Timer + * Misplaced double quote in Msp.ahrefa + +2.10 (August, 2013) + * Support for dynamic linking and callback from C also under MacOS X + * There may now be 2 G globals (string literals etc) instead of 64 K + * Bugs fixed: + * The HTML files generated for mosmllib now have valid URLs + * Substring.app more efficient + * Recursive structure compilation (elabRecSigExp) fixed + * Several errors in Mosmlcookie + * Misplaced double quote in Msp.ahrefa + * Exception Option wasn't available at top-level + * Linker did not check stamps of linked-in units + * Hash function now much faster on very long strings + * Double alignment constraints now correct with gcc-3.2 and Solaris + * Bug in Polyhash.filter + * Socket library returned only first 16 bytes of UDP datagram + * SML Basis Library changes: + * String and Substring: added concatWith, isSuffix, isSubstring, full + * ListPair: added zipEq, appEq, mapEq, foldlEq, foldrEq, allEq + * Added ArraySlice and VectorSlice structures, also for Char and Word8 + * Added find, findi, all, exists, collate to vector, array and + slice structures + * Added collate to List + * Added update to vector structures + * Path.{mkRelative,mkAbsolute} now take record arguments + * Negative Time.time values allowed + * OS.Process: new functions sleep and isSuccess; status not eqtype + * Listsort: added eqclasses, merge, mergeUniq + * Path: added functions isRoot, fromUnixPath, toUnixPath, and + exception InvalidArc (bug report by Henning Niss) + * TextIO: inputLine now have type instream -> string option + * Array: added type abbreviation vector (bug report by Andrzej + Wasowski) + * FileSys: type access renamed to access_mode (bug report by + Henning Niss) + * Byte: unpackString{,Vec} now uses vector slices (bug report by + Henning Niss) + * Unix: added functions fromStatus, textInstreamOf, binInstreamOf, + textOutstreamOf, binOutstreamOf, exit, and added phantom types + to proc (bug report by Henning Niss) + * Timer: added function checkCPUTimes + * Word and Word8: added functions toLarge, toLargeX, and fromLarge + (bug report by Martin Elsman) + * General: added exception Span and made the type of the function + 'before' less general (bug report by Henning Niss) + * Added modules to mosmllib: + * Buffer: mutable string buffers for fast and efficient + concatenation of strings + * Hashset: sets implemented by hash-tables + * Rbset: ordered sets implemented by red-black trees + * Redblackmap: maps implemented by red-black trees + * Moscow ML is now developed in the open at github. diff -Nru mosml-2.01/examples/msp/calendar.msp mosml-2.10.1/examples/msp/calendar.msp --- mosml-2.01/examples/msp/calendar.msp 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/calendar.msp 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,101 @@ + 0 orelse y mod 400 = 0 + + fun daysinmonth year = + fn Jan => 31 | Feb => if leap year then 29 else 28 + | Mar => 31 | Apr => 30 | May => 31 | Jun => 30 + | Jul => 31 | Aug => 31 | Sep => 30 | Oct => 31 + | Nov => 30 | Dec => 31 + + val tomonthcode = + fn 1 => Jan | 2 => Feb | 3 => Mar | 4 => Apr | 5 => May | 6 => Jun + | 7 => Jul | 8 => Aug | 9 => Sep | 10 => Oct | 11 => Nov | 12 => Dec + | _ => raise Fail "Illegal month number" + + val frommonthcode = + fn Jan => 1 | Feb => 2 | Mar => 3 | Apr => 4 + | May => 5 | Jun => 6 | Jul => 7 | Aug => 8 + | Sep => 9 | Oct => 10 | Nov => 11 | Dec => 12 + + fun toDatedate (year, month, day) = + date { year = year, month = tomonthcode month, day = day, + hour = 12, minute = 0, second = 0, offset = NONE } + + val wdayno = + fn Mon => 1 | Tue => 2 | Wed => 3 | Thu => 4 + | Fri => 5 | Sat => 6 | Sun => 7 + + val dayheader = tr(prmap (th o $) daynames) + + fun mkmonth (year : int) (month : int) wrap = + let val firstwdayno = wdayno (weekDay (toDatedate (year, month, 1))) + val daysinmonth = daysinmonth year (tomonthcode month) + val days = List.tabulate(firstwdayno-1, fn _ => NONE) + @ List.tabulate(daysinmonth, fn d => SOME(d+1)) + fun makeday NONE = Empty + | makeday (SOME day) = + let val daystring = $ (Int.toString day) + in wrap (year, month, day) daystring end + fun weeks [] = [] + | weeks days = + let val thisweek = List.take(days, Int.min(7, length days)) + val nextweek = List.drop(days, Int.min(7, length days)) + val firstrow = prmap (td o makeday) thisweek + in + firstrow :: weeks nextweek + end + val monthheader = + $$[Vector.sub(monthnames, month-1), " ", Int.toString year] + in + tablea "BORDER" (tr(tha "COLSPAN=7" monthheader) + && dayheader && Nl + && prsep Nl (tra "ALIGN=RIGHT") (weeks days)) + end +in + val today = + let val dt = fromTimeLocal(Time.now()) + in (year dt, frommonthcode (month dt), day dt) end + + fun calmonth year month = + let fun wrap date s = if date = today then strong s else s + in mkmonth year month wrap end + + fun calyear year = + let fun prtab(n, f) = List.foldr (op &&) Empty (List.tabulate(n, f)) + fun mkcalrow r = + tra "VALIGN=TOP" (prtab(3, + fn s => td(calmonth year (3*r+s+1)))) + in + tablea "BORDER" (prtab(4, mkcalrow)) + end + + val year = %%#("year", #1 today); +end +?> + +MSP example: calendar for year <?MSP= Int.toString year ?> + +

MSP example: calendar for year

+ + +

+ +

Your free bonus: a calendar for a random month

+ + + + diff -Nru mosml-2.01/examples/msp/database.msp mosml-2.10.1/examples/msp/database.msp --- mosml-2.01/examples/msp/database.msp 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/database.msp 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,79 @@ +MSP example: database query + + +

MSP example: database queries

+ +This page was generated at to illustrate some database +facilities with ML Server Pages. The script behind the page was last +updated 2000-01-06. + +

The time to generate, compile, and link the script that generated +this page is approximately 0.2 sec (user+sys time as well as real +time). Most of this time is spent compiling and linking the 84 lines +of SML code generated from the script (which is 80 lines). The size +of the compiled and linked script is 12 KB. The script needs to be +regenerated, recompiled, and relinked only after a change to its +source. + +

The time to execute the compiled script (for generating the 19 KB +of HTML code making up this page) is approximately 0.1 sec user+sys +time in the script and another 0.25 sec in the database server, for a +total real time delay of 0.35 sec, including time for communication +between script and database server. + +

All times are for a Dell Latitude PII 266 MHz notebook with 128 MB +RAM running SuSE Linux 6.1, Postgres 6.3, and Moscow ML 1.44. + + + +

Example database query

+ +We open a database connection db and execute the following SML code + +
+    Postgres.showquery db 
+    "SELECT * FROM message WHERE name = 'Peter Sestoft' ORDER BY day" 
+
+ +

The result is this table, automatically generated by +Postgres.showquery: + +

+ + +

Another query

+ +We execute the following SML code + +
+    Postgres.showquery db "SELECT name, COUNT(msg) FROM message GROUP BY name" 
+
+ +

The result is: + +

+ + + + + + diff -Nru mosml-2.01/examples/msp/dbquery.msp mosml-2.10.1/examples/msp/dbquery.msp --- mosml-2.01/examples/msp/dbquery.msp 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/dbquery.msp 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,31 @@ +MSP example: database query called from a +form + + +

MSP example: database query called from a form

+ + + +

Messages about

+ + + +

This database extract was generated by a mosml server pages script, +invoked from a form generated by another mosml server pages script. + diff -Nru mosml-2.01/examples/msp/dbrequestform.msp mosml-2.10.1/examples/msp/dbrequestform.msp --- mosml-2.01/examples/msp/dbrequestform.msp 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/dbrequestform.msp 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,42 @@ +MSP example: using a form to set up a database +query + + +

MSP example: using a form to set up a database query

+ +

Select person

+ +
+
Select name: + +
+
+ +

This form was generated by a mosml server pages script. It will +invoke another mosml server pages script to compute and display the +set of messages requested. + + diff -Nru mosml-2.01/examples/msp/fileindex.msp mosml-2.10.1/examples/msp/fileindex.msp --- mosml-2.01/examples/msp/fileindex.msp 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/fileindex.msp 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,58 @@ + +Automatic file index generation + + +

Automatic file index generation

+ +To download a file, hold down the Shift key while clicking on the +link, or right-click the link and choose Save Link As. + + + *) + +open Msp +infix && + +fun mem x [] = false + | mem x (y::yr) = x=y orelse mem x yr + +fun relevant relevantExt = + List.filter (fn f => + f <> "index.html" andalso not (FileSys.isDir f) + andalso mem (getOpt(Path.ext f, "")) relevantExt) + +fun getfiles relevantExt dir = + Listsort.sort String.compare (relevant relevantExt (Mosml.listDir dir)) + +fun urlpath path = + let val {isAbs, vol, arcs} = Path.fromString path + in Path.toString {isAbs = isAbs, vol = vol, arcs = List.map urlencode arcs} + end + +fun mkfile dir file = + td (ahref (urlpath (Path.concat(dir, file))) ($file)) + +fun mkfileindex dir relevantExt = + let fun process line = tr (prmap (mkfile dir) line) && Nl + fun loop [] = Empty + | loop (x1 :: x2 :: x3 :: x4 :: rest) = + process [x1, x2, x3, x4] && loop rest + | loop xs = process xs + in tablea "CELLSPACING=5" (loop (getfiles relevantExt dir)) end + handle exn => + br && strong ($$["Fileindex failed: ", exnMessage exn]) && br +?> + +

Example scripts in this directory

+ + + + +

Example source files in this directory

+ + + +
Peter Sestoft +(sestoft@dina.kvl.dk) 2000-02-06 + diff -Nru mosml-2.01/examples/msp/getcookies.msp mosml-2.10.1/examples/msp/getcookies.msp --- mosml-2.01/examples/msp/getcookies.msp 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/getcookies.msp 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,39 @@ + + +
+Ny x: + +
+ + + +

+

    +
  • + (); + + +val (gety, sety) = Session.var session "y" + +val _ = print (case getx () of NONE => "Ingen" | SOME i => Int.toString i); +val _ = Option.map (fn i => setx (i+1)) (getx ()); +?> + +
  • + "Ingen" | SOME i => Int.toString i); + +val _ = Option.map (fn i => sety (i+1)) (gety ()); + +?> + +
  • Age of this session in seconds: + "" + | SOME st => Time.fmt 0 (Time.-(Time.now(), st)) + ?> + +
diff -Nru mosml-2.01/examples/msp/hello.msp mosml-2.10.1/examples/msp/hello.msp --- mosml-2.01/examples/msp/hello.msp 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/hello.msp 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,9 @@ + + +

Hello world!

+ +The current date and time is + + +
Your friendly ML server page
+ diff -Nru mosml-2.01/examples/msp/index.msp mosml-2.10.1/examples/msp/index.msp --- mosml-2.01/examples/msp/index.msp 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/index.msp 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,231 @@ + + + ML server pages + + +

ML server pages (version 1.2)

+ +ML Server Pages (MSP) is a web scripting language, a loose integration +of Standard ML (SML) and HTML in the style of Sun's Java Server Pages, +Microsoft's Active Server Pages, or PHP. + + +

News and links

+ +
    +
  • Version 1.2 (March 2014) minor updates and moved to mosml distribution. + +
  • Version 1.1 (April 2001) no longer requires the Regex library +(which, being based on a C program, is flaky). Also, quotations and +antiquotations may now be used in MSP scripts. + +
  • The MSP implementation is available in the examples/msp directory in the Moscow ML distribution. + + + + +
+ + +

Some example scripts

+ + +
DescriptionScript sourceRun script + +
+ +

You may pass arguments to msp-scripts, as in calendar.msp?year=1962 or test.msp?nvalue=10&mvalue=17. + +

(In MS Internet Explorer, you must select View | Source to see the +document source after clicking on the *.msp.txt file; Internet +Explorer erroneously ignores the contents-type sent by the webserver). + +

Writing ML Server Pages

+ +An ML server page script is stored in an .msp file and consists of +HTML (text) fragments and SML (code) fragments. + +

Thus a date-enhanced Hello World script might look like this: + +

+   <HTML><BODY>
+   <H1>Hello world!</H1>
+
+   The current date and time is
+   <?MSP= Date.toString (Date.fromTimeLocal(Time.now())) ?>
+
+   <HR><ADDRESS>Your friendly ML server page</ADDRESS>
+   </BODY></HTML>
+
+ +

To see the webpage produced by the above code, run the hello.msp script. + +

In general, an SML fragment must have one of the following forms: + +

<?MSP dec ?> +
+ An SML declaration dec in <?MSP dec ?> may + define types, functions and variables, and may print (on standard + output) HTML code that becomes part of the resulting HTML page. + +
<?MSP= exp ?> +
+ An SML expression exp in <?MSP= exp ?> must + have type string. The expression is evaluated and the resulting + string is printed on standard output as part of the resulting HTML + page. + +
<?MSP$ exp ?> +
+ An SML expression exp in <?MSP$ exp ?> must + have type Msp.wseq. The expression is evaluated and the resulting + word sequence is printed on standard output as part of the resulting + HTML page. +
+ +

The strange tag syntax   <?MSP +... ?>   follows the standard for so-called XML processing +instructions. + +

The following structures are particularly useful for writing ML + server page scripts: + +

  • Msp for +efficient functional generation of HTML. Here are the raw Msp.sig and Msp.sml files. + +
  • Mosmlcgi for +accessing CGI parameters + +
  • Mosmlcookie for +manipulating cookies. Here are the raw Mosmlcookie.sig and Mosmlcookie.sml files. Untested. +Cookies can be accessed anywhere in an MSP script, but can be set only +in a ML fragment immediately at the beginning of the MSP script. +
+ + +

Implementation

+ +This is how an msp-script is executed in our early proof-of-concept +implementation (January 2000, minor updates March 2014): + +
    +
  • When the Apache web server receives a request for a file with the +.msp extension, it will invoke the CGI script /cgi-bin/mspcompile. +This is achieved by adding the following lines to the Apache +configuration file: + +
    +        Action application/x-msp /cgi-bin/mspcompile
+        AddHandler application/x-msp .msp
+
    + +
  • To make Apache translate a request for a directory into a request +for index.msp (if it exists), add index.msp to the DirectoryIndex +directive: + +
    +        DirectoryIndex index.msp 
+
    + +

    When running MSP under Apache under MS Windows NT, the Apache +configuration must set the MOSMLLIB environment variable: + +

    +        SetEnv MOSMLLIB "c:/mosml/lib"
+
    + +
  • The program /cgi-bin/mspcompile will check whether an up-to-date +compiled version of the msp-script exists. If not, it will +preprocess the msp-script to obtain a corresponding .sml-file, then +compile and link it. + +
  • When the msp-script has been compiled (or recompiled), the program +/cgi-bin/mspcompile will invoke it, passing its own environment +variables, standard input, and standard output on to the compiled +script. The script executes and produces HTML-code which is returned +to the browser. The script executes in its source directory, so it +can read and write files there. This is demonstrated by the +script logtofile.msp (if webserver user +has write right to the directory, normally not recommended). +
+ +

The CGI script mspcompile is the main workhorse, yet it consists of +little more than two pages of ML code. It splits an .msp-file into +HTML fragments and ML fragments, to build the corresponding .sml-file. +An HTML fragment <FOO>bar... is transformed into an ML +string constant (with quotes, backslashes, newlines etc. properly +escaped) which is then embedded into a declaration of the form + +

+        val _ = print "<FOO>bar..."; 
+
+ +

An ML declaration fragment is copied to the .sml-file as is. An ML +expression fragments is embedded in val _ = print(...) or +val _ = Msp.printseq(...) or val _ = (...) depending +on its type: string, Msp.wseq, or unit. It would be nice to +distinguish these three cases automatically, but that would require a +typecase construct. + +

The name of a compiled msp-script is simply the MD5 checksum of +the full local pathname of the msp-script. This gives a fast and +probabilistically one-to-one mapping from the name of an msp-script +to the name of the corresponding compiled script. + + +

Future work

+ +Lots: security, efficiency, session management, persistence, +scalability, real-world examples, ... + + +

Who is responsible?

+ +The concept of ML server pages was presented by Christian Stefansen at a Funtechs meeting in December 1999 + at the IT University of Copenhagen. This early design and + implementation is by Peter + Sestoft. The third honourable member of the ML server pages + group is Peter Lund. + +

Where?

+ +The MSP homepage is at +http://ellemose.dina.kvl.dk/~sestoft/msp/index.msp + +

Peter Sestoft (sestoft@itu.dk) 2000-02-22, +2001-04-29. (Minor updates by Ken Friis Larsen 2014-03-05.) + diff -Nru mosml-2.01/examples/msp/logtofile.msp mosml-2.10.1/examples/msp/logtofile.msp --- mosml-2.01/examples/msp/logtofile.msp 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/logtofile.msp 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,36 @@ + +MSP example: log to a file + + +

MSP example: log to a file

+ +This script writes to and reads from a log file, kept in the script +source directory. + +

The log file can be kept outside the script source directory if +desirable for security. + +") ^ "\n" +val _ = output(os, msg) +val _ = closeOut os +?> + +

The current contents of the log file is: + +

+ + + diff -Nru mosml-2.01/examples/msp/Makefile mosml-2.10.1/examples/msp/Makefile --- mosml-2.01/examples/msp/Makefile 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/Makefile 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,18 @@ +# Making and installing ML Server Pages version 1.2, for Moscow ML 2.10 + +# NB: Must set `SCRIPTCACHE' and `mosmlc' in mspcompile.sml prior to compilation. + +CGI_DIR=/usr/lib/cgi-bin +SCRIPTCACHE=/var/cache/mspscripts + +all: + mosmlc -standalone -o mspcompile mspcompile.sml + +install: + cp mspcompile ${CGI_DIR} + mkdir ${SCRIPTCACHE} + chown www-data:www-data ${SCRIPTCACHE} + +clean: + rm -f *.ui *.uo + rm -f mspcompile diff -Nru mosml-2.01/examples/msp/mspcompile.sml mosml-2.10.1/examples/msp/mspcompile.sml --- mosml-2.01/examples/msp/mspcompile.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/mspcompile.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,176 @@ +(* ML serverpages -- sestoft@dina.kvl.dk 2001-04-29 v 1.1 + -- 2014-03-05 Ken Friis Larsen minor changes, v 1.2 + + Under Unix/Linux/MacOSX compile with + mosmlc -standalone -o mspcompile mspcompile.sml + + Under MS Windows compile with + mosmlc -o mspcompile.exe mspcompile.sml + and note the lines marked MSWINDOWS below. + *) + +(* Directory for compiling and storing scripts; must agree with Makefile *) + +val SCRIPTCACHE = "/var/cache/mspscripts" + +(* The path to the Moscow ML compiler. Add .exe under MSWINDOWS: *) + +val mosmlc = "/usr/bin/mosmlc" + +(* Transform [x1, x2, ..., xn] to [f x1, sep, f x2, sep, ..., sep, f xn] *) + +fun delimit sep f res xs = + case xs of + [] => [] + | x1 :: xr => f x1 :: List.foldr (fn (x, r) => sep :: f x :: r) res xr + +(* The end of the HTTP response header *) + +val httpheader : string option ref = ref NONE; + +(* Process plain HTML-code, which surrounds the ML script fragments. + Create an SML string constant with newlines and line + continuations, and with quotes and backslashes properly escaped. *) + +fun dohtml out sus = + let open Substring + val lines = fields (fn c => c = #"\n") sus + val linesres = delimit "\\n\\\n\\" (translate Char.toString) + ["\";\n"] lines + in + (* Do not terminate HTTP response header until HTML code begins *) + if not (isEmpty sus) then + (Option.app out (!httpheader); httpheader := NONE; + List.app out ("val _ = print \"" :: linesres)) + else () + end + +(* This function takes care of XML Processing Instructions, including MSP: *) + +local + open Substring + + val xmlpihandlers : (string * (substring -> substring list)) list = + [("MSP", + fn ml => + (case first ml of + SOME #"=" => [all "val _ = print(", triml 1 ml, all ");\n"] + | SOME #"$" => [all "val _ = Msp.printseq(", + triml 1 ml, all ");\n"] + | _ => [ml])) + ] +in + fun doxmlpi outsus pifrag = + let fun process [] = raise Fail "Unknown XML PI type" + | process ((target, processor) :: rest) = + if isPrefix target pifrag then + List.app outsus + (processor (slice(pifrag, String.size target, NONE))) + else + process rest + in + process xmlpihandlers + end + + (* Find and process XML Processing Instructions; output HTML code: *) + + fun findxmlpi dohtml doxmlpi (sus : substring) = + let val (pre1, suf1) = position "" suf1 + in + if not (isEmpty suf2) then + (doxmlpi (triml 2 pre2); + findxmlpi dohtml doxmlpi (triml 2 suf2)) + else + dohtml suf1 + end +end; + +(* Turn fbase.msp into fbase.sml, then compile and link it: *) + +fun compile src bin = + let val is = TextIO.openIn src + val mspsrc = Substring.all (TextIO.inputAll is) + fun addext ext = Path.joinBaseExt{ base = bin, ext = SOME ext } + val smlsrc = addext "sml" + val os = TextIO.openOut smlsrc + fun out s = TextIO.output(os, s) + fun outsus sus = TextIO.outputSubstr(os, sus) + fun remove ext = (FileSys.remove (addext ext)) handle SysErr _ => () + in + httpheader := SOME (String.concat + ["val _ = print \"Content-type: text/html\\n\\n\\\n\ + \\\\\n\"\n"]); + findxmlpi (dohtml out) (doxmlpi outsus) mspsrc; + TextIO.closeOut os; + TextIO.closeIn is; + (Mosml.run mosmlc ["-q", "-o", bin, "-I", Path.dir src, smlsrc] "") + before (remove "ui"; remove "uo"; remove "sml") + end + +(* Log to httpd.error_log *) + +fun log s = + let val client = Option.getOpt(Process.getEnv "REMOTE_ADDR", "N/A") + in TextIO.output(TextIO.stdErr, "MSP [" ^ client ^ "]: " ^ s ^ "\n") end + +(* Report an error back to the invoking browser *) + +fun err msg = + (print "Content-type: text/plain\n\n"; + print (msg ^ "\n"); + log msg) + +(* Compile the .msp file if it does not exist or is out of date: *) + +fun update path : string option = + let val src = Path.joinBaseExt{base = path, ext = SOME "msp" } + fun hexify c = if Char.isAlphaNum c then str c + else Int.fmt StringCvt.HEX (ord c) + val bin = String.translate hexify (Mosml.md5sum path) + (* MSWINDOWS add: + val bin = Path.joinBaseExt {base = bin, ext = SOME "exe"} *) + in + if not (FileSys.access(bin, [])) + orelse Time.>(FileSys.modTime src, FileSys.modTime bin) then + case compile src bin of + Mosml.Success _ => SOME bin + | Mosml.Failure s => + (err ("Compilation of " ^ src ^ " failed:\n" ^ s); NONE) + else + SOME bin + end; + +(* Invoke a compiled script *) + +fun invoke path bin = + let fun intOf NONE = NONE + | intOf (SOME s) = Int.fromString s + val len = Option.getOpt(intOf (Process.getEnv("CONTENT_LENGTH")), 0) + val input = TextIO.inputN(TextIO.stdIn, len) + in + FileSys.chDir (Path.dir path); + case Mosml.run (Path.concat(SCRIPTCACHE, bin)) [] input of + Mosml.Failure s => err ("Invocation of " ^ path ^ " failed:\n" ^ s) + | Mosml.Success s => print s + end + +(* Main program *) + +val _ = + (FileSys.chDir SCRIPTCACHE; + case Process.getEnv("PATH_TRANSLATED") of + NONE => err "Invocation failed. Contact server administrator" + | SOME path => + let val base = Path.base path + in + case update base of + NONE => () + | SOME bin => invoke path bin + end) + handle Fail s => err ("Script failed: " ^ s) + | Io {function, name, ...} => + err ("Io error: " ^ function ^ " failed on " ^ name) + | SysErr _ => err "SysErr" diff -Nru mosml-2.01/examples/msp/msp.conf mosml-2.10.1/examples/msp/msp.conf --- mosml-2.01/examples/msp/msp.conf 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/msp.conf 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,3 @@ +Action mspcompile /cgi-bin/mspcompile +AddHandler mspcompile .msp +DirectoryIndex index.msp \ No newline at end of file diff -Nru mosml-2.01/examples/msp/README.md mosml-2.10.1/examples/msp/README.md --- mosml-2.01/examples/msp/README.md 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/README.md 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,153 @@ +ML Server Pages (version 1.2) +============================= + +ML Server Pages (MSP) is a web scripting language, a loose integration +of Standard ML (SML) and HTML in the style of Sun's Java Server Pages, +Microsoft's Active Server Pages, or PHP. + +This note describes how to install MSP under Moscow ML 2.10. + +To use MSP scripts you'll need + + - Moscow ML 2.10 (may even work with older versions) + - an Apache webserver (or similar) + +This directory contains: + + - mspcompile.sml + - example MSP scripts + + +Installation instructions +------------------------- + + 1. Edit CGI_DIR and SCRIPTCACHE in `Makefile` to reflect your + webserver setup for cgi scripts and where to store compiled MSP + scripts. + + 2. Edit `mspcompile.sml` to reflect the location of your Moscow ML + installation and where to store compiled MSP scripts. + + 3. Do + + make all + + 4. Then, install everything by + + sudo make install + + 5. Setup your Apache webserver configuration (tested with a standard + Apache 2.4 installation under Ubuntu 13.10): + + 5a. copy the file `msp.conf` to `/etc/apache2/conf-available` + + 5b. enable the MSP configuration with the command + + sudo a2enconf msp + + 5c. Restart Apache with the command + + sudo service apache2 restart + + 5d. If you are not using Ubuntu or Debian, then your Apache setup + might be slightly different. In that case, copy the content of + `msp.conf` to the relevant Apache conf file for your setup. + + 6. Test it. Copy `hello.msp` to a directory accessible from the web, + say, `http://foo.com/hello.msp` and point your browser to that URL. + + +If it doesn't work +------------------ + + - If you get an error like: + + AH00526: Syntax error on line 1 of /etc/apache2/conf-enabled/msp.conf: + Invalid command 'Action', perhaps misspelled or defined by a module not included in the server configuration + + After you restart Apache, you probably need to enable the `actions` + module. For instance, by the command: + + sudo a2enmod actions + + And then you most likely also need to enable the `cgi` module + (using the `a2enmod` command). + + - If mspcompile does start, then check Apache's `error.log`; the + mspcompile script logs all errors there. + + - If mspcompile starts but cannot compile the generated scripts, then + possibly the compiler mosmlc cannot find the Msp.ui and Msp.uo files. + Make sure you set MOSMLLIB correctly in the Makefile (in this directory). + + +Writing ML Server Pages +----------------------- + +An ML server page script is stored in an .msp file and consists of +HTML (text) fragments and SML (code) fragments. + +Thus a date-enhanced Hello World script might look like this: + + + +

Hello world!

+ + The current date and time is + + +
Your friendly ML server page
+ + + +In general, an SML fragment must have one of the following forms: + +* `` + + An SML declaration dec in may define types, + functions and variables, and may print (on standard output) HTML + code that becomes part of the resulting HTML page. + +* `` + + An SML expression exp in must have type string. + The expression is evaluated and the resulting string is printed on + standard output as part of the resulting HTML page. + +* `` + + An SML expression exp in must have type Msp.wseq. + + The expression is evaluated and the resulting word sequence is + printed on standard output as part of the resulting HTML page. + +The following structures are particularly useful for writing ML server +page scripts: + + * `Msp` for efficient functional generation of HTML. + + * `Mosmlcgi` for accessing CGI parameters + + * `Mosmlcookie` for manipulating cookies. Untested. Cookies can be + accessed anywhere in an MSP script, but can be set + only in a ML fragment immediately at the beginning of + the MSP script, before any HTML fragment. + + +Who is responsible? +------------------- + +The concept of ML server pages was presented by Christian Stefansen at +a Funtechs meeting in December 1999 at the IT University of +Copenhagen. This early design and implementation is by Peter Sestoft. +The third honourable member of the ML server pages group is Peter +Lund. + + +For further information +----------------------- + +See MSP homepage in `index.msp` + +Peter Sestoft (sestoft@itu.dk) 2000-02-22, 2000-08-20 +Ken Friis Larsen (ken@friislarsen.net) 2014-03-05 diff -Nru mosml-2.01/examples/msp/script1.msp mosml-2.10.1/examples/msp/script1.msp --- mosml-2.01/examples/msp/script1.msp 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/script1.msp 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,8 @@ + + +
+ +
Login name: +
Password: +
+
diff -Nru mosml-2.01/examples/msp/script2.msp mosml-2.10.1/examples/msp/script2.msp --- mosml-2.01/examples/msp/script2.msp 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/script2.msp 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,41 @@ + + + + + + +OK, you are logged in as + +

What do you want to order: + + + + + + +

+ + + ok false n + | (NONE, SOME n, SOME p) => if n=p then ok true n + else print "Wrong password." + | (_ , NONE, _ ) => print "Missing name" + | (_ , _, NONE ) => print "Missing password" +?> + + diff -Nru mosml-2.01/examples/msp/script3.msp mosml-2.10.1/examples/msp/script3.msp --- mosml-2.01/examples/msp/script3.msp 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/script3.msp 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,37 @@ + + + + +

Your order so far

+ +Hello, ") ?>, you have ordered the +following items: + +

+ + +
ProductQuantity + tr (td ($p) && td($(Int.toString q)))) + (getOpt(getorder(), [])) +?> +
+ +

+ +
+ +

+ +

+ + +
+ diff -Nru mosml-2.01/examples/msp/test.msp mosml-2.10.1/examples/msp/test.msp --- mosml-2.01/examples/msp/test.msp 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/msp/test.msp 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,101 @@ + +MSP examples: generating tables in various styles + + +

MSP examples: generating tables in various styles

+ +This page was generated to illustrate Mosml Server Pages. + +"; print (Int.toString (opr(r,s)))) + fun mkhead i = (print ""; print (Int.toString i)) + fun mkrow m r = (print ""; mkhead r; + List.tabulate(m, mkcell r); print "\n") + in + print "
"; print oprname; + List.tabulate(m, mkhead); print "\n"; + List.tabulate(n, mkrow m); + print "
" + end +?> + +" && $ (Int.toString (opr(r,s))) + fun mkhead i = $ "" && $ (Int.toString i) + fun tabulate(n, f) = List.foldr (op&&) Empty (List.tabulate(n, f)) + fun mkrow m r = $ "" && mkhead r && tabulate(m, mkcell r) && Nl + in + $ "
" && $ oprname && tabulate(m, mkhead) && Nl + && tabulate(n, mkrow m) + && $"
" + end +?> + + + + + +

A multiplication table (generated by imperative code)

+ + + +

A multiplication table (generated by functional code)

+ + + +

An addition table (generated by functional code)

+ + + +

A subtraction table (generated by functional code using Msp HTML functions)

+ + + +

+ + c = #"0") (all s)) +in + val shortmon = drop0 (Date.fmt "%m" now) + val shortday = drop0 (Date.fmt "%d" now) +end +?> + + +
Year +
Month +
Danish date format +
US date format +
ISO date format +
The time now is +
+ + diff -Nru mosml-2.01/examples/parsercomb/exprparser.sml mosml-2.10.1/examples/parsercomb/exprparser.sml --- mosml-2.01/examples/parsercomb/exprparser.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/examples/parsercomb/exprparser.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,181 @@ +(* Expression parser using Parser combinators *) +(* By Ken Friis Larsen *) +(* (Re)Created: 20010907 *) +structure ExprParser = +struct + +local + structure C = Char + structure PC = Parsercomb + infix 6 $-- --$ #-- --# + infix 5 -- + infix 3 >> >>* + infix 2 >>= + infix 0 || + + val (op$--, op--$, op#--, op--#, op--, op>>, op>>*, op>>=, op||) = + (PC.$--, PC.--$, PC.#--, PC.--#, PC.--, PC.>>, PC.>>*, PC.>>=, PC.||) + (* Instead of this line-noise I'd prefer to write + open PC.Symbols + *) + + infix 3 ##> + fun e ##> res = PC.getLit e >> (fn _ => res) + + fun compose(par1, par2) strm = + let val par1stream = PC.stream par1 strm + in par2 par1stream end + + infix 3 >>> + val op >>> = compose + + fun toReader par get src = + let val input = PC.stream get src + in Option.map (fn(res,_) => (res, src)) (par input) end + + val % = PC.getLit + +in + + datatype operator = PLUS | MULT | MINUS | DIV + + (* The datatype of abstact syntax trees for expressions *) + datatype expr = VAR of string + | INT of int + | BIN of expr * operator * expr + + local + datatype token = VAR_T of string + | INT_T of int + | PLUS_T | MULT_T | MINUS_T | DIV_T + | LPAR_T | RPAR_T + | EOF_T + + (* First a simple lexer *) + local + val ident = + PC.getChars1 C.isAlpha -- PC.getChars0 C.isAlphaNum >> op^ + + val number = PC.scan (Int.scan StringCvt.DEC) + in + val token = PC.skipWS + ( ident >> VAR_T + || #"+" ##> PLUS_T + || number >> INT_T + || #"*" ##> MULT_T + || #"-" ##> MINUS_T + || #"/" ##> DIV_T + || #"(" ##> LPAR_T + || #")" ##> RPAR_T + || PC.eof EOF_T + ) + + val lexer = PC.stream token + end + + fun toList stream = + case PC.getItem stream of + SOME(EOF_T, _) => [EOF_T] + | SOME(x, stream) => x :: toList stream + | NONE => [] + + + (* Then the parser *) + + (* The grammar we want to parse: + start ::= expr EOF_T + + expr ::= sum + + sum ::= sum sumOpr prod + | prod + + prod ::= prod prodOpr term + | term + + term ::= VAR_T + | INT_T + | LPAR_T expr RPAR_T + + sumOpr ::= PLUS_T | MINUS_T + prodOrd ::= MULT_T | DIV_T + + But first we need to eliminate left recursion in sum and prod. + Hence, they are changed to: + + sum ::= prod sum' + + sum' ::= sumOpr prod sum' + | empty + + prod ::= term prod' + + prod' ::= prodOpr term prod' + | empty + *) + + (* helper functions *) + fun buildBin (x, oprRest) = + case oprRest of + SOME(opr, y) => BIN(x, opr, y) + | NONE => x + + fun mkBin opr (x, y) = BIN(x, opr, y) + + fun getOpt f = PC.getItem >>* f + + (* simple productions *) + val getVar = getOpt(fn (VAR_T s) => SOME s | _ => NONE) + val getInt = getOpt(fn (INT_T i) => SOME i | _ => NONE) + + val sumOpr = PLUS_T ##> mkBin PLUS + || MINUS_T ##> mkBin MINUS + + val prodOpr = MULT_T ##> mkBin MULT + || DIV_T ##> mkBin DIV + + fun chainl left recur opr right = + (PC.optional((opr -- right >> (fn (opr, right) => opr(left, right))) + >>= recur)) + >> (fn NONE => left | SOME e => e) + + + (* recursive productions *) + fun start toks = (expr --# % EOF_T) toks + + and expr toks = sum toks + + and sum toks = (prod >>= sum') toks + and sum' e = chainl e sum' sumOpr prod +(* (PC.optional((sumOpr -- prod >> (fn (opr, y) => BIN(e, opr, y))) + >>= sum')) + >> (fn NONE => e | SOME e => e) +*) + and prod toks = (term >>= prod') toks + and prod' e = chainl e prod' prodOpr term + + and term toks = + ( getVar >> VAR + || getInt >> INT + || % LPAR_T #-- expr --# % RPAR_T + ) toks + in + + val parse = fn x => toReader(token >>> start) x + + val parseString = StringCvt.scanString parse + + fun parseFile filename = + let val dev = TextIO.openIn filename + in #1((TextIO.scanStream parse dev) + handle ? => (TextIO.closeIn dev; raise ?) + , TextIO.closeIn dev) + end + end +end +end + +(* Test + val e1 = ExprParser.parseString "x+3 * pi"; + val e2 = ExprParser.parseString "(x + 3 ) * pi "; +*) diff -Nru mosml-2.01/examples/parsercomb/Parsercomb.sig mosml-2.10.1/examples/parsercomb/Parsercomb.sig --- mosml-2.01/examples/parsercomb/Parsercomb.sig 2000-05-16 11:50:34.000000000 +0000 +++ mosml-2.10.1/examples/parsercomb/Parsercomb.sig 2014-08-28 08:47:22.000000000 +0000 @@ -63,7 +63,7 @@ end (* - ['elm stream] is the type of a lazy streams (sequences) of 'elm values. + ['elm stream] is the type of a lazy stream (sequence) of 'elm values. [('elm, 'res) parser] is the type of parsers that consume elements from an 'elm stream to produce a result of type 'res. The attempt diff -Nru mosml-2.01/examples/parsercomb/Parsercomb.sml mosml-2.10.1/examples/parsercomb/Parsercomb.sml --- mosml-2.01/examples/parsercomb/Parsercomb.sml 2000-05-16 11:50:34.000000000 +0000 +++ mosml-2.10.1/examples/parsercomb/Parsercomb.sml 2014-08-28 08:47:22.000000000 +0000 @@ -1,5 +1,5 @@ (* Parsercomb -- Hutton/Paulson-style parser combinators for Moscow ML. - Fritz Henglein, Ken Larsen, Peter Sestoft. + Fritz Henglein, Ken Friis Larsen, Peter Sestoft. Documentation by sestoft@dina.kvl.dk. Version 0.4 of 2000-04-30 *) structure Parsercomb :> Parsercomb = diff -Nru mosml-2.01/examples/parsercomb/README mosml-2.10.1/examples/parsercomb/README --- mosml-2.01/examples/parsercomb/README 2000-05-22 14:17:15.000000000 +0000 +++ mosml-2.10.1/examples/parsercomb/README 2014-08-28 08:47:22.000000000 +0000 @@ -1,7 +1,7 @@ PARSER COMBINATORS ------------------ -The module Parsercomb implements Hutton/Paulson-style parser +The module Parsercomb implements Burge/Hutton/Paulson-style parser combinators for Moscow ML. It is based on work by Fritz Henglein, Ken Friis Larsen, and Peter Sestoft. A version of this module will be included in the Moscow ML Library, once it has stabilized. diff -Nru mosml-2.01/examples/README mosml-2.10.1/examples/README --- mosml-2.01/examples/README 2000-06-28 22:53:38.000000000 +0000 +++ mosml-2.10.1/examples/README 2014-08-28 08:47:22.000000000 +0000 @@ -31,6 +31,10 @@ language, an extension of Standard ML's Modules language. These are small examples without Makefiles. +msp ML Server Pages. A loose integration of Standard ML + (SML) and HTML in the style of Sun's Java Server + Pages, Microsoft's Active Server Pages, or PHP. + parsercomb An implementation of Hutton/Paulson-style parser combinators for Moscow ML, based on work by Fritz Henglein, Ken Friis Larsen, and Peter Sestoft. diff -Nru mosml-2.01/examples/webserver/mosmlserver.sml mosml-2.10.1/examples/webserver/mosmlserver.sml --- mosml-2.01/examples/webserver/mosmlserver.sml 2000-01-21 10:07:12.000000000 +0000 +++ mosml-2.10.1/examples/webserver/mosmlserver.sml 2014-08-28 08:47:22.000000000 +0000 @@ -8,7 +8,7 @@ *) val server = "Moscow ML HTTP Server version 0.6 of 1999-06-28" -val myaddr = "130.225.40.253" +val myaddr = "127.0.0.1" val port = 8080 val docroot = "/home/sestoft/.public_html" val admin = "sestoft@dina.kvl.dk" diff -Nru mosml-2.01/.gitignore mosml-2.10.1/.gitignore --- mosml-2.01/.gitignore 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/.gitignore 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1 @@ +/config diff -Nru mosml-2.01/include/alloc.h mosml-2.10.1/include/alloc.h --- mosml-2.01/include/alloc.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/alloc.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,19 +0,0 @@ -#ifndef _alloc_ -#define _alloc_ - - -#include "misc.h" -#include "mlvalues.h" - -EXTERN value alloc(mlsize_t, tag_t); -EXTERN value alloc_tuple(mlsize_t); -EXTERN value alloc_string(mlsize_t); -EXTERN value alloc_final(mlsize_t, final_fun, mlsize_t, mlsize_t); -EXTERN value copy_string(char *); -EXTERN value copy_string_array(char **); -EXTERN value copy_double(double); -EXTERN value alloc_array(value (*funct) (char *), char ** array); -EXTERN int convert_flag_list(value, int *); - - -#endif /* _alloc_ */ diff -Nru mosml-2.01/include/callback.h mosml-2.10.1/include/callback.h --- mosml-2.01/include/callback.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/callback.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,26 +0,0 @@ -/* callback.h */ - -#ifndef _callback_ -#define _callback_ - -#include "mlvalues.h" /* for Field, Reference_tag etc */ -#include "fail.h" /* for failwith */ -#include "memory.h" /* for alloc_shr */ -#include "alloc.h" /* for copy_string */ -#include "minor_gc.h" /* for minor_collection */ -#include "interp.h" /* for callback */ - -typedef value valueptr; /* An 'a option ref */ - -EXTERN valueptr get_valueptr(char* nam); -EXTERN value get_value(valueptr mvp); -EXTERN value callbackptr(valueptr closureptr, value arg1); -EXTERN value callbackptr2(valueptr closureptr, value arg1, value arg2); -EXTERN value callbackptr3(valueptr closureptr, value arg1, value arg2, - value arg3); -EXTERN void registervalue(char* nam, value mlval); -EXTERN void unregistervalue(char* nam); - -EXTERN void registercptr(char* nam, void* cptr); - -#endif /* _callback_ */ diff -Nru mosml-2.01/include/config.h mosml-2.10.1/include/config.h --- mosml-2.01/include/config.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/config.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,170 +0,0 @@ -#ifndef _config_ -#define _config_ - - -#if defined(__MWERKS__) || defined(THINK_C) -#include "m.h" -#include "s.h" -#else -#ifdef macintosh -#include ":::config:m.h" -#include ":::config:s.h" -#else -#if defined(msdos) -#include "../config.dos/m.h" -#include "../config.dos/s.h" -#elif defined(WIN32) -#include "../config.w32/m.h" -#include "../config.w32/s.h" -#else -#include "../config/m.h" -#include "../config/s.h" -#endif -#endif -#endif - -#ifdef WIN32 - -#ifdef CAMLRT -#define EXTERN __declspec(dllexport) -#else -#define EXTERN __declspec(dllimport) -#endif - -#else -#define EXTERN extern -#endif - -/* Library dependencies */ - -#ifdef HAS_MEMMOVE -#define bcopy(src,dst,len) memmove((dst), (src), (len)) -#else -#ifdef HAS_BCOPY -/* Nothing to do */ -#else -#ifdef HAS_MEMCPY -#define bcopy(src,dst,len) memcpy((dst), (src), (len)) -#else -#define bcopy(src,dst,len) memmov((dst), (src), (len)) -#define USING_MEMMOV -#endif -#endif -#endif - -#ifndef HAS__SETJMP -#define _setjmp setjmp -#define _longjmp longjmp -#endif - -/* Signed char type */ - -#if defined(__STDC__) || defined(SIGNED_CHAR_WORKS) || defined(WIN32) -typedef signed char schar; -#else -typedef char schar; -#endif - -/* Do not change this definition. */ -#define Page_size (1 << Page_log) - -/* Memory model parameters */ - -#if !defined(SMALL) && !defined(SIXTEEN) - -/* The size of a page for memory management (in bytes) is [1 << Page_log]. - It must be a multiple of [sizeof (long)]. */ -#define Page_log 12 /* A page is 4 kilobytes. */ - -/* Initial sizes of stacks (bytes). */ -#define Stack_size 32768 - -/* Minimum free size of stacks (bytes); below that, they are reallocated. */ -#define Stack_threshold 2048 - -/* Maximum sizes for the stacks (bytes). */ - -#ifdef MINIMIZE_MEMORY -#define Max_stack_size 262144 -#else -#define Max_stack_size 1048576 -#endif - -/* Maximum size of a block allocated in the young generation (words). */ -/* Must be > 4 */ -#define Max_young_wosize 256 - - -/* Minimum size of the minor zone (words). - This must be at least [Max_young_wosize + 1]. */ -#define Minor_heap_min 4096 - -/* Maximum size of the minor zone (words). - Must be greater than or equal to [Minor_heap_min]. -*/ -#define Minor_heap_max (1 << 28) - -/* Default size of the minor zone. (words) */ -#define Minor_heap_def 32768 - - -/* Minimum size increment when growing the heap (words). - Must be a multiple of [Page_size / sizeof (value)]. */ -#define Heap_chunk_min (2 * Page_size / sizeof (value)) - -/* Maximum size of a contiguous piece of the heap (words). - Must be greater than or equal to [Heap_chunk_min]. - Must be greater than or equal to [Bhsize_wosize (Max_wosize)]. */ -#define Heap_chunk_max (Bhsize_wosize (Max_wosize)) - -/* Default size increment when growing the heap. (bytes) - Must be a multiple of [Page_size / sizeof (value)]. */ -#define Heap_chunk_def (62 * Page_size / sizeof (value)) - - -/* Default speed setting for the major GC. The heap will grow until - the dead objects and the free list represent this percentage of the - heap size. The rest of the heap is live objects. */ -#define Percent_free_def 30 - - -#else -#ifdef SIXTEEN /* Scaled-down parameters for 16-bit machines */ - -#define Page_log 10 -#define Stack_size 32768 -#define Stack_threshold 2048 - -#define Max_stack_size 65532 -#define Max_young_wosize 256 -#define Minor_heap_min 512 -#define Minor_heap_max 0x3F00 -#define Minor_heap_def 8192 -#define Heap_chunk_min 0x400 -#define Heap_chunk_max 0x3C00 -#define Heap_chunk_def 0x2000 -#define Percent_free_def 15 - -#else -#ifdef SMALL /* Scaled-down parameters for small memory */ - -#define Page_log 10 -#define Stack_size 32768 -#define Stack_threshold 2048 -#define Max_stack_size 1048576 -#define Max_young_wosize 256 -#define Minor_heap_min 1024 -#define Minor_heap_max (1 << 28) -#define Minor_heap_def 16384 -#define Heap_chunk_min (2 * Page_size / sizeof (value)) -#define Heap_chunk_max (1 << 28) -#define Heap_chunk_def (126 * Page_size / sizeof (value)) -#define Percent_free_def 20 - -#endif /* SMALL */ -#endif /* SIXTEEN */ - -#endif /* !defined(SMALL) && !defined(SIXTEEN) */ - - -#endif /* _config_ */ diff -Nru mosml-2.01/include/debugger.h mosml-2.10.1/include/debugger.h --- mosml-2.01/include/debugger.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/debugger.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,53 +0,0 @@ -#ifndef _debugger_ -#define _debugger_ - -#include "misc.h" -#include "mlvalues.h" - -#ifdef DEBUG - -#define LOG_BUFFER_SIZE 100 -extern bytecode_t log_buffer[LOG_BUFFER_SIZE]; -extern bytecode_t * log_ptr; -extern int trace_flag; - -#define Debug(x) x - -#if defined(__STDC__) || defined(WIN32) -#define Assert(x) if (!(x)) failed_assert ( #x , __FILE__, __LINE__) -#define Dprintx(x) printf ("expression %s %ld\n", #x, (unsigned long) (x)) -#else -#ifndef __LINE__ -#define __LINE__ 0 -#endif -#ifndef __FILE__ -#define __FILE__ "(?)" -#endif -#define Assert(x) if (!(x)) failed_assert ("(?)" , __FILE__, __LINE__) -#define Dprintx(x) printf ("expression %ld\n", (unsigned long) (x)) -#endif /* __STDC__ */ - -void failed_assert (char *, char *, int); -void print_value (value); -bytecode_t disasm_instr (bytecode_t); -void post_mortem (int); -unsigned long not_random (void); - -#else /* DEBUG */ - -#define Debug(x) -#define Assert(x) -#define Dprintx(x) - -#endif /* DEBUG */ - -#define nTrace(msg, x, y) - -#ifdef TRACE -#define Trace(msg, x, y) printf (msg, x, y) -#else -#define Trace(msg, x, y) -#endif - - -#endif /* _debugger_ */ diff -Nru mosml-2.01/include/exec.h mosml-2.10.1/include/exec.h --- mosml-2.01/include/exec.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/exec.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,26 +0,0 @@ -/* exec.h : format of executable bytecode files */ - -/* offset 0 ---> initial junk - code block - data block - symbol table - debug infos - trailer - end of file ---> -*/ - -/* Structure of the trailer: five 32-bit, unsigned integers, big endian */ - -#define TRAILER_SIZE 20 - -struct exec_trailer { - unsigned long code_size; /* Size of the code block (in bytes) */ - unsigned long data_size; /* Size of the global data table (bytes) */ - unsigned long symbol_size; /* Size of the symbol table (bytes) */ - unsigned long debug_size; /* Size of the debug infos (bytes) */ - unsigned long magic; /* A magic number */ -}; - -/* Magic number for this release */ - -#define EXEC_MAGIC 0x4d4c3038 /* "ML08" */ diff -Nru mosml-2.01/include/expand.h mosml-2.10.1/include/expand.h --- mosml-2.01/include/expand.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/expand.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,4 +0,0 @@ -/* expand.h -- replace bytecode with threaded code */ - -realcode_t expandcode(bytecode_t byteprog, int code_size, void * jumptable[]); - diff -Nru mosml-2.01/include/fail.h mosml-2.10.1/include/fail.h --- mosml-2.01/include/fail.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/fail.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,27 +0,0 @@ -#ifndef _fail_ -#define _fail_ - -#include -#include "misc.h" -#include "mlvalues.h" - -struct longjmp_buffer { - jmp_buf buf; -}; - -extern struct longjmp_buffer * external_raise; -extern value exn_bucket; - -EXTERN Noreturn mlraise(value); -EXTERN Noreturn raiseprimitive0(int exnindex); -EXTERN Noreturn raiseprimitive1(int exnindex, value arg); -EXTERN Noreturn raise_with_string(int exnindex, char * msg); -EXTERN Noreturn failwith(char *); -EXTERN Noreturn invalid_argument(char *); -EXTERN Noreturn raise_overflow(void); -EXTERN Noreturn raise_out_of_memory(void); -extern volatile int float_exn; - -extern double maxdouble; - -#endif /* _fail_ */ diff -Nru mosml-2.01/include/freelist.h mosml-2.10.1/include/freelist.h --- mosml-2.01/include/freelist.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/freelist.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,16 +0,0 @@ -/* Free lists of heap blocks. */ - -#ifndef _freelist_ -#define _freelist_ - - -#include "misc.h" -#include "mlvalues.h" - -char *fl_allocate (mlsize_t); -void fl_init_merge (void); -char *fl_merge_block (char *); -void fl_add_block (char *); - - -#endif /* _freelist_ */ diff -Nru mosml-2.01/include/gc_ctrl.h mosml-2.10.1/include/gc_ctrl.h --- mosml-2.01/include/gc_ctrl.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/gc_ctrl.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,17 +0,0 @@ -#ifndef _gc_ctrl_ -#define _gc_ctrl_ - -#include "misc.h" - -extern long - stat_minor_words, - stat_promoted_words, - stat_major_words, - stat_minor_collections, - stat_major_collections, - stat_heap_size; - -void init_gc (long, long, int, int); - - -#endif /* _gc_ctrl_ */ diff -Nru mosml-2.01/include/gc.h mosml-2.10.1/include/gc.h --- mosml-2.01/include/gc.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/gc.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,42 +0,0 @@ -#ifndef _gc_ -#define _gc_ - - -#include "mlvalues.h" - -/* Defined in [major_gc.c]. */ -extern unsigned free_mem_percent_min, free_mem_percent_max; - -#define White (0 << 8) -#define Gray (1 << 8) -#define Blue (2 << 8) -#define Black (3 << 8) - -#define Color_hd(hd) ((color_t) ((hd) & Black)) -#define Color_hp(hp) Color_hd (Hd_hp (hp)) - -#define Is_white_hd(hd) (Color_hd (hd) == White) -#define Is_gray_hd(hd) (Color_hd (hd) == Gray) -#define Is_blue_hd(hd) (Color_hd (hd) == Blue) -#define Is_black_hd(hd) (Color_hd (hd) == Black) - -#define Whitehd_hd(hd) ((hd) & ~Black) -#define Grayhd_hd(hd) (((hd) & ~Black) | Gray) -#define Blackhd_hd(hd) ((hd) | Black) -#define Bluehd_hd(hd) (((hd) & ~Black) | Blue) - -/* This depends on the layout of the header. See [mlvalues.h]. */ -#define Make_header(wosize, tag, color) \ - ((header_t) (((header_t) (wosize) << 10) \ - + (color) \ - + (tag_t) (tag))) - -#define Color_val(val) (Color_hd (Hd_val (val))) - -#define Is_white_val(val) (Color_val(val) == White) -#define Is_gray_val(val) (Color_val(val) == Gray) -#define Is_blue_val(val) (Color_val(val) == Blue) -#define Is_black_val(val) (Color_val(val) == Black) - - -#endif /* _gc_ */ diff -Nru mosml-2.01/include/.gitignore mosml-2.10.1/include/.gitignore --- mosml-2.01/include/.gitignore 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/include/.gitignore 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1 @@ +*.h diff -Nru mosml-2.01/include/globals.h mosml-2.10.1/include/globals.h --- mosml-2.01/include/globals.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/globals.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,60 +0,0 @@ -/* ML global variables reachable from C. */ - -#ifndef _globals_ -#define _globals_ - - -#include "mlvalues.h" - -extern value global_data; - -#define GLOBAL_DATA 0 /* "meta","global_data" */ -#define SYS__S_IRUSR 1 /* "sys","s_irusr" */ -#define SYS__S_IWUSR 2 /* "sys","s_iwusr" */ -#define SYS__S_IXUSR 3 /* "sys","s_ixusr" */ -#define SYS__S_IRGRP 4 /* "sys","s_irgrp" */ -#define SYS__S_IWGRP 5 /* "sys","s_iwgrp" */ -#define SYS__S_IXGRP 6 /* "sys","s_ixgrp" */ -#define SYS__S_IROTH 7 /* "sys","s_iroth" */ -#define SYS__S_IWOTH 8 /* "sys","s_iwoth" */ -#define SYS__S_IXOTH 9 /* "sys","s_ixoth" */ -#define SYS__S_ISUID 10 /* "sys","s_isuid" */ -#define SYS__S_ISGID 11 /* "sys","s_isgid" */ -#define SYS__S_IRALL 12 /* "sys","s_irall" */ -#define SYS__S_IWALL 13 /* "sys","s_iwall" */ -#define SYS__S_IXALL 14 /* "sys","s_ixall" */ -#define SYS__COMMAND_LINE 15 /* "sys","command_line" */ -#define SYS__INTERACTIVE 16 /* "sys","interactive" */ -#define SYS__MAX_STRING_LENGTH 17 /* "sys","max_string_length" */ -#define SYS__MAX_VECT_LENGTH 18 /* "sys","max_vect_length" */ - -/* Exn indexes names for pervasive dynamic exceptions. The - corresponding exn names (string refs) are allocated by sys_init */ - -#define SYS__EXN_MEMORY 19 /* "sys","exn_memory" */ -#define SYS__EXN_ARGUMENT 20 /* "sys","exn_argument" */ -#define SYS__EXN_GRAPHIC 21 /* "sys","exn_graphic" */ -#define SYS__EXN_SYSERR 22 /* "sys","exn_syserr" */ -#define SYS__EXN_FAIL 23 /* "sys","exn_fail" */ -#define SYS__EXN_SIZE 24 /* "sys","exn_size" */ -#define SYS__EXN_INTERRUPT 25 /* "sys","exn_interrupt" */ -#define SYS__EXN_SUBSCRIPT 26 /* "sys","exn_subscript" */ -#define SYS__EXN_CHR 27 /* "sys","exn_chr" */ -#define SYS__EXN_DIV 28 /* "sys","exn_div" */ -#define SYS__EXN_DOMAIN 29 /* "sys","exn_domain" */ -#define SYS__EXN_ORD 30 /* "sys","exn_ord" */ -#define SYS__EXN_OVERFLOW 31 /* "sys","exn_overflow" */ -#define SYS__EXN_BIND 32 /* "sys","exn_bind" */ -#define SYS__EXN_MATCH 33 /* "sys","exn_match" */ -#define SYS__EXN_IO 34 /* "sys","exn_io" */ - -/* Frequently used exception values (NOT exn indexes); alloc by sys_init */ - -#define EXN_INTERRUPT 35 /* "sys","val_exn_interrupt" */ -#define EXN_DIV 36 /* "sys","val_exn_div" */ -#define EXN_OVERFLOW 37 /* "sys","val_exn_overflow" */ - -#define SYS__FIRST_EXN 19 -#define SYS__LAST_EXN 34 - -#endif /* _globals_ */ diff -Nru mosml-2.01/include/instruct.h mosml-2.10.1/include/instruct.h --- mosml-2.01/include/instruct.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/instruct.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,215 +0,0 @@ -/* The instruction set. */ - -/* --- The instruction set has been extended for Moscow ML! --- */ - -/* One instruction per line only. */ - -enum instructions { - CONSTBYTE, - CONSTSHORT, - SWITCH, - BRANCH, - BRANCHIF, - BRANCHIFNOT, - POPBRANCHIFNOT, - BRANCHIFNEQTAG, - BRANCHIFEQ, - BRANCHIFNEQ, - BRANCHIFLT, - BRANCHIFGT, - BRANCHIFLE, - BRANCHIFGE, - BRANCHINTERVAL, - C_CALL1, - C_CALL2, - C_CALL3, - C_CALL4, - C_CALL5, - C_CALLN, - MAKEBLOCK, - MAKEBLOCK1, - MAKEBLOCK2, - MAKEBLOCK3, - MAKEBLOCK4, - TAGOF, - ACCESS, - ACC0, - ACC1, - ACC2, - ACC3, - ACC4, - ACC5, - ACC6, - ACC7, - PUSHACC, - PUSHACC0, - PUSHACC1, - PUSHACC2, - PUSHACC3, - PUSHACC4, - PUSHACC5, - PUSHACC6, - PUSHACC7, - ENVACC, - ENV1, - ENV2, - ENV3, - ENV4, - ENV5, - ENV6, - ENV7, - PUSHENVACC, - PUSHENV1, - PUSHENV2, - PUSHENV3, - PUSHENV4, - PUSHENV5, - PUSHENV6, - PUSHENV7, - PUSH_ENV1_APPLY1, - PUSH_ENV1_APPLY2, - PUSH_ENV1_APPLY3, - PUSH_ENV1_APPLY4, - PUSH_ENV1_APPTERM1, - PUSH_ENV1_APPTERM2, - PUSH_ENV1_APPTERM3, - PUSH_ENV1_APPTERM4, - PUSHATOM, - ATOM, - PUSHATOM0, - ATOM0, - ATOM1, - ATOM2, - ATOM3, - ATOM4, - ATOM5, - ATOM6, - ATOM7, - ATOM8, - ATOM9, - CONSTINT, - PUSHCONSTINT, - CONST0, - CONST1, - CONST2, - CONST3, - PUSHCONST0, - PUSHCONST1, - PUSHCONST2, - PUSHCONST3, - GETFIELD, - GETFIELD0, - GETFIELD1, - GETFIELD2, - GETFIELD3, - GETFIELD0_0, - GETFIELD0_1, - GETFIELD1_0, - GETFIELD1_1, - SETFIELD, - SETFIELD0, - SETFIELD1, - SETFIELD2, - SETFIELD3, - GETGLOBAL, - PUSH_GETGLOBAL, - PUSH_GETGLOBAL_APPLY1, - PUSH_GETGLOBAL_APPLY2, - PUSH_GETGLOBAL_APPLY3, - PUSH_GETGLOBAL_APPLY4, - PUSH_GETGLOBAL_APPTERM1, - PUSH_GETGLOBAL_APPTERM2, - PUSH_GETGLOBAL_APPTERM3, - PUSH_GETGLOBAL_APPTERM4, - SETGLOBAL, - PUSH_RETADDR, - APPLY, - APPLY1, - APPLY2, - APPLY3, - APPLY4, - APPTERM, - APPTERM1, - APPTERM2, - APPTERM3, - APPTERM4, - RESTART, - GRAB, - RETURN1, - RETURN2, - RETURN, - CLOSURE, - CLOSREC, - DUMMY, - UPDATE, - PUSHTRAP, - RAISE, - POPTRAP, - SWAP, - PUSH, - POP, - ASSIGN, - BOOLNOT, - ADDINT, - SUBINT, - MULINT, - DIVINT, - MODINT, - ANDINT, - ORINT, - XORINT, - SHIFTLEFTINT, - SHIFTRIGHTINTSIGNED, - SHIFTRIGHTINTUNSIGNED, - EQ, - NEQ, - LTINT, - GTINT, - LEINT, - GEINT, - FLOATOFINT, - SMLNEGFLOAT, - SMLADDFLOAT, - SMLSUBFLOAT, - SMLMULFLOAT, - SMLDIVFLOAT, - INTOFFLOAT, - EQFLOAT, - NEQFLOAT, - LTFLOAT, - GTFLOAT, - LEFLOAT, - GEFLOAT, - STRINGLENGTH, - GETSTRINGCHAR, - SETSTRINGCHAR, - EQSTRING, - NEQSTRING, - LTSTRING, - GTSTRING, - LESTRING, - GESTRING, - MAKEVECTOR, - VECTLENGTH, - GETVECTITEM, - SETVECTITEM, - SMLNEGINT, - SMLSUCCINT, - SMLPREDINT, - SMLADDINT, - SMLSUBINT, - SMLMULINT, - SMLDIVINT, - SMLMODINT, - MAKEREFVECTOR, - SMLQUOTINT, - SMLREMINT, - CHECK_SIGNALS, - STOP, - EQUNSIGN, - NEQUNSIGN, - LTUNSIGN, - GTUNSIGN, - LEUNSIGN, - GEUNSIGN -}; diff -Nru mosml-2.01/include/interp.h mosml-2.10.1/include/interp.h --- mosml-2.01/include/interp.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/interp.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -#include "mlvalues.h" - -EXTERN value interprete(int mode, bytecode_t bprog, int code_size, CODE* rprog); -EXTERN value callback(value closure, value arg); -EXTERN value callback2(value closure, value arg1, value arg2); -EXTERN value callback3(value closure, value arg1, value arg2, value arg3); diff -Nru mosml-2.01/include/intext.h mosml-2.10.1/include/intext.h --- mosml-2.01/include/intext.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/intext.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,96 +0,0 @@ -/* Structured input/output */ - -#ifndef __intext__ -#define __intext__ - -#include "misc.h" -#include "mlvalues.h" -#include "io.h" - -/* Magic numbers used to discriminate between the extern formats */ - -#define Base_magic_number 0x8495A6B9 -#define Big_endian_32_magic_number Base_magic_number -#define Little_endian_32_magic_number (Base_magic_number + 1) -#define Big_endian_64_magic_number (Base_magic_number + 2) -#define Little_endian_64_magic_number (Base_magic_number + 3) -#define Compact_magic_number (Base_magic_number + 4) -#define First_valid_magic_number Base_magic_number -#define Last_valid_magic_number (Base_magic_number + 4) - -#ifdef SIXTYFOUR -# ifdef MOSML_BIG_ENDIAN -# define Extern_magic_number Big_endian_64_magic_number -# else -# define Extern_magic_number Little_endian_64_magic_number -# endif -#else -# ifdef MOSML_BIG_ENDIAN -# define Extern_magic_number Big_endian_32_magic_number -# else -# define Extern_magic_number Little_endian_32_magic_number -# endif -#endif - -/* Codes for the compact format */ - -#define PREFIX_SMALL_BLOCK 0x80 -#define PREFIX_SMALL_INT 0x40 -#define PREFIX_SMALL_STRING 0x20 -#define CODE_INT8 0x0 -#define CODE_INT16 0x1 -#define CODE_INT32 0x2 -#define CODE_INT64 0x3 -#define CODE_SHARED8 0x4 -#define CODE_SHARED16 0x5 -#define CODE_SHARED32 0x6 -#define CODE_BLOCK32 0x8 -#define CODE_STRING8 0x9 -#define CODE_STRING32 0xA -#define CODE_DOUBLE 0xB - -/* Initial sizes of data structures for extern */ - -#ifndef INITIAL_EXTERN_SIZE -#define INITIAL_EXTERN_SIZE 4096 -#endif -#ifndef INITIAL_EXTERN_TABLE_SIZE -#define INITIAL_EXTERN_TABLE_SIZE 2039 -#endif - -/* The hashtable of objects already emitted */ - -typedef unsigned long byteoffset_t; - -struct extern_obj { - value obj; - byteoffset_t ofs; -}; - -extern struct extern_obj * extern_table; -extern asize_t extern_table_size, extern_table_used; - -extern byteoffset_t * extern_block; -extern asize_t extern_size, extern_pos; - -#ifdef SIXTYFOUR -#define Hash(v) (((asize_t) ((v) >> 3)) % extern_table_size) -#else -#define Hash(v) (((asize_t) ((v) >> 2)) % extern_table_size) -#endif - -void alloc_extern_table (void); -void resize_extern_table (void); - -/* The entry points */ - -value extern_val (struct channel *, value); -value extern_compact_val (struct channel *, value); -value intern_val (struct channel *); -value intern_compact_val (struct channel *); - -byteoffset_t emit_all(value root); -void adjust_pointers(value * start, mlsize_t size, color_t color); - -#endif - diff -Nru mosml-2.01/include/io.h mosml-2.10.1/include/io.h --- mosml-2.01/include/io.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/io.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,52 +0,0 @@ -/* Buffered input/output */ - -#ifndef _io_ -#define _io_ - - -#include "misc.h" -#include "mlvalues.h" - -#ifndef IO_BUFFER_SIZE -#define IO_BUFFER_SIZE 4096 -#endif - -struct channel { - int fd; /* Unix file descriptor */ - long offset; /* Absolute position of fd in the file */ - char * curr; /* Current position in the buffer */ - char * max; /* Logical end of the buffer */ - char * end; /* Physical end of the buffer */ - char buff[IO_BUFFER_SIZE]; /* The buffer itself */ -}; - -/* For an output channel: - [offset] is the absolute position of the beginning of the buffer [buff]. - For an input channel: - [offset] is the absolute position of the logical end of the buffer [max]. -*/ - -#define putch(channel, ch) \ - { if ((channel)->curr >= (channel)->end) flush(channel); \ - *((channel)->curr)++ = (ch); \ - if ((channel)->curr > (channel)->max) (channel)->max = (channel)->curr; } - -#define getch(channel) \ - ((channel)->curr >= (channel)->max \ - ? refill(channel) \ - : (unsigned char) *((channel))->curr++) - -struct channel * open_descr (int); -value flush (struct channel *); -void putword (struct channel *, uint32); -void putblock (struct channel *, char *, unsigned); -unsigned char refill (struct channel *); -uint32 getword (struct channel *); -int getblock (struct channel *, char *, unsigned, int); -int really_getblock (struct channel *, char *, unsigned long); -value close_in (struct channel *); -void close_stdouterr(void); -void flush_stdouterr(void); -value pos_out(struct channel * channel); -value seek_out(struct channel * channel, value pos); -#endif /* _io_ */ diff -Nru mosml-2.01/include/jumptbl.h mosml-2.10.1/include/jumptbl.h --- mosml-2.01/include/jumptbl.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/jumptbl.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,256 +0,0 @@ - &&lbl_CONSTBYTE, - &&lbl_CONSTSHORT, - &&lbl_SWITCH, - &&lbl_BRANCH, - &&lbl_BRANCHIF, - &&lbl_BRANCHIFNOT, - &&lbl_POPBRANCHIFNOT, - &&lbl_BRANCHIFNEQTAG, - &&lbl_BRANCHIFEQ, - &&lbl_BRANCHIFNEQ, - &&lbl_BRANCHIFLT, - &&lbl_BRANCHIFGT, - &&lbl_BRANCHIFLE, - &&lbl_BRANCHIFGE, - &&lbl_BRANCHINTERVAL, - &&lbl_C_CALL1, - &&lbl_C_CALL2, - &&lbl_C_CALL3, - &&lbl_C_CALL4, - &&lbl_C_CALL5, - &&lbl_C_CALLN, - &&lbl_MAKEBLOCK, - &&lbl_MAKEBLOCK1, - &&lbl_MAKEBLOCK2, - &&lbl_MAKEBLOCK3, - &&lbl_MAKEBLOCK4, - &&lbl_TAGOF, - &&lbl_ACCESS, - &&lbl_ACC0, - &&lbl_ACC1, - &&lbl_ACC2, - &&lbl_ACC3, - &&lbl_ACC4, - &&lbl_ACC5, - &&lbl_ACC6, - &&lbl_ACC7, - &&lbl_PUSHACC, - &&lbl_PUSHACC0, - &&lbl_PUSHACC1, - &&lbl_PUSHACC2, - &&lbl_PUSHACC3, - &&lbl_PUSHACC4, - &&lbl_PUSHACC5, - &&lbl_PUSHACC6, - &&lbl_PUSHACC7, - &&lbl_ENVACC, - &&lbl_ENV1, - &&lbl_ENV2, - &&lbl_ENV3, - &&lbl_ENV4, - &&lbl_ENV5, - &&lbl_ENV6, - &&lbl_ENV7, - &&lbl_PUSHENVACC, - &&lbl_PUSHENV1, - &&lbl_PUSHENV2, - &&lbl_PUSHENV3, - &&lbl_PUSHENV4, - &&lbl_PUSHENV5, - &&lbl_PUSHENV6, - &&lbl_PUSHENV7, - &&lbl_PUSH_ENV1_APPLY1, - &&lbl_PUSH_ENV1_APPLY2, - &&lbl_PUSH_ENV1_APPLY3, - &&lbl_PUSH_ENV1_APPLY4, - &&lbl_PUSH_ENV1_APPTERM1, - &&lbl_PUSH_ENV1_APPTERM2, - &&lbl_PUSH_ENV1_APPTERM3, - &&lbl_PUSH_ENV1_APPTERM4, - &&lbl_PUSHATOM, - &&lbl_ATOM, - &&lbl_PUSHATOM0, - &&lbl_ATOM0, - &&lbl_ATOM1, - &&lbl_ATOM2, - &&lbl_ATOM3, - &&lbl_ATOM4, - &&lbl_ATOM5, - &&lbl_ATOM6, - &&lbl_ATOM7, - &&lbl_ATOM8, - &&lbl_ATOM9, - &&lbl_CONSTINT, - &&lbl_PUSHCONSTINT, - &&lbl_CONST0, - &&lbl_CONST1, - &&lbl_CONST2, - &&lbl_CONST3, - &&lbl_PUSHCONST0, - &&lbl_PUSHCONST1, - &&lbl_PUSHCONST2, - &&lbl_PUSHCONST3, - &&lbl_GETFIELD, - &&lbl_GETFIELD0, - &&lbl_GETFIELD1, - &&lbl_GETFIELD2, - &&lbl_GETFIELD3, - &&lbl_GETFIELD0_0, - &&lbl_GETFIELD0_1, - &&lbl_GETFIELD1_0, - &&lbl_GETFIELD1_1, - &&lbl_SETFIELD, - &&lbl_SETFIELD0, - &&lbl_SETFIELD1, - &&lbl_SETFIELD2, - &&lbl_SETFIELD3, - &&lbl_GETGLOBAL, - &&lbl_PUSH_GETGLOBAL, - &&lbl_PUSH_GETGLOBAL_APPLY1, - &&lbl_PUSH_GETGLOBAL_APPLY2, - &&lbl_PUSH_GETGLOBAL_APPLY3, - &&lbl_PUSH_GETGLOBAL_APPLY4, - &&lbl_PUSH_GETGLOBAL_APPTERM1, - &&lbl_PUSH_GETGLOBAL_APPTERM2, - &&lbl_PUSH_GETGLOBAL_APPTERM3, - &&lbl_PUSH_GETGLOBAL_APPTERM4, - &&lbl_SETGLOBAL, - &&lbl_PUSH_RETADDR, - &&lbl_APPLY, - &&lbl_APPLY1, - &&lbl_APPLY2, - &&lbl_APPLY3, - &&lbl_APPLY4, - &&lbl_APPTERM, - &&lbl_APPTERM1, - &&lbl_APPTERM2, - &&lbl_APPTERM3, - &&lbl_APPTERM4, - &&lbl_RESTART, - &&lbl_GRAB, - &&lbl_RETURN1, - &&lbl_RETURN2, - &&lbl_RETURN, - &&lbl_CLOSURE, - &&lbl_CLOSREC, - &&lbl_DUMMY, - &&lbl_UPDATE, - &&lbl_PUSHTRAP, - &&lbl_RAISE, - &&lbl_POPTRAP, - &&lbl_SWAP, - &&lbl_PUSH, - &&lbl_POP, - &&lbl_ASSIGN, - &&lbl_BOOLNOT, - &&lbl_ADDINT, - &&lbl_SUBINT, - &&lbl_MULINT, - &&lbl_DIVINT, - &&lbl_MODINT, - &&lbl_ANDINT, - &&lbl_ORINT, - &&lbl_XORINT, - &&lbl_SHIFTLEFTINT, - &&lbl_SHIFTRIGHTINTSIGNED, - &&lbl_SHIFTRIGHTINTUNSIGNED, - &&lbl_EQ, - &&lbl_NEQ, - &&lbl_LTINT, - &&lbl_GTINT, - &&lbl_LEINT, - &&lbl_GEINT, - &&lbl_FLOATOFINT, - &&lbl_SMLNEGFLOAT, - &&lbl_SMLADDFLOAT, - &&lbl_SMLSUBFLOAT, - &&lbl_SMLMULFLOAT, - &&lbl_SMLDIVFLOAT, - &&lbl_INTOFFLOAT, - &&lbl_EQFLOAT, - &&lbl_NEQFLOAT, - &&lbl_LTFLOAT, - &&lbl_GTFLOAT, - &&lbl_LEFLOAT, - &&lbl_GEFLOAT, - &&lbl_STRINGLENGTH, - &&lbl_GETSTRINGCHAR, - &&lbl_SETSTRINGCHAR, - &&lbl_EQSTRING, - &&lbl_NEQSTRING, - &&lbl_LTSTRING, - &&lbl_GTSTRING, - &&lbl_LESTRING, - &&lbl_GESTRING, - &&lbl_MAKEVECTOR, - &&lbl_VECTLENGTH, - &&lbl_GETVECTITEM, - &&lbl_SETVECTITEM, - &&lbl_SMLNEGINT, - &&lbl_SMLSUCCINT, - &&lbl_SMLPREDINT, - &&lbl_SMLADDINT, - &&lbl_SMLSUBINT, - &&lbl_SMLMULINT, - &&lbl_SMLDIVINT, - &&lbl_SMLMODINT, - &&lbl_MAKEREFVECTOR, - &&lbl_SMLQUOTINT, - &&lbl_SMLREMINT, - &&lbl_CHECK_SIGNALS, - &&lbl_STOP, - &&lbl_EQUNSIGN, - &&lbl_NEQUNSIGN, - &&lbl_LTUNSIGN, - &&lbl_GTUNSIGN, - &&lbl_LEUNSIGN, - &&lbl_GEUNSIGN -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT -, &&lbl_EVENT diff -Nru mosml-2.01/include/major_gc.h mosml-2.10.1/include/major_gc.h --- mosml-2.01/include/major_gc.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/major_gc.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,49 +0,0 @@ -#ifndef _major_gc_ -#define _major_gc_ - - -#include "freelist.h" -#include "misc.h" - -typedef struct { - asize_t size; - char *next; -} heap_chunk_head; - -extern int gc_phase; -extern unsigned long allocated_words; -extern unsigned long extra_heap_memory; - -#define Phase_mark 0 -#define Phase_weak 1 -#define Phase_sweep 2 - -extern char *heap_start; -extern char *heap_end; -extern unsigned long total_heap_size; -extern char *page_table; -extern asize_t page_table_size; -extern char *gc_sweep_hp; - -#define In_heap 1 -#define Not_in_heap 0 -#ifndef SIXTEEN -#define Page(p) (((addr) (p) - (addr) heap_start) >> Page_log) -#define Is_in_heap(p) \ - ((addr)(p) >= (addr)heap_start && (addr)(p) < (addr)heap_end \ - && page_table [Page (p)] == In_heap) -#else -#define Page(p) \ - (((unsigned long)(p) >> (16 + Page_log - 4)) + ((unsigned)(p) >> Page_log)) -#define Is_in_heap(p) (page_table [Page (p)] == In_heap) -#endif - -void init_major_heap (asize_t); -asize_t round_heap_chunk_size (asize_t); -void darken (value); -void major_collection_slice (void); -void major_collection (void); -void finish_major_cycle (void); - - -#endif /* _major_gc_ */ diff -Nru mosml-2.01/include/md5sum.h mosml-2.10.1/include/md5sum.h --- mosml-2.01/include/md5sum.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/md5sum.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -#ifdef __md5sum__ -#define __md5sum__ - -EXTERN value md5sum(value str); - -#endif diff -Nru mosml-2.01/include/memory.h mosml-2.10.1/include/memory.h --- mosml-2.01/include/memory.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/memory.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,82 +0,0 @@ -/* Allocation macros and functions */ - -#ifndef _memory_ -#define _memory_ - - -#include "config.h" -#include "gc.h" -#include "major_gc.h" -#include "minor_gc.h" -#include "misc.h" -#include "mlvalues.h" - -EXTERN value *c_roots_head; - -void init_c_roots (void); -EXTERN value alloc_shr (mlsize_t, tag_t); -void adjust_gc_speed (mlsize_t, mlsize_t); -EXTERN void modify (value *, value); -EXTERN void initialize (value *, value); -EXTERN char * stat_alloc (asize_t); /* Size in bytes. */ -EXTERN void stat_free (char *); -EXTERN char * stat_resize (char *, asize_t); /* Size in bytes. */ - - -#define Alloc_small(result, wosize, tag) { \ - char *_res_ = young_ptr; \ - young_ptr += Bhsize_wosize (wosize); \ - if (young_ptr > young_end){ \ - Setup_for_gc; \ - minor_collection (); \ - Restore_after_gc; \ - _res_ = young_ptr; \ - young_ptr += Bhsize_wosize (wosize); \ - } \ - Hd_hp (_res_) = Make_header ((wosize), (tag), Black); \ - (result) = Val_hp (_res_); \ -} - -/* You must use [Modify] to change a field of an existing shared block, - unless you are sure the value being overwritten is not a shared block and - the value being written is not a young block. */ -/* [Modify] never calls the GC. */ -#define Modify(fp, val) { \ - value _old_ = *(fp); \ - *(fp) = (val); \ - if (Is_in_heap (fp)){ \ - if (gc_phase == Phase_mark) darken (_old_); \ - if (Is_block (val) && Is_young (val) \ - && ! (Is_block (_old_) && Is_young (_old_))){ \ - *ref_table_ptr++ = (fp); \ - if (ref_table_ptr >= ref_table_limit){ \ - Assert (ref_table_ptr == ref_table_limit); \ - realloc_ref_table (); \ - } \ - } \ - } \ -} - -/* [Push_roots] and [Pop_roots] are used for C variables that are GC roots. - * It must contain all values in C local variables at the time the minor GC is - * called. - * Usage: - * At the end of the declarations of your C local variables, add - * [ Push_roots (variable_name, size); ] - * The size is the number of declared roots. They are accessed as - * [ variable_name [0] ... variable_name [size - 1] ]. - * The [variable_name] and the [size] must not be [ _ ]. - * Just before the function return, add a call to [Pop_roots]. - */ - -#define Push_roots(name, size) \ - value name [(size) + 2]; \ - { long _; for (_ = 0; _ < (size); name [_++] = Val_long (0)); } \ - name [(size)] = (value) (size); \ - name [(size) + 1] = (value) c_roots_head; \ - c_roots_head = &(name [(size)]); - -#define Pop_roots() {c_roots_head = (value *) c_roots_head [1]; } - - -#endif /* _memory_ */ diff -Nru mosml-2.01/include/m.h mosml-2.10.1/include/m.h --- mosml-2.01/include/m.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/m.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -#undef MOSML_BIG_ENDIAN -#undef ALIGNMENT diff -Nru mosml-2.01/include/minor_gc.h mosml-2.10.1/include/minor_gc.h --- mosml-2.01/include/minor_gc.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/minor_gc.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,19 +0,0 @@ -#ifndef _minor_gc_ -#define _minor_gc_ - - -#include "misc.h" - -extern char *young_start, *young_ptr, *young_end; -extern value **ref_table_ptr, **ref_table_limit; -extern asize_t minor_heap_size; - -#define Is_young(val) \ - ((addr)(val) > (addr)young_start && (addr)(val) < (addr)young_end) - -extern void set_minor_heap_size (asize_t); -extern void minor_collection (void); -extern void realloc_ref_table (void); - - -#endif /* _minor_gc_ */ diff -Nru mosml-2.01/include/misc.h mosml-2.10.1/include/misc.h --- mosml-2.01/include/misc.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/misc.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,51 +0,0 @@ -/* Miscellaneous macros and variables. */ - -#ifndef _misc_ -#define _misc_ - -#include "config.h" -#if defined(__STDC__) || defined(WIN32) -#include -#endif -#if defined(SIXTEEN) || defined (__MWERKS__) -#include -#include -#endif - -#if defined(__STDC__) || defined(WIN32) -typedef size_t asize_t; -#else -typedef int asize_t; -#endif - -#ifndef NULL -#define NULL 0 -#endif - -#ifdef SIXTEEN -typedef char huge * addr; -#else -typedef char * addr; -#endif - -#if defined(__STDC__) || defined(WIN32) -#define Volatile volatile -#else -#define Volatile -#endif - -#define Noreturn void - -extern int verb_gc; -extern int Volatile something_to_do; -extern int Volatile force_minor_flag; - -void force_minor_gc(void); -void gc_message(char *, unsigned long); -Noreturn fatal_error(char *); -Noreturn fatal_error_arg(char *, char *); -void memmov(char *, char *, unsigned long); -char * aligned_malloc(asize_t, int); - - -#endif /* _misc_ */ diff -Nru mosml-2.01/include/mlvalues.h mosml-2.10.1/include/mlvalues.h --- mosml-2.01/include/mlvalues.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/mlvalues.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,255 +0,0 @@ -#ifndef _mlvalues_ -#define _mlvalues_ - - -#include "config.h" -#include "misc.h" - -/* Definitions - - word: Four bytes on 32 and 16 bit architectures, - eight bytes on 64 bit architectures. - long: A C long integer. - val: The ML representation of something. A long or a block or a pointer - outside the heap. If it is a block, it is the (encoded) address - of an object. If it is a long, it is encoded as well. - object: Something allocated. It always has a header and some - fields or some number of bytes (a multiple of the word size). - field: A word-sized val which is part of an object. - bp: Pointer to the first byte of an object. (a char *) - op: Pointer to the first field of an object. (a value *) - hp: Pointer to the header of an object. (a char *) - int32: Four bytes on all architectures. - - Remark: An object size is always a multiple of the word size, and at least - one word plus the header. - - bosize: Size (in bytes) of the "bytes" part. - wosize: Size (in words) of the "fields" part. - bhsize: Size (in bytes) of the object with its header. - whsize: Size (in words) of the object with its header. - - hd: A header. - tag: The value of the tag field of the header. - color: The value of the color field of the header. - This is for use only by the GC. -*/ - -typedef long value; -typedef unsigned long header_t; -#ifdef SIXTEEN -typedef unsigned int mlsize_t; -#else -typedef unsigned long mlsize_t; -#endif -typedef unsigned int tag_t; /* Actually, an unsigned char */ -typedef unsigned long color_t; -typedef unsigned long mark_t; - -#ifdef SIXTYFOUR -typedef int int32; /* Not portable, but checked by autoconf. */ -typedef unsigned int uint32; /* Seems like a reasonable assumption anyway. */ -#else -typedef long int32; -typedef unsigned long uint32; -#endif - -/* Longs vs blocks. */ -#define Is_long(x) (((x) & 1) == 1) -#define Is_block(x) (((x) & 1) == 0) - -/* Conversion macro names are always of the form "to_from". */ -/* Example: Val_long as in "Val from long" or "Val of long". */ -#define Val_long(x) (((long)(x) << 1) + 1) -#define Long_val(x) ((x) >> 1) -#define Max_long ((long)((1L << (8 * sizeof(value) - 2)) - 1)) -#define Min_long ((long) -(1L << (8 * sizeof(value) - 2))) -#define Val_int Val_long -#define Int_val(x) ((int) Long_val(x)) - -/* Structure of the header: - -For 16-bit and 32-bit architectures: - +--------+-------+-----+ - | wosize | color | tag | - +--------+-------+-----+ -bits 31 10 9 8 7 0 - -For 64-bit architectures: - - +--------+-------+-----+ - | wosize | color | tag | - +--------+-------+-----+ -bits 63 10 9 8 7 0 - -*/ - -#define Tag_hd(hd) ((tag_t) ((hd) & 0xFF)) -#define Wosize_hd(hd) ((mlsize_t) ((hd) >> 10)) - -#define Hd_val(val) (((header_t *) (val)) [-1]) /* Also an l-value. */ -#define Hd_op(op) (Hd_val (op)) /* Also an l-value. */ -#define Hd_bp(bp) (Hd_val (bp)) /* Also an l-value. */ -#define Hd_hp(hp) (* ((header_t *) (hp))) /* Also an l-value. */ -#define Hp_val(val) ((char *) (((header_t *) (val)) - 1)) -#define Hp_op(op) (Hp_val (op)) -#define Hp_bp(bp) (Hp_val (bp)) -#define Val_op(op) ((value) (op)) -#define Val_hp(hp) ((value) (((header_t *) (hp)) + 1)) -#define Op_hp(hp) ((value *) Val_hp (hp)) -#define Bp_hp(hp) ((char *) Val_hp (hp)) - -#define Num_tags (1 << 8) -#ifdef SIXTYFOUR -#define Max_wosize ((1L << 54) - 1) -#else -#ifdef SIXTEEN -#define Max_wosize ((1 << 14) - 1) -#else -#define Max_wosize ((1 << 22) - 1) -#endif -#endif - -#define Wosize_val(val) (Wosize_hd (Hd_val (val))) -#define Wosize_op(op) (Wosize_val (op)) -#define Wosize_bp(bp) (Wosize_val (bp)) -#define Wosize_hp(hp) (Wosize_hd (Hd_hp (hp))) -#define Whsize_wosize(sz) ((sz) + 1) -#define Wosize_whsize(sz) ((sz) - 1) -#define Wosize_bhsize(sz) ((sz) / sizeof (value) - 1) -#define Bsize_wsize(sz) ((sz) * sizeof (value)) -#define Wsize_bsize(sz) ((sz) / sizeof (value)) -#define Bhsize_wosize(sz) (Bsize_wsize (Whsize_wosize (sz))) -#define Bhsize_bosize(sz) ((sz) + sizeof (header_t)) -#define Bosize_val(val) (Bsize_wsize (Wosize_val (val))) -#define Bosize_op(op) (Bosize_val (Val_op (op))) -#define Bosize_bp(bp) (Bosize_val (Val_bp (bp))) -#define Bosize_hd(hd) (Bsize_wsize (Wosize_hd (hd))) -#define Whsize_hp(hp) (Whsize_wosize (Wosize_hp (hp))) -#define Whsize_val(val) (Whsize_hp (Hp_val (val))) -#define Whsize_bp(bp) (Whsize_val (Val_bp (bp))) -#define Whsize_hd(hd) (Whsize_wosize (Wosize_hd (hd))) -#define Bhsize_hp(hp) (Bsize_wsize (Whsize_hp (hp))) -#define Bhsize_hd(hd) (Bsize_wsize (Whsize_hd (hd))) - -#ifdef MOSML_BIG_ENDIAN -#define Tag_val(val) (((unsigned char *) (val)) [-1]) - /* Also an l-value. */ -#define Tag_hp(hp) (((unsigned char *) (hp)) [sizeof(value)-1]) - /* Also an l-value. */ -#else -#define Tag_val(val) (((unsigned char *) (val)) [-sizeof(value)]) - /* Also an l-value. */ -#define Tag_hp(hp) (((unsigned char *) (hp)) [0]) - /* Also an l-value. */ -#endif - -/* The tag values MUST AGREE with compiler/Config.mlp: */ - -/* The Lowest tag for blocks containing no value. */ -#define No_scan_tag (Num_tags - 5) - - -/* 1- If tag < No_scan_tag : a tuple of fields. */ - -/* Pointer to the first field. */ -#define Op_val(x) ((value *) (x)) -/* Fields are numbered from 0. */ -#define Field(x, i) (((value *)(x)) [i]) /* Also an l-value. */ - -/* A sequence of bytecodes */ -typedef unsigned char * bytecode_t; - -/* A sequence of real machine instruction addresses */ -typedef void ** realcode_t; - -/* GCC 2.0 has labels as first-class values. We take advantage of that - to provide faster dispatch than the "switch" statement. */ - -#if defined(__GNUC__) && __GNUC__ >= 2 && !defined(DEBUG) -#define DIRECT_JUMP -#endif - -#if defined(DIRECT_JUMP) && defined(THREADED) -#define CODE realcode_t -#else -#define CODE bytecode_t -#endif - -#define Closure_wosize 2 -#define Closure_tag (No_scan_tag - 2) -#define Code_val(val) (((CODE *) (val)) [0]) /* Also an l-value. */ -#define Env_val(val) (Field(val, 1)) /* Also an l-value. */ - -/* --- Reference cells are used in Moscow SML --- */ - -#define Reference_tag (No_scan_tag - 1) - -/* --- --- */ - - -/* 2- If tag >= No_scan_tag : a sequence of bytes. */ - -/* Pointer to the first byte */ -#define Bp_val(v) ((char *) (v)) -#define Val_bp(p) ((value) (p)) -/* Bytes are numbered from 0. */ -#define Byte(x, i) (((char *) (x)) [i]) /* Also an l-value. */ -#define Byte_u(x, i) (((unsigned char *) (x)) [i]) /* Also an l-value. */ - -/* Arrays of weak pointers. Just like abstract things, but the GC will - reset each cell (during the weak phase, between marking and sweeping) - as the pointed-to object gets deallocated. -*/ -#define Weak_tag No_scan_tag - -/* Abstract things. Their contents is not traced by the GC; therefore they - must not contain any [value]. -*/ -#define Abstract_tag (No_scan_tag + 1) - -/* Strings. */ -#define String_tag (No_scan_tag + 2) -#define String_val(x) ((char *) Bp_val(x)) - -/* Floating-point numbers. */ -#define Double_tag (No_scan_tag + 3) -#define Double_wosize ((sizeof(double) / sizeof(value))) -#ifndef ALIGN_DOUBLE -#define Double_val(v) (* (double *) (v)) -#else -EXTERN double Double_val (value); -#endif -void Store_double_val (value,double); - -/* Finalized things. Just like abstract things, but the GC will call the - [Final_fun] before deallocation. -*/ -#define Final_tag (No_scan_tag + 4) -typedef void (*final_fun) (value); -#define Final_fun(val) (((final_fun *) (val)) [0]) /* Also an l-value. */ - - -/* 3- Atoms are 0-tuples. They are statically allocated once and for all. */ - -EXTERN header_t first_atoms[]; -#define Atom(tag) (Val_hp (&(first_atoms [tag]))) -#define Is_atom(v) (v >= Atom(0) && v <= Atom(255)) - -/* Booleans are atoms tagged 0 or 1 */ - -#define Val_bool(x) Atom((x) != 0) -#define Bool_val(x) Tag_val(x) -#define Val_false Atom(0) -#define Val_true Atom(1) - -/* The unit value is the atom tagged 0 */ - -#define Val_unit Atom(0) - -/* SML option values: Must match compiler/Types.sml: */ - -#define NONE Atom(0) -#define SOMEtag (1) - -#endif /* _mlvalues_ */ diff -Nru mosml-2.01/include/mosml.h mosml-2.10.1/include/mosml.h --- mosml-2.01/include/mosml.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/mosml.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,8 +0,0 @@ -#ifndef _mosml_ -#define _mosml_ - -#include "mlvalues.h" - -char* exnmessage_aux(value); - -#endif /* _mosml_ */ diff -Nru mosml-2.01/include/prims.h mosml-2.10.1/include/prims.h --- mosml-2.01/include/prims.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/prims.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,11 +0,0 @@ -/* Interface with C primitives. */ - -#ifndef _prims_ -#define _prims_ - -typedef value (*c_primitive)(); - -extern c_primitive cprim[]; -extern char * names_of_cprim[]; - -#endif /* _prims_ */ diff -Nru mosml-2.01/include/reverse.h mosml-2.10.1/include/reverse.h --- mosml-2.01/include/reverse.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/reverse.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,54 +0,0 @@ -/* Swap byte-order in 16-bit, 32-bit and 64-bit words */ - -#ifndef _reverse_ -#define _reverse_ - - -#define Reverse_short(s) { \ - char * _p; \ - int _a; \ - _p = (char *) (s); \ - _a = _p[0]; \ - _p[0] = _p[1]; \ - _p[1] = _a; \ -} - -#define Reverse_int32(w) { \ - char * _p; \ - int _a; \ - _p = (char *) (w); \ - _a = _p[0]; \ - _p[0] = _p[3]; \ - _p[3] = _a; \ - _a = _p[1]; \ - _p[1] = _p[2]; \ - _p[2] = _a; \ -} - -#define Reverse_int64(d) { \ - char * _p; \ - int _a; \ - _p = (char *) (d); \ - _a = _p[0]; \ - _p[0] = _p[7]; \ - _p[7] = _a; \ - _a = _p[1]; \ - _p[1] = _p[6]; \ - _p[6] = _a; \ - _a = _p[2]; \ - _p[2] = _p[5]; \ - _p[5] = _a; \ - _a = _p[3]; \ - _p[3] = _p[4]; \ - _p[4] = _a; \ -} - -#ifdef SIXTYFOUR -#define Reverse_word Reverse_int64 -#else -#define Reverse_word Reverse_int32 -#endif - -#define Reverse_double Reverse_int64 - -#endif /* _reverse_ */ diff -Nru mosml-2.01/include/roots.h mosml-2.10.1/include/roots.h --- mosml-2.01/include/roots.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/roots.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,9 +0,0 @@ -#ifndef _roots_ -#define _roots_ - -#include "misc.h" - -void local_roots (void (*copy_fn) (value *, value)); - - -#endif /* _roots_ */ diff -Nru mosml-2.01/include/runtime.h mosml-2.10.1/include/runtime.h --- mosml-2.01/include/runtime.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/runtime.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,30 +0,0 @@ -/* runtime.h */ - -#ifdef macintosh - -/* 23Nov93 e */ -/* 16Mar94 e */ - -void init_timers(void); -void beg_runtime(int); -void acc_runtime(int); - -#define beg_gc_time() beg_runtime(1) -#define end_gc_time() acc_runtime(1) - -#define beg_mf_time() beg_runtime(2) -#define end_mf_time() acc_runtime(2) - -#else - -void beg_gc_time(); -void end_gc_time(); - -struct mosml_timeval { - long tv_sec; /* seconds */ - long tv_usec; /* microseconds */ -}; - -extern struct mosml_timeval gc_time; - -#endif diff -Nru mosml-2.01/include/s.h mosml-2.10.1/include/s.h --- mosml-2.01/include/s.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/s.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,24 +0,0 @@ -#define HAS_MEMMOVE -#define HAS_BCOPY -#define HAS__SETJMP -#define sighandler_return_type void -#define BSD_SIGNALS -#define HAS_RENAME -#define HAS_STRERROR -#define HAS_SOCKETS -#define HAS_UNISTD -#define HAS_DIRENT -#define HAS_LOCKF -#define HAS_MKFIFO -#define HAS_GETPRIORITY -#define HAS_UTIME -#define HAS_UTIMES -#define HAS_DUP2 -#define HAS_FCHMOD -#define HAS_TRUNCATE -#define HAS_SELECT -#define HAS_SYMLINK -#define HAS_WAIT3 -#define HAS_WAITPID -#define HAS_GETGROUPS -#define HAS_TERMIOS diff -Nru mosml-2.01/include/signals.h mosml-2.10.1/include/signals.h --- mosml-2.01/include/signals.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/signals.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,26 +0,0 @@ -#ifndef _signals_ -#define _signals_ - -#include "misc.h" - -#if defined(__STDC__) || defined(WIN32) - -extern volatile int signal_is_pending; -extern volatile CODE signal_handler; -extern volatile int signal_number; -extern int in_blocking_section; - -#else - -extern int signal_is_pending; -extern CODE signal_handler; -extern int signal_number; -extern int in_blocking_section; - -#endif - -void execute_signal (void); -EXTERN void enter_blocking_section (void); -EXTERN void leave_blocking_section (void); -extern CODE raise_break_exn; -#endif /* _signals_ */ diff -Nru mosml-2.01/include/stacks.h mosml-2.10.1/include/stacks.h --- mosml-2.01/include/stacks.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/stacks.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,27 +0,0 @@ -/* structure of the stacks */ - -#ifndef _stacks_ -#define _stacks_ - - -#include "misc.h" -#include "mlvalues.h" -#include "memory.h" - -extern value * stack_low; -extern value * stack_high; -extern value * stack_threshold; -extern value * extern_sp; -extern value * trapsp; - -extern value global_data; - -#define Trap_pc(tp) (((CODE *)(tp))[0]) -#define Trap_link(tp) (((value **)(tp))[1]) - -void reset_roots (void); -void init_stack (void); -void realloc_stack (void); - - -#endif /* _stacks_ */ diff -Nru mosml-2.01/include/str.h mosml-2.10.1/include/str.h --- mosml-2.01/include/str.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/str.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,11 +0,0 @@ -#ifndef _str_ -#define _str_ - - -#include "misc.h" - -EXTERN mlsize_t string_length (value); -EXTERN value compare_strings (value, value); - - -#endif /* _str_ */ diff -Nru mosml-2.01/include/sys.h mosml-2.10.1/include/sys.h --- mosml-2.01/include/sys.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/sys.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,11 +0,0 @@ -#ifndef _sys_ -#define _sys_ - -#include "misc.h" - -void sys_error (char *); -void raise_pending_signal (void); -void sys_init (char **); -void sys_exit (value); - -#endif /* _sys_ */ diff -Nru mosml-2.01/include/unalignd.h mosml-2.10.1/include/unalignd.h --- mosml-2.01/include/unalignd.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/unalignd.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,31 +0,0 @@ -/* To read 16 bit and 32 bit words when they are not aligned */ - -#ifndef _unaligned_ -#define _unaligned_ - - -#ifdef ALIGNMENT - -#define s16(p) (int) ((((schar *) (p))[1] << 8) + ((unsigned char *) (p))[0]) -#define u16(p) (unsigned int) ((((unsigned char *) (p))[1] << 8) \ - + ((unsigned char *) (p))[0]) -#define s32(p) (int32) ((((schar *) (p))[3] << 24) \ - + (((unsigned char *) (p))[2] << 16) \ - + (((unsigned char *) (p))[1] << 8) \ - + ((unsigned char *) (p))[0]) -#define u32(p) (uint32) ((((unsigned char *) (p))[3] << 24) \ - + (((unsigned char *) (p))[2] << 16) \ - + (((unsigned char *) (p))[1] << 8) \ - + ((unsigned char *) (p))[0]) - -#else - -#define s16(p) (* (short *) (p)) -#define u16(p) (* (unsigned short *) (p)) -#define s32(p) (* (int32 *) (p)) -#define u32(p) (* (uint32 *) (p)) - -#endif - - -#endif /* _unaligned_ */ diff -Nru mosml-2.01/include/version.h mosml-2.10.1/include/version.h --- mosml-2.01/include/version.h 2004-01-19 15:02:21.000000000 +0000 +++ mosml-2.10.1/include/version.h 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -#define VERSION "0.8e for Moscow ML" diff -Nru mosml-2.01/install.txt mosml-2.10.1/install.txt --- mosml-2.01/install.txt 2000-07-20 12:54:01.000000000 +0000 +++ mosml-2.10.1/install.txt 2014-08-28 08:47:22.000000000 +0000 @@ -70,11 +70,11 @@ for a personal installation. (S2) Download the Unix source files from - ftp://ftp.dina.kvl.dk/pub/mosml/mos20src.tar.gz + http://www.itu.dk/people/sestoft/mosml/mos201src.tar.gz (S3) Unpack it by executing (in /usr/local, or ${HOME}) - gzip -dc mos20src.tar.gz | tar xvf - + gzip -dc mos201src.tar.gz | tar xvf - (S4) Change directory to mosml/src @@ -133,7 +133,7 @@ - to install support for sockets, consult mosml/src/dynlibs/msocket/README - - to install support for Thomas Boutell's gd GIF image + - to install support for Thomas Boutell's gd PNG image package, consult mosml/src/dynlibs/mgd/README - to install support for process manipulation under Unix, @@ -156,7 +156,7 @@ and Claudio V. Russo (Claudio.Russo@cl.cam.ac.uk), University of Cambridge. Thanks to Don Sannella at LFCS, Division of Informatics, University of Edinburgh for funding under EPSRC grant GR/K63795 -and Peter Sestoft (sestoft@dina.kvl.dk), +and Peter Sestoft (sestoft@itu.dk), Department of Mathematics and Physics, Royal Veterinary and Agricultural University, Thorvaldsensvej 40, DK-1871 Frederiksberg C, Denmark. Much of the work was done at the Technical University of diff -Nru mosml-2.01/install.txt.w32 mosml-2.10.1/install.txt.w32 --- mosml-2.01/install.txt.w32 2000-08-01 20:30:30.000000000 +0000 +++ mosml-2.10.1/install.txt.w32 2014-08-28 08:47:22.000000000 +0000 @@ -1,13 +1,13 @@ -File install.txt.w32 for Moscow ML 2.00 for Win95/98/NT/2000 (June 2000) +File install.txt.w32 for Moscow ML 2.00 for Win95/98/ME/NT/2000/XP (June 2000) SYSTEM REQUIREMENTS -Moscow ML requires Windows 95, 98, NT or 2000. The installation -requires around 18 MB disk space. +Moscow ML requires Windows 95, 98, ME, NT, 2000 or XP. The +installation requires around 18 MB disk space. -INSTALLING MOSCOW ML (BINARIES ONLY) UNDER WINDOWS 95/98/NT +INSTALLING MOSCOW ML (BINARIES ONLY) UNDER WINDOWS 95/98/ME/NT/2000/XP (1) Change directory to C:\ and unpack the Moscow ML distribution by executing @@ -30,15 +30,24 @@ tools/ mosmldep, Makefile.stub (2) Add C:\mosml\bin to the PATH variable, and set the environment - variable `mosmllib' to C:\mosml\lib -- that is, in the case of - Windows 95/98 your AUTOEXEC.BAT file should contain something like: + variable `mosmllib' to C:\mosml\lib. - set PATH=C:\dos; ... ;C:\mosml\bin - set MOSMLLIB=C:\mosml\lib + (a) In the case of Windows 95/98/ME your AUTOEXEC.BAT file should + contain something like: -(3) In the case of Windows 95/98 reboot the system to enable the new - environment variables, and start Moscow ML by entering the command - line + set PATH=C:\dos; ... ;C:\mosml\bin + set MOSMLLIB=C:\mosml\lib + + The system must be rebooted to enable the new environment + variables. + + (b) In the case of Windows NT/2000/XP, choose + Start | Settings | Control Panel | System | Advanced + | Environment Variables | System Variables | New + Enter MOSMLLIB as Variable Name and C:\mosml\lib as Variable Value. + Double-click on Path and add ;C:\mosml\bin to the Variable Value. + +(3) Start Moscow ML by entering the command line mosml @@ -54,7 +63,7 @@ and Claudio V. Russo (Claudio.Russo@cl.cam.ac.uk), University of Cambridge. Thanks to Don Sannella at LFCS, Division of Informatics, University of Edinburgh for funding under EPSRC grant GR/K63795 -and Peter Sestoft (sestoft@dina.kvl.dk), +and Peter Sestoft (sestoft@itu.dk), Department of Mathematics and Physics, Royal Veterinary and Agricultural University, Thorvaldsensvej 40, DK-1871 Frederiksberg C, Denmark. Much of the work was done at the Technical University of diff -Nru mosml-2.01/lib/.gitignore mosml-2.10.1/lib/.gitignore --- mosml-2.01/lib/.gitignore 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/lib/.gitignore 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,12 @@ +*.sig +*.ui +*.uo +camlrunm +helpsigs.val +README +header +mosmlcmmc +mosmlcmp +mosmllex +mosmllnk +mosmltop diff -Nru mosml-2.01/man/mosml.1 mosml-2.10.1/man/mosml.1 --- mosml-2.01/man/mosml.1 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/man/mosml.1 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,130 @@ +.TH MOSML 1 "18 September 2001" "Version 2.0" +.SH NAME +mosml \- Standard ML interpreter +.SH SYNOPSIS +.B mosml [\fIOPTION\fR]... [\fIFILE\fR]... +.SH DESCRIPTION +.PP +Invokes the interactive Moscow ML system. The interactive system allows +you to enter declarations and evaluate expressions. +.PP +You can quit the interactive session by typing \fBquit();\fR or +control-D. Type \fBhelp "lib";\fR for an overview of built-in +function libraries, and e.g. \fBhelp "Array";\fR for help on +\fBArray\fR operations. +.PP +Invoking the interactive system with a list of files \fIFILE\fRs +correspond to invoking it without the file list, and when the +Moscow ML has started entering +\fBuse "file1";\fR ... \fBuse "filen";\fR. +.PP +This manual page documents the options accepted by +.B mosml. +For more information consult the online manuals. +.SH OPTIONS +.TP +\fB\-conservative\fR +Sets conservative mode for compilation of subsequent units: accept +all extensions to the SML Modules language, but issue a warning for +each use. This is the default. +.TP +\fB\-I\fR \fIdirectory\fR +Specifies directories to be searched for interface files, bytecode +files, and source files. A call to \fBuse\fR, \fBload\fR or +\fBloadOne\fR will first search the current directory, then all +directories specified by option \fB\-I\fR in order of appearance +from left to right, and finally the standard library directory. +(This option affects the variable \fBMeta.loadPath\fR.) +.TP +\fB\-imptypes\fR +Specifies that the type checker should distinguish between +imperative and applicative type variables, generalize all +applicative type variables, and generalize imperative type variables +only in non-expansive expressions. +.TP +\fB\-liberal\fR +Sets liberal mode for compilation of subsequent units: accept +without warnings all extensions to the SML Modules language. +.TP +\fB\-orthodox\fR +Sets orthodox mode for the compilation of subsequent units: reject +all uses of the extensions to the SML Modules language. That is, +accept only SML Modules syntax. +.TP +\fB\-P\fR \fIunit-set\fR +Determines which library units will be included and open at +compile-time. Any library unit in the load path can be used by the +\fBcompile\fR function for type checking purposes. Thus regardless +\fB\-P\fR option, the \fBcompile\fR function knows the type of +library functions such as \fBArray.foldl\fR. +.RS +.TP +\fB\-P\fR \fIdefault\fR +The initial environment for the SML Basis Library: modules +\fBArray\fR, \fBChar\fR, \fBList\fR, \fBString\fR, and \fBVector\fR +will be loaded, and \fBChar\fR, \fBList\fR, and \fBString\fR will be +partially opened. +.TP +\fB\-P sml90\fR +This provides an initial environment which is upwards compatible with +that of the 1990 `Definition of Standard ML' and with pre-1.30 releases +of Moscow ML. In particular, the functions \fBchr\fR, \fBexplode\fR, +\fBimplode\fR, and \fBord\fR work on strings, not characters. The new +versions of these functions are still available as \fBChar.chr\fR, +\fBChar.ord\fR, \fBString.explode\fR, and \fBString.implode\fR. The +math functions and input-output facilities required by the 1990 +Definition are available at top-level. In addition the same libraries +are loaded as with \fB-P default\fR. +.TP +\fB\-P nj93\fR +This provides a top-level environment which is mostly compatible with +that of SML/NJ 0.93. The functions \fBapp\fR, \fBceiling\fR, +\fBchr\fR, \fBdec\fR, \fBexplode\fR, \fBfold\fR, \fBhd\fR, \fBimplode\fR, +\fBinc\fR, \fBmax\fR, \fBmin\fR, \fBnth\fR, \fBnthtail\fR, \fBord\fR, +\fBordof\fR, \fBrevapp\fR, \fBrevfold\fR, \fBsubstring\fR, \fBtl\fR, +and \fBtruncate\fR have the same type and meaning as in SML/NJ 0.93. +Note that this is incompatible with SML/NJ version 110. The math +functions and input-output facilities required by the 1990 `Definition +of Standard ML' are available at top-level. In addition the same (new) +libraries are loaded as with \fB-P default\fR. This option does not +imply \fB-imptypes\fR. +.TP +\fB\-P full\fR +This loads all the libraries marked \fBF\fR in the library list (see +the online manuals), and partially opens the \fBChar\fR, \fBList\fR, +and \fBString\fR units. +.TP +\fB\-P none\fR +No library units are loaded or opened initially. +.PP +Additional library units can loaded into the interactive system by +using the \fBload\fR function. +.RE +.TP +\fB\-quietdec\fR +Turns off the interactive system's prompt and responses, except for +warnings and error messages. Useful for writing scripts in SML. +Sets \fBMeta.quietdec\fR to \fBtrue\fR. +.TP +\fB\-stdlib\fR \fIstdlib-directory\fR +Specify the standard library directory to be \fIstdlib-directory\fR. +The default standard library is \fB/usr/lib/mosml\fR under Debian. +.TP +\fB\-valuepoly\fR +Specifies that the type checker should use `value polymorphism'. +Default. +.SH AUTHOR +Compiled by Henning Niss from the various Moscow ML documents +written by Sergei Romanenko, Claudio Russo, and Peter Sestoft. +.SH "SEE ALSO" +.BR mosmlc (1), +.BR mosmlyac (1), +.BR mosmllex (1) +.PP +The full documentation for +.B mosml +and the other Moscow ML tools can be found in the online manuals in +\fB/usr/share/doc/mosml/manual.pdf.gz\fR +(`Moscow ML Owner's Manual') and +\fB/usr/share/doc/mosml/mosmllib.pdf.gz\fR +(`Moscow ML Library Documentation'). diff -Nru mosml-2.01/man/mosmlc.1 mosml-2.10.1/man/mosmlc.1 --- mosml-2.01/man/mosmlc.1 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/man/mosmlc.1 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,230 @@ +.TH MOSMLC 1 "18 September 2001" "Version 2.0" +.SH NAME +mosmlc \- Standard ML batch compiler +.SH SYNOPSIS +.B mosmlc [\fIOPTION\fR]... [\fIFILE\fR]... +.SH DESCRIPTION +.PP +Invokes the Moscow ML batch compiler and linker. The compiler +compiles units and links programs, and can turn them into standalone +executable bytecode files. +.PP +The +.B mosmlc +command has a command-line interface similar to that of most C +compilers. It accepts several types of arguments: source files for +unit interfaces, source files for unit implementations, compiled unit +interfaces (which are added to the compilation context), and compiled +unit implementations (which are added to the linked executable). +.PP +A \fIFILE\fR argument ending in \fB.sig\fR is taken to be the name of +a source file containing a unit interface. Given a file \fBU.sig\fR, +the compiler produces a compiled interface in the file \fBU.ui\fR. +.PP +A \fIFILE\fR argument ending in \fB.sml\fR is taken to be the name of +a source file containing a unit implementation. Given a file \fBU.sml\fR, +the compiler produces compiled object code in the file \fBU.uo\fR. It +also produces an inferred interface file \fBU.ui\fR if there is no +explicit interface \fBU.sig\fR. +.PP +A \fIFILE\fR argument ending in \fB.ui\fR is taken to be the name of a +compilation unit interface. The contents of that compilation unit +are added to the compilation context of the remaining source files. +.PP +A \fIFILE\fR argument ending in \fB.uo\fR is taken to be the name of a +compiled unit implementation. Such files are linked together, along +with the compiled unit implementations obtained by compiling \fB.sml\fR +arguments (if any), and the necessary Moscow ML library files, to produce +a standalone executable program. +.PP +The output of the linking phase is a file containing compiled code +that can be executed by the runtime system +.B camlrunm. +If \fBmosmlout\fR is the name of the file produced by the linking +phase (with option \fB\-o mosmlout\fR), the command +.B mosmlout arg1 ... argn +executes the compiled code contained in \fBmosmlout\fR. +.PP +Executing the code means executing the toplevel declarations of all +the bytecode files involved, in the order in which they were linked. +The list of command-line arguments \fBarg1\fR ... \fBargn\fR can +be obtained in a program by \fBCommandLine.arguments ()\fR. +.PP +There is no distinguished function which is automatically invoked when +the program is executed, but it is common to define a \fBmain\fR +function and invoke it using the toplevel declaration +\fBval \_ = main()\fR. +.PP +This manual page documents the options accepted by +.B mosmlc. +For more information consult the online manuals. +.SH OPTIONS +.TP +\fB\-c\fR +Compile only. Suppresses the linking phase of the compilation. +Source code files are turned into compiled files (\fB.ui\fR +and \fB.uo\fR), but no executable file is produced. This option is +useful for compiling separate units. +.TP +\fB\-conservative\fR +Sets conservative mode for compilation of subsequent units: accept +all extensions to the SML Modules language, but issue a warning for +each use. This is the default. +.TP +\fB\-files\fR \fIresponse-file\fR +Pass the names of files listed in file \fIresponse-file\fR to the +linking phase just as if these names appeared on the command line. +File names in \fIresponse-file\fR are separated by blanks (spaces, +tabs, newlines) and must end either in \fB.sml\fR or \fB.uo\fR. A +name \fBU.sml\fR appearing in the response file is equivalent to +\fBU.uo\fR. +.TP +\fB\-g\fR +This option causes some information about exception names to be +written at the end of the executable bytecode file. +.TP +\fB\-g\fR +Causes the compiler to print the inferred interface(s) of the unit +implementation(s) being compiled. Also causes the linker to list +all object files linked. A \fBU.sig\fR file corresponding to a given +\fBU.sml\fR file can be produced semi-automatically by piping the +output of the compiler to a file \fBU.out\fR, and subsequently editing +this file to obtain a file \fBU.sig\fR. +.TP +\fB\-I\fR \fIdirectory\fR +Add the given directory to the list of directories searched for +compiled interface files (\fB.ui\fR) and compiled implementation +files (\fB.uo\fR). By default, the current directory is searched +first, then the standard library directory. Directories added with +\fB\-I\fR are searched after the current directory, but before the +standard library directory. When several directories are added with +several \fB\-I\fR options on the command line, these directories are +searched from left to right. +.TP +\fB\-imptypes\fR +Specifies that the type checker should distinguish between +imperative and applicative type variables, generalize all +applicative type variables, and generalize imperative type variables +only in non-expansive expressions. +.TP +\fB\-liberal\fR +Sets liberal mode for compilation of subsequent units: accept +without warnings all extensions to the SML Modules language. +.TP +\fB\-msgstyle\fR \fIstyle\fR +By specifying \fB\-msgstyle msdev\fR, one can make the compiler +generate error messages understandable by Microsoft Developer +Studio. The default behaviour is to generate error messages +understandable the Emacs editor in SML mode. +.TP +\fB\-noautolink\fR +The linker automatically links in any additional object files +required by the files explicitly specified on the command line. +With option \fB\-noautolink\fR all required object files must be +explicitly specified in the appropriate order. +.TP +\fB\-noheader\fR +Causes the output file produced by the linker to contain only the +bytecode, not preceded by any executable code. A file +\fBmosmlout\fR thus obtained can be executed only by explicitly +invoking the runtime system as follows: +.B camlrunm mosmlout. +.TP +\fB\-o\fR \fIexec-file\fR +Specify the name of the output file produced by the linker. In the +absence of this option, a default name, \fBa.out\fR is used. +.TP +\fB\-orthodox\fR +Sets orthodox mode for the compilation of subsequent units: reject +all uses of the extensions to the SML Modules language. That is, +accept only SML Modules syntax. +.TP +\fB\-P\fR \fIunit-set\fR +Determines which library units will be open at compile-time. +Any library unit in the load path can be used by the compiler for +type checking purposes. Thus regardless of the \fB\-P\fR option, +the compiler knows the type of library functions such as +\fBArray.foldl\fR. +.RS +.TP +\fB\-P\fR \fIdefault\fR +The units \fBChar\fR, \fBList\fR, and \fBString\fR will be partially +openend. This is the default, permitting e.g. \fBString.concat\fR +to be referred to just as \fBconcat\fR. +.TP +\fB\-P sml90\fR +Provides an initial environment which is upwards compatible with +that of the 1990 `Definition of Standard ML' and with pre-1.30 releases +of Moscow ML. In particular, the functions \fBchr\fR, \fBexplode\fR, +\fBimplode\fR, and \fBord\fR work on strings, not characters. The +math functions and input-output facilities required by the 1990 +Definition are available at top-level. In addition the same libraries +are opened as with \fB-P default\fR. +.TP +\fB\-P nj93\fR +Provides a top-level environment which is mostly compatible with +that of SML/NJ 0.93. The functions \fBapp\fR, \fBceiling\fR, +\fBchr\fR, \fBdec\fR, \fBexplode\fR, \fBfold\fR, \fBhd\fR, \fBimplode\fR, +\fBinc\fR, \fBmax\fR, \fBmin\fR, \fBnth\fR, \fBnthtail\fR, \fBord\fR, +\fBordof\fR, \fBrevapp\fR, \fBrevfold\fR, \fBsubstring\fR, \fBtl\fR, +and \fBtruncate\fR have the same type and meaning as in SML/NJ 0.93. +Note that this is incompatible with SML/NJ version 110. The math +functions and input-output facilities required by the 1990 `Definition +of Standard ML' are available at top-level. In addition the same (new) +libraries are opened as with \fB-P default\fR. This option does not +imply \fB-imptypes\fR. +.TP +\fB\-P full\fR +Same as \fB\-P default\fR. +.TP +\fB\-P none\fR +No library units are initially opened. +.PP +Additional directories to be searched for library units can be +specified with the \fB-I\fR \fIdirectory\fR option. +.RE +.TP +\fB\-q\fR +Enables the quotation/antiquotation mechanism. +.TP +\fB\-standalone\fR +Specifies that the runtime system should be prepended to the +linked bytecode, thus creating a stand-alone executable. This adds +75--100 KB to the size of the linked file. +.TP +\fB\-stdlib\fR \fIstdlib-directory\fR +Specifies the standard library directory, which will be searched by +the compiler and linker for the \fB.ui\fR and \fB.uo\fR files +corresponding to units mentioned in the files being linked. The +default standard library is set when the system is created; under +Debian it is \fB/usr/lib/mosml\fR. +.TP +\fB\-structure\fR +Specifies that subsequent \fB.sml\fR and \fB.sig\fR source files +must be compiled in `structure' mode. +.TP +\fB\-toplevel\fR +Specifies that subsequent \fB.sml\fR and \fB.sig\fR source files +must be compiled in `toplevel' mode. +.TP +\fB\-v\fR +Prints the version number of the various passes of the compiler. +.TP +\fB\-valuepoly\fR +Specifies that the type checker should use `value polymorphism'. +Default. +.SH AUTHOR +Compiled by Henning Niss from the various Moscow ML documents +written by Sergei Romanenko, Claudio Russo, and Peter Sestoft. +.SH "SEE ALSO" +.BR mosml (1), +.BR mosmlyac (1), +.BR mosmllex (1) +.PP +The full documentation for +.B mosmlc +and the other Moscow ML tools can be found in the online manuals in +\fB/usr/share/doc/mosml/manual.pdf.gz\fR +(`Moscow ML Owner's Manual') and +\fB/usr/share/doc/mosml/mosmllib.pdf.gz\fR +(`Moscow ML Library Documentation'). diff -Nru mosml-2.01/man/mosmllex.1 mosml-2.10.1/man/mosmllex.1 --- mosml-2.01/man/mosmllex.1 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/man/mosmllex.1 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,38 @@ +.TH MOSMLLEX 1 "18 September 2001" "Version 2.0" +.SH NAME +mosmllex \- Moscow ML lexer generator +.SH SYNOPSIS +.B mosmllex \fIFILE\fR +.SH DESCRIPTION +.PP +Given a set of regular expressions with attached semantic actions +.B mosmllex +produces a lexical analyser in the style of \fBlex\fR. +.PP +If \fiFILE\fR is \fBlexer.lex\fR containing a specification +of a lexical analyser then +.B mosmllex +\fblexer.lex\fR +produces a file \fBlexer.sml\fR containing Moscow ML code +for the lexical analyser. This file defines one lexing function per +entry point in the lexer definition. These functions have the same +names as the entry points. Lexing functions take as argument a lexer +buffer, and return the semantic attribute of the corresponding entry +point. +.PP +For more information consult the online manuals. +.SH AUTHOR +Compiled by Henning Niss from the various Moscow ML documents +written by Sergei Romanenko, Claudio Russo, and Peter Sestoft. +.SH "SEE ALSO" +.BR mosml (1), +.BR mosmlc (1), +.BR mosmlyac (1) +.PP +The full documentation for +.B mosmllex +and the other Moscow ML tools can be found in the online manuals in +\fB/usr/share/doc/mosml/manual.pdf.gz\fR +(`Moscow ML Owner's Manual') and +\fB/usr/share/doc/mosml/mosmllib.pdf.gz\fR +(`Moscow ML Library Documentation'). diff -Nru mosml-2.01/man/mosmlyac.1 mosml-2.10.1/man/mosmlyac.1 --- mosml-2.01/man/mosmlyac.1 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/man/mosmlyac.1 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,49 @@ +.TH MOSMLYAC 1 "18 September 2001" "Version 2.0" +.SH NAME +mosmlyac \- Moscow ML parser generator +.SH SYNOPSIS +.B mosmlyac [\fIOPTION\fR]... \fIFILE\fR +.SH DESCRIPTION +.PP +Given a context-free grammar specification with attached semantic +actions, +.B mosmlyac +produces a parser, in the style of \fByacc\fR. +.PP +If \fiFILE\fR is \fBgrammar.grm\fR containing a grammar specification +then +.B mosmlyac +\fBgrammar.grm\fR +produces a file \fBgrammar.sml\fR containing a Moscow ML unit with +code for a parser and a file \fBgrammar.sig\fR containing its +interface. +.PP +This manual page documents the options accepted by +.B mosmlyac. +For more information consult the online manuals. +.SH OPTIONS +.TP +\fB\-v\fR +Generate a description of the parsing tables and a report on +conflicts resulting from ambiguities in the grammar. The +description is put in file \fBgrammar.output\fR (when +\fIFILE\fR is \fBgrammar.grm\fR). +.TP +\fB\-v\fR \fIprefix\fR +Name the output files \fBprefix.sml\fR, \fBprefix.sig\fR, +\fBprefix.output\fR, instead of using the default naming convention. +.SH AUTHOR +Compiled by Henning Niss from the various Moscow ML documents +written by Sergei Romanenko, Claudio Russo, and Peter Sestoft. +.SH "SEE ALSO" +.BR mosml (1), +.BR mosmlc (1), +.BR mosmllex (1) +.PP +The full documentation for +.B mosmlyac +and the other Moscow ML tools can be found in the online manuals in +\fB/usr/share/doc/mosml/manual.pdf.gz\fR +(`Moscow ML Owner's Manual') and +\fB/usr/share/doc/mosml/mosmllib.pdf.gz\fR +(`Moscow ML Library Documentation'). diff -Nru mosml-2.01/README mosml-2.10.1/README --- mosml-2.01/README 2000-06-30 11:08:16.000000000 +0000 +++ mosml-2.10.1/README 2014-08-28 08:47:22.000000000 +0000 @@ -1,8 +1,8 @@ -This is file README for Moscow ML 2.00 for Linux/Unix (June 2000) +This is file README for Moscow ML 2.10 for Linux/Unix (August 2013) EXTENT OF THE IMPLEMENTATION -The current version 2.00 of Moscow ML +The current version 2.10.1 of Moscow ML * implements the full Standard ML language, as revised 1997, including Modules and some extensions @@ -13,36 +13,70 @@ * supports quotations and antiquotations, useful for metaprogramming * supports dynamic linking of external functions under Linux (x86 and Alpha), FreeBSD, NetBSD, Solaris, Digital Unix, HP-UX, - MacOS, and MS Windows'95/98/NT + MacOS, and MS Windows'95/98/NT/XP/Vista and possibly also 7 and 8. -New in version 2.00 of Moscow ML +New in version 2.10.1 of Moscow ML + + * ML Server Pages added to examples + +New in version 2.10 of Moscow ML + + * Support for dynamic linking and callback from C also under MacOS X + * There may now be 2 G globals (string literals etc) instead of 64 K + * Bugs fixed: + * The HTML files generated for mosmllib now have valid URLs + * Substring.app more efficient + * Recursive structure compilation (elabRecSigExp) fixed + * Several errors in Mosmlcookie + * Misplaced double quote in Msp.ahrefa + * Exception Option wasn't available at top-level + * Linker did not check stamps of linked-in units + * Hash function now much faster on very long strings + * Double alignment constraints now correct with gcc-3.2 and Solaris + * Bug in Polyhash.filter + * Socket library returned only first 16 bytes of UDP datagram + * SML Basis Library changes: + * String and Substring: added concatWith, isSuffix, isSubstring, full + * ListPair: added zipEq, appEq, mapEq, foldlEq, foldrEq, allEq + * Added ArraySlice and VectorSlice structures, also for Char and Word8 + * Added find, findi, all, exists, collate to vector, array and + slice structures + * Added collate to List + * Added update to vector structures + * Path.{mkRelative,mkAbsolute} now take record arguments + * Negative Time.time values allowed + * OS.Process: new functions sleep and isSuccess; status not eqtype + * Listsort: added eqclasses, merge, mergeUniq + * Path: added functions isRoot, fromUnixPath, toUnixPath, and + exception InvalidArc (bug report by Henning Niss) + * TextIO: inputLine now have type instream -> string option + * Array: added type abbreviation vector (bug report by Andrzej + Wasowski) + * FileSys: type access renamed to access_mode (bug report by + Henning Niss) + * Byte: unpackString{,Vec} now uses vector slices (bug report by + Henning Niss) + * Unix: added functions fromStatus, textInstreamOf, binInstreamOf, + textOutstreamOf, binOutstreamOf, exit, and added phantom types + to proc (bug report by Henning Niss) + * Timer: added function checkCPUTimes + * Word and Word8: added functions toLarge, toLargeX, and fromLarge + (bug report by Martin Elsman) + * General: added exception Span and made the type of the function + 'before' less general (bug report by Henning Niss) + * Added modules to mosmllib: + * Buffer: mutable string buffers for fast and efficient + concatenation of strings + * Hashset: sets implemented by hash-tables + * Rbset: ordered sets implemented by red-black trees + * Redblackmap: maps implemented by red-black trees + * Moscow ML is now developed in the open at github. - * The full SML Modules language (structures, signatures, and functors) - is now supported, thanks to Claudio Russo. Also, several extensions - to the SML Modules language are provided: - - higher-order functors: functors may be defined within structures - and functors - - first-class modules: structures and functors may be packed and - then handled as Core language values, which may then be unpacked - as structures or functors again - - recursive modules: signatures and structures may be recursively - defined - * Value polymorphism has become friendlier: non-generalizable free - type variables are left free, and become instantiated (once only) - when the bound variable is used - * Added facilities for creating and communicating with subprocesses - (structure Unix and Signal from SML Basis Library). - * Added facilities for efficient functional generation of HTML code - (structure Msp); also supports the writing of ML Server Page scripts. - * Added facilities setting and accessing `cookies' in CGI scripts - (structure Mosmlcookie), thanks to Hans Molin, Uppsala, Sweden. - * The Gdimage structure now produces PNG images (using Thomas - Boutell's gd library). SYSTEM REQUIREMENTS Compilation under Unix is best done using GNU make, gcc, and Perl. A -binary installation requires 5 MB disk space; a source installation +binary installation requires 8 MB disk space; a source installation requires 25 MB disk space. LIST OF FILES @@ -67,14 +101,18 @@ Sergei Romanenko (roman@keldysh.ru) Keldysh Institute of Applied Mathematics, Russian Academy of Sciences Miusskaya Pl. 4, 125047 Moscow, Russia -and Claudio V. Russo (Claudio.Russo@cl.cam.ac.uk), University of Cambridge. +and Claudio V. Russo at Edinburgh University, now at Microsoft Research UK, Thanks to Don Sannella at LFCS, Division of Informatics, University of Edinburgh for funding under EPSRC grant GR/K63795 -and Peter Sestoft (sestoft@dina.kvl.dk), - Department of Mathematics and Physics, Royal Veterinary and - Agricultural University, Thorvaldsensvej 40, DK-1871 Frederiksberg C, - Denmark. Much of the work was done at the Technical University of +and Peter Sestoft (sestoft@itu.dk), + IT University of Copenhagen, Denmark. + Previously at Department of Mathematics and Physics, Royal Veterinary and + Agricultural University, Denmark. + Much of the work was done at the Technical University of Denmark, and while visiting AT&T Bell Laboratories, New Jersey, USA. +and Ken Friis Larsen (ken@friislarsen.net) + Department of Computer Science, University of Copenhagen, + Denmark. Moscow ML owes much to: * the CAML Light implementation by Xavier Leroy and Damien Doligez @@ -87,9 +125,8 @@ * the good work by Doug Currie, Flavors Technology, USA, on the MacOS port and many improvements; and * feedback, contributions, and useful suggestions, in particular - from Ken Friis Larsen, but also from Jonas Barklund, Mike Gordon, - Michael Norrish, Konrad Slind, Jakob Lichtenberg, Hans Molin, and - numerous other people. + from Jonas Barklund, Mike Gordon, Michael Norrish, Konrad Slind, + Jakob Lichtenberg, Hans Molin, and numerous other people. COPYRIGHT NOTICE FOR MOSCOW ML @@ -120,22 +157,9 @@ AVAILABILITY - * The Moscow ML home page is at - http://www.dina.kvl.dk/~sestoft/mosml.html - * Moscow ML library documentation - http://www.dina.kvl.dk/~sestoft/mosmllib/ - * The Linux executables (and documentation) are in - ftp://ftp.dina.kvl.dk/pub/mosml/linux-mos20bin.tar.gz - * The MS Windows executables are in - ftp://ftp.dina.kvl.dk/pub/mosml/win32-mos20bin.zip - * The MS DOS executables (and documentation) are in - ftp://ftp.dina.kvl.dk/pub/mosml/mos20bin.zip - * The Macintosh/MacOS (68k and PPC) executables are in - ftp://ftp.dina.kvl.dk/pub/mosml/mac-mos20bin.sea.hqx - * The Unix source files (and documentation) are in - ftp://ftp.dina.kvl.dk/pub/mosml/mos20src.tar.gz - * The MacOS modified source files (relative to Unix) are in - ftp://ftp.dina.kvl.dk/pub/mosml/mac-mos20src.sea.hqx - -The files are mirrored at - ftp://ftp.csd.uu.se/pub/mirror/mosml + * The Moscow ML home page is at + http://mosml.org + * Moscow ML library documentation + http://mosml.org/mosmllib/ + * The source files can be downloaded from GitHub at + https://github.com/kfl/mosml/zipball/master diff -Nru mosml-2.01/src/compiler/Back.sml mosml-2.10.1/src/compiler/Back.sml --- mosml-2.01/src/compiler/Back.sml 2000-04-26 16:09:21.000000000 +0000 +++ mosml-2.10.1/src/compiler/Back.sml 2014-08-28 08:47:22.000000000 +0000 @@ -126,14 +126,14 @@ (* *) fun addPop n C = - if n = 0 - then C + if n = 0 then C else case C of - Kpop m :: C => addPop (n + m) C - | Kreturn m :: C => Kreturn (n + m) :: C - | Kraise :: _ => C - | _ => Kpop n :: C + Kpop m :: C1 => addPop (n + m) C1 + | Kreturn m :: C1 => Kreturn (n + m) :: C1 + | Klabel _ :: Kreturn m :: _ => Kreturn (n + m) :: C + | Kraise :: _ => C + | _ => Kpop n :: C ; (* Generate a jump through table, unless unnecessary. *) @@ -442,15 +442,15 @@ (* The translator from lambda terms to lists of instructions. - env: the map from Lvar ids to stackptr offsets; side-effected + env : the map from Lvar ids to stackptr offsets; updated by side-effects staticfail : the pair (label,sz) where Lstaticfail must branch. - sz: the current runtime stack model depth (includes codegen temporaries) - dp: the depth of the Front.sml stack model (excludes codegen temporaries) + sz : the current runtime stack model depth (includes codegen temporaries) + dp : the depth of the Front.sml stack model (excludes codegen temporaries) exp : the lambda term to compile. - C : the continuation, i.e. the code that follows the code for lambda. + C : the continuation, i.e. the code that follows the code for lambda. - The tests on the continuation detect tail-calls and avoid jumps to jumps, - or jumps to function returns. + The tests on the continuation detect tail-calls and avoid jumps to + jumps, or jumps to function returns. *) @@ -716,8 +716,10 @@ and compTest2 sz dp cond ifso ifnot C = let val (sflbl,sftsz) = staticfail val Cc = -(* This optimization is rather ill-considered. It works if the result () - of the switch is disregarded, but otherwise it fails. sestoft 2000-04-26 + + (* This optimization is rather ill-considered. It works if + the result () of the switch is disregarded, but otherwise + it fails. sestoft 2000-04-26 if ifnot = Lconst constUnit then let val (lbl, C1) = labelCode C diff -Nru mosml-2.01/src/compiler/Buffcode.sml mosml-2.10.1/src/compiler/Buffcode.sml --- mosml-2.01/src/compiler/Buffcode.sml 2000-01-21 10:07:12.000000000 +0000 +++ mosml-2.10.1/src/compiler/Buffcode.sml 2014-08-28 08:47:22.000000000 +0000 @@ -18,8 +18,7 @@ let val len = CharArray.length (!out_buffer) val new_buffer = make_buffer (2 * len) in - CharArray.copy { src = !out_buffer, si = 0, len = NONE, - dst = new_buffer, di = 0 }; + CharArray.copy { src = !out_buffer, dst = new_buffer, di = 0 }; out_buffer := new_buffer end; diff -Nru mosml-2.01/src/compiler/Compiler.sml mosml-2.10.1/src/compiler/Compiler.sml --- mosml-2.01/src/compiler/Compiler.sml 2000-06-22 22:11:21.000000000 +0000 +++ mosml-2.10.1/src/compiler/Compiler.sml 2014-08-28 08:47:22.000000000 +0000 @@ -290,10 +290,12 @@ val sigexp = resolveToplevelSigExp sigexp val LAMBDA(T, RS) = elabToplevelSigExp sigexp in + incrBindingLevel(); + refreshTyNameSet PARAMETERts T; updateCurrentStaticT T; (strOptOfSig (!currentSig)) := SOME RS; let val S' = normStr (SofRecStr RS) (* cvr: we norm S so that calculated (sub)fields - are correct *) + are correct *) in extendCurrentStaticME (MEofStr S'); extendCurrentStaticFE (FEofStr S'); @@ -313,6 +315,8 @@ val (iBas,spec) = resolveToplevelSpec spec val LAMBDA(T, S) = elab spec in + incrBindingLevel(); + refreshTyNameSet PARAMETERts T; updateCurrentStaticT T; extendCurrentStaticIBas iBas; extendCurrentStaticS S; @@ -339,10 +343,9 @@ (* val () = (msgIBlock 0; msgString "[compiling file \""; msgString source_name; msgString "\"]"; msgEOL(); msgEBlock();) *) - val restorePrState = savePrState() val () = startCompilingUnit uname "" umode val () = initInitialEnvironments context - val () = resetTypePrinter() + val () = resetTypes (); val is = open_in_bin source_name val () = remove_file target_name; val lexbuf = createLexerStream is @@ -378,9 +381,8 @@ (compileSig (parseSigFile umode lexbuf); ignore (rectifySignature ()); ignore (writeCompiledSignature target_name); - close_in is; - restorePrState()) - handle x => (close_in is;restorePrState();raise x) + close_in is) + handle x => (close_in is;raise x) end ; @@ -390,8 +392,9 @@ (* that the intermediate results will be discarded. *) fun updateCurrentCompState ((iBas, ExEnv as EXISTS(T,(ME,FE,GE,VE, TE))), RE) = -( - updateCurrentInfixBasis iBas; +( updateCurrentInfixBasis iBas; + incrBindingLevel(); + refreshTyNameSet PARAMETERts T; updateCurrentStaticT T; updateCurrentStaticME ME; updateCurrentStaticFE FE; @@ -440,13 +443,12 @@ (* val () = (msgIBlock 0; msgString "[compiling file \""; msgString filename_sml; msgString "\"]"; msgEOL(); msgEBlock()) *) - val restorePrState = savePrState(); (* cvr: *) val () = startCompilingUnit uname uident umode val () = initInitialEnvironments context val () = extendInitialSigEnv specSig_opt (* if in STRmode and the optional sig is there then we add the signature to the environment of the body *) - val () = resetTypePrinter(); + val () = resetTypes(); val os = open_out_bin filename_uo in ( start_emit_phrase os; @@ -476,11 +478,10 @@ (getOption (!uStamp)) (#uMentions (!currentSig)) os end); - close_out os; - restorePrState() + close_out os end ) - handle x => (close_out os; remove_file filename_uo;restorePrState();raise x) + handle x => (close_out os; remove_file filename_uo;raise x) end; (* cvr: TODO @@ -529,3 +530,9 @@ (compileStruct (parseStructFile umode lexbuf)) handle x => (close_in is; raise x) end; + + + + + + diff -Nru mosml-2.01/src/compiler/Config.mlp mosml-2.10.1/src/compiler/Config.mlp --- mosml-2.01/src/compiler/Config.mlp 2004-01-12 15:32:20.000000000 +0000 +++ mosml-2.10.1/src/compiler/Config.mlp 2014-08-28 08:47:22.000000000 +0000 @@ -1,7 +1,8 @@ local open Fnlib in (* version string *) -val version = "2.01 (January 2004)"; +#include "../config/defs.h" +val version = VERSION_S (* Integer ranges *) @@ -52,10 +53,12 @@ val fulllib = ["Option", "List", "ListPair", "Strbase", "Char", "String", "StringCvt", "TextIO", "BasicIO", "Vector", - "Array", "Misc", "Substring", + "Array", "VectorSlice", "ArraySlice", "Misc", "Substring", "Bool", "Int", "Real", "Math", - "Word", "Word8", "Word8Vector", "Word8Array", "Byte", + "Word", "Word8", "Word8Vector", "Word8Array", + "Word8VectorSlice", "Word8ArraySlice", "Byte", "BinIO", "CharVector", "CharArray", + "CharVectorSlice", "CharArraySlice", "Time", "Timer", "Date", "Path", "FileSys", "Process", "OS", "Mosml", "PP", "CommandLine"] @@ -83,6 +86,7 @@ #ifdef msdos val kosherUnitNames = [ + ("Arraysli", "ArraySlice"), ("Basicio", "BasicIO"), ("Binio", "BinIO"), ("Chararra", "CharArray"), @@ -97,6 +101,7 @@ ("Stringcv", "StringCvt"), ("Substrin", "Substring"), ("Textio", "TextIO"), + ("Vectorsl", "VectorSlice"), ("Word8arr", "Word8Array"), ("Word8vec", "Word8Vector") ]; @@ -104,22 +109,28 @@ #ifdef win32 val kosherUnitNames = [ - ("Basicio", "BasicIO"), - ("Binio", "BinIO"), - ("Chararray", "CharArray"), - ("Charvector", "CharVector"), - ("Commandline", "CommandLine"), - ("Filesys", "FileSys"), - ("Listpair", "ListPair"), - ("Nj93", "NJ93"), - ("Os", "OS"), - ("Pp", "PP"), - ("Sml90", "SML90"), - ("Stringcvt", "StringCvt"), - ("Substring", "Substring"), - ("Textio", "TextIO"), - ("Word8array", "Word8Array"), - ("Word8vector", "Word8Vector") + ("Arrayslice", "ArraySlice"), + ("Basicio", "BasicIO"), + ("Binio", "BinIO"), + ("Chararray", "CharArray"), + ("Chararrayslice", "CharArraySlice"), + ("Charvector", "CharVector"), + ("Charvectorslice", "CharVectorSlice"), + ("Commandline", "CommandLine"), + ("Filesys", "FileSys"), + ("Listpair", "ListPair"), + ("Nj93", "NJ93"), + ("Os", "OS"), + ("Pp", "PP"), + ("Sml90", "SML90"), + ("Stringcvt", "StringCvt"), + ("Substring", "Substring"), + ("Textio", "TextIO"), + ("Vectorslice", "VectorSlice"), + ("Word8array", "Word8Array"), + ("Word8arrayslice", "Word8ArraySlice"), + ("Word8vector", "Word8Vector"), + ("Word8vectorslice", "Word8VectorSlice") ]; #endif diff -Nru mosml-2.01/src/compiler/Elab.sml mosml-2.10.1/src/compiler/Elab.sml --- mosml-2.01/src/compiler/Elab.sml 2000-06-27 14:46:19.000000000 +0000 +++ mosml-2.10.1/src/compiler/Elab.sml 2014-08-28 08:47:22.000000000 +0000 @@ -374,14 +374,14 @@ and unguardedModBind (MODBINDmodbind(modid,modexp)) = unguardedModExp modexp | unguardedModBind (ASmodbind(modid,sigexp,exp)) = - (unguardedSigExp sigexp; + (unguardedSigExp sigexp U unguardedExp exp) and unguardedSigBind (SIGBINDsigbind(sigid,sigexp)) = unguardedSigExp sigexp and unguardedFunBind (FUNBINDfunbind(funid,modexp)) = unguardedModExp modexp | unguardedFunBind (ASfunbind(funid,sigexp,exp)) = - (unguardedSigExp sigexp; + (unguardedSigExp sigexp U unguardedExp exp) and unguardedModExp (_,(modexp,_)) = case modexp of @@ -571,12 +571,27 @@ if (isExpansiveExp exp) then (domPatAcc pat acc) else acc ; +(* Bug fix 2004-05-24 from Claudio; bug from Andrzej Wasowski *) + +fun renameScheme scheme = Types.copyTypeScheme [] [] scheme + +fun closeValBindVE loc (pvbs: ValBind list) VE = + let val exIds = foldR expansiveIdsInValBind [] pvbs in + mapEnv (fn id => fn {qualid, info = (t,sc)} => + {qualid=qualid,info = (renameScheme(generalization (member id +exIds) t),sc)}) VE + end +; + + +(* fun closeValBindVE loc (pvbs: ValBind list) VE = let val exIds = foldR expansiveIdsInValBind [] pvbs in mapEnv (fn id => fn {qualid, info = (t,sc)} => {qualid=qualid,info = (generalization (member id exIds) t,sc)}) VE end ; +*) fun findAndMentionStrSig loc i = let val cu = findAndMentionSig loc i @@ -1034,6 +1049,7 @@ "Duplicate parameter in a prim_type binding" ; + (* checkApplicativeModExp dec is used to ensures that module values are not opened at top-level within (both generative and applicative) functor bodies (doing so is unsound in the presence of applicative functors). @@ -1086,6 +1102,31 @@ | _ => () ; +fun checkApplicativeMod loc (STRmod recstr) = + checkApplicativeRecStr loc recstr +| checkApplicativeMod loc (FUNmod F) = + checkApplicativeFun loc F +and checkApplicativeFun loc (forall,dom,(EXISTSexmod(exists,rng))) = + case exists of + [] => checkApplicativeMod loc rng + | _ => errorMsg loc "Illegal applicative functor argument: \ + \the signature specifies a generative functor \ + \in a positive position" +and checkApplicativeRecStr loc (RECrec(fwd,bdy)) = + checkApplicativeRecStr loc bdy +| checkApplicativeRecStr loc (NONrec str) = + checkApplicativeStr loc str +and checkApplicativeStr loc (STRstr (ME,FE,GE,TE,VE)) = + (traverseEnv (fn modid => fn {info=recstr,...} => + checkApplicativeRecStr loc recstr) + ME; + traverseEnv (fn funid => fn {info=F,...} => + checkApplicativeFun loc F) + FE) +| checkApplicativeStr loc (SEQstr(S1,S2)) = + (checkApplicativeStr loc S1; + checkApplicativeStr loc S2) + (* semantic checks *) val bindOnceInEnv = fn env => fn (loc,id) => fn info => fn msg => @@ -1522,7 +1563,7 @@ | VARpat ii => (case ii of {qualid = {id = [id],...}, info={idLoc,...}} => - let val q = (* mkName onTop *) mkLocalName id + let val q = mkLocalName id val vi = { qualid=q, info=REGULARo } in bindOnceInEnv PE (idLoc,id) {qualid=q, info= (trivial_scheme pat_t,VARname REGULARo)} @@ -1886,28 +1927,19 @@ (elabDatBind ME FE GE UE VE TE) (NILenv,NILenv) dbs ; -fun elabExBind (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) onTop = fn +fun elabExBind (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) = fn EXDECexbind(ii, SOME ty) => let val _ = checkRebinding illegalCon ii val {qualid, info = {idLoc,idKind,...}} = ii val id = longIdentAsIdent (#id qualid) "elabExBind" val ei = mkExConInfo() - val q = (* mkName onTop *) mkLocalName id + val q = mkLocalName id val _ = idKind := { qualid=q, info=EXCONik ei }; val _ = setExConArity ei 1 -(* ps: val _ = if onTop then - setExConTag ei (SOME (q, newExcStamp())) - else () -*) val arg_t = (elabTy ME FE GE UE VE TE ty) in if typeIsImperative arg_t then () else errorMsg (xLR ty) "Non-imperative exception type"; -(* ps: if isExConStatic ei andalso isRecTy ty then - (setExConArity ei (arityOfRecTy ty); - setExConIsGreedy ei true) - else (); -*) ((idLoc,id), {qualid = q,info = (type_arrow arg_t type_exn, EXNname ei)}) end | EXDECexbind(ii, NONE) => @@ -1915,13 +1947,9 @@ val {qualid, info = {idLoc,idKind,...}} = ii val id = longIdentAsIdent (#id qualid) "elabDec:EXDECexbind" val ei = mkExConInfo() - val q = (* mkName onTop *) mkLocalName id + val q = mkLocalName id val _ = idKind := { qualid=q, info=EXCONik ei }; val _ = setExConArity ei 0 -(* ps: val _ = if onTop then - setExConTag ei (SOME (q, newExcStamp())) - else () -*) in ((idLoc,id), {qualid = q, info = (type_exn, EXNname ei)}) end @@ -1943,7 +1971,7 @@ | REFname => errorMsg loc' "`ref' is used as an exception name" | EXNname ei' => (* cvr: TODO review *) - let val q = (* mkName onTop *) mkLocalName id in + let val q = mkLocalName id in #idKind info' := { qualid= csqualid, info=EXCONik ei' }; #idFields info' := fields; idKind := { qualid= q, info=EXCONik ei' }; @@ -1953,12 +1981,12 @@ end ; -fun elabExBindList (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) onTop ebs = +fun elabExBindList (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) ebs = closeEE (foldL_map (fn (locid, tau) => fn env => bindOnceInEnv env locid tau "The same exception constructor is declared\ \ twice in an exception declaration" ) - (elabExBind ME FE GE UE VE TE onTop) NILenv ebs) + (elabExBind ME FE GE UE VE TE ) NILenv ebs) ; (* OVL1TXXo is not a true overloaded type, *) @@ -2066,7 +2094,7 @@ end | LETexp(dec, body) => let val EXISTS(T,(ME',FE',GE', VE', TE')) = - elabDec ME FE GE UE VE TE false dec + elabDec ME FE GE UE VE TE dec val () = incrBindingLevel(); val () = refreshTyNameSet PARAMETERts T; val tau = @@ -2238,7 +2266,7 @@ case (pats, arg_ts) of ([], []) => elabExp ME FE GE UE VE TE exp res_t | (pat :: pats', arg_t :: arg_ts') => - let val VE' = elabPat ME FE GE UE VE TE (* false *) pat arg_t NILenv + let val VE' = elabPat ME FE GE UE VE TE pat arg_t NILenv in elabMRule ME FE GE UE (plusEnv VE VE') TE exp res_t pats' arg_ts' end | (_, _) => fatalError "elabMRule" @@ -2250,7 +2278,7 @@ in (VEofCE CE,mk1Env tycon tyStr) end and elabDec (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) - (TE : TyEnv) (onTop : bool) (loc, dec') = + (TE : TyEnv) (loc, dec') = case dec' of VALdec (tvs, (pvbs, rvbs)) => let val _ = checkDuplIds tvs "Duplicate explicit type variable" @@ -2282,7 +2310,7 @@ EXISTS([],(NILenv, NILenv, NILenv, VE',NILenv)) end | FUNdec (ref (UNRESfundec _)) => fatalError "elabDec" - | FUNdec (ref (RESfundec dec)) => elabDec ME FE GE UE VE TE onTop dec + | FUNdec (ref (RESfundec dec)) => elabDec ME FE GE UE VE TE dec | TYPEdec tbs => let val tbsTE = elabTypBindList ME FE GE UE VE TE tbs in @@ -2301,7 +2329,7 @@ val tbsTE = elabTypBindList_opt ME FE GE UE VE (plusEnv TE dbsTE) tbs_opt (* Here dbsTE will get destructively updated too. *) val _ = checkNoRebindingsTyEnv loc (plusEnv dbsTE tbsTE) - "the same type constructur is defined twice in this datatype declaration" + "the same type constructor is defined twice in this datatype declaration" val (VE',dbsTE') = elabDatBindList ME FE GE UE VE (plusEnv (plusEnv TE dbsTE) tbsTE) dbs val _ = checkNoRebindingsVarEnv loc VE' "the same constructor is defined twice in this datatype declaration" @@ -2323,38 +2351,39 @@ val tbsTE = elabTypBindList_opt ME FE GE UE VE (plusEnv TE dbsTE) tbs_opt (* Here dbsTE will get destructively updated too. *) val _ = checkNoRebindingsTyEnv loc (plusEnv dbsTE tbsTE) - "the same type constructur is defined twice in this abstype declaration" + "the same type constructor is defined twice in this abstype declaration" val (VE',dbsTE') = elabDatBindList ME FE GE UE VE (plusEnv (plusEnv TE dbsTE) tbsTE) dbs val _ = checkNoRebindingsVarEnv loc VE' "the same constructor is bound twice in this abstype declaration" val () = maximizeEquality dbsTE' - val () = setEquality tbsTE; + val () = setEquality tbsTE; val EXISTS(T2,(ME2,FE2,GE2,VE2, TE2)) = elabDec ME FE GE UE (plusEnv VE VE') - (plusEnv (plusEnv TE dbsTE') tbsTE) onTop dec2 + (plusEnv (plusEnv TE dbsTE') tbsTE) dec2 in (* Now let's destructively update the equality attributes *) (* and the lists of constructors! *) (* Here VE2 and TE2 will be implicitly influenced too. *) let val dbsTE2 = absTE dbsTE'; in - setEquality tbsTE; - decrBindingLevel(); - EXISTS(T1@T2,(ME2,FE2,GE2,VE2, plusEnv(plusEnv dbsTE2 tbsTE) TE2)) + setEquality tbsTE; (* cvr: TODO review why is this repeated? *) + decrBindingLevel(); + refreshExEnv(EXISTS(T1@T2,(ME2,FE2,GE2,VE2, plusEnv(plusEnv dbsTE2 tbsTE) TE2))) end (* cvr: *) end | EXCEPTIONdec ebs => - EXISTS([],(NILenv,NILenv,NILenv,(elabExBindList ME FE GE UE VE TE onTop ebs), NILenv)) + EXISTS([],(NILenv,NILenv,NILenv,(elabExBindList ME FE GE UE VE TE ebs), NILenv)) | LOCALdec (dec1, dec2) => - let val EXISTS(T',(ME',FE',GE',VE', TE')) = - elabDec ME FE GE UE VE TE onTop dec1; - val _ = incrBindingLevel(); - val _ = refreshTyNameSet PARAMETERts T'; + let val EXISTS(T',(ME',FE',GE',VE', TE')) = + refreshExEnv(elabDec ME FE GE UE VE TE dec1) + val _ = incrBindingLevel() + val _ = refreshTyNameSet PARAMETERts T' val EXISTS(T'',(ME'', FE'', GE'', VE'',TE'')) = - elabDec (plusEnv ME ME') (plusEnv FE FE') (plusEnv GE GE') UE (plusEnv VE VE') (plusEnv TE TE') onTop dec2 + elabDec (plusEnv ME ME') (plusEnv FE FE') (plusEnv GE GE') + UE (plusEnv VE VE') (plusEnv TE TE') dec2 in decrBindingLevel(); - EXISTS(T'@T'',(ME'', FE'', GE'', VE'', TE'')) + refreshExEnv(EXISTS(T'@T'',(ME'', FE'', GE'', VE'', TE''))) end | OPENdec longmodidinfos => EXISTS([], @@ -2379,22 +2408,23 @@ | EMPTYdec => EXISTS([],(NILenv, NILenv,NILenv,NILenv, NILenv)) | SEQdec (dec1, dec2) => let val EXISTS(T',(ME',FE',GE',VE', TE')) = - elabDec ME FE GE UE VE TE onTop dec1 + elabDec ME FE GE UE VE TE dec1 val _ = incrBindingLevel(); val _ = refreshTyNameSet PARAMETERts T'; val EXISTS(T'',(ME'', FE'', GE'', VE'',TE'')) = - elabDec (plusEnv ME ME') (plusEnv FE FE') (plusEnv GE GE') UE (plusEnv VE VE') (plusEnv TE TE') onTop dec2 + elabDec (plusEnv ME ME') (plusEnv FE FE') (plusEnv GE GE') UE (plusEnv VE VE') (plusEnv TE TE') dec2 in (decrBindingLevel(); - EXISTS(T'@T'',(plusEnv ME' ME'', plusEnv FE' FE'',plusEnv GE' GE'',plusEnv VE' VE'', plusEnv TE' TE''))) + (*cvr: is this refresh too expensive? *) + refreshExEnv(EXISTS(T'@T'',(plusEnv ME' ME'', plusEnv FE' FE'',plusEnv GE' GE'',plusEnv VE' VE'', plusEnv TE' TE'')))) end | FIXITYdec _ => EXISTS([],(NILenv,NILenv,NILenv,NILenv,NILenv)) | STRUCTUREdec mbs => - let val EXISTS(T,ME') = elabModBindList ME FE GE UE VE TE mbs - in EXISTS(T,(ME',NILenv,NILenv,NILenv, NILenv)) + let val EXISTS(T,ME') = elabModBindList ME FE GE UE VE TE mbs + in refreshExEnv(EXISTS(T,(ME',NILenv,NILenv,NILenv, NILenv))) end | FUNCTORdec fbs => - let val EXISTS(T,FE') = elabFunBindList ME FE GE UE VE TE fbs - in EXISTS(T,(NILenv,FE',NILenv,NILenv, NILenv)) + let val EXISTS(T,FE') = elabFunBindList ME FE GE UE VE TE fbs + in refreshExEnv(EXISTS(T,(NILenv,FE',NILenv,NILenv, NILenv))) end | SIGNATUREdec sbs => let val GE' = elabSigBindList ME FE GE UE VE TE sbs @@ -2419,7 +2449,7 @@ "This module expression is actually a functor \ \but should be a structure" in - EXISTS(T,(locmodid,{qualid = (* mkName onTop *) mkLocalName modid, info = S})) + EXISTS(T,(locmodid,{qualid = mkLocalName modid, info = S})) end | elabModBind (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) (ASmodbind (locmodid as (loc,modid),sigexp as (loc',_),exp)) = @@ -2428,7 +2458,7 @@ | STRmod S => normRecStr S val tau = elabExp ME FE GE UE VE TE exp (PACKt(EXISTSexmod(T,M))) in - EXISTS(T,(locmodid,{qualid = (* mkName onTop *) mkLocalName modid, info = S})) + EXISTS(T,(locmodid,{qualid = mkLocalName modid, info = S})) end and elabFunBindList (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) mbs = @@ -2448,7 +2478,7 @@ "This module expression is actually a structure \ \but should be a functor" in - EXISTS(T,(locfunid,{qualid = (* mkName onTop *) mkLocalName funid, info = F})) + EXISTS(T,(locfunid,{qualid = mkLocalName funid, info = F})) end | elabFunBind (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) (ASfunbind (locfunid as (loc,funid),sigexp as (loc',_),exp)) = @@ -2458,7 +2488,7 @@ | FUNmod F => F val tau = elabExp ME FE GE UE VE TE exp (PACKt(EXISTSexmod(T,M))) in - EXISTS(T,(locfunid,{qualid = (* mkName onTop *) mkLocalName funid, info = F})) + EXISTS(T,(locfunid,{qualid = mkLocalName funid, info = F})) end and elabSigBindList (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) sbs = @@ -2478,7 +2508,7 @@ case modexp' of DECmodexp dec => let - val EXISTS(T',(ME',FE',GE',VE',TE')) = elabDec ME FE GE UE VE TE false dec + val EXISTS(T',(ME',FE',GE',VE',TE')) = elabDec ME FE GE UE VE TE dec val exmod = EXISTSexmod(T',(STRmod (NONrec (STRstr (sortEnv ME', sortEnv FE', NILenv, @@ -2573,7 +2603,7 @@ | LETmodexp (dec, modexp) => let val EXISTS(T',(ME',FE',GE',VE', TE')) = - elabDec ME FE GE UE VE TE false dec; + elabDec ME FE GE UE VE TE dec; val _ = incrBindingLevel(); val _ = refreshTyNameSet PARAMETERts T'; val EXISTSexmod(T'',M) = @@ -2610,8 +2640,10 @@ X' end end - | FUNCTORmodexp (Applicative,(loc,modid),idKindDescRef,sigexp,modexp) => - let val LAMBDAsig (T,M) = elabSigExp ME FE GE UE VE TE sigexp + | FUNCTORmodexp (Applicative,(loc,modid),idKindDescRef,sigexp as (locsigexp,_),modexp) => + let val _ = checkApplicativeModExp modexp + val LAMBDAsig (T,M) = elabSigExp ME FE GE UE VE TE sigexp + val _ = checkApplicativeMod locsigexp M val (ME',FE') = case M of STRmod S => (idKindDescRef := STRik; @@ -2760,7 +2792,7 @@ val ty_t = elabTy ME FE GE UE VE TE ty val {qualid, info = {idLoc,...}} = ii val pid = longIdentAsIdent (#id qualid) "elabPrimValBind" - val q = (* mkName onTop *) mkLocalName pid + val q = mkLocalName pid in ((idLoc,pid), {qualid =q, info=(mkScheme tvs ty_t,mkPrimStatus arity n)}) @@ -2774,16 +2806,16 @@ val ty_t = elabTy ME FE GE UE VE TE ty val {qualid, info = {idLoc,...}} = ii val vid = longIdentAsIdent (#id qualid) "elabValDesc" - val q = (* mkGlobalName *) mkLocalName vid + val q = mkLocalName vid in ((idLoc,vid), {qualid = q, info = (mkScheme tvs ty_t,VARname (REGULARo))}) end -and elabExDesc (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) onTop +and elabExDesc (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) ((ii, ty_opt) : ExDesc) = let val _ = checkRebinding illegalCon ii val {qualid, info = {idLoc,idKind,...}} = ii val eid = longIdentAsIdent (#id qualid) "elabExDesc" val ei = mkExConInfo() - val q = (* mkGlobalName *) mkLocalName eid + val q = mkLocalName eid in idKind := { qualid=q, info=EXCONik ei }; (case ty_opt of @@ -2803,19 +2835,19 @@ end and elabExDescList (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) - (VE : VarEnv) (TE : TyEnv) onTop eds = + (VE : VarEnv) (TE : TyEnv) eds = closeEE (foldL_map (fn (locid, tau) => fn env => bindOnceInEnv env locid tau "the same exception constructor is specified twice\ \ in an exception specification") - (elabExDesc ME FE GE UE VE TE onTop) NILenv eds) + (elabExDesc ME FE GE UE VE TE ) NILenv eds) and elabSigExp (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) (TE:TyEnv) (loc, sigexp) = (case sigexp of SPECsigexp spec => - let val LAMBDA(T,S) = elabSpec ME FE GE UE VE TE false spec + let val LAMBDA(T,S) = elabSpec ME FE GE UE VE TE spec val _ = checkNoRebindingsStr loc S "the same identifier is specified twice in the body of this signature" in LAMBDAsig (T,STRmod (NONrec (removeGEofStr S))) @@ -2864,8 +2896,8 @@ end | WHEREsigexp (sigexp, tyvarseq, longtycon,ty) => (* cvr: TODO review *) (* Unlike SML, we reject where type constraints that construct inconsistent signatures - by equating a specified datatype with an non-equivalent type or datatype. - In SML, an inconsitent signature can never be implemented, but in Mosml it + by equating a specified datatype with a non-equivalent type or datatype. + In SML, an inconsistent signature can never be implemented, but in Mosml it can, by using a recursive structure, so we have to rule out inconsitent signatures from the start. *) @@ -2975,7 +3007,6 @@ raise Toplevel)); LAMBDAsig(remove tn T,STRmod RS) end) - | RECsigexp ((_,modid),sigexp as (locforward,_),sigexp' as (locbody,_)) => let val LAMBDAsig(T,M) = elabSigExp ME FE GE UE VE TE sigexp val (ME',RS) = @@ -3012,16 +3043,11 @@ msgEBlock(); errMatchReason "body" "forward specification" matchReason; raise Toplevel) - val T2T' = map (fn tn as {info = ref {tnSort = - REAts (APPtyfun tyapp), - ...}, - ...} => (tn,tyapp) - | _ => fatalError "elabRecSigExp") - T in (decrBindingLevel(); - LAMBDAsig(T',copyMod T2T' [] (STRmod (RECrec(RS,RS'))))) + LAMBDAsig(T',STRmod (RECrec(RS,RS')))) end) + and elabModDesc (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) (TE : TyEnv) (MODDESCmoddesc (locmodid as (loc,modid), sigexp as (loc',_)) : ModDesc)= let val LAMBDAsig(T,M) = elabSigExp ME FE GE UE VE TE sigexp val S = case M of @@ -3057,7 +3083,7 @@ "the same functor identifier is specified twice\ \ in a functor specification")) (elabFunDesc ME FE GE UE VE TE ) (LAMBDA([],NILenv)) mds -and elabSpec (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) onTop (loc, spec') = +and elabSpec (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) (loc, spec') = case spec' of VALspec (tyvarseq,vds) => let val _ = checkDuplIds tyvarseq "Duplicate explicit type variable" @@ -3130,7 +3156,7 @@ (if U_map unguardedExDesc eds <> [] then errorMsg loc "Type variables in an exception description" else (); (* cvr: TODO can be relaxed? *) - LAMBDA([],STRstr(NILenv, NILenv, NILenv, NILenv,elabExDescList ME FE GE [] VE TE onTop eds))) + LAMBDA([],STRstr(NILenv, NILenv, NILenv, NILenv,elabExDescList ME FE GE [] VE TE eds))) | STRUCTUREspec mds => let val LAMBDA(T,ME') = elabModDescList ME FE GE UE VE TE mds in LAMBDA(T,STRstr (ME', NILenv, NILenv, NILenv, NILenv)) end @@ -3140,12 +3166,12 @@ | LOCALspec (spec1, spec2) => let val (ME',FE',GE',VE', TE') = elabLocalSpec ME FE GE UE VE TE spec1 in - elabSpec (plusEnv ME ME') (plusEnv FE FE') (plusEnv GE GE') UE (plusEnv VE VE') (plusEnv TE TE') onTop spec2 + elabSpec (plusEnv ME ME') (plusEnv FE FE') (plusEnv GE GE') UE (plusEnv VE VE') (plusEnv TE TE') spec2 end | EMPTYspec => LAMBDA([],STRstr(NILenv, NILenv, NILenv, NILenv, NILenv)) | INCLUDEspec sigexp => let val LAMBDAsig(T,M) = elabSigExp ME FE GE UE VE TE sigexp - in case M of (* cvr: TODO revise to deal properly with onTop since this may kill static exception status *) + in case M of FUNmod _ => errorMsg loc "Illegal include: the included \ \signature must specify a structure, not a functor" @@ -3154,7 +3180,7 @@ \signature may not be recursive" end | SHARINGTYPEspec (spec,longtyconlist) => - let val LAMBDA(T,S) = elabSpec ME FE GE UE VE TE onTop spec + let val LAMBDA(T,S) = elabSpec ME FE GE UE VE TE spec val _ = incrBindingLevel(); val _ = refreshTyNameSet PARAMETERts T; val LocTyFunOfLongTyCon = @@ -3205,7 +3231,7 @@ LAMBDA(TminusT'', S) end | SEQspec (spec1, spec2) => - let val LAMBDA(T',S) = elabSpec ME FE GE UE VE TE onTop spec1 + let val LAMBDA(T',S) = elabSpec ME FE GE UE VE TE spec1 val _ = incrBindingLevel(); val _ = refreshTyNameSet PARAMETERts T'; val LAMBDA(T'',S') = @@ -3215,13 +3241,13 @@ UE (plusEnv VE (VEofStr S)) (plusEnv TE (TEofStr S)) - onTop + spec2 in decrBindingLevel(); LAMBDA(T'@T'',SEQstr(S,S')) end | SHARINGspec (spec1, (loc',longmodids)) => - let val LAMBDA(T, S) = elabSpec ME FE GE UE VE TE onTop spec1 + let val LAMBDA(T, S) = elabSpec ME FE GE UE VE TE spec1 val _ = incrBindingLevel(); val _ = refreshTyNameSet PARAMETERts T; val Ss = @@ -3295,14 +3321,12 @@ fun elabToplevelDec (dec : Dec) = -( - if unguardedDec dec <> [] then + (if unguardedDec dec <> [] then errorMsg (xLR dec) "Unguarded type variables at the top-level" else (); - resetBindingLevel(); let val EXISTS(T',(ME',FE',GE',VE',TE')) = elabDec (mkGlobalME()) (mkGlobalFE()) (mkGlobalGE()) [] - (mkGlobalVE()) (mkGlobalTE()) (* ps: true *) false dec + (mkGlobalVE()) (mkGlobalTE()) dec val _ = if (!currentCompliance) <> Liberal then Synchk.compliantTopDec dec else () @@ -3311,18 +3335,15 @@ cleanEnv GE', cleanEnv VE', cleanEnv TE')) - end -); + end); fun elabStrDec (dec : Dec) = -( - if unguardedDec dec <> [] then + (if unguardedDec dec <> [] then errorMsg (xLR dec) "Unguarded type variables at the top-level" else (); - resetBindingLevel(); let val EXISTS(T',(ME',FE',GE',VE',TE')) = elabDec (mkGlobalME()) (mkGlobalFE()) (mkGlobalGE()) [] - (mkGlobalVE()) (mkGlobalTE()) (* ps: true *) false dec + (mkGlobalVE()) (mkGlobalTE()) dec val _ = if (!currentCompliance) <> Liberal then Synchk.compliantStrDec dec else () @@ -3332,20 +3353,18 @@ cleanEnv GE', cleanEnv VE', cleanEnv TE')) - end -); + end) fun elabToplevelSigExp (sigexp as (loc,_) : SigExp) = - (resetBindingLevel(); - let val LAMBDAsig(T,M) = - elabSigExp (mkGlobalME()) - (mkGlobalFE()) - (mkGlobalGE()) - [] - (mkGlobalVE()) - (mkGlobalTE()) - sigexp - in case M of + let val LAMBDAsig(T,M) = + elabSigExp (mkGlobalME()) + (mkGlobalFE()) + (mkGlobalGE()) + [] + (mkGlobalVE()) + (mkGlobalTE()) + sigexp + in case M of FUNmod _ => errorMsg loc "Illegal unit signature: the signature \ \must specify a structure, not a functor" @@ -3354,38 +3373,34 @@ then Synchk.compliantSigExp sigexp else (); LAMBDA(T,RS)) - end); + end fun elabToplevelSpec (spec : Spec) = - (resetBindingLevel(); - let val StrSig = + let val StrSig = elabSpec (mkGlobalME()) (mkGlobalFE()) (mkGlobalGE()) [] (mkGlobalVE()) (mkGlobalTE()) - (* ps: true *) false spec - in - (* we could, but don't, check compliance since toplevel-mode .sig files don't need to be ported + spec + in + (* we could, but don't, check compliance since toplevel-mode .sig files don't need to be ported if (!currentCompliance) <> Liberal then Synchk.compliantTopSpec spec else (); *) StrSig - end ) -; + end fun elabSigSpec (spec : Spec) = - (resetBindingLevel(); - let val StrSig = + let val StrSig = elabSpec (mkGlobalME()) (mkGlobalFE()) (mkGlobalGE()) [] (mkGlobalVE()) (mkGlobalTE()) - (* ps: true *) false spec - in - if (!currentCompliance) <> Liberal - then Synchk.compliantSpec spec - else (); - StrSig - end ) -; + spec + in + if (!currentCompliance) <> Liberal + then Synchk.compliantSpec spec + else (); + StrSig + end diff -Nru mosml-2.01/src/compiler/Exec_phr.sml mosml-2.10.1/src/compiler/Exec_phr.sml --- mosml-2.01/src/compiler/Exec_phr.sml 2000-06-27 14:46:19.000000000 +0000 +++ mosml-2.10.1/src/compiler/Exec_phr.sml 2014-08-28 08:47:22.000000000 +0000 @@ -89,6 +89,8 @@ fun updateCurrentState ((iBas, (Env as EXISTS(T,(ME,FE,GE,VE, TE)))), RE) = ( catch_interrupt false; + incrBindingLevel(); + refreshTyNameSet PARAMETERts T; updateCurrentInfixBasis iBas; updateCurrentStaticT T; updateCurrentStaticME ME; @@ -109,10 +111,11 @@ app (fn (is_pure, lam) => ( (* msgIBlock 0; Pr_lam.printLam lam; msgEOL(); msgEBlock(); *) - (* msgIBlock 0; Pr_lam.printLam lam; msgEOL(); msgEBlock();msgFlush(); *) (* cvr: TODO remove *) + (* msgIBlock 0; Pr_lam.printLam lam; msgEOL(); msgEBlock(); + msgFlush(); *) ignore (loadZamPhrase let val zam = compileLambda is_pure lam in - (* printZamPhrase zam; msgFlush(); *) + (* printZamPhrase zam; msgFlush(); *) zam end) )) diff -Nru mosml-2.01/src/compiler/Filename.mlp mosml-2.10.1/src/compiler/Filename.mlp --- mosml-2.01/src/compiler/Filename.mlp 2000-01-21 10:07:12.000000000 +0000 +++ mosml-2.10.1/src/compiler/Filename.mlp 2014-08-28 08:47:22.000000000 +0000 @@ -1,6 +1,8 @@ (* filename.mlp *) -open CharVector; +(* open CharVector; *) + +fun extract arg = Substring.string(Substring.extract arg) fun check_suffix name suff = let val name_len = size name diff -Nru mosml-2.01/src/compiler/.gitignore mosml-2.10.1/src/compiler/.gitignore --- mosml-2.01/src/compiler/.gitignore 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler/.gitignore 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,19 @@ +# Files derived from .mlp files +# auto-generated +# binaries +*.ui +*.uo +/mosmlcmp.w32 +/mosmllnk.w32 +/mosmltop.w32 +Config.sml +Filename.sml +Lexer.sml +Opcodes.sml +Parser.sig +Parser.sml +Predef.sml +Prim_c.sml +mosmlcmp +mosmllnk +mosmltop diff -Nru mosml-2.01/src/compiler/Labels.sml mosml-2.10.1/src/compiler/Labels.sml --- mosml-2.01/src/compiler/Labels.sml 2000-01-21 10:07:12.000000000 +0000 +++ mosml-2.10.1/src/compiler/Labels.sml 2014-08-28 08:47:22.000000000 +0000 @@ -21,7 +21,7 @@ val new_table = Array.array((needed div old + 1) * old, Label_undefined []) in - Array.copy { src= !label_table, si=0, len = NONE, dst= new_table, di=0 }; + Array.copy { src= !label_table, dst= new_table, di=0 }; label_table := new_table end; diff -Nru mosml-2.01/src/compiler/Lexer.lex mosml-2.10.1/src/compiler/Lexer.lex --- mosml-2.01/src/compiler/Lexer.lex 2000-06-27 14:46:19.000000000 +0000 +++ mosml-2.10.1/src/compiler/Lexer.lex 2014-08-28 08:47:22.000000000 +0000 @@ -111,8 +111,7 @@ in if !string_index >= len then let val new_buff = array(len * 2, #"\000") in - copy - { src = !string_buff, si = 0, len = NONE, dst = new_buff, di = 0 }; + copy { src = !string_buff, dst = new_buff, di = 0 }; string_buff := new_buff end else (); @@ -121,37 +120,22 @@ end fun get_stored_string() = - let open CharArray - val s = extract(!string_buff, 0, SOME (!string_index)) + let open CharArraySlice + val s = vector(slice(!string_buff, 0, SOME (!string_index))) in string_buff := initial_string_buffer; s end -(* -fun splitQualId s = - let open CharVector - val len' = size s - 1 - fun parse n = - if n >= len' then - ("", s) - else if sub(s, n) = #"." then - ( normalizedUnitName (extract(s, 0, SOME n)), - extract(s, n + 1, SOME(len' - n)) ) - else - parse (n+1) - in parse 0 end -*) - (* cvr: NOTE normalizeUnitName done elsewhere now *) fun splitQualId s = - let open CharVector + let open CharVectorSlice val len' = size s fun parse i n acc = if n >= len' then - (extract(s, i, SOME (len' - i)) :: acc) - else if sub(s, n) = #"." then - parse (n+1) (n+1) ((extract(s, i, SOME (n - i)))::acc) + vector(slice(s, i, SOME (len' - i))) :: acc + else if CharVector.sub(s, n) = #"." then + parse (n+1) (n+1) (vector(slice(s, i, SOME (n - i)))::acc) else parse i (n+1) acc in parse 0 0 [] end @@ -474,8 +458,8 @@ notTerminated "antiquotation" lexbuf } | _ - { lexingMode := QUOTElm; - lexError "ill-formed antiquotation" lexbuf + { + skipString "ill-formed antiquotation" SkipQuotation lexbuf } ; diff -Nru mosml-2.01/src/compiler/Link.sml mosml-2.10.1/src/compiler/Link.sml --- mosml-2.01/src/compiler/Link.sml 2000-06-27 14:46:19.000000000 +0000 +++ mosml-2.10.1/src/compiler/Link.sml 2014-08-28 08:47:22.000000000 +0000 @@ -67,10 +67,21 @@ msgEOL(); msgEBlock(); processed)) - | NONE => let val implicit = case stampOpt of NONE => false | _ => true - val _ = if not(!autolink) andalso implicit - then raise NotYet else () - val (truename, tables) = read_file name + | NONE => let val (truename, tables) = + case stampOpt of + NONE => read_file name + | SOME stamp => + if !autolink then + let val res as (_, tables) = + read_file name + in + if stamp = #cu_sig_stamp tables then + res + else + raise WrongStamp + end + else + raise NotYet val precedingUnits = Hasht.fold needs processed (#cu_mentions tables) in diff -Nru mosml-2.01/src/compiler/Load_phr.sml mosml-2.10.1/src/compiler/Load_phr.sml --- mosml-2.01/src/compiler/Load_phr.sml 2000-06-27 14:46:19.000000000 +0000 +++ mosml-2.10.1/src/compiler/Load_phr.sml 2014-08-28 08:47:22.000000000 +0000 @@ -23,7 +23,7 @@ | _ => ()); msgIBlock 0; - errPrompt "Uncaught exception: "; msgEOL(); errPrompt ""; + errPrompt "Uncaught exception:"; msgEOL(); errPrompt ""; printVal (trivial_scheme type_exn) (repr x); msgEOL(); msgEBlock(); diff -Nru mosml-2.01/src/compiler/Mainc.sml mosml-2.10.1/src/compiler/Mainc.sml --- mosml-2.01/src/compiler/Mainc.sml 2000-06-27 14:46:19.000000000 +0000 +++ mosml-2.10.1/src/compiler/Mainc.sml 2014-08-28 08:47:22.000000000 +0000 @@ -158,7 +158,7 @@ load_path := !load_path @ [!path_library] else (); initPervasiveEnvironments(); - resetTypePrinter(); (* cvr *) + resetTypes(); Miscsys.catch_interrupt true; if null (!initialFiles) then show_version() else (); app compileFile (!initialFiles); diff -Nru mosml-2.01/src/compiler/Maint.sml mosml-2.10.1/src/compiler/Maint.sml --- mosml-2.01/src/compiler/Maint.sml 2000-06-26 07:20:20.000000000 +0000 +++ mosml-2.10.1/src/compiler/Maint.sml 2014-08-28 08:47:22.000000000 +0000 @@ -145,7 +145,7 @@ app evalLoad (!preloadedUnits); initInitialEnvironments []; execToplevelOpen nilLocation "Meta"; - resetTypePrinter(); (* cvr *) + resetTypes(); Miscsys.catch_interrupt true; input_lexbuf := Compiler.createLexerStream std_in; (initial_loop() handle EndOfFile => ()); diff -Nru mosml-2.01/src/compiler/Makefile mosml-2.10.1/src/compiler/Makefile --- mosml-2.01/src/compiler/Makefile 2000-06-27 14:46:19.000000000 +0000 +++ mosml-2.10.1/src/compiler/Makefile 2014-08-28 08:47:22.000000000 +0000 @@ -117,9 +117,17 @@ rm -f Makefile.bak install: - ${INSTALL_DATA} mosmlcmp $(LIBDIR) - ${INSTALL_DATA} mosmllnk $(LIBDIR) - ${INSTALL_DATA} mosmltop $(LIBDIR) + ${INSTALL_DATA} mosmlcmp $(DESTDIR)$(LIBDIR) + ${INSTALL_DATA} mosmllnk $(DESTDIR)$(LIBDIR) + ${INSTALL_DATA} mosmltop $(DESTDIR)$(LIBDIR) + + +install_w32: + ${INSTALL_DATA} mosmlcmp.w32 $(DESTDIR)$(LIBDIR)/mosmlcmp + ${INSTALL_DATA} mosmllnk.w32 $(DESTDIR)$(LIBDIR)/mosmllnk + ${INSTALL_DATA} mosmltop.w32 $(DESTDIR)$(LIBDIR)/mosmltop + + promote: test -f ../mosmlcmp.orig || cp ../mosmlcmp ../mosmlcmp.orig diff -Nru mosml-2.01/src/compiler/Parser.grm mosml-2.10.1/src/compiler/Parser.grm --- mosml-2.01/src/compiler/Parser.grm 2000-06-27 14:46:19.000000000 +0000 +++ mosml-2.10.1/src/compiler/Parser.grm 2014-08-28 08:47:22.000000000 +0000 @@ -125,14 +125,16 @@ /* cvr: in Mosml144, COLON was nonassociative but this conflicts with the modexp COLON SigExp production */ -/* %nonassoc COLON */ + +/* %left COLON COLONGT */ + +/* %left WHERE */ %right ARROW + %nonassoc ID EQUALS %right STAR - - %start ToplevelPhrase %type ToplevelPhrase @@ -761,7 +763,7 @@ TyConPath : - LongTypeIdent WhereModBind_opt {(case $2 of + LongTypeIdent WhereModBind_opt {(case $2 of NONE => mkLoc(LONGtyconpath $1) | SOME (modid,modexp) => mkLoc(WHEREtyconpath($1,modid,modexp))) } diff -Nru mosml-2.01/src/compiler/Patch.sml mosml-2.10.1/src/compiler/Patch.sml --- mosml-2.01/src/compiler/Patch.sml 2000-02-04 10:10:49.000000000 +0000 +++ mosml-2.10.1/src/compiler/Patch.sml 2014-08-28 08:47:22.000000000 +0000 @@ -16,6 +16,16 @@ set_nth_char_ buff (pos+1) (Char.chr (rshiftuns_ v 8)) ); + fun patch_long buff pos v = + ( + (* `set_nth_char` must not check the length of buff, *) + (* because buff may be allocated outside the heap! *) + set_nth_char_ buff pos (Char.chr (andb_ 255 v)); + set_nth_char_ buff (pos+1) (Char.chr (andb_ 255 (rshiftuns_ v 8))); + set_nth_char_ buff (pos+2) (Char.chr (andb_ 255 (rshiftuns_ v 16))); + set_nth_char_ buff (pos+3) (Char.chr (andb_ 255 (rshiftuns_ v 24))) + ); + in (* To relocate a block of object bytecode *) @@ -23,14 +33,14 @@ fun patch_object buff offset (stringlist, otherlist) = let fun relliteral (lit, poss) = let val slot = get_slot_for_literal lit - fun patchlit pos = patch_short buff (pos + offset) slot + fun patchlit pos = patch_long buff (pos + offset) slot in List.app patchlit poss end fun relother (Reloc_literal sc, pos) = - patch_short buff (pos + offset) (get_slot_for_literal sc) + patch_long buff (pos + offset) (get_slot_for_literal sc) | relother (Reloc_getglobal uid, pos) = - patch_short buff (pos + offset) (get_slot_for_variable uid) + patch_long buff (pos + offset) (get_slot_for_variable uid) | relother (Reloc_setglobal uid, pos) = - patch_short buff (pos + offset) (get_slot_for_defined_variable uid) + patch_long buff (pos + offset) (get_slot_for_defined_variable uid) | relother (Reloc_primitive name, pos) = patch_short buff (pos + offset) (get_num_of_prim name) in diff -Nru mosml-2.01/src/compiler/Readword.sml mosml-2.10.1/src/compiler/Readword.sml --- mosml-2.01/src/compiler/Readword.sml 2000-01-21 10:07:12.000000000 +0000 +++ mosml-2.10.1/src/compiler/Readword.sml 2014-08-28 08:47:22.000000000 +0000 @@ -24,7 +24,8 @@ | #"\t" => readword() | c => (CharArray.update(buff, 0, c); - CharArray.extract(buff, 0, SOME (readchars 1))) + CharArraySlice.vector(CharArraySlice.slice(buff, 0, + SOME (readchars 1)))) fun readwords l = (readwords(readword() :: l)) handle Size => List.rev l diff -Nru mosml-2.01/src/compiler/Reloc.sml mosml-2.10.1/src/compiler/Reloc.sml --- mosml-2.01/src/compiler/Reloc.sml 2000-02-04 10:10:49.000000000 +0000 +++ mosml-2.10.1/src/compiler/Reloc.sml 2014-08-28 08:47:22.000000000 +0000 @@ -23,15 +23,15 @@ (case Hasht.peek literals sc of SOME addrs => addrs := !out_position :: !addrs | NONE => Hasht.insert literals sc (ref [!out_position])); - out_short 0 + out_long 0 end fun slot_for_get_global uid = - (enter (Reloc_getglobal uid); out_short 0) + (enter (Reloc_getglobal uid); out_long 0) ; fun slot_for_set_global uid = - (enter (Reloc_setglobal uid); out_short 0) + (enter (Reloc_setglobal uid); out_long 0) ; fun slot_for_c_prim name = diff -Nru mosml-2.01/src/compiler/Sigmtch.sml mosml-2.10.1/src/compiler/Sigmtch.sml --- mosml-2.01/src/compiler/Sigmtch.sml 2000-06-27 14:46:19.000000000 +0000 +++ mosml-2.10.1/src/compiler/Sigmtch.sml 2014-08-28 08:47:22.000000000 +0000 @@ -125,6 +125,7 @@ else valRenList | EXNname ei' => errorImplMismatch id | REFname => errorImplMismatch id) +(*cvr: TODO remove | EXNname ei => (case infInfo of VARname ovltype' => errorImplMismatch id @@ -135,6 +136,22 @@ then errorExConImplMismatch id else valRenList | REFname => errorImplMismatch id) +*) +(*cvr: TODO review + since even top-level exceptions are dynamic, + we have to re-export the stamp carrying values 02/07/2001 *) + | EXNname ei => + (case infInfo of + VARname ovltype' => errorImplMismatch id + | PRIMname pi' => errorImplMismatch id + | CONname ci' => errorImplMismatch id + | EXNname ei' => + if #exconArity(!ei) <> #exconArity(!ei') + then errorExConImplMismatch id + else if specQual <> infQual then + exportValAsVal os valRenList id infStatus specStatus + else valRenList + | REFname => errorImplMismatch id) | REFname => (case infInfo of VARname ovltype' => errorImplMismatch id diff -Nru mosml-2.01/src/compiler/Smlperv.sml mosml-2.10.1/src/compiler/Smlperv.sml --- mosml-2.01/src/compiler/Smlperv.sml 2000-05-11 20:02:39.000000000 +0000 +++ mosml-2.10.1/src/compiler/Smlperv.sml 2014-08-28 08:47:22.000000000 +0000 @@ -266,7 +266,9 @@ ("Ord", ("exn_ord", 0, sc_exn)), ("Overflow", ("exn_overflow", 0, sc_exn)), ("Bind", ("exn_bind", 0, sc_exn)), - ("Match", ("exn_match", 0, sc_exn)) + ("Match", ("exn_match", 0, sc_exn)), + ("Option", ("exn_option", 0, sc_exn)), + ("Span", ("exn_span", 0, sc_exn)) ]; val () = diff -Nru mosml-2.01/src/compiler/Smltop.sml mosml-2.10.1/src/compiler/Smltop.sml --- mosml-2.01/src/compiler/Smltop.sml 2000-04-25 14:56:46.000000000 +0000 +++ mosml-2.10.1/src/compiler/Smltop.sml 2014-08-28 08:47:22.000000000 +0000 @@ -37,13 +37,17 @@ val () = let val stop = input_binary_int is + (* Debugging HOL too large object problem: *) + (* val _ = (print "Stop = "; print (Int.toString stop); print "\n") *) val start = pos_in is val code_len = stop - start + (* val _ = (print (Int.toString code_len); print "\n") *) val () = (block_len := code_len + 1) (* Now we have to check, whether the unit body is compatible *) (* with its compiled signature and previously loaded units. *) val () = seek_in is stop val tables = (input_value is : compiled_unit_tables) + (* val _ = (print "Got here 2\n") *) val () = Hasht.apply (fn uname' => fn stamp' => let val stamp'' = Hasht.find (!watchDog) uname' in @@ -215,7 +219,7 @@ (* Compile a file *) fun tryEvalCompile mode context s = - protect_current_input (fn () => protectCurrentUnit (fn () => + protect_current_input (fn () => protectCurrentTypes (fn () => protectCurrentUnit (fn () => if Filename.check_suffix s ".sig" then let val filename = Filename.chop_suffix s ".sig" in compileSignature context @@ -231,7 +235,7 @@ filename end else - raise Fail "compile: unknown file name extension")) + raise Fail "compile: unknown file name extension"))) ; fun evalCompile mode context s = @@ -344,3 +348,4 @@ ("installPP", repr evalInstallPP) ]; + diff -Nru mosml-2.01/src/compiler/test/eq.sml mosml-2.10.1/src/compiler/test/eq.sml --- mosml-2.01/src/compiler/test/eq.sml 2000-01-21 10:07:12.000000000 +0000 +++ mosml-2.10.1/src/compiler/test/eq.sml 2014-08-28 08:47:22.000000000 +0000 @@ -49,6 +49,36 @@ op F:functor X:sig eqtype t end -> sig eqtype u end; +(* test equality attribute matching of type abbreviations with free variables *) + +fun f x = let structure X as sig type t = 'a end = x in x end; +val g = f : [sig type t = int -> int end] -> [sig type t = int -> int end]; +val p = [structure struct type t = int -> int end as sig type t = int -> int end]; +val ok = f p; +val ok = g p; + +(* test equality attribute matching of type abbreviations with free equality type variables *) +fun f x = let structure X as sig type t = ''a end = x in x end; +val g = f : [sig type t = int * int end] -> [sig type t = int * int end]; +val p = [structure struct type t = int * int end as sig type t = int * int end]; +val q = [structure struct type t = ''b * ''b end as sig type t = ''b * ''b end]; +val r = [structure struct type t = ''b * 'c end as sig type t = ''b * 'c end]; +val t = [structure struct type t = int -> int end as sig type t = int -> int end]; +val ok = f p; +val ok = g p; +val ok = f q; +val ok = f r; +val fail = f t; + +(* ok to realise equality type constructor by equality type *) +fun ok x = let structure X as sig eqtype t end where type t = ''a = x in x end; +fun ok x = let structure X as sig eqtype t end where type t = ''a * ''b = x in x end; +fun ok x = let structure X as sig eqtype 'b t end where type 'b t = ''a * 'b = x in x end; + +(* wrong to realise equality type constructor by nonequality type *) +fun fail x = let structure X as sig eqtype t end where type t = 'a = x in x end; +fun fail x = let structure X as sig eqtype t end where type t = ''a -> ''b = x in x end; +fun fail x = let structure X as sig eqtype 'b t end where type 'b t = 'a -> 'b = x in x end; diff -Nru mosml-2.01/src/compiler/test/fcmodulebug.sml mosml-2.10.1/src/compiler/test/fcmodulebug.sml --- mosml-2.01/src/compiler/test/fcmodulebug.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler/test/fcmodulebug.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,6 @@ +(* this is a bug because a functor can't eliminate a package type in its body *) +(* WrongGen is rejected, but WrongApp is not! *) +functor WrongApp X:sig end = struct structure X as sig type t end = [structure struct type t = int end as sig type t end] end; + +functor WrongGen (A : sig end) = struct structure X as sig type t end = [structure struct type t = int end as sig type t end] end; + diff -Nru mosml-2.01/src/compiler/test/loophole.sml mosml-2.10.1/src/compiler/test/loophole.sml --- mosml-2.01/src/compiler/test/loophole.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler/test/loophole.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,29 @@ +signature S = + sig type t val x : t val f : t -> unit end; + +signature UNIT = sig end +structure Unit = struct end + +functor F1 (X:UNIT) :> S = + struct + type t = int + val x = 12 + fun f x = () + end + +functor F2 (X:UNIT) :> S = + struct + type t = unit -> unit + fun x () = () + fun f g = g () + end + +signature ARG = functor (X:UNIT) -> S + +functor Apply F:ARG = F(Unit) + +structure Res1 = Apply(F1) +structure Res2 = Apply(F2) + +val breakit = Res2.f(Res1.x) (* core dump ensues *) + diff -Nru mosml-2.01/src/compiler/test/lvlbug.sml mosml-2.10.1/src/compiler/test/lvlbug.sml --- mosml-2.01/src/compiler/test/lvlbug.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler/test/lvlbug.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,3 @@ +datatype t = C +val f = (fn x => x) (fn x =>x) +val z = f C diff -Nru mosml-2.01/src/compiler/test/Makefile mosml-2.10.1/src/compiler/test/Makefile --- mosml-2.01/src/compiler/test/Makefile 2000-06-28 22:53:38.000000000 +0000 +++ mosml-2.10.1/src/compiler/test/Makefile 2014-08-28 08:47:22.000000000 +0000 @@ -3,6 +3,7 @@ # This works with bash MOSML=mosml -liberal +MOSMLC=mosmlc -liberal # with the supplied compiler all: @@ -34,12 +35,19 @@ $(MOSML) -P full < wheretyp.sml >> result 2>&1 #this one last as its slow $(MOSML) -P full test.sml >> result 2>&1 + #these are new and need to be validated + $(MOSML) -P full < loophole.sml >> result 2>&1 + $(MOSML) -P full < fcmodulebug.sml >> result 2>&1 + $(MOSML) -P full < matchbug.sml >> result 2>&1 + $(MOSMLC) -P full lvlbug.sml >> result 2>&1 + + diff result result.ok # with the current compiler current: rm -f result - make all MOSML=../../camlrunm\ ../mosmltop\ -stdlib\ ../../mosmllib + make all MOSML=../../camlrunm\ ../mosmltop\ -stdlib\ ../../mosmllib MOSMLC=../../camlrunm\ ../mosmlcmp\ -stdlib\ ../../mosmllib clean: rm -f result diff -Nru mosml-2.01/src/compiler/test/matchbug.sml mosml-2.10.1/src/compiler/test/matchbug.sml --- mosml-2.01/src/compiler/test/matchbug.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler/test/matchbug.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,4 @@ +signature S = sig val x : ('a -> 'a) ref end; +structure S :> S = struct fun id x = x; val x = ref id end; +val _ = S.x := (fn _ => 0); + diff -Nru mosml-2.01/src/compiler/test/recmod.sml mosml-2.10.1/src/compiler/test/recmod.sml --- mosml-2.01/src/compiler/test/recmod.sml 2000-04-10 20:23:57.000000000 +0000 +++ mosml-2.10.1/src/compiler/test/recmod.sml 2014-08-28 08:47:22.000000000 +0000 @@ -212,6 +212,54 @@ structure C = B :> S; +(* misc unsystematic tests *) + +(* nullary opaque constructor *) +signature S = sig type t end; + +signature Ok = rec (X : S) sig datatype t = C of X.t end; + +signature Ok = rec (X : S) sig type t = int end; + +signature Ok = rec (X : S) sig type t = int -> int end; + +signature Wrong = rec (X : S) sig type t = X.t end; + +signature Wrong = rec (X : S) sig type t = unit -> X.t end; + +(* nullary transparent constructor *) + +signature S = sig type t = int end; + +signature Ok = rec (X : S) sig type t = int end; + +signature Wrong = rec (X : S) sig datatype t = C of X.t end; + +signature Ok = rec (X : S) sig type t = X.t end; + +signature Wrong = rec (X : S) sig type t = unit -> X.t end; + +(* unary opaque constructor *) + +signature S = sig type 'a t end; + +signature Ok = rec (X : S) sig type 'a t = 'a list end; + +signature Ok = rec (X : S) S where type 'a t = 'a list; + +(* unary transparent constructor *) + +signature S = sig type 'a t = 'a list end; + +signature Ok = rec (X : S) sig type 'a t = 'a list end; + +signature Wrong = rec (X : S) sig type 'a t = 'a end; + +signature Wrong = rec (X : S) S where type 'a t = 'a list; + + + + diff -Nru mosml-2.01/src/compiler/test/result.ok mosml-2.10.1/src/compiler/test/result.ok --- mosml-2.01/src/compiler/test/result.ok 2000-06-22 22:16:45.000000000 +0000 +++ mosml-2.10.1/src/compiler/test/result.ok 2014-08-28 08:47:22.000000000 +0000 @@ -1,4 +1,4 @@ -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - linking values OK: a @@ -272,7 +272,7 @@ functor OK: X.x functor OK: B.y- - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > structure A : {structure a : {val v : string}, @@ -716,7 +716,7 @@ functor OK: X.x functor OK: B.y- - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > val it = () : unit - > val it = () : unit @@ -996,7 +996,7 @@ functor OK: B.y > val it = () : unit - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > signature Array = /\array. @@ -1058,7 +1058,7 @@ int list val test2 = "OK" : string - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > signature Array = /\array. @@ -1120,7 +1120,7 @@ int list val test2 = "OK" : string - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > val divides = fn : int -> int -> bool - > val succ = fn : int -> int @@ -1184,7 +1184,7 @@ 503, 509, 521, 523, 541] : int list - > val test = "OK" : string - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > signature POLY = /\nat. @@ -1323,7 +1323,7 @@ val z : nat}, val eval : nat -> nat list -> nat} - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > functor F : {val a : unit}->{val b : unit}->{val c : unit}->{} - > structure A : {val a : unit} @@ -1414,7 +1414,7 @@ con 'a C : 'a -> 'a (u/1 t w x), con 'b D : 'b -> 'b (v/1 t w x)} - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > functor ok : !u.(!t.{type t = t}->{type u = (u t)})->!t.{type t = t}->?u/1.{type u = u/1} @@ -1634,7 +1634,7 @@ val x = D(B{l = (1, false), r = (1, false)}) : (int * bool) (x int bool (/\'a.{l : 'a, r : 'a})) - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > structure A : {structure B : {val b : bool, val c : string}, @@ -1663,7 +1663,7 @@ ! ^^^^^^^^^^^^^^^^^ ! Illegal projection: this projection causes an existential type constructor to escape its scope - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > signature Collection = /\e t.{type e = e, type t = t, val empty : t, val add : e -> t -> t} @@ -1716,7 +1716,7 @@ ! cannot have type ! (t/2 bool) - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > structure X : {type 'a r = 'a ref} - > type 'a r = 'a ref @@ -1724,7 +1724,7 @@ - > structure Z : {type 'a r = 'a ref} type 'a r = 'a ref - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > New type names: =u structure A : @@ -1820,8 +1820,76 @@ ! type u = (u/4 t) ! but its declaration does not admit equality in the module ! type u = (u/5 t) +- > val 'a f = fn : [{type t = 'a}] -> [{type t = 'a}] +- > val g = fn : [{type t = int -> int}] -> [{type t = int -> int}] +- > val p = [structure ...] : [{type t = int -> int}] +- > val ok = [structure ...] : [{type t = int -> int}] +- > val ok = [structure ...] : [{type t = int -> int}] +- > val ''a f = fn : [{type t = ''a}] -> [{type t = ''a}] +- > val g = fn : [{type t = int * int}] -> [{type t = int * int}] +- > val p = [structure ...] : [{type t = int * int}] +- ! Warning: Value polymorphism: +! Free type variable(s) at top level in value identifier q +> val q = [structure ...] : [{type t = ''a * ''a}] +- ! Warning: Value polymorphism: +! Free type variable(s) at top level in value identifier r +> val r = [structure ...] : [{type t = ''b * 'c}] +- > val t = [structure ...] : [{type t = int -> int}] +- > val ok = [structure ...] : [{type t = int * int}] +- > val ok = [structure ...] : [{type t = int * int}] +- > val ok = [structure ...] : [{type t = ''a * ''a}] +- ! Warning: the free type variable 'c has been instantiated to ''c +> val ok = [structure ...] : [{type t = ''b * ''c}] +- ! Toplevel input: +! val fail = f t; +! ^ +! Type clash: expression of type +! [{type t = int -> int}] +! cannot have type +! [{type t = ''d}] +! because the first module type does not match the second module type ... +! Type mismatch: type constructor t +! is specified as one abbreviation in the second module type +! type t = ''d +! but declared as a different abbreviation in the first module type +! type t = int -> int +! The abbreviations should be equivalent (or unifiable) +- > val ''a' ok = fn : [{type t = ''a'}] -> [{type t = ''a'}] +- > val (''a', ''b') ok = fn : + [{type t = ''a' * ''b'}] -> [{type t = ''a' * ''b'}] +- > val ''a' ok = fn : [{type 'b' t = ''a' * 'b'}] -> [{type 'b' t = ''a' * 'b'}] +- ! Toplevel input: +! fun fail x = let structure X as sig eqtype t end where type t = 'a = x in x end; +! ^^^^^^^^^^^ +! Illegal where constraint: the type constructor t +! cannot be constrained in this way because ... +! Equality type mismatch: type constructor t +! is specified as admitting equality in the signature +! type t = t +! but its declaration does not admit equality in the constraint +! type t = 'a' +- ! Toplevel input: +! fun fail x = let structure X as sig eqtype t end where type t = ''a -> ''b = x in x end; +! ^^^^^^^^^^^^^^^^^^^ +! Illegal where constraint: the type constructor t +! cannot be constrained in this way because ... +! Equality type mismatch: type constructor t +! is specified as admitting equality in the signature +! type t = t +! but its declaration does not admit equality in the constraint +! type t = ''a' -> ''b' +- ! Toplevel input: +! fun fail x = let structure X as sig eqtype 'b t end where type 'b t = 'a -> 'b = x in x end; +! ^^^^^^^^^^^^^^^^^^^^ +! Illegal where constraint: the type constructor t +! cannot be constrained in this way because ... +! Equality type mismatch: type constructor t +! is specified as admitting equality in the signature +! type 'd t = 'd t +! but its declaration does not admit equality in the constraint +! type 'b' t = 'a' -> 'b' - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > val 'a ok = fn : 'a -> 'a - > val ('a, 'b) ok = fn : ('a -> 'b) -> 'a -> 'b @@ -1904,13 +1972,261 @@ ! The declaration violates the specification because ! the type constructor u/1 is a parameter ! that is declared within the scope of u. +- ! Warning: Value polymorphism: +! Free type variable(s) at top level in value identifier y1 +! Warning: Value polymorphism: +! Free type variable(s) at top level in value identifier y2 +> val y1 = ref [] : 'a list ref + val y2 = ref [] : 'b list ref +- ! Toplevel input: +! val fail : 'a list ref = y1; +! ^^ +! Type clash: expression of type +! 'a list ref +! cannot have type +! 'a' list ref +! because of a scope violation: +! the type variable 'a' is a parameter +! that is declared within the scope of 'a +- ! Toplevel input: +! val fail : 'a list ref = y2; +! ^^ +! Type clash: expression of type +! 'b list ref +! cannot have type +! 'a' list ref +! because of a scope violation: +! the type variable 'a' is a parameter +! that is declared within the scope of 'b +- ! Toplevel input: +! structure R : sig val r: 'a list ref end = S; +! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +! Signature mismatch: the module does not match the signature ... +! Scheme mismatch: value identifier r +! is specified with type scheme +! val 'a' r : 'a' list ref +! in the signature +! but its declaration has the unrelated type scheme +! val r : 'c list ref +! in the module +! The declared type scheme should be at least as general as the specified type scheme +- ! Toplevel input: +! structure Fail : sig val r: 'a list ref end = S; +! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +! Signature mismatch: the module does not match the signature ... +! Scheme mismatch: value identifier r +! is specified with type scheme +! val 'a' r : 'a' list ref +! in the signature +! but its declaration has the unrelated type scheme +! val r : 'c list ref +! in the module +! The declared type scheme should be at least as general as the specified type scheme +- ! Warning: Value polymorphism: +! Free type variable(s) at top level in structure identifier U +> structure U : {val r : 'c list ref, val x : int} +- ! Toplevel input: +! structure Fail : sig val r: 'a list ref end = U; +! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +! Signature mismatch: the module does not match the signature ... +! Scheme mismatch: value identifier r +! is specified with type scheme +! val 'a' r : 'a' list ref +! in the signature +! but its declaration has the unrelated type scheme +! val r : 'c list ref +! in the module +! The declared type scheme should be at least as general as the specified type scheme +- ! Warning: Value polymorphism: +! Free type variable(s) at top level in structure identifier W +> structure W : {val r : 'd list ref} +- ! Toplevel input: +! structure Fail : sig val r: 'a list ref end = W; +! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +! Signature mismatch: the module does not match the signature ... +! Scheme mismatch: value identifier r +! is specified with type scheme +! val 'a' r : 'a' list ref +! in the signature +! but its declaration has the unrelated type scheme +! val r : 'd list ref +! in the module +! The declared type scheme should be at least as general as the specified type scheme +- ! Toplevel input: +! structure Fail : sig val 'a r: 'a list ref end = S; +! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +! Signature mismatch: the module does not match the signature ... +! Scheme mismatch: value identifier r +! is specified with type scheme +! val 'a' r : 'a' list ref +! in the signature +! but its declaration has the unrelated type scheme +! val r : 'e list ref +! in the module +! The declared type scheme should be at least as general as the specified type scheme +- ! Toplevel input: +! val fail = x:=[C]; +! ^ +! Type clash: expression of type +! t/5 +! cannot have type +! 'e +! because of a scope violation: +! the type constructor t/5 is a parameter +! that is declared within the scope of 'e +- ! Warning: Value polymorphism: +! Free type variable(s) at top level in value identifier x +> val x = ref [] : 'e list ref +- > New type names: =t/5 + datatype t = (t/5,{con C : t/5}) + con C = C : t/5 +- ! Toplevel input: +! val fail = x:=[C]; +! ^ +! Type clash: expression of type +! t/5 +! cannot have type +! 'f +! because of a scope violation: +! the type constructor t/5 is a parameter +! that is declared within the scope of 'f +- ! Toplevel input: +! val fail = x:=[C]; +! ^ +! Type clash: expression of type +! t/6 +! cannot have type +! 'f +! because of a scope violation: +! the type constructor t/6 is a parameter +! that is declared within the scope of 'f +- > New type names: =t/6 + structure Ok : + {datatype t = (t/6,{con C : t/6}), + con C : t/6, + val ok : unit, + val x : t/6 list ref} +- ! Warning: Value polymorphism: +! Free type variable(s) at top level in structure identifier N +> New type names: =t/7 + structure N : + {datatype t = (t/7,{con C : t/7}), con C : t/7, val x : 'f list ref} +- ! Toplevel input: +! val fail = N.x := [N.C]; +! ^^^ +! Type clash: expression of type +! t/7 +! cannot have type +! 'g +! because of a scope violation: +! the type constructor t/7 is a parameter +! that is declared within the scope of 'g +- ! Toplevel input: +! val fail = X.x:=[C]; +! ^ +! Type clash: expression of type +! t/8 +! cannot have type +! 'g +! because of a scope violation: +! the type constructor t/8 is a parameter +! that is declared within the scope of 'g +- ! Toplevel input: +! val fail = X.x:=[C]; +! ^ +! Type clash: expression of type +! t/8 +! cannot have type +! 'g +! because of a scope violation: +! the type constructor t/8 is a parameter +! that is declared within the scope of 'g +- ! Warning: Value polymorphism: +! Free type variable(s) at top level in value identifier y +! Warning: Value polymorphism: +! Free type variable(s) at top level in value identifier z +> val y = ref [] : 'g list ref + val z = ref [] : 'h list ref +- ! Toplevel input: +! val fail : 'a list ref = x; +! ^ +! Type clash: expression of type +! 'e list ref +! cannot have type +! 'a' list ref +! because of a scope violation: +! the type variable 'a' is a parameter +! that is declared within the scope of 'e +- ! Toplevel input: +! val fail : 'a list ref = z; +! ^ +! Type clash: expression of type +! 'h list ref +! cannot have type +! 'a' list ref +! because of a scope violation: +! the type variable 'a' is a parameter +! that is declared within the scope of 'h +- ! Toplevel input: +! val fail : 'a list ref = X.x; +! ^^^ +! Cannot access unit X before it has been loaded. +- ! Warning: Value polymorphism: +! Free type variable(s) at top level in value identifier ok +> val ok = ref [] : 'i list ref +- ! Warning: Value polymorphism: +! Free type variable(s) at top level in value identifier ok +> val ok = ref [] : 'j list ref +- ! Toplevel input: +! val ('b) fail : 'b list ref = x +! ^ +! Type clash: expression of type +! 'k list ref +! cannot have type +! 'b' list ref +! because of a scope violation: +! the type variable 'b' is a parameter +! that is declared within the scope of 'k +- ! Toplevel input: +! val ('b) fail : 'b list ref = x +! ^ +! Type clash: expression of type +! 'k list ref +! cannot have type +! 'b' list ref +! because of a scope violation: +! the type variable 'b' is a parameter +! that is declared within the scope of 'k +- ! Toplevel input: +! val ('b) fail : 'b list ref = (fn y => y) x +! ^ +! Type clash: expression of type +! 'k list ref +! cannot have type +! 'b' list ref +! because of a scope violation: +! the type variable 'b' is a parameter +! that is declared within the scope of 'k +- > val ok = ref [] : int list ref +- > val 'b' ok = fn : 'b' -> 'b' list ref +- ! Toplevel input: +! val fail = fn _ :'b => x : 'b list ref +! ^ +! Type clash: expression of type +! 'k list ref +! cannot have type +! 'b' list ref +! because of a scope violation: +! the type variable 'b' is a parameter +! that is declared within the scope of 'k +- > val 'b' ok = fn : 'b' -> 'b' list ref - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > New type names: =v, =u, =t val matchsuc = "OK" : string - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - ! Toplevel input: ! structure X = struct open General end: sig val + : (int * int) -> int end; @@ -2777,74 +3093,82 @@ ! L:G; ! ^^^ ! Signature mismatch: the module does not match the signature ... -! Equality type mismatch: type constructor myref -! is specified as a `prim_EQtype' in the signature +! Type mismatch: type constructor myref +! is specified as one abbreviation in the signature ! type 'a myref = 'a ref -! but is not declared as a `prim_EQtype' in the module +! but declared as a different abbreviation in the module ! type 'a myref = 'a +! The abbreviations should be equivalent (or unifiable) - ! Toplevel input: ! LL:functor(L:L)->G; ! ^^^^^^^^^^^^^^^^^^ ! Signature mismatch: the module does not match the signature ... -! Equality type mismatch: type constructor myref of the range -! is specified as a `prim_EQtype' in the signature +! Type mismatch: type constructor myref of the range +! is specified as one abbreviation in the signature ! type 'a myref = 'a ref -! but is not declared as a `prim_EQtype' in the module +! but declared as a different abbreviation in the module ! type 'a myref = 'a +! The abbreviations should be equivalent (or unifiable) - ! Toplevel input: ! GL:functor(L:L)->L; ! ^^^^^^^^^^^^^^^^^^ ! Signature mismatch: the module does not match the signature ... -! Equality type mismatch: type constructor myref of the domain -! is specified as a `prim_EQtype' in the module +! Type mismatch: type constructor myref of the domain +! is specified as one abbreviation in the module ! type 'a myref = 'a ref -! but is not declared as a `prim_EQtype' in the signature +! but declared as a different abbreviation in the signature ! type 'a myref = 'a +! The abbreviations should be equivalent (or unifiable) - ! Toplevel input: ! YL:sig structure Y: G end; ! ^^^^^^^^^^^^^^^^^^^^^^^^^ ! Signature mismatch: the module does not match the signature ... -! Equality type mismatch: type constructor Y.myref -! is specified as a `prim_EQtype' in the signature +! Type mismatch: type constructor Y.myref +! is specified as one abbreviation in the signature ! type 'a myref = 'a ref -! but is not declared as a `prim_EQtype' in the module +! but declared as a different abbreviation in the module ! type 'a myref = 'a +! The abbreviations should be equivalent (or unifiable) - ! Toplevel input: ! L_YL:functor(L:L)->sig structure Y: G end; ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ! Signature mismatch: the module does not match the signature ... -! Equality type mismatch: type constructor Y.myref of the range -! is specified as a `prim_EQtype' in the signature +! Type mismatch: type constructor Y.myref of the range +! is specified as one abbreviation in the signature ! type 'a myref = 'a ref -! but is not declared as a `prim_EQtype' in the module +! but declared as a different abbreviation in the module ! type 'a myref = 'a +! The abbreviations should be equivalent (or unifiable) - ! Toplevel input: ! YG_L:functor(YL:sig structure Y: L end)->L; ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ! Signature mismatch: the module does not match the signature ... -! Equality type mismatch: type constructor Y.myref of the domain -! is specified as a `prim_EQtype' in the module +! Type mismatch: type constructor Y.myref of the domain +! is specified as one abbreviation in the module ! type 'a myref = 'a ref -! but is not declared as a `prim_EQtype' in the signature +! but declared as a different abbreviation in the signature ! type 'a myref = 'a +! The abbreviations should be equivalent (or unifiable) - ! Toplevel input: ! L_YG_L:functor(L:L)->functor(YL:sig structure Y:L end)->L; ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ! Signature mismatch: the module does not match the signature ... -! Equality type mismatch: type constructor Y.myref of the domain of the range -! is specified as a `prim_EQtype' in the module +! Type mismatch: type constructor Y.myref of the domain of the range +! is specified as one abbreviation in the module ! type 'a myref = 'a ref -! but is not declared as a `prim_EQtype' in the signature +! but declared as a different abbreviation in the signature ! type 'a myref = 'a +! The abbreviations should be equivalent (or unifiable) - ! Toplevel input: ! FLYGL:sig functor F: functor(L:L)->functor(YL:sig structure Y:L end)->L end; ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ! Signature mismatch: the module does not match the signature ... -! Equality type mismatch: type constructor Y.myref of the domain of the range of F -! is specified as a `prim_EQtype' in the module +! Type mismatch: type constructor Y.myref of the domain of the range of F +! is specified as one abbreviation in the module ! type 'a myref = 'a ref -! but is not declared as a `prim_EQtype' in the signature +! but declared as a different abbreviation in the signature ! type 'a myref = 'a +! The abbreviations should be equivalent (or unifiable) - > signature G = /\=t.{type t = t} - > signature L = /\t.{type t = t} - ! Toplevel input: @@ -2999,74 +3323,82 @@ ! L:G; ! ^^^ ! Signature mismatch: the module does not match the signature ... -! Equality type mismatch: type constructor t -! is specified as admitting equality in the signature +! Type mismatch: type constructor t +! is specified as one abbreviation in the signature ! type t = unit -! but its declaration does not admit equality in the module +! but declared as a different abbreviation in the module ! type t = unit -> unit +! The abbreviations should be equivalent (or unifiable) - ! Toplevel input: ! LL:functor(L:L)->G; ! ^^^^^^^^^^^^^^^^^^ ! Signature mismatch: the module does not match the signature ... -! Equality type mismatch: type constructor t of the range -! is specified as admitting equality in the signature +! Type mismatch: type constructor t of the range +! is specified as one abbreviation in the signature ! type t = unit -! but its declaration does not admit equality in the module +! but declared as a different abbreviation in the module ! type t = unit -> unit +! The abbreviations should be equivalent (or unifiable) - ! Toplevel input: ! GL:functor(L:L)->L; ! ^^^^^^^^^^^^^^^^^^ ! Signature mismatch: the module does not match the signature ... -! Equality type mismatch: type constructor t of the domain -! is specified as admitting equality in the module +! Type mismatch: type constructor t of the domain +! is specified as one abbreviation in the module ! type t = unit -! but its declaration does not admit equality in the signature +! but declared as a different abbreviation in the signature ! type t = unit -> unit +! The abbreviations should be equivalent (or unifiable) - ! Toplevel input: ! YL:sig structure Y: G end; ! ^^^^^^^^^^^^^^^^^^^^^^^^^ ! Signature mismatch: the module does not match the signature ... -! Equality type mismatch: type constructor Y.t -! is specified as admitting equality in the signature +! Type mismatch: type constructor Y.t +! is specified as one abbreviation in the signature ! type t = unit -! but its declaration does not admit equality in the module +! but declared as a different abbreviation in the module ! type t = unit -> unit +! The abbreviations should be equivalent (or unifiable) - ! Toplevel input: ! L_YL:functor(L:L)->sig structure Y: G end; ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ! Signature mismatch: the module does not match the signature ... -! Equality type mismatch: type constructor Y.t of the range -! is specified as admitting equality in the signature +! Type mismatch: type constructor Y.t of the range +! is specified as one abbreviation in the signature ! type t = unit -! but its declaration does not admit equality in the module +! but declared as a different abbreviation in the module ! type t = unit -> unit +! The abbreviations should be equivalent (or unifiable) - ! Toplevel input: ! YG_L:functor(YL:sig structure Y: L end)->L; ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ! Signature mismatch: the module does not match the signature ... -! Equality type mismatch: type constructor Y.t of the domain -! is specified as admitting equality in the module +! Type mismatch: type constructor Y.t of the domain +! is specified as one abbreviation in the module ! type t = unit -! but its declaration does not admit equality in the signature +! but declared as a different abbreviation in the signature ! type t = unit -> unit +! The abbreviations should be equivalent (or unifiable) - ! Toplevel input: ! L_YG_L:functor(L:L)->functor(YL:sig structure Y:L end)->L; ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ! Signature mismatch: the module does not match the signature ... -! Equality type mismatch: type constructor Y.t of the domain of the range -! is specified as admitting equality in the module +! Type mismatch: type constructor Y.t of the domain of the range +! is specified as one abbreviation in the module ! type t = unit -! but its declaration does not admit equality in the signature +! but declared as a different abbreviation in the signature ! type t = unit -> unit +! The abbreviations should be equivalent (or unifiable) - ! Toplevel input: ! FLYGL:sig functor F: functor(L:L)->functor(YL:sig structure Y:L end)->L end; ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ! Signature mismatch: the module does not match the signature ... -! Equality type mismatch: type constructor Y.t of the domain of the range of F -! is specified as admitting equality in the module +! Type mismatch: type constructor Y.t of the domain of the range of F +! is specified as one abbreviation in the module ! type t = unit -! but its declaration does not admit equality in the signature +! but declared as a different abbreviation in the signature ! type t = unit -> unit +! The abbreviations should be equivalent (or unifiable) - > signature G = /\=t.{datatype t = (t,{con C : t}), con C : t} - > signature L = {type t = unit} - ! Toplevel input: @@ -3258,7 +3590,7 @@ ! the type constructor u/1 is a parameter ! that is declared within the scope of u. - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > signature OK = {type t = int} - > signature OK = {structure X : {type t = int}} @@ -3279,7 +3611,7 @@ {structure X : {type t = t, type u = u}, type u = u/1, type v = v}}, structure W : {type u = u/1, type v = v}} - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > structure X : {exn e : int -> exn} - > structure Y : {val e : int -> exn} @@ -3292,7 +3624,7 @@ - > exn s = s : exn - > val it = (s, s) : exn * exn - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > signature S = {} - > signature F = {}->{} @@ -3372,7 +3704,7 @@ - > functor Ok : ({}->{})->{}->{} - > functor OK : ({}->{})->{}->{} - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > val integer = fn : int -> int - > val ok = fn : int -> int @@ -3401,7 +3733,7 @@ ! the type constructor b is a parameter ! that is declared within the scope of 'a - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - ! Toplevel input: ! ..................rec(Fail: sig type a; type b end) @@ -3751,8 +4083,81 @@ con ('a, 'b) C : ('a, 'b) a/13 -> ('a, 'b) a/13, con ('a, 'b) D : 'a -> ('a, 'b) a/13, con ('a, 'b) E : 'b -> ('a, 'b) a/13} +- > signature S = /\t.{type t = t} +- > signature Ok = + /\t.rec ({type t = t},{datatype t = (t,{con C : t -> t}), con C : t -> t}) +- > signature Ok = rec ({type t = int},{type t = int}) +- > signature Ok = rec ({type t = int -> int},{type t = int -> int}) +- ! Toplevel input: +! signature Wrong = rec (X : S) sig type t = X.t end; +! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +! Illegal recursive signature: the body does not match the forward specification... +! Circularity: type constructor t has specification: +! type t = t +! in the forward specification +! but is implemented by the declaration: +! type t = t +! in the body +! The declaration violates the specification because +! of the circular occurrence of t +- ! Toplevel input: +! signature Wrong = rec (X : S) sig type t = unit -> X.t end; +! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +! Illegal recursive signature: the body does not match the forward specification... +! Circularity: type constructor t has specification: +! type t = t +! in the forward specification +! but is implemented by the declaration: +! type t = unit -> t +! in the body +! The declaration violates the specification because +! of the circular occurrence of t +- > signature S = {type t = int} +- > signature Ok = rec ({type t = int},{type t = int}) +- ! Toplevel input: +! signature Wrong = rec (X : S) sig datatype t = C of X.t end; +! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +! Illegal recursive signature: the body does not match the forward specification... +! Type mismatch: type constructor t +! is specified as one abbreviation in the forward specification +! type t = int +! but declared as a different abbreviation in the body +! datatype t = (t,{con C : int -> t}) +! The abbreviations should be equivalent (or unifiable) +- > signature Ok = rec ({type t = int},{type t = int}) +- ! Toplevel input: +! signature Wrong = rec (X : S) sig type t = unit -> X.t end; +! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +! Illegal recursive signature: the body does not match the forward specification... +! Type mismatch: type constructor t +! is specified as one abbreviation in the forward specification +! type t = int +! but declared as a different abbreviation in the body +! type t = unit -> int +! The abbreviations should be equivalent (or unifiable) +- > signature S = /\t.{type 'a t = 'a t} +- > signature Ok = rec ({type 'a t = 'a list},{type 'a t = 'a list}) +- > signature Ok = rec ({type 'a t = 'a list},{type 'a t = 'a list}) +- > signature S = {type 'a t = 'a list} +- > signature Ok = rec ({type 'a t = 'a list},{type 'a t = 'a list}) +- ! Toplevel input: +! signature Wrong = rec (X : S) sig type 'a t = 'a end; +! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +! Illegal recursive signature: the body does not match the forward specification... +! Type mismatch: type constructor t +! is specified as one abbreviation in the forward specification +! type 'a t = 'a list +! but declared as a different abbreviation in the body +! type 'a t = 'a +! The abbreviations should be equivalent (or unifiable) +- ! Toplevel input: +! signature Wrong = rec (X : S) S where type 'a t = 'a list; +! ^^^^^^^^^^^^^^^^^^^ +! Illegal where constraint: the type constructor t +! refers to a transparent type specification +! but should refer to an opaque type or datatype specification - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > signature ORDERED = /\T.{type T = T, val leq : T * T -> bool} - > signature HEAP = @@ -3859,7 +4264,7 @@ - > val test1 = true : bool - > val test2 = true : bool - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > New type names: =a datatype a = (a,{con A : a}) @@ -4306,7 +4711,7 @@ ! change "C of " ! to "C of {a : , b : }" - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > signature S = /\t.{type t = t, type v = t} - > New type names: t @@ -4560,7 +4965,7 @@ con ('a, 'b) PAIR : 'a * 'b * ('a, 'b) pairlist/1 -> ('a, 'b) pairlist/1}}} - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. - > New type names: =t datatype t = (t,{con C : t -> t}) @@ -4800,7 +5205,7 @@ ! in the constraint ! The declared type scheme should be at least as general as the specified type scheme - -Moscow ML version 2.00 (June 2000) +Moscow ML version 2.01a (January 2004) Enter `quit();' to quit. [opening file "test.sml"] > structure Real : @@ -8411,3 +8816,42 @@ > val it = () : unit [closing file "test10.sml"] > val it = () : unit +Moscow ML version 2.01a (January 2004) +Enter `quit();' to quit. +- > signature S = /\t.{type t = t, val x : t, val f : t -> unit} +- ! Toplevel input: +! functor Apply F:ARG = F(Unit) +! ^^^ +! Illegal applicative functor argument: the signature specifies a generative functor in a positive position +- +Moscow ML version 2.01a (January 2004) +Enter `quit();' to quit. +- ! Toplevel input: +! functor WrongApp X:sig end = struct structure X as sig type t end = [structure struct type t = int end as sig type t end] end; +! ^ +! Illegal structure binding: a structure value cannot be opened in a functor body +- ! Toplevel input: +! functor WrongGen (A : sig end) = struct structure X as sig type t end = [structure struct type t = int end as sig type t end] end; +! ^ +! Illegal structure binding: a structure value cannot be opened in a functor body +- +Moscow ML version 2.01a (January 2004) +Enter `quit();' to quit. +- > signature S = {val 'a x : ('a -> 'a) ref} +- ! Toplevel input: +! structure S :> S = struct fun id x = x; val x = ref id end; +! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +! Signature mismatch: the module does not match the signature ... +! Scheme mismatch: value identifier x +! is specified with type scheme +! val 'a' x : ('a' -> 'a') ref +! in the signature +! but its declaration has the unrelated type scheme +! val x : ('a -> 'a) ref +! in the module +! The declared type scheme should be at least as general as the specified type scheme +- ! Toplevel input: +! val _ = S.x := (fn _ => 0); +! ^^^ +! Cannot access unit S before it has been loaded. +- diff -Nru mosml-2.01/src/compiler/test/scope.sml mosml-2.10.1/src/compiler/test/scope.sml --- mosml-2.01/src/compiler/test/scope.sml 2000-01-21 10:07:12.000000000 +0000 +++ mosml-2.10.1/src/compiler/test/scope.sml 2014-08-28 08:47:22.000000000 +0000 @@ -86,11 +86,132 @@ (functor(X:sig type t end)=>struct datatype u = C of X.t end) :functor X:sig type t end -> sig type u end; +(* tricky scope tests that check levels are maintained correctly *) - - - - +local val z = 1;val l = 2 ; val x1 = ref [] val x2: 'a list ref = ref [] in val y1 = x1 val y2 = x2 end; +val fail : 'a list ref = y1; +val fail : 'a list ref = y2; + +(* ok: the single topdec is correctly rejected *) +structure S = struct val x = 1; val r = ref [] end (* NB: no semicolon! *) +structure R : sig val r: 'a list ref end = S; + +structure S = struct val x = 1; val y = 2; val r = ref [] end +structure Fail : sig val r: 'a list ref end = S; + +structure U = struct val x = 1; val r = ref [] end; +structure Fail : sig val r: 'a list ref end = U; + +structure W = struct val r = ref [] end; +structure Fail : sig val r: 'a list ref end = W; + +structure Y = + struct structure S = struct val x = 1; val r = ref [] end + structure Fail : sig val 'a r: 'a list ref end = S; + end; + + +(* a single topdec *) +val x = ref [] +datatype t = C +val fail = x:=[C]; + +(* a sequence of topdecs *) +val x = ref []; +datatype t = C; +val fail = x:=[C]; + + +structure Z = + struct val x = ref []; + datatype t = C; + val fail = x:=[C]; + end; + +structure Ok = + struct datatype t = C; + val x = ref []; + val ok = x:=[C]; + end; + +structure N = struct val x = ref []; + datatype t = C; + end; +val fail = N.x := [N.C]; + + +structure M = + struct structure X = struct val a = 1; val b = 2; val x = ref [] end; + datatype t = C; + val fail = X.x:=[C]; + end; + +structure O = + struct structure X = struct val x = ref [] end; + datatype t = C; + val fail = X.x:=[C]; + end; + +local val x = ref [] in val y = x val z = ref [] end; +val fail : 'a list ref = x; +val fail : 'a list ref = z; + +(* fail should be rejected since X.x must be monomorphic *) +structure P = let val x = ref [] in struct val x = x end end +val fail : 'a list ref = X.x; + + +(* Unlike the Definition, Mosml treats non-generalizable explicit variables arising from + non-expansive definitions as unification variables *) + +val ok = let val x : 'a list ref = ref [] in x end; +val ok = let val a =1 val b = 2 val c = 3 val x : 'a list ref = ref [] in x end; + +local val x : 'a list ref = ref [] in + val ('b) fail : 'b list ref = x +end; + + + +local val a =1 val b = 2 val c = 3 val x : 'a list ref = ref [] +in + val ('b) fail : 'b list ref = x +end; + +local val a =1 val b = 2 val c = 3 val x : 'a list ref = ref [] +in + val ('b) fail : 'b list ref = (fn y => y) x +end; + +local + val a = 1 val b = 2 val c = 3 val x : 'a list ref = ref [] +in + val ok : int list ref = (fn y => y) x +end; + + +val ok = + fn _ :'b => + let + val a = 1 val b = 2 val c = 3 val x : 'a list ref = ref [] + in + x : 'b list ref + end; + +local + val a = 1 val b = 2 val c = 3 val x : 'a list ref = ref [] +in + val fail = fn _ :'b => x : 'b list ref +end; + +val ok = + fn _ :'b => + let + val a = 1 val b = 2 val c = 3 val x : 'a list ref = ref [] + val f = fn _ :'b => x : 'b list ref + in + x + end; diff -Nru mosml-2.01/src/compiler/TODO.txt mosml-2.10.1/src/compiler/TODO.txt --- mosml-2.01/src/compiler/TODO.txt 2000-06-27 14:46:19.000000000 +0000 +++ mosml-2.10.1/src/compiler/TODO.txt 2014-08-28 08:47:22.000000000 +0000 @@ -1,5 +1,8 @@ Hi Mom! +excRenList seems obsolete now --- can we remove it? +---------------------------------------------- + mosmldep's Lexer really needs to be updated to Modules, though it's fine for the recommended use. ---------------------------- diff -Nru mosml-2.01/src/compiler/Types.sig mosml-2.10.1/src/compiler/Types.sig --- mosml-2.01/src/compiler/Types.sig 2000-06-27 14:46:19.000000000 +0000 +++ mosml-2.10.1/src/compiler/Types.sig 2014-08-28 08:47:22.000000000 +0000 @@ -64,9 +64,7 @@ val normMod : Mod -> Mod; val normExMod : ExMod -> ExMod; -val savePrState : unit -> (unit -> unit); val under_binder : ('a -> 'b) -> 'a -> 'b; - val checkpoint_free_typevar_names: unit -> unit; val rollback_free_typevar_names: unit -> unit; val commit_free_typevar_names: unit -> unit; @@ -88,7 +86,6 @@ (* val prGenFun : GenFun -> unit; *) val prTyFun : TyFun -> unit; -val resetTypePrinter: unit -> unit; val collectExplicitVars: Type -> unit; val collectTopVars: ExEnvironment -> unit; val printNextType: Type -> unit; @@ -140,7 +137,6 @@ val scheme_2u: (Type -> Type -> Type) -> TypeScheme; val scheme_3u: (Type -> Type -> Type -> Type) -> TypeScheme; -val resetBindingLevel: unit -> unit; val incrBindingLevel: unit -> unit; val decrBindingLevel: unit -> unit; val currentBindingLevel: unit -> int; @@ -196,7 +192,8 @@ val copyRecStr : (TyName * TyApp) list -> (TypeVar * Type) list -> RecStr -> RecStr; val copyStr : (TyName * TyApp) list -> (TypeVar * Type) list -> Str -> Str; val copyGenFun : (TyName * TyApp) list -> (TypeVar * Type) list -> GenFun -> GenFun; - +val copyTypeScheme : (TyName * TyApp) list -> (TypeVar * Type) list + -> TypeScheme -> TypeScheme val parameteriseTyNameSet: TyNameSet -> TyNameSet -> (TyNameSet * (TyName * TyApp) list); val conEnvOfTyApp: TyApp -> ConEnv option; @@ -207,6 +204,9 @@ val refreshTyName: TnSort -> TyName -> unit; val refreshTyNameSet: TnSort -> TyNameSet -> unit; +(* lower the level of free unification vars in obj to the current-binding level, returning obj *) +val refreshExEnv: ExEnvironment -> ExEnvironment; + val realizeLongTyCon : QualifiedIdent -> TyStr -> TyStr -> unit; val matchMod : Mod -> Mod -> unit; val matchCSig : CSig -> CSig -> unit; @@ -227,13 +227,10 @@ val lookupVEofEnv : Environment -> string -> (int* (TypeScheme * ConStatusDesc) global); -end; - - - - - - +(* First protect, then restore the current type state (current binding level + printer state) after applying f *) +val protectCurrentTypes: (unit -> 'a) -> unit; +val resetTypes: unit -> unit; +end; diff -Nru mosml-2.01/src/compiler/Types.sml mosml-2.10.1/src/compiler/Types.sml --- mosml-2.01/src/compiler/Types.sml 2000-06-27 14:46:19.000000000 +0000 +++ mosml-2.10.1/src/compiler/Types.sml 2014-08-28 08:47:22.000000000 +0000 @@ -197,11 +197,20 @@ (* Binding levels *) val binding_level = ref 0; - fun resetBindingLevel() = binding_level := 0; fun incrBindingLevel() = incr binding_level; fun decrBindingLevel() = decr binding_level; fun currentBindingLevel() = !binding_level; (* cvr: added *) +fun protectCurrentBindingLevel fct = + let val savedLevel = !binding_level + in + (fct(); + binding_level := savedLevel) + handle x => (binding_level := savedLevel; + raise x) + end +; + fun setCurrentBindingLevel isOverloaded = fn VARt var => @@ -819,6 +828,8 @@ #4 (copyExMod bns bvs X) val copySig = fn bns => fn bvs => fn G => #4 (copySig bns bvs G) + val copyTypeScheme = fn bns => fn bvs => fn scheme => + #4 (copyTypeScheme bns bvs scheme) end; (* free variables (type names, type vars and rho vars) *) @@ -1181,6 +1192,27 @@ else ()) frvs) ; +(* refresh the levels of free unification vars in Obj after a decrease in current binding level *) +local + fun refreshVars freeVarsObj Obj = + let val (_,fvs,frvs) = freeVarsObj [] [] ([],[],[]) Obj + val max_level = !binding_level + in + app (fn (tv:TypeVar) => + if #tvLevel(!tv) > max_level then + (if isExplicit tv then () (* cvr: TODO review this shouldn't even be possible, should it? *) + else setTvLevel tv max_level) + else ()) fvs; + app (fn (rv:RowVar) => + if #rvLevel(!rv) > max_level then + setRvLevel rv max_level + else ()) frvs + end +in + fun refreshExEnv E = (refreshVars freeVarsExEnv E;E) +end +; + fun assumingEqualityTypeVars tvs f a = let val tvRecords = @@ -1527,7 +1559,7 @@ let val (_,fvs,_)= freeVarsType [] [] ([],[],[]) tau val parameters = foldL (fn var => fn parameters => - let val {tvImp, tvOvl, tvLevel, ...} = !var in + let val {tvImp, tvOvl, tvLevel, tvKind, ...} = !var in if member var parameters then parameters else if tvLevel <= !binding_level then parameters @@ -1536,9 +1568,17 @@ parameters) else if tvImp andalso isExpansive then (setTvLevel var (!binding_level); + (case tvKind of + Explicit _ => setTvKind var NoLink + (* cvr: TODO review + although this deviates from the Definition, + we choose to replace non-generalizable + (and hence meaningless) + explicit type variables by fresh + unification variables *) + | _ => ()); parameters) - else - var :: parameters + else var :: parameters end) [] fvs @@ -2011,39 +2051,41 @@ patternOfTyApp (tyapp,tn::tns) | patternOfTyApp _ = raise NotAPattern; + + fun realizeTyStr path id (infTyStr : TyFun * ConEnv) (specTyStr : TyFun * ConEnv) = -(*cvr: modified case (#1 infTyStr, #1 specTyStr) of *) +(* cvr: modified case (#1 infTyStr, #1 specTyStr) of *) case (normTyFun (#1 infTyStr), normTyFun (#1 specTyStr)) of (* cvr: inserted call to normTyFun *) (infTyFun, specTyFun) => - (let - in - (case (kindTyFun infTyFun, kindTyFun specTyFun) of + ((case (kindTyFun infTyFun, kindTyFun specTyFun) of (ARITYkind infArity, ARITYkind specArity) => if specArity <> infArity then raise MatchError (ArityMismatch (path,id,infTyStr,specTyStr,infArity,specArity)) else () - | (_,_) => fatalError "realizeTyStr:1" (* cvr: TODO *)); - (case EqualityOfTyFun specTyFun of - (* cvr: TODO revise - it should be sufficient - (and more efficient) to do this - check only once we've determined that specTyFun - is a pattern *) - REFequ => - if (EqualityOfTyFun infTyFun) <> REFequ then - raise MatchError (RefEqualityMismatch (path,id,infTyStr,specTyStr)) - else () - | TRUEequ => - if (EqualityOfTyFun infTyFun) = FALSEequ then - raise MatchError (EqualityMismatch (path,id,infTyStr,specTyStr)) - else () - | FALSEequ => - () - | _ => fatalError "realizeTyStr:2"); - ((case patternOfTyFun specTyFun of + | (_,_) => fatalError "realizeTyStr:1"); + ((case patternOfTyFun specTyFun of (tn,tns) => - let val tnLevel = #tnLevel(!(#info tn)) + let val _ = + (* cvr: its important that we match equality *only* + when specTyFun is a pattern (ie. opaque), since + specTyFun may otherwise contain unification variables + whose equality status is determined only *after* + unification. *) + (case EqualityOfTyFun specTyFun of + REFequ => + if (EqualityOfTyFun infTyFun) <> REFequ then + raise MatchError (RefEqualityMismatch (path,id,infTyStr,specTyStr)) + else () + | TRUEequ => + if (EqualityOfTyFun infTyFun) = FALSEequ then + raise MatchError (EqualityMismatch (path,id,infTyStr,specTyStr)) + else () + | FALSEequ => + () + | _ => fatalError "realizeTyStr:2") + val tnLevel = #tnLevel(!(#info tn)) val (fns,fvs,frvs) = freeVarsTyFun tns [] ([],[],[]) infTyFun - val _ = (* occur check *) + val _ = (* occur check, required for recursive modules *) app (fn tn' => if tn = tn' then raise MatchError (CircularMismatch(path, @@ -2065,8 +2107,7 @@ setTnSort (#info tn) (REAts (foldR (fn tn => fn tyfun => LAMtyfun(tn,tyfun)) (normTyFun infTyFun) tns)) end) handle NotAPattern => ()) - (* cvr: *) - end) + ); fun checkRealization (* (inferredSig : CSig) (specSig : CSig)*) path id (infTyStr : TyFun * ConEnv) (specTyStr : TyFun * ConEnv) = @@ -2075,7 +2116,7 @@ let val infTyFun = normTyFun (#1 infTyStr) in unifyTyFun infTyFun specTyFun (* cvr: CHECK THIS *) - handle Unify _ => + handle Unify _ => (* cvr: TODO improve error message *) raise MatchError (TransparentMismatch (path,id,infTyStr,specTyStr)) end | (specTyFun, specCE) => @@ -2281,23 +2322,13 @@ val free_variable_names = ref ([] : (TypeVar * string) list); val free_variable_counter = ref 0; -val savePrState = fn () => - (let val temp_freetyname_names = !free_tyname_names - val temp_freetyname_counter = !free_tyname_counter - val temp_free_variable_names = !free_variable_names - val temp_free_variable_counter = !free_variable_counter - in fn () => (free_tyname_names := temp_freetyname_names; - free_tyname_counter := temp_freetyname_counter; - free_variable_names := temp_free_variable_names; - free_variable_counter := temp_free_variable_counter) - end); fun under_binder f a = (let val temp_freetyname_names = !free_tyname_names val temp_freetyname_counter = !free_tyname_counter val temp_free_variable_names = !free_variable_names val temp_free_variable_counter = !free_variable_counter - val r = f a + val r = f a in free_tyname_names := temp_freetyname_names; free_tyname_counter := temp_freetyname_counter; free_variable_names := temp_free_variable_names; @@ -2372,6 +2403,54 @@ | rest => rest)) end + +(* reset the current printer state *) +fun resetPrinter () = +( free_tyname_names := []; + free_tyname_counter := 0; + free_variable_names := []; + free_variable_counter := 0; + app (fn tn as {qualid,...} => + if isGlobalName qualid andalso + not (member (#qual qualid) (!preopenedPreloadedUnits)) andalso + not (member (#qual qualid) (pervasiveOpenedUnits)) + then free_tyname_names := (tn,(showQualId qualid,0)) :: !free_tyname_names (* cvr: TODO revise *) + else + (case #id(qualid) of + [""] => free_tyname_names := ((tn,choose_arbitrary_tyname()) + :: !free_tyname_names) + | [name] => + let val newname = choose_derived_tyname name + in + free_tyname_names := ((tn, newname) + :: !free_tyname_names) + end + | _ => free_tyname_names := ((tn,choose_arbitrary_tyname()) :: !free_tyname_names))) + (mkGlobalT ()) +); + +(* protect the current printer state *) + +fun protectCurrentPrinter fct = + let val saved_freetyname_names = !free_tyname_names + val saved_freetyname_counter = !free_tyname_counter + val saved_free_variable_names = !free_variable_names + val saved_free_variable_counter = !free_variable_counter + in + (fct(); + free_tyname_names := saved_freetyname_names; + free_tyname_counter := saved_freetyname_counter; + free_variable_names := saved_free_variable_names; + free_variable_counter := saved_free_variable_counter) + handle x => (free_tyname_names := saved_freetyname_names; + free_tyname_counter := saved_freetyname_counter; + free_variable_names := saved_free_variable_names; + free_variable_counter := saved_free_variable_counter; + raise x) + end +; + + (* cvr: TODO rationalise *) fun collectExplicitVarsInObj freeVarsObj obj = let val (fns,fvs,_) = @@ -2388,7 +2467,7 @@ free_variable_names := ((var, newname) :: !free_variable_names) end) fvs; - revApp (fn tn as {qualid={id = id,...},...} => + revApp (fn tn as {qualid={id = id,...},...} => (case id of [""] => free_tyname_names := ((tn,choose_arbitrary_tyname()) :: !free_tyname_names) | [name] => @@ -2853,31 +2932,6 @@ val prTyFun = prTyFun 0; val prType = prType 0; -fun resetTypePrinter () = -( free_tyname_names := []; - free_tyname_counter := 0; - free_variable_names := []; - free_variable_counter := 0; - app (fn tn as {qualid,...} => - if isGlobalName qualid andalso - not (member (#qual qualid) (!preopenedPreloadedUnits)) andalso - not (member (#qual qualid) (pervasiveOpenedUnits)) - then -(* free_tyname_names := (tn,showQualId qualid) :: !free_tyname_names *) - free_tyname_names := (tn,(showQualId qualid,0)) :: !free_tyname_names (* cvr: TODO revise *) - else - (case #id(qualid) of - [""] => free_tyname_names := ((tn,choose_arbitrary_tyname()) - :: !free_tyname_names) - | [name] => - let val newname = choose_derived_tyname name - in - free_tyname_names := ((tn, newname) - :: !free_tyname_names) - end - | _ => free_tyname_names := ((tn,choose_arbitrary_tyname()) :: !free_tyname_names))) - (mkGlobalT ()) -); local val checkpointed_free_variable_names = ref [] in @@ -3396,7 +3450,7 @@ errPrompt "but declared as a different abbreviation in the "; prInf path;msgEOL(); errPrompt " ";prTyInfo id infTyStr;msgEOL(); - errPrompt "The abbreviations should be equivalent";msgEOL(); + errPrompt "The abbreviations should be equivalent (or unifiable) ";msgEOL(); msgEBlock())) () | PatternMismatch (path,id,infTyStr, specTyStr, tn,sv) => @@ -3739,4 +3793,8 @@ end end; +(* reset the current type state *) +fun resetTypes fct = (resetBindingLevel ();resetPrinter ()); +(* protect, then restore the current type state *) +fun protectCurrentTypes fct = protectCurrentBindingLevel (fn () => protectCurrentPrinter fct); diff -Nru mosml-2.01/src/compiler/Units.sml mosml-2.10.1/src/compiler/Units.sml --- mosml-2.01/src/compiler/Units.sml 2000-06-27 14:46:19.000000000 +0000 +++ mosml-2.10.1/src/compiler/Units.sml 2014-08-28 08:47:22.000000000 +0000 @@ -18,6 +18,7 @@ uSigEnv: (string, SigInfo) Hasht.t, (* uTyNameSet is the set of names introduced in the unit's implementation, or the set of names bound in the unit's interface (if any). + All type name levels should be 0 (this is ensured in rectifySignature before writing.) *) uTyNameSet: TyNameSet ref, (* The optional Str uStrOpt comes from the unit's optional interface. @@ -574,28 +575,8 @@ traverseEnv add_InfixBasis (revEnv iBas) ; - -(* cvr: added *) -local -fun updateTyName ({qualid,info}:TyName) = - let val { tnStamp, - tnKind, - tnEqu, - tnSort, - tnLevel, - tnConEnv} = !info in - info := {tnStamp=tnStamp, - tnKind=tnKind, - tnEqu=tnEqu, - tnSort=tnSort, - tnLevel=0, (* update the level *) - tnConEnv = tnConEnv} - end; -in fun updateCurrentStaticT T = - (app updateTyName T; - tyNameSetOfSig (!currentSig) := (!(tyNameSetOfSig (!currentSig))) @ T) -end; + (tyNameSetOfSig (!currentSig) := (!(tyNameSetOfSig (!currentSig))) @ T) fun extendCurrentStaticS S = let val strOpt = strOptOfSig (!currentSig) @@ -684,7 +665,7 @@ fun execToplevelOpen loc uname = let val cu = findAndMentionSig loc uname in updateCurrentInfixBasis (mk1TopEnv (#uIBas cu)); - updateCurrentStaticT (!(#uTyNameSet cu)); + updateCurrentStaticT (!(#uTyNameSet cu)); (* tynames assumed to have level 0 *) updateCurrentStaticVE (mk1TopEnv (#uVarEnv cu)); updateCurrentStaticTE (mk1TopEnv (#uTyEnv cu)); updateCurrentStaticME (mk1TopEnv (#uModEnv cu)); @@ -739,6 +720,9 @@ currentRenEnv := mkRenEnv() ); + +fun rectifyTyNameSet (T:TyNameSet) = app (fn tn => setTnLevel (#info tn) 0) T; + fun rectifyVarEnv VE = let val excRen = ref( [] : (QualifiedIdent * (QualifiedIdent * int)) list ) @@ -760,7 +744,7 @@ fun rectifySignature() = - let + let val _ = rectifyTyNameSet (!(#uTyNameSet(!currentSig))) val excRenList = rectifyVarEnv (#uVarEnv(!currentSig)) val valRenList = foldEnv (fn id => fn stamp => fn acc => (id,stamp)::acc) diff -Nru mosml-2.01/src/compiler.cminusminus/Arg.sig mosml-2.10.1/src/compiler.cminusminus/Arg.sig --- mosml-2.01/src/compiler.cminusminus/Arg.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Arg.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,55 @@ +(* Parsing of command line arguments. *) + +(* This module provides a general mechanism for extracting options and + arguments from the command line to the program. *) +(* Syntax of command lines. + A keyword is a character string starting with a [-]. + An option is a keyword alone or followed by an argument. + There are 4 types of keywords: Unit, String, Int, and Float. + Unit keywords do not take an argument. + String, Int, and Float keywords take the following word on the command line + as an argument. + Arguments not preceded by a keyword are called anonymous arguments. + + Examples ([foo] is assumed to be the command name): + +- [foo -flag ](a unit option) +- [foo -int 1 ](an int option with argument [1]) +- [foo -string foobar ](a string option with argument ["foobar"]) +- [foo -real 12.34 ](a real option with argument [12.34]) +- [foo 1 2 3 ](three anonymous arguments: ["1"], ["2"], and ["3"]) +- [foo 1 2 -flag 3 -string bar 4] +- [ ](four anonymous arguments, a unit option, and +- [ ] a string option with argument ["bar"]) +*) + +datatype spec = + String of (string -> unit) + | Int of (int -> unit) + | Unit of (unit -> unit) + | Real of (real -> unit) +; + +(* + The concrete type describing the behavior associated with a keyword. +*) + +val parse : (string * spec) list -> (string -> unit) -> unit; +(* + [parse speclist anonfun] + parses the command line, calling the functions in [speclist] + whenever appropriate, and [anonfun] on anonymous arguments. + The functions are called in the same order as they appear on the command + line. + The strings in the [(string * spec) list] are keywords and must + start with a [-], else they are ignored. + For the user to be able to specify anonymous arguments starting with a + [-], include for example [("--", String anonfun)] in [speclist]. +*) + +exception Bad of string + +(* + Functions in [speclist] or [anonfun] can raise [Bad message] + to reject invalid arguments. +*) diff -Nru mosml-2.01/src/compiler.cminusminus/Arg.sml mosml-2.10.1/src/compiler.cminusminus/Arg.sml --- mosml-2.01/src/compiler.cminusminus/Arg.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Arg.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,83 @@ +(* arg.sml *) + +open BasicIO Fnlib; + +exception Bad of string + +datatype spec = + String of (string -> unit) + | Int of (int -> unit) + | Unit of (unit -> unit) + | Real of (real -> unit) +; + +datatype error = + Unknown of string + | Wrong of string * string * string (* option, actual, expected *) + | Missing of string + | Message of string +; + +fun stop error = + let val progname = if Vector.length Miscsys.command_line > 0 + then Vector.sub(Miscsys.command_line, 0) + else "(?)" + val message = + case error of + Unknown s => + progname ^ ": unknown option: \"" ^ s ^ "\"." + | Missing s + => progname ^ ": option \"" ^ s ^ "\" needs an argument." + | Wrong (opt, arg, expected) + => progname ^ ": wrong argument \"" ^ arg ^ "\"; option \"" + ^ opt ^ "\" expects " ^ expected ^ "." + | Message s + => progname ^ ": " ^ s + in + output(std_err, message); output(std_err, "\n"); flush_out std_err; + exit 2 + end; + +prim_val sml_int_of_string : string -> int = 1 "sml_int_of_string"; +prim_val sml_float_of_string : string -> real = 1 "sml_float_of_string"; + +fun listOfVector v = + List.tabulate(Vector.length v, fn i => Vector.sub(v, i)) +; + +fun parse speclist anonfun = + let fun p [] = () + | p (s::t) = + if size s >= 1 andalso CharVector.sub(s, 0) = #"-" + then do_key s t + else ((anonfun s; p t) + handle Bad m => stop (Message m)) + and do_key s l = + let val action = + lookup s speclist + handle Subscript => stop (Unknown s) + in + (case (action, l) of + (Unit f, l) => (f (); p l) + | (String f, arg::t) => (f arg; p t) + | (Int f, arg::t) => + let val arg_i = + sml_int_of_string arg + handle Fail _ => + stop (Wrong (s, arg, "an integer")) + in f arg_i; p t end + | (Real f, arg::t) => + let val arg_r = + sml_float_of_string arg + handle Fail _ => + stop (Wrong (s, arg, "a real")) + in f arg_r; p t end + | (_, []) => stop (Missing s) + ) handle Bad m => stop (Message m) + end + in + case listOfVector Miscsys.command_line of + [] => () + | a::l => p l + end; + diff -Nru mosml-2.01/src/compiler.cminusminus/Asyntfn.sig mosml-2.10.1/src/compiler.cminusminus/Asyntfn.sig --- mosml-2.01/src/compiler.cminusminus/Asyntfn.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Asyntfn.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,33 @@ +local + open Fnlib Mixture Const Globals Location Types Asynt; +in + +val mkIdInfo : (Location * QualifiedIdent) -> bool -> IdInfo; +val getConInfo : IdInfo -> ConInfo; +val getExConInfo : IdInfo -> ExConInfo; + +val pairExp : Exp -> Exp -> Exp; +val tupleExp : Location * Exp list -> Exp; +val quoteExp : Exp -> Exp; +val antiquoteExp : Exp -> Exp; +val listExp : Location * Exp list -> Exp; +val seqExp : Exp list -> Exp; +val hashLabelExp : Location * Lab -> Exp; +val mkLabPatOfId : Location * string -> Ty option -> Pat option + -> Lab * Pat; +val pairPat : Pat -> Pat -> Pat; +val tuplePat : Location * Pat list -> Pat; +val listPat : Location * Pat list -> Pat; +val tupleTy : Ty list -> Ty; + +val mkValIt : Exp -> Dec; + +val domPat : Pat -> string list; +val domPatAcc : Pat -> string list -> string list; +val varsOfPatAcc : Pat -> IdInfo list -> IdInfo list; +val curriedness : Match -> int; + +val printExp : Exp -> unit; +val printDec : Dec -> unit; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Asyntfn.sml mosml-2.10.1/src/compiler.cminusminus/Asyntfn.sml --- mosml-2.01/src/compiler.cminusminus/Asyntfn.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Asyntfn.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,553 @@ +open List Fnlib Mixture Const Globals Location Types Asynt; + +fun mkIdInfo (loc, qualid) withOp = + { qualid = qualid, + info = { idLoc=loc, withOp=withOp, + idKind= ref { qualid=qualid, info=VARik }, + idFields = ref ([]:int list)}} +; + +fun getConInfo (ii : IdInfo) = + case #info(! (#idKind (#info ii))) of + CONik ci => ci + | _ => fatalError "getConInfo" +; + +fun getExConInfo (ii : IdInfo) = + case #info(!(#idKind (#info ii))) of + EXCONik ei => ei + | _ => fatalError "getExConInfo" +; + +fun pairExp e1 e2 = + (xxLR e1 e2, RECexp(ref (RECre(mkPairRow e1 e2)))) +; + +fun tupleExp (loc, exps) = + (loc, RECexp(ref (RECre(mkTupleRow exps)))) +; + +val qQUOTE = { qual = "General", id = ["QUOTE"] }; +val qANTIQUOTE = { qual = "General", id = ["ANTIQUOTE"] }; + +fun quoteExp exp = + let val loc = xLR exp in + (loc, APPexp((loc, + VIDPATHexp(ref (RESvidpath(mkIdInfo (loc, qQUOTE) false)))), exp)) + end +; + +fun antiquoteExp exp = + let val loc = xLR exp in + (loc, APPexp((loc, + VIDPATHexp(ref (RESvidpath(mkIdInfo (loc, qANTIQUOTE) false)))), exp)) + end +; + +val qNil = { qual = "", id = ["nil"] }; +val qCons = { qual = "", id = ["::"] }; + +fun listExp (Loc(l,r), exps) = + let val locR = Loc(r-1,r) in + foldR (fn e1 => fn e2 => + let val locO = xxLR e1 e2 + val locI = xxRL e1 e2 + in + (locO, APPexp((locI, + VIDPATHexp(ref (RESvidpath(mkIdInfo (locI, qCons) false)))), + pairExp e1 e2)) + end) + (locR, VIDPATHexp(ref (RESvidpath(mkIdInfo (locR,qNil) false)))) exps + end; + +fun seqExp exps = + foldR1 (fn e1 => fn e2 => + let val loc12 = xxLR e1 e2 in (loc12, SEQexp(e1,e2)) end) + exps +; + +val qX = { qual = "", id = ["~x"] }; + +fun hashLabelExp (loc, lab) = + let val pat = + (loc, RECpat(ref + (RECrp([(lab, (loc, VARpat(mkIdInfo (loc,qX) false)))], + SOME (fresh3DotType()))))) + and exp = + (loc, VIDPATHexp(ref (RESvidpath(mkIdInfo (loc, qX) false)))) + in (loc, FNexp [MRule(ref([pat]),exp)]) end +; + +fun mkLabPatOfId (locId as (loc, id)) ty_opt pat_opt = + let val lab = STRINGlab id + val var = (loc, VARpat(mkIdInfo (loc, { qual="", id=[id] }) false)) + in + case (ty_opt, pat_opt) of + (SOME ty, SOME pat) => + (lab, (xxLR locId pat, LAYEREDpat(var, + (xxLR ty pat, TYPEDpat(pat, ty))))) + | (NONE, SOME pat) => + (lab, (xxLR locId pat, LAYEREDpat(var, pat))) + | (SOME ty, NONE) => + (lab, (xxLR locId ty, TYPEDpat(var, ty))) + | (NONE, NONE) => + (lab, var) + end; + +fun pairPat p1 p2 = + let val loc = xxLR p1 p2 in + (loc, RECpat(ref (RECrp(mkPairRow p1 p2, NONE)))) + end; + +fun tuplePat (loc, pats) = + (loc, RECpat(ref (RECrp(mkTupleRow pats, NONE)))) +; + +fun listPat (Loc(l,r), exps) = + let val locR = Loc(r-1,r) in + foldR (fn e1 => fn e2 => + let val locO = xxLR e1 e2 + val locI = xxRL e1 e2 + in + (locO, CONSpat(mkIdInfo (locI,qCons) true, pairPat e1 e2)) + end) + (locR, (VARpat (mkIdInfo (locR, qNil) true))) exps + end; + +fun tupleTy [t] = t + | tupleTy ts = + let val loc = xxLR (hd ts) (last ts) in + (loc, RECty (mkTupleRow ts)) + end +; + +val qIt = { qual = "", id = ["it"] }; + +fun mkValIt exp = + let val loc = xLR exp in + (loc, VALdec + ([], ([ValBind(ref(loc, (VARpat (mkIdInfo (loc, qIt) false))), exp)], []))) + end; + +fun domPatAcc (_, pat') ids = + case pat' of + SCONpat _ => ids + | VARpat ii => (hd(#id(#qualid ii))) :: ids + | WILDCARDpat => ids + | NILpat _ => ids + | CONSpat(_, p) => domPatAcc p ids + | EXNILpat _ => ids + | EXCONSpat(_, p) => domPatAcc p ids + | EXNAMEpat _ => fatalError "domPatAcc" + | REFpat p => domPatAcc p ids + | RECpat(ref (RECrp(fs, _))) => + foldL_map domPatAcc snd ids fs + | RECpat(ref (TUPLErp ps)) => + foldL domPatAcc ids ps + | VECpat ps => + foldL domPatAcc ids ps + | INFIXpat _ => fatalError "domPatAcc" + | PARpat p => domPatAcc p ids + | TYPEDpat(p,_) => domPatAcc p ids + | LAYEREDpat(p1,p2) => domPatAcc p2 (domPatAcc p1 ids) +; + +fun domPat pat = domPatAcc pat []; + +fun varsOfPatAcc (_, pat') iis = + case pat' of + SCONpat _ => iis + | VARpat ii => ii :: iis + | WILDCARDpat => iis + | NILpat _ => iis + | CONSpat(_, p) => varsOfPatAcc p iis + | EXNILpat _ => iis + | EXCONSpat(_, p) => varsOfPatAcc p iis + | EXNAMEpat _ => fatalError "varsOfPatAcc" + | REFpat p => varsOfPatAcc p iis + | RECpat(ref (RECrp(fs, _))) => foldL_map varsOfPatAcc snd iis fs + | RECpat(ref (TUPLErp _)) => fatalError "varsOfPatAcc" + | VECpat ps => foldL varsOfPatAcc iis ps + | INFIXpat _ => fatalError "varsOfPatAcc" + | PARpat p => varsOfPatAcc p iis + | TYPEDpat(p,_) => varsOfPatAcc p iis + | LAYEREDpat(p1,p2) => varsOfPatAcc p2 (varsOfPatAcc p1 iis) +; + +fun curriedness (MRule(ref pats,_) :: _) = List.length pats + | curriedness _ = fatalError "curriedness" +; + + +fun printIdInfo (ii : IdInfo) = + let val {qualid, info} = ii in + if #withOp info then msgString "op " else (); + printQualId qualid + end; + +fun printLocString (loc,string) = msgString string;; +fun printVId vid = printLocString vid ;; +fun printTyCon tycon = printLocString tycon; +fun printModId modid = printLocString modid; +fun printModId modid = printLocString modid; +fun printFunId funid = printLocString funid; +fun printSigId sigid = printLocString sigid; + + +fun printTyVarSeq [] = () + | printTyVarSeq [ii] = + (printIdInfo ii; msgString " ") + | printTyVarSeq iis = + (msgString "("; printSeq printIdInfo ", " iis; + msgString ") ") +; + + +fun printTyConPath (_, tyconpath') = + case tyconpath' of + LONGtyconpath ii => + printIdInfo ii + | WHEREtyconpath (ii,(loc,modid),modexp) => + (printIdInfo ii; + msgString " where "; + msgString modid; + msgString " = "; + printModExp modexp) + +and printTy (_, ty') = + case ty' of + TYVARty ii => + msgString (hd (#id (#qualid ii))) + | RECty fs => + (msgString "{"; printSeq printRecTyField ", " fs; msgString "}") + | CONty(ts, tyconpath) => + (printTySeq ts; printTyConPath tyconpath) + | FNty(t, t') => + (msgString "("; printTy t; msgString " -> "; printTy t'; + msgString ")") + | PACKty sigexp => + (msgString "{"; printSigExp sigexp; + msgString "}") + | PARty ty => + (msgString "("; printTy ty; + msgString ")") + +and printRecTyField (lab, ty) = + (msgIBlock 0; printLab lab; msgString " :"; msgBreak(1, 2); printTy ty; + msgEBlock()) + +and printTySeq [] = () + | printTySeq [t] = + (printTy t; msgString " ") + | printTySeq ts = + (msgString "("; printSeq printTy ", " ts; + msgString ")") + +and printOvlType ovltype tau = +( + msgString + (case ovltype of + REGULARo => " " num/ " + | OVL1NSo => " string/ " + | OVL2NNBo => " bool/ " + | OVL2NNNo => " num/ " + | OVL1TXXo => "<'a -> 'a/ " + | OVL1TPUo => "<(ppstream -> 'a -> unit) -> unit/ " + | OVL2EEBo => "<''a * ''a -> bool/ "); + printType tau; + msgString " > " +) + + +and printVIdPathInfo (ref(RESvidpath longvid)) = + printIdInfo longvid + | printVIdPathInfo (ref(OVLvidpath (longvid,ovltype,tau))) = + (printIdInfo longvid; + printOvlType ovltype tau) + +and printInfixExp ie = + case ie of + UNRESinfixexp es => + (msgString "(UNRES "; + printSeq printExp " " es; + msgString ")") + | RESinfixexp exp => + printExp exp + +and printExp (_, exp') = + case exp' of + SCONexp (scon, _) => + printSCon scon + | VIDPATHexp vidpathinfo => + printVIdPathInfo vidpathinfo + | RECexp(ref (RECre fs)) => + (msgString "{"; printSeq printExpField ", " fs; + msgString "}") + | RECexp(ref (TUPLEre es)) => + (msgString "("; printSeq printExp ", " es; + msgString ")") + | VECexp es => + (msgString "#["; printSeq printExp ", " es; + msgString "]") + | PARexp e => printExp e + | FNexp mrules => + (msgString "(fn "; printSeq printMRule " | " mrules; + msgString ")") + | APPexp (e1,e2) => + (msgString "("; printSeq printExp " " [e1,e2]; + msgString ")") + | LETexp (dec,exp) => + (msgString "let "; printDec dec; msgString " in "; + printExp exp; msgString " end") + | INFIXexp (ref infixexp) => + (msgString "(INFIXexp "; + printInfixExp infixexp; + msgString ")") + | TYPEDexp(exp,ty) => + (msgString "("; printExp exp; msgString " : "; + printTy ty; msgString ")") + | ANDALSOexp(exp1,exp2) => + (printExp exp1; msgString " andalso "; printExp exp2) + | ORELSEexp(exp1,exp2) => + (printExp exp1; msgString " orelse "; printExp exp2) + | HANDLEexp(exp, mrules) => + (msgString "("; printExp exp; msgString " handle "; + printSeq printMRule " | " mrules; msgString ")") + | RAISEexp exp => + (msgString "raise "; printExp exp) + | IFexp(exp0,exp1,exp2) => + (msgString "if "; printExp exp0; msgString " then "; + printExp exp1; msgString " else "; printExp exp2) + | WHILEexp(exp1,exp2) => + (msgString "while "; printExp exp1; msgString " do "; + printExp exp2) + | SEQexp(exp1,exp2) => + (msgString "("; printExp exp1; msgString "; "; + printExp exp2; msgString ")") + | STRUCTUREexp(modexp,sigexp,_) => + (msgString "[structure "; printModExp modexp; msgString " as "; + printSigExp sigexp; + msgString "]") + | FUNCTORexp(modexp,sigexp,_) => + (msgString "[functor "; printModExp modexp; msgString " as "; + printSigExp sigexp; + msgString "]") +and printExpField (lab, e) = + (msgIBlock 0; printLab lab; msgString " ="; msgBreak(1, 2); + printExp e; msgEBlock()) + +and printMRule (MRule(ref ps, e)) = + (printSeq printPat " => " ps; msgString " => "; printExp e) + +and printInfixPat ip = + case ip of + UNRESinfixpat ps => + (msgString "(UNRES "; + printSeq printPat " " ps; + msgString ")") + | RESinfixpat pat => + printPat pat + +and printPat (_, pat') = + case pat' of + SCONpat (scon , _) => printSCon scon + | VARpat ii => printIdInfo ii + | WILDCARDpat => msgString "_" + | NILpat ii => printIdInfo ii + | CONSpat(ii, p) => + (msgString "("; printIdInfo ii; printPat p; msgString ")") + | EXNILpat ii => printIdInfo ii + | EXCONSpat(ii,p) => + (msgString "("; printIdInfo ii; printPat p; msgString ")") + | EXNAMEpat lam => + (msgString "") + | REFpat p => + (msgString "("; msgString "ref "; printPat p; msgString ")") + | RECpat(ref (RECrp(fs, dots))) => + (msgString "{"; printSeq printPatField ", " fs; + case dots of + NONE => + msgString "}" + | SOME _ => + msgString ", ...}") + | RECpat(ref (TUPLErp ps)) => + (msgString "("; printSeq printPat ", " ps; msgString ")") + | VECpat ps => + (msgString "#["; printSeq printPat ", " ps; msgString "]") + | PARpat p => + printPat p + | INFIXpat (ref infixpat) => + (msgString "(INFIXpat"; + printInfixPat infixpat; + msgString ")") + | TYPEDpat(pat, ty) => + (msgString "("; printPat pat; msgString " : "; + printTy ty; msgString ")") + | LAYEREDpat(pat1, pat2) => + (msgString "("; printPat pat1; msgString " as "; + printPat pat2; msgString ")") + +and printPatField (lab, pat) = + (msgIBlock 0; printLab lab; msgString " ="; msgBreak(1, 2); + printPat pat; msgEBlock()) + +and printDec (_, dec') = + case dec' of + VALdec (tvs, (pvbs, rvbs)) => + (msgString "val "; printTyVarSeq tvs; + case (pvbs, rvbs) of + (_, []) => printValBindSeq pvbs + | ([], _) => (msgString "rec "; printValBindSeq rvbs) + | (_, _) => (printValBindSeq pvbs; msgString " and rec "; + printValBindSeq rvbs)) + | PRIM_VALdec (tvs,vbs) => + (msgString "prim_val "; printTyVarSeq tvs; + printSeq printPrimValBind " and " vbs) + | FUNdec (ref (UNRESfundec (tvs, fvalbind))) => + (msgString "fun "; printTyVarSeq tvs; + printSeq printFValBind " and " fvalbind) + | FUNdec (ref (RESfundec dec)) => + printDec dec + | TYPEdec tbs => + (msgString "type "; printSeq printTypBind " and " tbs) + | PRIM_TYPEdec(eq, tbs) => + (msgString "prim_"; + msgString + (case eq of + FALSEequ => "" + | TRUEequ => "eq" + | REFequ => "EQ" + | _ => fatalError "printDec"); + msgString "type "; printSeq printPrimTypBind " and " tbs) + | DATATYPEdec(dbs, tbs_opt) => + (msgString "datatype "; printSeq printDatBind " and " dbs; + printWithtype tbs_opt) + | DATATYPErepdec(tycon,tyconpath) => + (msgString "datatype "; + printTyCon tycon; + msgString " = datatype "; + printTyConPath tyconpath + ) + | ABSTYPEdec(dbs, tbs_opt, dec) => + (msgString "abstype "; printSeq printDatBind " and " dbs; + printWithtype tbs_opt; + msgString " with "; printDec dec) + | EXCEPTIONdec ebs => + (msgString "exception "; printSeq printExBind " and " ebs) + | LOCALdec(dec1,dec2) => + (msgString "local "; printDec dec1; msgString " in "; + printDec dec2) + | OPENdec longmodidinfos => + (msgString "open "; printSeq printIdInfo " " (map #1 longmodidinfos)) + | STRUCTUREdec mbs => + (msgString "structure "; printSeq printModBind " and " mbs) + | FUNCTORdec fbs => + (msgString "functor "; printSeq printFunBind " and " fbs) + | SIGNATUREdec sbs => + (msgString "signature "; printSeq printSigBind " and " sbs) + | EMPTYdec => () + | SEQdec(dec1,dec2) => + (printDec dec1; msgString "; "; printDec dec2) + | FIXITYdec(status, ids) => + (case status of + INFIXst i => + (msgString "INFIX "; msgInt i; msgString " ") + | INFIXRst i => + (msgString "INFIXR "; msgInt i; msgString " ") + | NONFIXst => + msgString "NONFIX "; + printSeq msgString " " ids) + +and printValBindSeq vbs = + printSeq printValBind " and " vbs + +and printValBind (ValBind(ref p, e)) = + (msgIBlock 0; printPat p; msgString " ="; msgBreak(1, 2); + printExp e; msgEBlock()) + +and printPrimValBind(ii, ty, arity, name) = + (msgIBlock 0; printIdInfo ii; + msgString " :"; msgBreak(1, 2); + printTy ty; msgString " ="; msgBreak(1, 2); + msgInt arity; msgString " "; printSCon (STRINGscon name); + msgEBlock()) + +and printFValBind (_, fclauses) = + (printSeq printFClause " | " fclauses) + +and printFClause (FClause (ref pats, exp)) = + (msgIBlock 0; printSeq printPat " " pats; msgString " ="; msgBreak(1, 2); + printExp exp; msgEBlock()) + +and printWithtype (SOME tbs) = + (msgString " withtype "; printSeq printTypBind " and " tbs) + | printWithtype NONE = () + +and printTypBind (tvs, tc, t) = + (msgIBlock 0; printTyVarSeq tvs; printTyCon tc; + msgString " ="; msgBreak(1, 2); + printTy t; msgEBlock()) + +and printPrimTypBind (tvs, tc) = + (printTyVarSeq tvs; printTyCon tc) + +and printDatBind (tvs, tc, cbs) = + (msgIBlock 0; printTyVarSeq tvs; printTyCon tc; + msgString " ="; msgBreak(1, 2); + printSeq printConBind " | " cbs; msgEBlock()) + +and printConBind (ConBind(ii, SOME t)) = + (printIdInfo ii; msgString " of "; printTy t) + | printConBind (ConBind(ii, NONE)) = + printIdInfo ii + +and printExBind (EXDECexbind(ii, SOME t)) = + (printIdInfo ii; msgString " of "; printTy t) + | printExBind (EXDECexbind(ii, NONE)) = + printIdInfo ii + | printExBind (EXEQUALexbind(ii, ii')) = + (msgIBlock 0; printIdInfo ii; msgString " ="; msgBreak(1, 2); + printIdInfo ii'; msgEBlock()) + +and printModBind (MODBINDmodbind(modid, me)) = + (msgIBlock 0; printModId modid; msgString " ="; msgBreak(1, 2); + printModExp me; msgEBlock()) + | printModBind (ASmodbind(modid,sigexp,exp)) = + (msgIBlock 0; printModId modid;msgString " as"; msgBreak(1,2); + printSigExp sigexp; msgString " ="; + msgBreak(1, 2);printExp exp; + msgEBlock()) + +and (* + printFunBind (FUNBINDfunbind(funid, modid, sigexp, modexp)) = + (msgIBlock 0; printFunId funid; + msgString "("; printModId modid; msgString ":"; + printSigExp sigexp; + msgString ")"; + msgString " ="; msgBreak(1, 2); + printModExp modexp; msgEBlock()) *) + printFunBind (FUNBINDfunbind(funid, me)) = + (msgIBlock 0; printFunId funid; msgString " ="; msgBreak(1, 2); + printModExp me; msgEBlock()) + | printFunBind (ASfunbind(funid,sigexp,exp)) = + (msgIBlock 0; printFunId funid;msgString " as"; msgBreak(1,2); + printSigExp sigexp; msgString " ="; + msgBreak(1, 2);printExp exp; + msgEBlock()) + +and printSigBind (SIGBINDsigbind(sigid, sigexp)) = + (msgIBlock 0; printSigId sigid; msgString " ="; msgBreak(1, 2); + printSigExp sigexp; msgEBlock()) + +and printModExp _ = msgString "" +and printSigExp _ = msgString ""; + +; + + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Asynt.sml mosml-2.10.1/src/compiler.cminusminus/Asynt.sml --- mosml-2.01/src/compiler.cminusminus/Asynt.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Asynt.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,261 @@ +local + open Fnlib Mixture Const Globals Location Types; +in + +datatype IdKindDesc = + VARik + | FUNik + | STRik + | PRIMik of PrimInfo + | CONik of ConInfo + | EXCONik of ExConInfo +; + +type IdKind = IdKindDesc global; + +type IdDesc = +{ + idLoc : Location, + withOp : bool, + idKind : IdKind ref, + idFields: int list ref +}; + +type IdInfo = IdDesc global; + +(* Identifiers *) + +type LocString = Location * string; + +type VId = LocString; (* this should really just be string... *) +type TyCon = LocString; (* this should really just be Locstring... *) + +type ModId = LocString; +type FunId = LocString; +type SigId = LocString; + +type LongModId = IdInfo; +type LongModIdInfo = IdInfo * ((Environment option) ref); +type LongVId = IdInfo; +type LongTyCon = IdInfo; + +type TyVar = IdInfo; +type TyVarSeq = TyVar list; + + +datatype TyConPath' = + LONGtyconpath of LongTyCon + | WHEREtyconpath of LongTyCon * ModId * ModExp + +and Ty' = + TYVARty of TyVar + | RECty of Ty Row + | CONty of Ty list * TyConPath + | FNty of Ty * Ty + | PACKty of SigExp + | PARty of Ty + + +and InfixPat = + UNRESinfixpat of Pat list + | RESinfixpat of Pat +and Pat' = + SCONpat of SCon * Type option ref + | VARpat of LongVId + | WILDCARDpat + | NILpat of LongVId + | CONSpat of LongVId * Pat + | EXNILpat of LongVId + | EXCONSpat of LongVId * Pat + | EXNAMEpat of Lambda.Lambda (* The exnname rep used in Match.sml *) + | REFpat of Pat + | RECpat of RecPat ref + | VECpat of Pat list + | INFIXpat of InfixPat ref + | PARpat of Pat + | TYPEDpat of Pat * Ty + | LAYEREDpat of Pat * Pat + +and RecPat = + RECrp of Pat Row * RowType option + | TUPLErp of Pat list + +and VIdPathInfo = + RESvidpath of LongVId + | OVLvidpath of LongVId * OvlType * Type +and InfixExp = + UNRESinfixexp of Exp list + | RESinfixexp of Exp +and Exp' = + SCONexp of SCon * Type option ref + | VIDPATHexp of VIdPathInfo ref + | RECexp of RecExp ref + | VECexp of Exp list + | LETexp of Dec * Exp + | PARexp of Exp + | APPexp of Exp * Exp + | INFIXexp of InfixExp ref + | TYPEDexp of Exp * Ty + | ANDALSOexp of Exp * Exp + | ORELSEexp of Exp * Exp + | HANDLEexp of Exp * Match + | RAISEexp of Exp + | IFexp of Exp * Exp * Exp + | WHILEexp of Exp * Exp + | FNexp of Match + | SEQexp of Exp * Exp + | STRUCTUREexp of ModExp * SigExp * (ExMod option) ref + | FUNCTORexp of ModExp * SigExp * (ExMod option) ref + +and RecExp = + RECre of Exp Row + | TUPLEre of Exp list + +and MRule = MRule of (Pat list ref) * Exp + +and FunDec = + UNRESfundec of TyVarSeq * (FValBind list) + | RESfundec of Dec + +and Dec' = + VALdec of TyVarSeq * (ValBind list * ValBind list) + | PRIM_VALdec of TyVarSeq * (PrimValBind list) + | FUNdec of FunDec ref + | TYPEdec of TypBind list + | PRIM_TYPEdec of TyNameEqu * TypDesc list + | DATATYPEdec of DatBind list * TypBind list option + | DATATYPErepdec of TyCon * TyConPath + | ABSTYPEdec of DatBind list * TypBind list option * Dec + | EXCEPTIONdec of ExBind list + | LOCALdec of Dec * Dec + | OPENdec of LongModIdInfo list + | STRUCTUREdec of ModBind list + | FUNCTORdec of FunBind list + | SIGNATUREdec of SigBind list + | EMPTYdec + | SEQdec of Dec * Dec + | FIXITYdec of InfixStatus * string list + +and ValBind = ValBind of (Pat ref) * Exp + +and FClause = FClause of (Pat list ref) * Exp + +and ConBind = ConBind of IdInfo * Ty option + +and ExBind = + EXDECexbind of IdInfo * Ty option + | EXEQUALexbind of IdInfo * IdInfo + +and ModBind = MODBINDmodbind of ModId * ModExp + | ASmodbind of ModId * SigExp * Exp +and FunBind = + FUNBINDfunbind of FunId * ModExp + | ASfunbind of FunId * SigExp * Exp +and SigBind = SIGBINDsigbind of SigId * SigExp +and FunctorSort = + Generative of bool (* true if conforms to SML 97 *) + | Applicative +and ModExp' = + DECmodexp of Dec + | LONGmodexp of LongModId + | LETmodexp of Dec * ModExp + | PARmodexp of ModExp + | CONmodexp of ModExp * SigExp + | ABSmodexp of ModExp * SigExp + | FUNCTORmodexp of FunctorSort * ModId * (IdKindDesc ref) * SigExp * ModExp + | APPmodexp of ModExp * ModExp + | RECmodexp of ModId * (RecStr option) ref * SigExp * ModExp +and ModDesc = MODDESCmoddesc of ModId * SigExp +and FunDesc = FUNDESCfundesc of FunId * SigExp +and SigExp' = + SPECsigexp of Spec + | SIGIDsigexp of SigId + | WHEREsigexp of SigExp * TyVarSeq * LongTyCon * Ty + | FUNSIGsigexp of FunctorSort * ModId * SigExp * SigExp + | RECsigexp of ModId * SigExp * SigExp +and Spec' = + VALspec of TyVarSeq * ValDesc list + | PRIM_VALspec of TyVarSeq * (PrimValBind list) + | TYPEDESCspec of TyNameEqu * TypDesc list + | TYPEspec of TypBind list + | DATATYPEspec of DatBind list * TypBind list option + | DATATYPErepspec of TyCon * TyConPath + | EXCEPTIONspec of ExDesc list + | LOCALspec of Spec * Spec + | OPENspec of LongModIdInfo list + | EMPTYspec + | SEQspec of Spec * Spec + | INCLUDEspec of SigExp + | STRUCTUREspec of ModDesc list + | FUNCTORspec of FunDesc list + | SHARINGTYPEspec of Spec * LongTyCon list + | SHARINGspec of Spec * (Location * LongModId list) + | FIXITYspec of InfixStatus * string list + | SIGNATUREspec of SigBind list + + +and Sig = + NamedSig of {locsigid : SigId, sigexp: SigExp} + | AnonSig of Spec list + | TopSpecs of Spec list + +and Struct = + NamedStruct of {locstrid : ModId, locsigid : SigId option, + decs : Dec list} + | Abstraction of {locstrid : ModId, locsigid : SigId, + decs : Dec list} + | AnonStruct of Dec list + | TopDecs of Dec list + +withtype TyConPath = Location * TyConPath' +and Ty = Location * Ty' +and Pat = Location * Pat' +and Exp = Location * Exp' +and ModExp = Location * (ModExp' * (ExMod option) ref) +and SigExp = Location * SigExp' +and Spec = Location * Spec' +and ValDesc = IdInfo * (Location * Ty') + (* IdInfo * Ty *) +and ExDesc = IdInfo * (Location * Ty') option + (* IdInfo * Ty option *) +and LocString = Location * string +and Match = MRule list +and Dec = Location * Dec' +and PrimValBind = IdInfo * (Location * Ty') * int * string + (* IdInfo * Ty * int * string *) +and FValBind = Location * FClause list +and TypBind = TyVarSeq * TyCon * (Location * Ty') + (* TyVar list * IdInfo * Ty *) +and TypDesc = TyVarSeq * TyCon +and DatBind = TyVarSeq * TyCon * ConBind list + + + +end; + + + + + + + + + + + + + + + + + + + + + + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Back.sig mosml-2.10.1/src/compiler.cminusminus/Back.sig --- mosml-2.01/src/compiler.cminusminus/Back.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Back.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1 @@ +val compileLambda: bool -> Lambda.Lambda -> Instruct.ZamPhrase; diff -Nru mosml-2.01/src/compiler.cminusminus/Back.sml mosml-2.10.1/src/compiler.cminusminus/Back.sml --- mosml-2.01/src/compiler.cminusminus/Back.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Back.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,877 @@ +(* back.sml : translation of lambda terms to lists of instructions. *) + +(* 1996.07.27 -- e *) + +open List Fnlib Mixture Const Lambda Prim Instruct; + +(* "isReturn" determines if we're in tail call position. *) + +fun isReturn (Kreturn _ :: _ ) = true + | isReturn (Klabel _ :: Kreturn _ :: _ ) = true + | isReturn _ = false +; + +(* Label generation *) + +val labelCounter = ref 0; + +fun resetLabel() = + labelCounter := 0 +; + +fun new_label() = + (incr labelCounter; !labelCounter) +; + +(* the label ref in an Lshared node is used as follows: + NoLabel -> (~1) initial value + n < 0 -> seen by the nth pass of unref + n >= 0 -> a real label, code has been emitted + Whenever a Lshared node is processed by a rewriter, + its label ref is set to !labelNotCtr. The counter is + bumped by each rewrite in UNdeBruijn's lftexp. +*) + +val labelNotCtr = ref Nolabel; (* for Lshared *) + +fun resetLabelNot() = + labelNotCtr := Nolabel - 1 +; + +fun newLabelNot() = + (decr labelNotCtr; !labelNotCtr) +; + + +(* Name generation *) + +val NameCounter = ref 100 + +fun resetName() = + NameCounter := 0 + + +fun new_name() = + (incr NameCounter; !NameCounter) + + + + +(* Add a label to a list of instructions. *) + +fun labelCode C = + case C of + Kbranch lbl :: _ => + (lbl, C) + | Klabel lbl :: _ => + (lbl, C) + | _ => + let val lbl = new_label() + in (lbl, Klabel lbl :: C) end +; + +(* Generate a branch to the given list of instructions. *) + +fun makeBranch C = + case C of + (return as Kreturn _) :: _ => (return, C) + | (branch as Kbranch _) :: _ => (branch, C) + | Kraise :: _ => (Kraise, C) + | Klabel _ :: (return as Kreturn _) :: _ => (return, C) + | Klabel lbl :: _ => (Kbranch lbl, C) + | _ => + let val lbl = new_label() + in (Kbranch lbl, Klabel lbl :: C) end +; + +(* Discard all instructions up to the next label. *) + +fun discardDeadCode C = + case C of + [] => [] + | Klabel _ :: _ => C + | Kname _ :: _ => C + | Kcontinuation _ :: _ => C + | Krestart :: _ => C + | Kset_global _ :: _ => C + | _ :: rest => discardDeadCode rest +; + +(* compile time model of runtime environment + mapping Lvar id to stack or heapenv offsets + fv is freevars, a list; position of negative id is the runtime env index + va is vararray, an array mapping positive ids to stack index +*) + +(* The nullEnv is used for compiling the initialization code of a + unit. A size of 4000 seems generous; the required number rarely + exceeds 200. The compiler reports Internal error: bindEnv if this + table is too small. *) + +val nullEnv = ([],Array.array(4000,(~1))) : int list * int Array.array; + +fun makeEnv fv maxstk = (fv, Array.array(maxstk,(~1))); + +fun findEnv (fv,va) sz n = + if n < 0 + then let fun f i [] = fatalError ("findEnv fv n: " ^ (makestring n)) + | f i (x::r) = if x = n then Kenvacc i else f (i + 1) r + in f 0 fv end + else let val i = Array.sub (va,n) + in if i < 0 then fatalError "findEnv va1" else Kaccess (sz - i) end + handle Subscript => fatalError ("findEnv va2 n: " ^ (makestring n)) +; +fun findStk (fv,va) sz n = + if n < 0 + then fatalError ("findStk n: " ^ (makestring n)) + else let val i = Array.sub (va,n) + in if i < 0 then fatalError "findStk va1" else Kassign (sz - i) end + handle Subscript => fatalError ("findStk va2 n: " ^ (makestring n)) +; + +(* e -- note: this destroys the env *) + +fun bindEnv (fv,va) n z = + let val n' = n + 1 + in + Array.update (va,n,z); (* not n' !? *) + n' + end + handle Subscript => fatalError "bindEnv" +; + +(* *) + + fun addPop n C = + if n = 0 then C + else + case C of + Kpop m :: C => addPop (n + m) C + | Kreturn m :: C => Kreturn (n + m) :: C + | Klabel _ :: Kreturn m :: _ => Kreturn (n + m) :: C + | Kraise :: _ => C + | _ => Kpop n :: C + +(* Generate a jump through table, unless unnecessary. *) + +exception JumpOut; + +fun add_SwitchTable switchtable C = + let open Array infix 9 sub in + (for (fn i => if (switchtable sub i) <> (switchtable sub 0) then + raise JumpOut + else ()) + 1 (length switchtable - 1); + case C of + Klabel lbl :: C1 => + if lbl = (switchtable sub 0) then C + else + Kbranch (switchtable sub 0) :: discardDeadCode C + | _ => + Kbranch (switchtable sub 0) :: discardDeadCode C) + handle JumpOut => + Kswitch switchtable :: C + end; + +(* Compiling N-way integer branches *) + +(* Input: a list of (key, action) pairs, where keys are integers. *) +(* Output: a decision tree with the format below *) + +datatype DecisionTree = + DTfail + | DTinterval of DecisionTree * Decision * DecisionTree + +withtype Decision = +{ + low: int, + act: Lambda Array.array, + high: int +}; + +fun compileNBranch int_of_key clauses = + let open Array infix 9 sub + val clauses_i = + map (fn (key, act) => (int_of_key key : int, act)) clauses + val clauses_s = + Sort.sort (fn (key1, act1) => fn (key2, act2) => key1 <= key2) + clauses_i + val keyv = Array.fromList (map fst clauses_s) + val actv = Array.fromList (map snd clauses_s) + val n = length keyv + fun extractAct start stop = + let val a = + array((keyv sub stop) - (keyv sub start) + 1, Lstaticfail) + in + for (fn i => + update(a, (keyv sub i) - (keyv sub start), actv sub i)) + start stop; + a + end + (* Now we partition the set of keys keyv into maximal + dense enough segments. A segment is dense enough + if its span (max point - min point) is less + than four times its size (number of points). *) + fun partition start = + if start >= n then [] else + let val stop = ref (n-1) in + while (keyv sub !stop) - (keyv sub start) >= 255 orelse + (keyv sub !stop) - (keyv sub start) > 4 * (!stop - start) + do decr stop; + (* We've found a segment that is dense enough. + In the worst case, !stop = start and the segment is + a single point *) + (* Now build the vector of actions *) + { low = keyv sub start, + act = extractAct start (!stop), + high = keyv sub !stop } :: partition (!stop + 1) + end + val part = Array.fromList (partition 0) + (* We build a balanced binary tree *) + fun make_tree start stop = + if start > stop then + DTfail + else + let val middle = (start + stop) div 2 in + DTinterval(make_tree start (middle-1), + part sub middle, + make_tree (middle+1) stop) + end + in make_tree 0 (length part - 1) end +; + +(* Inversion of a boolean test ( < becomes >= and so on) *) + +val invertPrimTest = fn + PTeq => PTnoteq + | PTnoteq => PTeq + | PTnoteqimm x => fatalError "invertPrimTest" + | PTlt => PTge + | PTle => PTgt + | PTgt => PTle + | PTge => PTlt +; + +val invertBoolTest = fn + Peq_test => Pnoteq_test + | Pnoteq_test => Peq_test + | Pint_test t => Pint_test(invertPrimTest t) + | Pfloat_test t => Pfloat_test(invertPrimTest t) + | Pstring_test t => Pstring_test(invertPrimTest t) + | Pword_test t => Pword_test(invertPrimTest t) + | Pnoteqtag_test t => fatalError "invertBoolTest" +; + +(* Production of an immediate test *) + +val testForAtom = fn + INTscon x => Pint_test(PTnoteqimm x) + | WORDscon x => Pword_test(PTnoteqimm x) + | CHARscon x => Pint_test(PTnoteqimm (Char.ord x)) + | REALscon x => Pfloat_test(PTnoteqimm x) + | STRINGscon x => Pstring_test(PTnoteqimm x) +; + +(* To keep track of function bodies that remain to be compiled. *) + +(* ... a stack of (lbl, nargs, free var ids list, max id, body) *) + +val stillToCompile = (Stack.new () : (int * int * int list * int * Lambda) Stack.t); + +(* translation of lambda-deBruijn to lambda-merged-stkdepth + this requires giving all the Lvars unique ids within the enclosing function + [well, kinda. unique within their scope, anyway] + to do this requires maintaining an rstack depth model + then the translation is simply: deBruijn -> depth - deBruijn - 1 + + all functions are lifted to top level simultaneously + as a result all free variables have negative ids + a closure map is constructed for compileRest + an Lfn is replaced with the closure constuction code +*) + +fun UNdeBruijn exp = + let + exception Refs'R'Us + val fv = ref [] + val md = ref 0 + + fun ins x [] = [x] + | ins x (ls as (y::r)) = + if x > y then x :: ls + else if x = y then ls + else let val z = ins x r in if z = r then ls else y :: z end + + fun extClo id = + if id >= 0 then () + else fv := (ins id (!fv)) + + fun unref i exp = (* turn refs from heap into stack cells *) + case exp of + Lvar n => (* oops, maybe it's a real reference *) + if n = i then raise Refs'R'Us else exp + | Lassign (n,exp') => (* we'd only see n = i in an Lshared node? *) + Lassign(n, unref i exp') + | Lconst cst => + exp + | Lapply(body, args) => + Lapply(unref i body, List.map (unref i) args) + | Lfn body => + fatalError "UNdeBruijn/unref Lfn!?" + | Llet(args, body) => + Llet(List.map (unref i) args, unref i body) + | Lletrec(args, body) => + Lletrec(List.map (unref i) args, unref i body) + | Lprim(Pfield 0, [opt as (Lvar v)]) => + if v = i + then opt + else exp + | Lprim(Psetfield 0, [Lvar v, e]) => + if v = i + then Lassign (i, unref i e) (* new *) + else Lprim(Psetfield 0, [Lvar v, unref i e]) + | Lprim(p, explist) => + Lprim(p, List.map (unref i) explist) + | Lstatichandle(body, handler) => + Lstatichandle(unref i body, unref i handler) + | Lstaticfail => + Lstaticfail + | Lhandle(body, handler) => + Lhandle(unref i body, unref i handler) + | Lif(cond, ifso, ifnot) => + Lif(unref i cond, unref i ifso, unref i ifnot) + | Lseq(exp1, exp2) => + Lseq(unref i exp1, unref i exp2) + | Lwhile(cond, body) => + Lwhile(unref i cond, unref i body) + | Landalso(exp1, exp2) => + Landalso(unref i exp1, unref i exp2) + | Lorelse(exp1, exp2) => + Lorelse(unref i exp1, unref i exp2) + | Lcase(arg, clauses) => + Lcase(unref i arg, + List.map (fn (tag,act) => (tag, unref i act)) clauses) + | Lswitch(size, arg, clauses) => + Lswitch(size, unref i arg, + List.map (fn (tag,act) => (tag, unref i act)) clauses) + | Lunspec => + Lunspec + | Lshared(exp_ref, lbl_ref) => + if !lbl_ref <> !labelNotCtr + then ( lbl_ref := !labelNotCtr; + exp_ref := unref i (!exp_ref); + exp ) + else exp + + fun lftexp depth exp = + (if depth > !md then md := depth else (); + case exp of + Lvar n => + let val id = (depth - n - 1) + in extClo id; Lvar id end + | Lassign (n,exp') => + let val id = (depth - n - 1) + in extClo id; Lassign (id,lftexp depth exp') end + | Lconst cst => exp + | Lapply(body, args) => Lapply(lftexp depth body, List.map (lftexp depth) args) + | Lfn body => + let val (qfv, exp') = UNdeBruijn exp (* recurse *) + in if qfv > 0 then lftexp depth exp' else exp' end + (* Optimize special case arising from #lab arg *) + | Llet([arg], Lprim(p, [Lvar 0])) => + Lprim(p, [lftexp depth arg]) + | Llet(args, body) => + let fun opt_refs body' i [] acc = + Llet(acc, body') + | opt_refs body' i (* do we care what the tag is? *) + ((exp as Lprim(Pmakeblock(CONtag(refTag,1)),[e])) + ::rest) acc = + (let val lnot = newLabelNot() + (* val () = BasicIO.print ("Optref: " ^ (makestring lnot)) *) + val acc' = List.map (unref i) acc + val body'' = unref i body' + in (* BasicIO.print " $\n"; *) + opt_refs body'' (i - 1) rest (e::acc') + end + handle Refs'R'Us => + ( (* BasicIO.print ("\n"); *) + opt_refs body' (i - 1) rest (exp::acc) ) ) + | opt_refs body' i (exp::rest) acc = + opt_refs body' (i - 1) rest (exp::acc) + fun lift_args ea [] acc = + opt_refs (lftexp ea body) (ea - 1) acc [] + | lift_args ea (exp::rest) acc = + lift_args (ea + 1) rest ((lftexp ea exp) :: acc) + in lift_args depth args [] end + | Lletrec(args, body) => + let val ea = depth + (List.length args) + in Lletrec(List.map (lftexp ea) args, lftexp ea body) end + | Lprim(p, explist) => Lprim(p, List.map (lftexp depth) explist) + | Lstatichandle(body, handler) => + Lstatichandle(lftexp depth body, lftexp depth handler) + | Lstaticfail => Lstaticfail + | Lhandle(body, handler) => + Lhandle(lftexp depth body, lftexp (depth + 1) handler) + | Lif(cond, ifso, ifnot) => Lif(lftexp depth cond, lftexp depth ifso, lftexp depth ifnot) + | Lseq(exp1, exp2) => Lseq(lftexp depth exp1, lftexp depth exp2) + | Lwhile(cond, body) => Lwhile(lftexp depth cond, lftexp depth body) + | Landalso(exp1, exp2) => Landalso(lftexp depth exp1, lftexp depth exp2) + | Lorelse(exp1, exp2) => Lorelse(lftexp depth exp1, lftexp depth exp2) + | Lcase(arg, clauses) => + Lcase(lftexp depth arg, List.map (fn (tag,act) => (tag, lftexp depth act)) clauses) + | Lswitch(size, arg, clauses) => + Lswitch(size, lftexp depth arg, List.map (fn (tag,act) => (tag, lftexp depth act)) clauses) + | Lunspec => Lunspec + | Lshared(exp_ref, lbl_ref) => + if !lbl_ref = Nolabel + then ( lbl_ref := !labelNotCtr; + exp_ref := lftexp depth (!exp_ref); + exp ) + else exp + ) + + fun liftbd depth exp = (* called with the body of an Lfn *) + let val exp' = lftexp depth exp + val lbl = new_name() + val fre = List.map (fn id => Lvar ((~1) - id)) (!fv) + val qfv = List.length fre + val exp'' = Lprim(Pclosure (lbl, qfv), fre) + in + Stack.push (lbl, depth, !fv, !md, exp') stillToCompile; + (* Pr_lam.printLam exp'; -- e *) + (* Pr_lam.printLam exp''; -- e *) + (qfv, exp'') + end + + fun liftfn depth exp = + case exp of + Lfn body => liftfn (depth + 1) body + | _ => liftbd depth exp + + fun liftit depth exp = + case exp of + Lfn body => liftfn (depth + 1) body + | _ => let val exp' = lftexp depth exp in (List.length (!fv), exp') end + + in liftit 0 exp end +; + +(* The translator from lambda terms to lists of instructions. + + env: the map from Lvar ids to stackptr offsets; side-effected + staticfail : the pair (label,sz) where Lstaticfail must branch. + sz: the current runtime stack model depth (includes codegen temporaries) + dp: the depth of the Front.sml stack model (excludes codegen temporaries) + exp : the lambda term to compile. + C : the continuation, i.e. the code that follows the code for lambda. + + The tests on the continuation detect tail-calls and avoid jumps to jumps, + or jumps to function returns. + +*) + +fun compileExp env staticfail = + let + open Array infix 9 sub + + fun compexp sz dp exp C = + case exp of + Lvar n => + (findEnv env sz n) :: C + | Lassign (n,exp') => + compexp sz dp exp' ((findStk env sz n) :: C) + | Lconst cst => + (case C of + Kquote _ :: _ => C + | Kget_global _ :: _ => C + | Kaccess _ :: _ => C + | Kenvacc _ :: _ => C + | _ => Kquote cst :: C) + | Lapply(body, args) => + let val na = List.length args + in + if isReturn C + then compExpList sz dp args + (Kpush :: compexp (sz + na) dp body + (Kappterm (na, sz + na) :: discardDeadCode C)) + else (*if na < 5 + then compExpList sz dp args + (Kpush :: compexp (sz + na) dp body (Kapply na :: C)) + else*) + (* 2 is the number of stack positions used by Kpush_retaddr *) + let val (lbl, C1) = labelCode C + in Kpush_retaddr lbl :: + compExpList (sz + 2) dp args + (Kpush :: compexp (sz + 2 + na) dp body (Kapply na :: C1)) + end + end + | Lfn body => + fatalError "compileExp Lfn!?" + (* Special case arising from val _ = arg *) + | Llet([arg], Lunspec) => compexp sz dp arg C + | Llet(args, body) => + let val na = List.length args + fun complet sz dp [] = + compexp sz dp body (addPop na C) + | complet sz dp (exp::rest) = + let val z = sz + 1 + in + compexp sz dp exp + (Kpush :: complet z (bindEnv env dp z) rest) + end + in complet sz dp args end + | Lletrec([e as Lprim(Pclosure (lbl, csz), fre)], body) => + let val z = sz + 1 + val d = bindEnv env dp z + val C1 = Kpush :: compexp z d body (addPop 1 C) + in + case fre of + (Lvar n)::rest => + if n = dp + then compExpList sz dp rest (Kclosurerec (lbl, csz) :: C1) + else compExpList sz dp fre (Kclosure (lbl, csz) :: C1) + | [] => Kclosure (lbl, 0) :: C1 + | _ => fatalError "compileExp: malformed Letrec!?" + end + | Lletrec(args, body) => + let val na = List.length args + fun comparg sz dp i [] = + compexp sz dp body (addPop na C) + | comparg sz dp i ((e as Lprim(Pclosure (lbl, csz), fre)) :: r) = + compexp sz dp e + (Kpush :: Kaccess i :: Kprim Pupdate :: comparg sz dp (i-1) r) + | comparg _ _ _ _ = + fatalError "compileExp Lletrec" + fun initarg sz dp [] = + comparg sz dp na args + | initarg sz dp (Lprim(Pclosure (lbl, csz), fre) :: r) = + let val z = sz + 1 + in + Kprim (Pdummy csz) :: Kpush :: initarg z (bindEnv env dp z) r + end + | initarg _ _ (e::_) = + ((* Pr_lam.printLam e; *) + fatalError "compileExp Lletrec") + in + initarg sz dp args + end + | Lprim(Psmladdint, [exp, Lconst(ATOMsc(INTscon 1))]) => + compexp sz dp exp (Kprim Psmlsuccint :: C) + | Lprim(Psmlsubint, [exp, Lconst(ATOMsc(INTscon 1))]) => + compexp sz dp exp (Kprim Psmlpredint :: C) + | Lprim(Pget_global uid, []) => + Kget_global uid :: C + | Lprim(Pset_global uid, [exp]) => + compexp sz dp exp (Kset_global uid :: C) + | Lprim(Pfield i, explist) => + compExpListLR sz dp explist (Kgetfield i :: C) + | Lprim(Psetfield i, explist) => + compExpListLR sz dp explist (Ksetfield i :: C) + | Lprim(Pmakeblock tag, explist) => + compExpListLR sz dp explist + (Kmakeblock(tag, List.length explist) :: C) + | Lprim(Pnot, [exp]) => + (case C of + Kbranchif lbl :: C' => + compexp sz dp exp (Kbranchifnot lbl :: C') + | Kbranchifnot lbl :: C' => + compexp sz dp exp (Kbranchif lbl :: C') + | _ => + compexp sz dp exp (Kprim Pnot :: C)) + | Lprim(p as Ptest tst, explist) => + (case C of + Kbranchif lbl :: C' => + compExpListLR sz dp explist (Ktest(tst,lbl) :: C') + | Kbranchifnot lbl :: C' => + compExpListLR sz dp explist (Ktest(invertBoolTest tst,lbl) :: C') + | _ => + compExpListLR sz dp explist (Kprim p :: C)) + | Lprim(Praise, explist) => + compExpListLR sz dp explist (Kraise :: discardDeadCode C) + | Lprim(Pclosure (lbl, csz), explist) => + compExpList sz dp explist (Kclosure (lbl, csz) :: C) + (* This enables merging of pop, return, etc *) + | Lprim(Pidentity, explist) => + compExpListLR sz dp explist C + | Lprim(p, explist) => + compExpListLR sz dp explist (Kprim p :: C) + | Lstatichandle(body, Lstaticfail) => + compexp sz dp body C + | Lstatichandle(body, handler) => + let val (branch1, C1) = makeBranch C + val (handle2, C2) = labelCode (compexp sz dp handler C1) + in + compileExp env (handle2, sz) sz dp body + (branch1 :: discardDeadCode C2) + end + | Lstaticfail => + let val (lbl,tsz) = staticfail + in addPop (sz - tsz) (Kbranch lbl :: discardDeadCode C) end + | Lhandle(body, handler) => + let val (branch1, C1) = makeBranch C + val lbl2 = new_label() + val z = sz + 1 + in + Kpushtrap lbl2 :: + compexp (sz + 4) dp body + (Kpoptrap :: branch1 + :: Kcontinuation lbl2 :: Kpush + :: compexp z (bindEnv env dp z) handler (addPop 1 C1)) + end + | Lif(cond, ifso, ifnot) => + compTest2 sz dp cond ifso ifnot C + | Lseq(exp1, exp2) => + compexp sz dp exp1 (compexp sz dp exp2 C) + | Lwhile(cond, body) => + let val lbl2 = new_label() + val (lbl1, C1) = labelCode (compexp sz dp cond + (Kbranchif lbl2 :: Kquote constUnit :: C)) + in + Kbranch lbl1 :: Klabel lbl2 :: Kcheck_signals :: compexp sz dp body C1 + end + | Landalso(exp1, exp2) => + (case C of + Kbranch lbl :: _ => + compexp sz dp exp1 (Kstrictbranchifnot lbl :: compexp sz dp exp2 C) + | Kbranchifnot lbl :: _ => + compexp sz dp exp1 (Kbranchifnot lbl :: compexp sz dp exp2 C) + | Kbranchif lbl :: C' => + let val (lbl1, C1) = labelCode C' in + compexp sz dp exp1 (Kbranchifnot lbl1 :: + compexp sz dp exp2 (Kbranchif lbl :: C1)) + end + | Klabel lbl :: _ => + compexp sz dp exp1 (Kstrictbranchifnot lbl :: compexp sz dp exp2 C) + | _ => + let val lbl = new_label() in + compexp sz dp exp1 (Kstrictbranchifnot lbl :: + compexp sz dp exp2 (Klabel lbl :: C)) + end) + | Lorelse(exp1, exp2) => + (case C of + Kbranch lbl :: _ => + compexp sz dp exp1 (Kstrictbranchif lbl :: compexp sz dp exp2 C) + | Kbranchif lbl :: _ => + compexp sz dp exp1 (Kbranchif lbl :: compexp sz dp exp2 C) + | Kbranchifnot lbl :: C' => + let val (lbl1, C1) = labelCode C' in + compexp sz dp exp1 (Kbranchif lbl1 :: + compexp sz dp exp2 (Kbranchifnot lbl :: C1)) + end + | Klabel lbl :: _ => + compexp sz dp exp1 (Kstrictbranchif lbl :: compexp sz dp exp2 C) + | _ => + let val lbl = new_label() in + compexp sz dp exp1 (Kstrictbranchif lbl :: + compexp sz dp exp2 (Klabel lbl :: C)) + end) + + | Lcase(arg, clauses) => + let val C1 = + if case clauses of + (INTscon _, _) :: _ => true + | (WORDscon _, _) :: _ => true + | (CHARscon _, _) :: _ => true + | _ => false + then + compDecision sz dp (compileNBranch intOfAtom clauses) C + else + compTests sz dp + (map (fn (cst, act) => (testForAtom cst, act)) clauses) C + in compexp sz dp arg C1 end + + | Lswitch(1, arg, [(CONtag(_,_), exp)]) => + compexp sz dp exp C + (* We assume the argument to be safe (not producing side-effects + and always terminating), + because switches are generated only by the match compiler *) + | Lswitch(2, arg, [(CONtag(0,_), exp0)]) => + compTest2 sz dp arg Lstaticfail exp0 C + | Lswitch(2, arg, [(CONtag(1,_), exp1)]) => + compTest2 sz dp arg exp1 Lstaticfail C + | Lswitch(2, arg, [(CONtag(0,_), exp0), (CONtag(1,_), exp1)]) => + compTest2 sz dp arg exp1 exp0 C + | Lswitch(2, arg, [(CONtag(1,_), exp1), (CONtag(0,_), exp0)]) => + compTest2 sz dp arg exp1 exp0 C + | Lswitch(size, arg, clauses) => + let val C1 = + if List.length clauses >= size - 5 then + Kprim Ptag_of :: compDirectSwitch sz dp size clauses C + else + Kprim Ptag_of :: + compDecision sz dp (compileNBranch intOfAbsoluteTag clauses) C + in compexp sz dp arg C1 end + | Lunspec => + C + | Lshared(exp_ref, lbl_ref) => + if !lbl_ref < 0 then + let val (lbl, C1) = labelCode (compexp sz dp (!exp_ref) C) + in + lbl_ref := lbl; C1 + end + else + Kbranch (!lbl_ref) :: discardDeadCode C + + (* Compile right-left evaluation of args of functions *) + and compExpList' sz dp [] C = C + | compExpList' sz dp [exp] C = compexp sz dp exp C + | compExpList' sz dp (exp::rest) C = + compExpList' (sz - 1) dp rest (Kpush :: compexp sz dp exp C) + + and compExpList sz dp ls C = + compExpList' (sz + List.length ls - 1) dp ls C + + (* Compile left-right evaluation of args of primitives *) + and compExpListLR' sz dp [] C = C + | compExpListLR' sz dp [exp] C = compexp sz dp exp C + | compExpListLR' sz dp (exp::rest) C = + compexp sz dp exp (Kpush :: compExpListLR' (sz + 1) dp rest C) + + and compExpListLR sz dp ls C = compExpListLR' sz dp ls C + + and compTest2 sz dp cond ifso ifnot C = + let val (sflbl,sftsz) = staticfail + val Cc = +(* This optimization is rather ill-considered. It works if the result () + of the switch is disregarded, but otherwise it fails. sestoft 2000-04-26 + + if ifnot = Lconst constUnit + then let val (lbl, C1) = labelCode C + in Kstrictbranchifnot lbl :: compexp sz dp ifso C1 end + else *) + + if ifso = Lstaticfail andalso sz = sftsz + then Kbranchif sflbl :: compexp sz dp ifnot C + else + if ifnot = Lstaticfail andalso sz = sftsz + then Kbranchifnot sflbl :: compexp sz dp ifso C + else + let val (branch1, C1) = makeBranch C + val (lbl2, C2) = labelCode (compexp sz dp ifnot C1) + in + Kbranchifnot lbl2 :: compexp sz dp ifso + (branch1 :: discardDeadCode C2) + end + in + compexp sz dp cond Cc + end + + and compTests sz dp clauses C = + let val (branch1, C1) = makeBranch C + val (sflbl,sftsz) = staticfail + val () = if sz <> sftsz then fatalError "compTests sz" else () (* e -- assert ?? *) + fun comp [] = + fatalError "compTests" + | comp [(test,exp)] = + Ktest(test, sflbl) :: compexp sz dp exp C1 + | comp ((test,exp)::rest) = + let val lbl = new_label() in + Ktest(test, lbl) :: + compexp sz dp exp (branch1 :: Klabel lbl :: comp rest) + end + in comp clauses end + + and compSwitch sz dp v branch1 C = + let val (sflbl,sftsz) = staticfail + val switchtable = array(length v, sflbl) + fun comp_cases n = + if n >= length v then + C + else + let val (lbl, C1) = + labelCode (compexp sz dp (v sub n) + (branch1 :: discardDeadCode (comp_cases (n+1)))) + in + update(switchtable, n, lbl); C1 + end + in add_SwitchTable switchtable (discardDeadCode(comp_cases 0)) end + + and compDecision sz dp tree C = + let val (branch1, C1) = makeBranch C + val (sflbl,sftsz) = staticfail + val () = if sz <> sftsz then fatalError "compDecision sz" else () (* e -- assert ?? *) + fun comp_dec DTfail C = + Kbranch sflbl :: discardDeadCode C + | comp_dec (DTinterval(left, dec, right)) C = + let val (lbl_right, Cright) = + case right of + DTfail => (sflbl, C) + | _ => labelCode (comp_dec right C) + val (lbl_left, Cleft) = + case left of + DTfail => (sflbl, Cright) + | _ => labelCode (comp_dec left Cright) + val {low, act, high} = dec + in + Kbranchinterval(low, high, lbl_left, lbl_right) :: + (case length act of + 1 => compexp sz dp (act sub 0) + (branch1 :: discardDeadCode Cleft) + | _ => compSwitch sz dp act branch1 Cleft) + end + in comp_dec tree C1 end + + and compDirectSwitch sz dp size clauses C = + let val (branch1, C1) = makeBranch C + val (sflbl,sftsz) = staticfail + val () = if sz <> sftsz andalso size <> (List.length clauses) + then fatalError "compDirectSwitch sz" else () (* e -- assert ?? *) + val switchtable = array(size, sflbl) + fun comp_case [] = + fatalError "compDirectSwitch" + | comp_case [(tag, exp)] = + let val (lbl, C2) = labelCode (compexp sz dp exp C1) in + update(switchtable, intOfAbsoluteTag tag, lbl); + C2 + end + | comp_case ((tag, exp) :: rest) = + let val (lbl, C2) = + labelCode (compexp sz dp exp + (branch1 :: discardDeadCode (comp_case rest))) + in + update(switchtable, intOfAbsoluteTag tag, lbl); + C2 + end + in add_SwitchTable switchtable (discardDeadCode(comp_case clauses)) end + + in compexp end +; + +fun compileRest C = + let val (lbl, nargs, fv, maxstk, exp) = Stack.pop stillToCompile + val env = makeEnv fv maxstk + fun inienv a sz = if a < nargs + then inienv (bindEnv env a sz) (sz - 1) + else () + val () = inienv 0 nargs + val restart_lbl = new_name() + val restart_fun = [Kname restart_lbl, Knewrestart lbl] + +(* val C' = compileExp env (Nolabel, 0) nargs nargs exp + (Kreturn nargs :: discardDeadCode C) +*) + val C' = compileExp env (Nolabel, 0) nargs nargs exp [Kreturn nargs] + in + compileRest (List.@(if nargs > 1 + then [restart_fun, + Kname lbl :: + Knewgrab (restart_lbl, nargs - 1) :: C'] + else [Kname lbl :: C'], C)) + end + handle Stack.Empty => C + + +fun compileLambda is_pure exp = + let val () = Stack.clear stillToCompile + (*val () = resetLabel() *) (* In C-- labels have global scope *) + (*val () = resetLabelNot()*) + val (qfv, exp') = UNdeBruijn exp (* e -- could check: qfv = 0 *) + val init_code = + compileExp nullEnv (Nolabel, 0) 0 0 exp' [] + val function_code = + compileRest [] + in + { kph_is_pure = is_pure, + kph_inits = init_code, + kph_funcs = function_code } + end; diff -Nru mosml-2.01/src/compiler.cminusminus/Buffcode.sml mosml-2.10.1/src/compiler.cminusminus/Buffcode.sml --- mosml-2.01/src/compiler.cminusminus/Buffcode.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Buffcode.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,47 @@ +(* To buffer bytecode during emission *) + +local + open Obj Fnlib Mixture Config Opcodes; + + prim_val andb_ : int -> int -> int = 2 "and"; + prim_val rshiftsig_ : int -> int -> int = 2 "shift_right_signed"; + prim_val rshiftuns_ : int -> int -> int = 2 "shift_right_unsigned"; + + fun make_buffer n = CharArray.array(n, #"\000"); + +in + +val out_buffer = ref (make_buffer 64); +val out_position = ref 0; + +fun realloc_out_buffer () = + let val len = CharArray.length (!out_buffer) + val new_buffer = make_buffer (2 * len) + in + CharArray.copy { src = !out_buffer, dst = new_buffer, di = 0 }; + out_buffer := new_buffer + end; + +fun init_out_code () = (out_position := 0); + +fun out (b : int) = +( + if !out_position < CharArray.length (!out_buffer) then () else + realloc_out_buffer(); + CharArray.update(!out_buffer, !out_position, Char.chr(andb_ b 255)); + incr out_position +); + +fun out_short s = + (out s; out (rshiftuns_ s 8)) +; + +fun out_long l = +( + out l; + out (rshiftuns_ l 8); + out (rshiftuns_ l 16); + out (rshiftsig_ l 24) +); + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/CmmAST.sml mosml-2.10.1/src/compiler.cminusminus/CmmAST.sml --- mosml-2.01/src/compiler.cminusminus/CmmAST.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/CmmAST.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,108 @@ +(* Abstract syntax for C--, nicked from Fermin Reig and heavily modified. *) +(* Ken Friis Larsen *) +structure CmmAST = +struct + +datatype toplevel = Imports of typ * (name option * name) list + | Exports of typ option * (name * name option) list + | Typedef of name * name + | Data of sectionname * pseudoop list + | Target of memsize option * byteorder + | Function of { conv : conv + , name : name + , formals : formal list + , stmts : stmts + } + +and byteorder = Little | Big + +and typ = Bits8 | Bits16 | Bits32 | Bits64 + +and stmt = DeclReg of formal + | DeclStackData of StackDatum list + | Assign of lvalue * expr + | If of expr * stmts * stmts option + | Switch of expr * range option * swt list + | Label of label + | Goto of label + | ComputedGoto of expr * label list + | Jump of conv * expr * actual list * target list + | Call of reg list * conv * expr * actual list * + target list * flow list + | Return of conv * actual list + | Continuation of name * reg list + | Cut of expr * actual list * flow list + | Comment of string + | Block of stmt list (* For easier assembly *) + | SafePoint + | MarkStmt of stmt * srcpos + +and lvalue = Var of name + | Mem of typ * expr * align option + +and expr = LitInt of literalInt + | LitFloat of literalFloat + | LitChar of literalChar + | Fetch of lvalue + | Prim of name * actual list + | EComment of expr * string + + +and flow = Aborts + | Cuts of name list + | Unwinds of name list + | Returns of name list + +and pseudoop = DataLabel of label + | DataExports of name list +(* | DataWord of typesize * int * const_expr list + (* repeat, constant exprs *) + | DataFloat of typesize * int * literalFloat list + *) (* repeat *) + | DataString of string + | DataAlign of align (* # of Bytes *) + | DataComm of name * const_expr * align option + (* size, align *) + | DataLcomm of name * const_expr * align option + (* size, align *) + +and StackDatum = StackLabel of label +(* | StackSpace of typesize * int (* size, repeat *) +*) | StackAlign of align + +and swt = Swt of (int list) * stmts + | SwtDefault of stmts + +(* Compile-time expressions. Addr, but never a Reg, StackL, etc *) +and const_expr = ConstExpr of expr + +(* Calling Convention *) +and conv = Cmm | Ccall + +withtype + program = toplevel list +and filename = string +and memsize = int +and sectionname = string +and name = string +and label = string +and target = string +and reg = string +and align = int (* in bytes; a power of two *) +and range = int * int +and actual = expr +and formal = typ * string (*reg*) +and literalInt = string +and literalFloat = string +and literalChar = string +and srcpos = int * int +and stmts = stmt list +and exprs = expr list + +(* An empty statement *) +val NOP = Block [] + +end + + + diff -Nru mosml-2.01/src/compiler.cminusminus/cmmbackend.txt mosml-2.10.1/src/compiler.cminusminus/cmmbackend.txt --- mosml-2.01/src/compiler.cminusminus/cmmbackend.txt 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/cmmbackend.txt 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,109 @@ +A C-- backend for Moscow ML +=========================== +Ken Friis Larsen , 2001-02-11 + + +New Files: +---------- +Wpp.{sig,sml} A Wadler style pretty printer +CmmAST.sml Abstract syntax for C--, nicked from cmmc and modified +CmmPrint.{sig,sml} Pretty print of C-- +CmmEmitcode.sml Translate Zam instructions to C-- + + +Modified files: +--------------- +Instruct.sml Added some new instructions for more information +Back.sml Minor changes, use new instructions. +Emit_phr.sml Use CmmEmitcode rather than Emitcode + + +Minor changes: +-------------- +Pr_zam.sml Modified to give less compact output +Compiler.{sig,sml} Extra options to control if lambda or zam IR +Mainc.sml should be printed. (-dlambda and -dzam) + + + +Compilation +----------- +We compile Instruct.ZamInstruction to C-- statements. That is, we +manage a stack of our own. + + +Functions: +Each SML function is compiled to a C-- function of the form + +name(bits32 sp, bits32 accu, bits32 env, bits32 extra_args){ + ... + return (sp, accu, env, extra_args); +} + +Do we need to transfer accu, env, and extra_args? + + +Exceptions: +Straight forward translation of pushtrap and poptrap, raise is +translated to C--'s cut to. + + +Garbage collection: +Dodge, dodge. We don't use any of C--'s GC features. For now all we +have done for GC is translating the Setup_for_gc and Restore_after_gc +macros. + + +Compilation unit: +A mosml CU is translated to a C-- file (a C-- CU). Each CU will have +a special init function which the toplevel calls to execute the side +effects of loading the module.[*] The functions getglobal and +setglobal are problematic, because we no longer do our own linking. A +quick and dirty hack solution is to have a C-- data section with a +"jump table" that the init function initalizes. Not only functions +goes into the "jump table". This approch is obfuscated + +[*] When batch-compiling to stand-alones we need to collect all the +init functions and call them from the (automatic generated) main +function. + + +Potential Bugs: +--------------- +Plenty :-) + +* The compilation of functions need to be examined carefully, + especially the translation of apply, appterm, push_retaddr, and + return. Is it necessary to transfer env and extra_args both on the + stack and as arguments? + +* Labels in C-- have global scope in a CU. + + +Future work: +------------ +Some optimizations/improvements not implemented. + +* The Zam "return" instruction results in a lot of dublicated C-- + code. Maybe we should only have the C-- code once and then "goto" to + the that code. (See also below). + +* The C-- code resulting from even simple SML expressions is big. + This size can be brought down by making a C-- function corresponding + to each Zam instruction (or just some of the more rare/big + instructions). + +* Unroll "for" loops. The functions CmmEmitcode.for{Up,Down} could be + modified so they unroll loops for small n. + +* Translate from Lambda instructions rather than Zam stack machine + instructions. Instead of translating directly to C-- we should + define a register machine (Yam) as an intermediate step. The Yam + should have an unlimited number of registers, a stack, similar + primitives as Zam, and some special instructions for implementing + special ML constructs, for example: makeblock, raise, pushtrap, + poptrap. What to do with GC? Push temp registers to the stack, use + {Push,Pop}_roots, or use C-- GC interface. + + + diff -Nru mosml-2.01/src/compiler.cminusminus/CmmBack.sml mosml-2.10.1/src/compiler.cminusminus/CmmBack.sml --- mosml-2.01/src/compiler.cminusminus/CmmBack.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/CmmBack.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,849 @@ +(* Translation of lambda terms to C-- functions *) +(* Created by Ken Friis Larsen 2001-02-14 *) +(* Inspired by the regular Moscow ML backend *) +structure CmmBack = +struct + local open CmmAST Lambda in + + (* "isReturn" determines if we're in tail call position. *) + fun isReturn (Return _ :: _ ) = true + | isReturn (Label _ :: Return _ :: _ ) = true + | isReturn _ = false + + + (* Label generation *) + + val labelCounter = ref 0 + + fun resetLabel() = + labelCounter := 0 + + fun new_label() = + (incr labelCounter; !labelCounter) + + (* the label ref in an Lshared node is used as follows: + NoLabel -> (~1) initial value + n < 0 -> seen by the nth pass of unref + n >= 0 -> a real label, code has been emitted + Whenever a Lshared node is processed by a rewriter, + its label ref is set to !labelNotCtr. The counter is + bumped by each rewrite in UNdeBruijn's lftexp. + *) + + val labelNotCtr = ref Nolabel (* for Lshared *) + + fun resetLabelNot() = + labelNotCtr := Nolabel - 1 + + fun newLabelNot() = + (decr labelNotCtr; !labelNotCtr) + + (* Add a label to a list of instructions. *) + fun labelCode C = + case C of + Goto lbl :: _ => (lbl, C) + | Label lbl :: _ => (lbl, C) + | _ => + let val lbl = new_label() + in (lbl, Label lbl :: C) end + + (* Generate a Goto to the given list of instructions. *) + fun makeGoto C = + case C of + (return as Return _) :: _ => (return, C) + | (goto as Goto _) :: _ => (goto, C) + | (cut as Cut _) :: _ => (cut, C) + | Label _ :: (return as Return _) :: _ => (return, C) + | Label lbl :: _ => (Goto lbl, C) + | _ => + let val lbl = new_label() + in (Goto lbl, Label lbl :: C) end + + (* Discard all instructions up to the next label or continuation. *) + fun discardDeadCode C = + case C of + [] => [] + | Label _ :: _ => C + | Call([], _, Reg"set_global", _, _, _) :: _ => C + | Continuation _ :: _ => C + | _ :: rest => discardDeadCode rest + + + (* compile time model of runtime environment + mapping Lvar id to stack or heapenv offsets + fv is freevars, a list; position of negative id is the runtime env index + va is vararray, an array mapping positive ids to stack index + *) + + (* The nullEnv is used for compiling the initialization code of a + unit. A size of 4000 seems generous; the required number rarely + exceeds 200. The compiler reports Internal error: bindEnv if this + table is too small. *) + + val nullEnv = ([],Array.array(4000,(~1))) : int list * int Array.array + + fun makeEnv fv maxstk = (fv, Array.array(maxstk,(~1))) + + fun findEnv (fv,va) sz n = + if n < 0 + then let fun f i [] = fatalError ("findEnv fv n: " ^ (makestring n)) + | f i (x::r) = if x = n then Kenvacc i else f (i + 1) r + in f 0 fv end + else let val i = Array.sub (va,n) + in if i < 0 then fatalError "findEnv va1" else Kaccess (sz - i) end + handle Subscript => + fatalError ("findEnv va2 n: " ^ (makestring n)) + + fun findStk (fv,va) sz n = + if n < 0 + then fatalError ("findStk n: " ^ (makestring n)) + else let val i = Array.sub (va,n) + in if i < 0 then fatalError "findStk va1" else Kassign (sz - i) end + handle Subscript => + fatalError ("findStk va2 n: " ^ (makestring n)) + + (* e -- note: this destroys the env *) + + fun bindEnv (fv,va) n z = + let val n' = n + 1 + in + Array.update (va,n,z); (* not n' !? *) + n' + end handle Subscript => fatalError "bindEnv" + + + (* *) + fun addPop n C = + if n = 0 + then C + else case C of + Kpop m :: C => addPop (n + m) C + | Kreturn m :: C => Kreturn (n + m) :: C + | Kraise :: _ => C + | _ => Kpop n :: C + + +(* Generate a jump through table, unless unnecessary. *) + +exception JumpOut; + +fun add_SwitchTable switchtable C = + let open Array infix 9 sub in + (for (fn i => if (switchtable sub i) <> (switchtable sub 0) then + raise JumpOut + else ()) + 1 (length switchtable - 1); + case C of + Klabel lbl :: C1 => + if lbl = (switchtable sub 0) then C + else + Kbranch (switchtable sub 0) :: discardDeadCode C + | _ => + Kbranch (switchtable sub 0) :: discardDeadCode C) + handle JumpOut => + Kswitch switchtable :: C + end; + +(* Compiling N-way integer branches *) + +(* Input: a list of (key, action) pairs, where keys are integers. *) +(* Output: a decision tree with the format below *) + +datatype DecisionTree = + DTfail + | DTinterval of DecisionTree * Decision * DecisionTree + +withtype Decision = +{ + low: int, + act: Lambda Array.array, + high: int +}; + +fun compileNBranch int_of_key clauses = + let open Array infix 9 sub + val clauses_i = + map (fn (key, act) => (int_of_key key : int, act)) clauses + val clauses_s = + Sort.sort (fn (key1, act1) => fn (key2, act2) => key1 <= key2) + clauses_i + val keyv = Array.fromList (map fst clauses_s) + val actv = Array.fromList (map snd clauses_s) + val n = length keyv + fun extractAct start stop = + let val a = + array((keyv sub stop) - (keyv sub start) + 1, Lstaticfail) + in + for (fn i => + update(a, (keyv sub i) - (keyv sub start), actv sub i)) + start stop; + a + end + (* Now we partition the set of keys keyv into maximal + dense enough segments. A segment is dense enough + if its span (max point - min point) is less + than four times its size (number of points). *) + fun partition start = + if start >= n then [] else + let val stop = ref (n-1) in + while (keyv sub !stop) - (keyv sub start) >= 255 orelse + (keyv sub !stop) - (keyv sub start) > 4 * (!stop - start) + do decr stop; + (* We've found a segment that is dense enough. + In the worst case, !stop = start and the segment is + a single point *) + (* Now build the vector of actions *) + { low = keyv sub start, + act = extractAct start (!stop), + high = keyv sub !stop } :: partition (!stop + 1) + end + val part = Array.fromList (partition 0) + (* We build a balanced binary tree *) + fun make_tree start stop = + if start > stop then + DTfail + else + let val middle = (start + stop) div 2 in + DTinterval(make_tree start (middle-1), + part sub middle, + make_tree (middle+1) stop) + end + in make_tree 0 (length part - 1) end +; + +(* Inversion of a boolean test ( < becomes >= and so on) *) + +val invertPrimTest = fn + PTeq => PTnoteq + | PTnoteq => PTeq + | PTnoteqimm x => fatalError "invertPrimTest" + | PTlt => PTge + | PTle => PTgt + | PTgt => PTle + | PTge => PTlt +; + +val invertBoolTest = fn + Peq_test => Pnoteq_test + | Pnoteq_test => Peq_test + | Pint_test t => Pint_test(invertPrimTest t) + | Pfloat_test t => Pfloat_test(invertPrimTest t) + | Pstring_test t => Pstring_test(invertPrimTest t) + | Pword_test t => Pword_test(invertPrimTest t) + | Pnoteqtag_test t => fatalError "invertBoolTest" +; + +(* Production of an immediate test *) + +val testForAtom = fn + INTscon x => Pint_test(PTnoteqimm x) + | WORDscon x => Pword_test(PTnoteqimm x) + | CHARscon x => Pint_test(PTnoteqimm (Char.ord x)) + | REALscon x => Pfloat_test(PTnoteqimm x) + | STRINGscon x => Pstring_test(PTnoteqimm x) +; + +(* To keep track of function bodies that remain to be compiled. *) + +(* ... a stack of (lbl, nargs, free var ids list, max id, body) *) + +val stillToCompile = (Stack.new () : (int * int * int list * int * Lambda) Stack.t); + +(* translation of lambda-deBruijn to lambda-merged-stkdepth + this requires giving all the Lvars unique ids within the enclosing function + [well, kinda. unique within their scope, anyway] + to do this requires maintaining an rstack depth model + then the translation is simply: deBruijn -> depth - deBruijn - 1 + + all functions are lifted to top level simultaneously + as a result all free variables have negative ids + a closure map is constructed for compileRest + an Lfn is replaced with the closure constuction code +*) + +fun UNdeBruijn exp = + let + exception Refs'R'Us + val fv = ref [] + val md = ref 0 + + fun ins x [] = [x] + | ins x (ls as (y::r)) = + if x > y then x :: ls + else if x = y then ls + else let val z = ins x r in if z = r then ls else y :: z end + + fun extClo id = + if id >= 0 then () + else fv := (ins id (!fv)) + + fun unref i exp = (* turn refs from heap into stack cells *) + case exp of + Lvar n => (* oops, maybe it's a real reference *) + if n = i then raise Refs'R'Us else exp + | Lassign (n,exp') => (* we'd only see n = i in an Lshared node? *) + Lassign(n, unref i exp') + | Lconst cst => + exp + | Lapply(body, args) => + Lapply(unref i body, List.map (unref i) args) + | Lfn body => + fatalError "UNdeBruijn/unref Lfn!?" + | Llet(args, body) => + Llet(List.map (unref i) args, unref i body) + | Lletrec(args, body) => + Lletrec(List.map (unref i) args, unref i body) + | Lprim(Pfield 0, [opt as (Lvar v)]) => + if v = i + then opt + else exp + | Lprim(Psetfield 0, [Lvar v, e]) => + if v = i + then Lassign (i, unref i e) (* new *) + else Lprim(Psetfield 0, [Lvar v, unref i e]) + | Lprim(p, explist) => + Lprim(p, List.map (unref i) explist) + | Lstatichandle(body, handler) => + Lstatichandle(unref i body, unref i handler) + | Lstaticfail => + Lstaticfail + | Lhandle(body, handler) => + Lhandle(unref i body, unref i handler) + | Lif(cond, ifso, ifnot) => + Lif(unref i cond, unref i ifso, unref i ifnot) + | Lseq(exp1, exp2) => + Lseq(unref i exp1, unref i exp2) + | Lwhile(cond, body) => + Lwhile(unref i cond, unref i body) + | Landalso(exp1, exp2) => + Landalso(unref i exp1, unref i exp2) + | Lorelse(exp1, exp2) => + Lorelse(unref i exp1, unref i exp2) + | Lcase(arg, clauses) => + Lcase(unref i arg, + List.map (fn (tag,act) => (tag, unref i act)) clauses) + | Lswitch(size, arg, clauses) => + Lswitch(size, unref i arg, + List.map (fn (tag,act) => (tag, unref i act)) clauses) + | Lunspec => + Lunspec + | Lshared(exp_ref, lbl_ref) => + if !lbl_ref <> !labelNotCtr + then ( lbl_ref := !labelNotCtr; + exp_ref := unref i (!exp_ref); + exp ) + else exp + + fun lftexp depth exp = + (if depth > !md then md := depth else (); + case exp of + Lvar n => + let val id = (depth - n - 1) + in extClo id; Lvar id end + | Lassign (n,exp') => + let val id = (depth - n - 1) + in extClo id; Lassign (id,lftexp depth exp') end + | Lconst cst => exp + | Lapply(body, args) => Lapply(lftexp depth body, List.map (lftexp depth) args) + | Lfn body => + let val (qfv, exp') = UNdeBruijn exp (* recurse *) + in if qfv > 0 then lftexp depth exp' else exp' end + (* Optimize special case arising from #lab arg *) + | Llet([arg], Lprim(p, [Lvar 0])) => + Lprim(p, [lftexp depth arg]) + | Llet(args, body) => + let fun opt_refs body' i [] acc = + Llet(acc, body') + | opt_refs body' i (* do we care what the tag is? *) + ((exp as Lprim(Pmakeblock(CONtag(refTag,1)),[e])) + ::rest) acc = + (let val lnot = newLabelNot() + (* val () = BasicIO.print ("Optref: " ^ (makestring lnot)) *) + val acc' = List.map (unref i) acc + val body'' = unref i body' + in (* BasicIO.print " $\n"; *) + opt_refs body'' (i - 1) rest (e::acc') + end + handle Refs'R'Us => + ( (* BasicIO.print ("\n"); *) + opt_refs body' (i - 1) rest (exp::acc) ) ) + | opt_refs body' i (exp::rest) acc = + opt_refs body' (i - 1) rest (exp::acc) + fun lift_args ea [] acc = + opt_refs (lftexp ea body) (ea - 1) acc [] + | lift_args ea (exp::rest) acc = + lift_args (ea + 1) rest ((lftexp ea exp) :: acc) + in lift_args depth args [] end + | Lletrec(args, body) => + let val ea = depth + (List.length args) + in Lletrec(List.map (lftexp ea) args, lftexp ea body) end + | Lprim(p, explist) => Lprim(p, List.map (lftexp depth) explist) + | Lstatichandle(body, handler) => + Lstatichandle(lftexp depth body, lftexp depth handler) + | Lstaticfail => Lstaticfail + | Lhandle(body, handler) => + Lhandle(lftexp depth body, lftexp (depth + 1) handler) + | Lif(cond, ifso, ifnot) => Lif(lftexp depth cond, lftexp depth ifso, lftexp depth ifnot) + | Lseq(exp1, exp2) => Lseq(lftexp depth exp1, lftexp depth exp2) + | Lwhile(cond, body) => Lwhile(lftexp depth cond, lftexp depth body) + | Landalso(exp1, exp2) => Landalso(lftexp depth exp1, lftexp depth exp2) + | Lorelse(exp1, exp2) => Lorelse(lftexp depth exp1, lftexp depth exp2) + | Lcase(arg, clauses) => + Lcase(lftexp depth arg, List.map (fn (tag,act) => (tag, lftexp depth act)) clauses) + | Lswitch(size, arg, clauses) => + Lswitch(size, lftexp depth arg, List.map (fn (tag,act) => (tag, lftexp depth act)) clauses) + | Lunspec => Lunspec + | Lshared(exp_ref, lbl_ref) => + if !lbl_ref = Nolabel + then ( lbl_ref := !labelNotCtr; + exp_ref := lftexp depth (!exp_ref); + exp ) + else exp + ) + + fun liftbd depth exp = (* called with the body of an Lfn *) + let val exp' = lftexp depth exp + val lbl = new_label() + val fre = List.map (fn id => Lvar ((~1) - id)) (!fv) + val qfv = List.length fre + val exp'' = Lprim(Pclosure (lbl, qfv), fre) + in + Stack.push (lbl, depth, !fv, !md, exp') stillToCompile; + (* Pr_lam.printLam exp'; -- e *) + (* Pr_lam.printLam exp''; -- e *) + (qfv, exp'') + end + + fun liftfn depth exp = + case exp of + Lfn body => liftfn (depth + 1) body + | _ => liftbd depth exp + + fun liftit depth exp = + case exp of + Lfn body => liftfn (depth + 1) body + | _ => let val exp' = lftexp depth exp in (List.length (!fv), exp') end + + in liftit 0 exp end +; + +(* The translator from lambda terms to lists of instructions. + + env: the map from Lvar ids to stackptr offsets; side-effected + staticfail : the pair (label,sz) where Lstaticfail must branch. + sz: the current runtime stack model depth (includes codegen temporaries) + dp: the depth of the Front.sml stack model (excludes codegen temporaries) + exp : the lambda term to compile. + C : the continuation, i.e. the code that follows the code for lambda. + + The tests on the continuation detect tail-calls and avoid jumps to jumps, + or jumps to function returns. + +*) + +fun compileExp env staticfail = + let + open Array infix 9 sub + + fun compexp sz dp exp C = + case exp of + Lvar n => + (findEnv env sz n) :: C + | Lassign (n,exp') => + compexp sz dp exp' ((findStk env sz n) :: C) + | Lconst cst => + (case C of + Kquote _ :: _ => C + | Kget_global _ :: _ => C + | Kaccess _ :: _ => C + | Kenvacc _ :: _ => C + | _ => Kquote cst :: C) + | Lapply(body, args) => + let val na = List.length args + in + if isReturn C + then compExpList sz dp args + (Kpush :: compexp (sz + na) dp body + (Kappterm (na, sz + na) :: discardDeadCode C)) + else if na < 5 + then compExpList sz dp args + (Kpush :: compexp (sz + na) dp body (Kapply na :: C)) + else + (* 3 is the number of stack positions used by Kpush_retaddr *) + let val (lbl, C1) = labelCode C + in Kpush_retaddr lbl :: + compExpList (sz + 3) dp args + (Kpush :: compexp (sz + 3 + na) dp body (Kapply na :: C1)) + end + end + | Lfn body => + fatalError "compileExp Lfn!?" + (* Special case arising from val _ = arg *) + | Llet([arg], Lunspec) => compexp sz dp arg C + | Llet(args, body) => + let val na = List.length args + fun complet sz dp [] = + compexp sz dp body (addPop na C) + | complet sz dp (exp::rest) = + let val z = sz + 1 + in + compexp sz dp exp + (Kpush :: complet z (bindEnv env dp z) rest) + end + in complet sz dp args end + | Lletrec([e as Lprim(Pclosure (lbl, csz), fre)], body) => + let val z = sz + 1 + val d = bindEnv env dp z + val C1 = Kpush :: compexp z d body (addPop 1 C) + in + case fre of + (Lvar n)::rest => + if n = dp + then compExpList sz dp rest (Kclosurerec (lbl, csz) :: C1) + else compExpList sz dp fre (Kclosure (lbl, csz) :: C1) + | [] => Kclosure (lbl, 0) :: C1 + | _ => fatalError "compileExp: malformed Letrec!?" + end + | Lletrec(args, body) => + let val na = List.length args + fun comparg sz dp i [] = + compexp sz dp body (addPop na C) + | comparg sz dp i ((e as Lprim(Pclosure (lbl, csz), fre)) :: r) = + compexp sz dp e + (Kpush :: Kaccess i :: Kprim Pupdate :: comparg sz dp (i-1) r) + | comparg _ _ _ _ = + fatalError "compileExp Lletrec" + fun initarg sz dp [] = + comparg sz dp na args + | initarg sz dp (Lprim(Pclosure (lbl, csz), fre) :: r) = + let val z = sz + 1 + in + Kprim (Pdummy csz) :: Kpush :: initarg z (bindEnv env dp z) r + end + | initarg _ _ (e::_) = + ((* Pr_lam.printLam e; *) + fatalError "compileExp Lletrec") + in + initarg sz dp args + end + | Lprim(Psmladdint, [exp, Lconst(ATOMsc(INTscon 1))]) => + compexp sz dp exp (Kprim Psmlsuccint :: C) + | Lprim(Psmlsubint, [exp, Lconst(ATOMsc(INTscon 1))]) => + compexp sz dp exp (Kprim Psmlpredint :: C) + | Lprim(Pget_global uid, []) => + Kget_global uid :: C + | Lprim(Pset_global uid, [exp]) => + compexp sz dp exp (Kset_global uid :: C) + | Lprim(Pfield i, explist) => + compExpListLR sz dp explist (Kgetfield i :: C) + | Lprim(Psetfield i, explist) => + compExpListLR sz dp explist (Ksetfield i :: C) + | Lprim(Pmakeblock tag, explist) => + compExpListLR sz dp explist + (Kmakeblock(tag, List.length explist) :: C) + | Lprim(Pnot, [exp]) => + (case C of + Kbranchif lbl :: C' => + compexp sz dp exp (Kbranchifnot lbl :: C') + | Kbranchifnot lbl :: C' => + compexp sz dp exp (Kbranchif lbl :: C') + | _ => + compexp sz dp exp (Kprim Pnot :: C)) + | Lprim(p as Ptest tst, explist) => + (case C of + Kbranchif lbl :: C' => + compExpListLR sz dp explist (Ktest(tst,lbl) :: C') + | Kbranchifnot lbl :: C' => + compExpListLR sz dp explist (Ktest(invertBoolTest tst,lbl) :: C') + | _ => + compExpListLR sz dp explist (Kprim p :: C)) + | Lprim(Praise, explist) => + compExpListLR sz dp explist (Kraise :: discardDeadCode C) + | Lprim(Pclosure (lbl, csz), explist) => + compExpList sz dp explist (Kclosure (lbl, csz) :: C) + (* This enables merging of pop, return, etc *) + | Lprim(Pidentity, explist) => + compExpListLR sz dp explist C + | Lprim(p, explist) => + compExpListLR sz dp explist (Kprim p :: C) + | Lstatichandle(body, Lstaticfail) => + compexp sz dp body C + | Lstatichandle(body, handler) => + let val (branch1, C1) = makeBranch C + val (handle2, C2) = labelCode (compexp sz dp handler C1) + in + compileExp env (handle2, sz) sz dp body + (branch1 :: discardDeadCode C2) + end + | Lstaticfail => + let val (lbl,tsz) = staticfail + in addPop (sz - tsz) (Kbranch lbl :: discardDeadCode C) end + | Lhandle(body, handler) => + let val (branch1, C1) = makeBranch C + val lbl2 = new_label() + val z = sz + 1 + in + Kpushtrap lbl2 :: + compexp (sz + 4) dp body + (Kpoptrap :: branch1 + :: Klabel lbl2 :: Kpush + :: compexp z (bindEnv env dp z) handler (addPop 1 C1)) + end + | Lif(cond, ifso, ifnot) => + compTest2 sz dp cond ifso ifnot C + | Lseq(exp1, exp2) => + compexp sz dp exp1 (compexp sz dp exp2 C) + | Lwhile(cond, body) => + let val lbl2 = new_label() + val (lbl1, C1) = labelCode (compexp sz dp cond + (Kbranchif lbl2 :: Kquote constUnit :: C)) + in + Kbranch lbl1 :: Klabel lbl2 :: Kcheck_signals :: compexp sz dp body C1 + end + | Landalso(exp1, exp2) => + (case C of + Kbranch lbl :: _ => + compexp sz dp exp1 (Kstrictbranchifnot lbl :: compexp sz dp exp2 C) + | Kbranchifnot lbl :: _ => + compexp sz dp exp1 (Kbranchifnot lbl :: compexp sz dp exp2 C) + | Kbranchif lbl :: C' => + let val (lbl1, C1) = labelCode C' in + compexp sz dp exp1 (Kbranchifnot lbl1 :: + compexp sz dp exp2 (Kbranchif lbl :: C1)) + end + | Klabel lbl :: _ => + compexp sz dp exp1 (Kstrictbranchifnot lbl :: compexp sz dp exp2 C) + | _ => + let val lbl = new_label() in + compexp sz dp exp1 (Kstrictbranchifnot lbl :: + compexp sz dp exp2 (Klabel lbl :: C)) + end) + | Lorelse(exp1, exp2) => + (case C of + Kbranch lbl :: _ => + compexp sz dp exp1 (Kstrictbranchif lbl :: compexp sz dp exp2 C) + | Kbranchif lbl :: _ => + compexp sz dp exp1 (Kbranchif lbl :: compexp sz dp exp2 C) + | Kbranchifnot lbl :: C' => + let val (lbl1, C1) = labelCode C' in + compexp sz dp exp1 (Kbranchif lbl1 :: + compexp sz dp exp2 (Kbranchifnot lbl :: C1)) + end + | Klabel lbl :: _ => + compexp sz dp exp1 (Kstrictbranchif lbl :: compexp sz dp exp2 C) + | _ => + let val lbl = new_label() in + compexp sz dp exp1 (Kstrictbranchif lbl :: + compexp sz dp exp2 (Klabel lbl :: C)) + end) + + | Lcase(arg, clauses) => + let val C1 = + if case clauses of + (INTscon _, _) :: _ => true + | (WORDscon _, _) :: _ => true + | (CHARscon _, _) :: _ => true + | _ => false + then + compDecision sz dp (compileNBranch intOfAtom clauses) C + else + compTests sz dp + (map (fn (cst, act) => (testForAtom cst, act)) clauses) C + in compexp sz dp arg C1 end + + | Lswitch(1, arg, [(CONtag(_,_), exp)]) => + compexp sz dp exp C + (* We assume the argument to be safe (not producing side-effects + and always terminating), + because switches are generated only by the match compiler *) + | Lswitch(2, arg, [(CONtag(0,_), exp0)]) => + compTest2 sz dp arg Lstaticfail exp0 C + | Lswitch(2, arg, [(CONtag(1,_), exp1)]) => + compTest2 sz dp arg exp1 Lstaticfail C + | Lswitch(2, arg, [(CONtag(0,_), exp0), (CONtag(1,_), exp1)]) => + compTest2 sz dp arg exp1 exp0 C + | Lswitch(2, arg, [(CONtag(1,_), exp1), (CONtag(0,_), exp0)]) => + compTest2 sz dp arg exp1 exp0 C + | Lswitch(size, arg, clauses) => + let val C1 = + if List.length clauses >= size - 5 then + Kprim Ptag_of :: compDirectSwitch sz dp size clauses C + else + Kprim Ptag_of :: + compDecision sz dp (compileNBranch intOfAbsoluteTag clauses) C + in compexp sz dp arg C1 end + | Lunspec => + C + | Lshared(exp_ref, lbl_ref) => + if !lbl_ref < 0 then + let val (lbl, C1) = labelCode (compexp sz dp (!exp_ref) C) + in + lbl_ref := lbl; C1 + end + else + Kbranch (!lbl_ref) :: discardDeadCode C + + (* Compile right-left evaluation of args of functions *) + and compExpList' sz dp [] C = C + | compExpList' sz dp [exp] C = compexp sz dp exp C + | compExpList' sz dp (exp::rest) C = + compExpList' (sz - 1) dp rest (Kpush :: compexp sz dp exp C) + + and compExpList sz dp ls C = + compExpList' (sz + List.length ls - 1) dp ls C + + (* Compile left-right evaluation of args of primitives *) + and compExpListLR' sz dp [] C = C + | compExpListLR' sz dp [exp] C = compexp sz dp exp C + | compExpListLR' sz dp (exp::rest) C = + compexp sz dp exp (Kpush :: compExpListLR' (sz + 1) dp rest C) + + and compExpListLR sz dp ls C = compExpListLR' sz dp ls C + + and compTest2 sz dp cond ifso ifnot C = + let val (sflbl,sftsz) = staticfail + val Cc = +(* This optimization is rather ill-considered. It works if the result () + of the switch is disregarded, but otherwise it fails. sestoft 2000-04-26 + + if ifnot = Lconst constUnit + then let val (lbl, C1) = labelCode C + in Kstrictbranchifnot lbl :: compexp sz dp ifso C1 end + else *) + + if ifso = Lstaticfail andalso sz = sftsz + then Kbranchif sflbl :: compexp sz dp ifnot C + else + if ifnot = Lstaticfail andalso sz = sftsz + then Kbranchifnot sflbl :: compexp sz dp ifso C + else + let val (branch1, C1) = makeBranch C + val (lbl2, C2) = labelCode (compexp sz dp ifnot C1) + in + Kbranchifnot lbl2 :: compexp sz dp ifso + (branch1 :: discardDeadCode C2) + end + in + compexp sz dp cond Cc + end + + and compTests sz dp clauses C = + let val (branch1, C1) = makeBranch C + val (sflbl,sftsz) = staticfail + val () = if sz <> sftsz then fatalError "compTests sz" else () (* e -- assert ?? *) + fun comp [] = + fatalError "compTests" + | comp [(test,exp)] = + Ktest(test, sflbl) :: compexp sz dp exp C1 + | comp ((test,exp)::rest) = + let val lbl = new_label() in + Ktest(test, lbl) :: + compexp sz dp exp (branch1 :: Klabel lbl :: comp rest) + end + in comp clauses end + + and compSwitch sz dp v branch1 C = + let val (sflbl,sftsz) = staticfail + val switchtable = array(length v, sflbl) + fun comp_cases n = + if n >= length v then + C + else + let val (lbl, C1) = + labelCode (compexp sz dp (v sub n) + (branch1 :: discardDeadCode (comp_cases (n+1)))) + in + update(switchtable, n, lbl); C1 + end + in add_SwitchTable switchtable (discardDeadCode(comp_cases 0)) end + + and compDecision sz dp tree C = + let val (branch1, C1) = makeBranch C + val (sflbl,sftsz) = staticfail + val () = if sz <> sftsz then fatalError "compDecision sz" else () (* e -- assert ?? *) + fun comp_dec DTfail C = + Kbranch sflbl :: discardDeadCode C + | comp_dec (DTinterval(left, dec, right)) C = + let val (lbl_right, Cright) = + case right of + DTfail => (sflbl, C) + | _ => labelCode (comp_dec right C) + val (lbl_left, Cleft) = + case left of + DTfail => (sflbl, Cright) + | _ => labelCode (comp_dec left Cright) + val {low, act, high} = dec + in + Kbranchinterval(low, high, lbl_left, lbl_right) :: + (case length act of + 1 => compexp sz dp (act sub 0) + (branch1 :: discardDeadCode Cleft) + | _ => compSwitch sz dp act branch1 Cleft) + end + in comp_dec tree C1 end + + and compDirectSwitch sz dp size clauses C = + let val (branch1, C1) = makeBranch C + val (sflbl,sftsz) = staticfail + val () = if sz <> sftsz andalso size <> (List.length clauses) + then fatalError "compDirectSwitch sz" else () (* e -- assert ?? *) + val switchtable = array(size, sflbl) + fun comp_case [] = + fatalError "compDirectSwitch" + | comp_case [(tag, exp)] = + let val (lbl, C2) = labelCode (compexp sz dp exp C1) in + update(switchtable, intOfAbsoluteTag tag, lbl); + C2 + end + | comp_case ((tag, exp) :: rest) = + let val (lbl, C2) = + labelCode (compexp sz dp exp + (branch1 :: discardDeadCode (comp_case rest))) + in + update(switchtable, intOfAbsoluteTag tag, lbl); + C2 + end + in add_SwitchTable switchtable (discardDeadCode(comp_case clauses)) end + + in compexp end +; + +fun compileRest C = + let val (lbl, nargs, fv, maxstk, exp) = Stack.pop stillToCompile + val env = makeEnv fv maxstk + fun inienv a sz = if a < nargs + then inienv (bindEnv env a sz) (sz - 1) + else () + val () = inienv 0 nargs + val C' = compileExp env (Nolabel, 0) nargs nargs exp + (Kreturn nargs :: discardDeadCode C) + in + compileRest (if nargs > 1 + then (Krestart :: Klabel lbl :: Kgrab (nargs - 1) :: C') + else (Klabel lbl :: C')) + end + handle Stack.Empty => + C +; + +fun compileLambda is_pure exp = + let val () = Stack.clear stillToCompile + val () = resetLabel() + val () = resetLabelNot() + val (qfv, exp') = UNdeBruijn exp (* e -- could check: qfv = 0 *) + val _ = (msgIBlock 0; + msgString "--------- PRINT LAM 2 ---------"; + msgEOL(); + Pr_lam.printLam exp'; + msgEOL(); + msgEBlock()) (*KFL*) + val init_code = + compileExp nullEnv (Nolabel, 0) 0 0 exp' [] + val function_code = + compileRest [] + in + { kph_is_pure = is_pure, + kph_inits = init_code, + kph_funcs = function_code } + end; +end diff -Nru mosml-2.01/src/compiler.cminusminus/CmmEmitcode.sml mosml-2.10.1/src/compiler.cminusminus/CmmEmitcode.sml --- mosml-2.01/src/compiler.cminusminus/CmmEmitcode.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/CmmEmitcode.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,741 @@ +(* Translate Zam instructions to C-- *) +(* Created by Ken Friis Larsen 2001-02-14 *) +structure CmmEmitcode = +struct +local open CmmAST + datatype Instruction = datatype Instruct.ZamInstruction + datatype SCon = datatype Const.SCon + datatype BlockTag = datatype Const.BlockTag + datatype StructConstant = datatype Const.StructConstant + val fatal = Fnlib.fatalError + infix o + fun f o g = fn x => f(g x) + +fun tooManyError kind = + (Mixture.msgIBlock 0; + Mixture.errPrompt ("Too many " ^ kind ^ "; unable to generate bytecode"); + Mixture.msgEOL(); + Mixture.msgEBlock(); + raise Mixture.Toplevel); + + +fun checkGlobals n = + if n > 0xFFFF then tooManyError "globals" else () + +fun checkLocals n = + if n > 0xFFFF then tooManyError "local variables" else () + +fun checkFields n = + if n > 0xFFFF then tooManyError "fields" else () + + +in + + +(* Make the C-- life easier *) + +fun litInt i = LitInt (Int.toString i) +fun litWord w = LitInt (Word.toString w) +fun litChar c = LitChar (Char.toCString c) +fun litCharInt c = litInt (Char.ord c) + +val bits32 = Bits32 +val bits8 = Bits8 + +val reg = Fetch o Var + +fun memaccess e = Mem(bits32, e, NONE) +val memread = Fetch o memaccess +val lvmem = memaccess + +fun ccall n args = Call([], Ccall, reg n, args, [], []) +fun call e args = Call([], Cmm, e, args, [], []) +fun assignCcall regs e args = Call(regs, Ccall, e, args, [], []) +fun assignCall regs e args = Call(regs, Cmm, e, args, [], []) +fun jump e args = Jump(Cmm, e, args, []) +fun cjump n args = Jump(Ccall, reg n, args, []) + +fun binary opr (e1, e2) = Prim(opr, [e1, e2]) +(* for cmmc *) +val shl = binary "<<" +val shr = binary ">>" +val add = binary "+" +val minus = binary "-" +val lt = binary "<" +val le = binary "<=" +val gt = binary ">" +val ge = binary ">=" +val eq = binary "==" +val ne = binary "!=" + +local val temp = ref 0; +in +fun newTemp name = + let val s = String.concat["_._", name, Int.toString(!temp)] + in temp := !temp + 1; + (s, DeclReg(bits32, s)) + end + +fun resetTemp() = temp := 0 +end + +local val lab = ref 0; +in +fun newLab name = + let val s = String.concat["_._", name, "_", Int.toString(!lab)] + in lab := !lab + 1; + s + end + +fun resetLab() = lab := 0 +end + + + + +(* C-- is not as friendly as C when it comes to working with addresses. *) +(* For now hard wired to 32 bit *) +fun wordSize i = shl (litInt i, litInt 2) +fun wordIncr e = add(e, wordSize 1) +fun wordIndex e = shl (e, litInt 2) + +fun addreg r 0 = reg r + | addreg r i = add(reg r, wordSize i) + +fun incr r = Assign(Var r, wordIncr(reg r)) +fun incrWith r i = Assign(Var r, addreg r i) + +fun wordDecr e = minus(e, wordSize 1) +fun decr r = Assign(Var r, wordDecr(reg r)) +fun decrWith r i = Assign(Var r, minus(reg r, wordSize i)) + +(* The real deal *) + +fun makeLetName i = "__let_bound"^Int.toString i + +fun getLetName (Kname lbl :: _) = makeLetName lbl + | getLetName _ = fatal "Unnamed let-bound function ?" + +fun makeLabel lbl = "__"^Int.toString lbl + +(* Mosml primitives *) +fun Atom tag = + let val hp = add (memread(reg"first_atoms"), wordSize tag) + in EComment(wordIncr hp, "Atom") + end + +val Val_unit = Atom 0 +fun Val_long x = add(shl(x, litInt 1), litInt 1) +fun Long_val x = shr(x, litInt 1) + +fun Field(x, i) = memaccess(add (x, wordSize i)) +fun FieldE(x, e) = memaccess(add (x, wordIndex e)) + + +fun Code_val x = memread x +fun Code_val_lv x = lvmem x + +fun Env_val x = Field(x, 1) + +val Max_young_wosize = 256 + +(* For little endian *) +fun Tag_val x = + Fetch(Mem(bits8, minus(x, wordSize 1), NONE)) + +(* For big endian *) +(*fun Tag_val x = + MemRead(bits8, minus(x, litInt 1), NONE) +*) + + +(* +#define Wosize_val(val) (Wosize_hd (Hd_val (val))) +#define Hd_val(val) (((header_t * ) (val)) [-1]) +#define Wosize_hd(hd) ((mlsize_t) ((hd) >> 10)) +*) +fun Wosize_val v = + let val hp = minus(v, wordSize 1) + in shr(memread hp, litInt 10) (* 32 bits? *) + end + + +(* mosml registers *) +val accu = reg"accu" +val sp = reg"sp" + +fun assignAccu e = Assign(Var "accu", e) +val assignAccuInt = assignAccu o Val_long o litInt +val assignAccuWord = assignAccu o Val_long o litWord +val assignAccuChar = assignAccu o Val_long o litCharInt + +val pushAccu = Block[decr "sp", Assign(lvmem sp, accu)] + +fun assignSp n e = Assign(lvmem (addreg "sp" n), e) +fun readSp n = memread (addreg "sp" n) + + +(* Stacks *) +val setExternsp = Assign(lvmem(reg"extern_sp"), sp) +val getExternsp = Assign(Var"sp", memread(reg"extern_sp")) +val checkStack = + If(lt(sp, memread(reg"stack_threshold")), + [setExternsp, + ccall "realloc_stack" [], + getExternsp],NONE) + +val Setup_for_gc = + Block[ decrWith "sp" 2 + , assignSp 0 accu + , assignSp 1 (reg"env") + , setExternsp + ] + +val Restore_after_gc = + Block[ assignAccu (readSp 0) + , Assign(Var"env", readSp 1) + , incrWith "sp" 2 + ] + + + +fun modify e1 e2 = ccall "modify" [e1, e2] + +fun getGlobal uid = assignAccu (Fetch(Field(reg"global_data", uid))) + +fun getField n = + assignAccu (Fetch(Field(accu, n))) + + +(* correspond to r = *sp++ *) +fun readTop r = Block[Assign(Var r, readSp 0), incr "sp"] + + +(* The following corresponds to: + modify(&Field( *sp++, n), accu); + accu = Val_unit; /* Atom(0); */ +*) +fun setField n = + let val (oldsp, decl) = newTemp "oldsp" + val old = memread(reg oldsp) + val modify_dest = add(old, wordSize n) + val modi = modify modify_dest accu + in Block[ decl + , readTop oldsp + , modi + , assignAccu Val_unit + ] + end + +(* FIXME: Here we should check for signals *) +fun apply n = + let val extra = Assign(Var"extra_args", litInt (n-1)) + val env = Assign(Var"env", accu) + val cp = Code_val accu + in Block[Comment "APPLY START", extra, env, + checkStack, + Call(["sp", "accu", "env","extra_args"], Cmm, cp, + [sp, accu, reg"env",reg"extra_args"], [], []), + Comment "APPLY END"] + end + +val pushRetAddr = + Block[ decrWith "sp" 2 + , assignSp 0 (reg"env") + , assignSp 1 (Val_long(reg"extra_args")) + ] + + +(* for-loop from 0 to (excluding) n *) +fun forUp n body = + let val ltop = newLab "FOR_LOOP_TOP" + val lend = newLab "FOR_LOOP_END" + val (i, idecl) = newTemp "i" + in Block[ idecl + , Assign(Var i, litInt 0) + , Goto lend + , Label ltop + , body (reg i) + , Assign(Var i, add(reg i, litInt 1)) + , Label lend + , If(lt(reg i, n), [Goto ltop], NONE) + ] + end + +(* for-loop from init to (and including) 0 *) +fun forDown init body = + let val ltop = newLab "FOR_LOOP_TOP" + val lend = newLab "FOR_LOOP_END" + val (i, idecl) = newTemp "i" + in Block[ idecl + , Assign(Var i, init) + , Goto lend + , Label ltop + , body (reg i) + , Assign(Var i, minus(reg i, litInt 1)) + , Label lend + , If(ge(reg i, litInt 0), [Goto ltop], NONE) + ] + end + + + +(* FIXME: Here we should check for signals *) +fun appterm nargs slotsize = + let val n = nargs - 1 + val (newsp, newspdecl) = newTemp "newsp" + val setnewsp = Assign(Var newsp, + minus(addreg "sp" slotsize, + wordSize nargs)) + fun copy i = + let fun iIndex r = add(reg r, wordIndex i) + (* newsp[i] = sp[i] *) + val copy = Assign(lvmem (iIndex newsp), memread (iIndex "sp")) + in copy + end + val spass = Assign(Var"sp", reg newsp) + val extra = incrWith "extra_args" n + val env = Assign(Var"env", accu) + val cp = Code_val accu + in Block[ Comment "APPTERM START" + , newspdecl + , setnewsp + , forDown (litInt n) copy + , spass + , extra + , env + , jump cp [sp, accu, reg"env", reg"extra_args"] + , Comment "APPTERM END" + ] + end + +(* FIXME: Here we should check for signals *) +fun return n = + let val incsp = incrWith "sp" n + val pos = Return(Cmm, [sp, accu, + accu, minus(reg"extra_args", litInt 1)]) + val zero = + [Assign(Var"env", readSp 0), + Assign(Var"extra_args", Long_val(readSp 1)), + incrWith "sp" 2, + Return(Cmm, [sp, accu, reg"env", reg"extra_args"])] + in Block[ Comment "RETURN START" + , incsp + , If(gt(reg"extra_args", litInt 0), [pos], SOME zero) + , Comment "RETURN STOP" + ] + end + +fun alloc tmp n t = assignCcall [tmp] (reg"alloc") [n, litInt t] +fun Alloc_small tmp n t = + Block[ Setup_for_gc + , alloc tmp (litInt n) t + , Restore_after_gc + ] +fun Alloc_smallE tmp n t = + Block[ Setup_for_gc + , alloc tmp n t + , Restore_after_gc + ] + +fun makeblock (CONtag(t,_)) n = + (*if n < Max_young_wosize + then*) + let val (tmp, tmpdecl) = newTemp "tmp" + val setLast = Assign(Field(reg tmp, n-1), accu) + fun body i = + let val set = Assign(FieldE(reg tmp, i), sp) + val incsp = incr "sp" + in Block[set, incsp] + end + in Block[ tmpdecl + , Alloc_small tmp n t + , setLast + , forDown (litInt (n-2)) body + , assignAccu (reg tmp) + ] + end + +val Num_tags = Word.toInt(Word.<<(0w1, 0w8)) +val No_scan_tag = Num_tags - 5 +val Closure_tag = No_scan_tag - 2 + +fun closure lbl nvars = + let val (tmp, tmpdecl) = newTemp "tmp" + in Block[ tmpdecl + , if nvars > 0 then pushAccu else NOP + , Alloc_small tmp (1 + nvars) Closure_tag + , assignAccu (reg tmp) + , Assign(Code_val_lv accu, reg(makeLetName lbl)) + , forUp (litInt nvars) + (fn i => Assign(FieldE(accu, add(i, litInt 1)), + memread(add(sp, i)))) + , incrWith "sp" nvars + ] + end + +fun closrec lbl nvars = + let val (tmp, tmpdecl) = newTemp "tmp" + in Block[ tmpdecl + , if nvars > 0 then pushAccu else NOP + , Alloc_small tmp (2 + nvars) Closure_tag + , assignAccu (reg tmp) + , Assign(Code_val_lv accu, reg(makeLetName lbl)) + , forUp (litInt nvars) + (fn i => Assign(FieldE(accu, add(i, litInt 2)), + memread(add(sp, i)))) + , incrWith "sp" nvars + , modify (addreg "accu" 1) accu + ] + end + +fun restart grab_lbl = + let val (nargs, nargsdecl) = newTemp "nargs" + fun stackEnv i = Assign(memaccess(add(sp, wordIndex i)), + Fetch(FieldE(reg"env", add(i, litInt 2)))) + in Block[ nargsdecl + , Assign(Var nargs, minus(Wosize_val(reg"env"), litInt 2)) + , Assign(Var"sp", minus(sp, reg nargs)) + , forUp (reg nargs) stackEnv + , Assign(Var"env", Fetch(Field(reg"env", 1))) + , Assign(Var"extra_args", add(reg"extra_args", reg nargs)) + , jump (reg(makeLetName grab_lbl)) + [sp, accu, reg"env", reg"extra_args"] + ] + end + +fun grab restart_lbl required = + let val (nargs, nargsdecl) = newTemp "nargs" + val (tmp, tmpdecl) = newTemp "tmp" + val setnargs = Assign(Var nargs, add(litInt 1, reg"extra_args")) + val clos = + Alloc_smallE tmp (add(litInt 2, reg nargs)) Closure_tag + val setaccu = assignAccu (reg tmp) + fun saveStack i = Assign(FieldE(accu, add(i, litInt 2)), + memread (add(sp, wordIndex i))) + in If(ge(reg"extra_args", litInt required), + [Assign(Var"extra_args", minus(reg"extra_args", litInt required))], + SOME[ nargsdecl + , tmpdecl + , setnargs + , clos + , setaccu + , Assign(Field(accu, 1), reg"env") + , forUp (reg nargs) saveStack + , Assign(Code_val_lv(accu), reg(makeLetName restart_lbl)) + , Assign(Var"sp", add(sp, wordIndex (reg nargs))) + , Assign(Var"env", readSp 0) + , Assign(Var"extra_args", Long_val(readSp 1)) + , incrWith "sp" 3 + , Return(Cmm, [sp, accu, reg"env", reg"extra_args"]) + ]) + end + +(* FIXME: Here we should check for overflow *) +val smladdint = + let val sp = Long_val(readSp 0) + val tmp = add(sp, Long_val accu) + in Block[incr "sp", assignAccu (Val_long tmp)] + end + +(* FIXME: Here we should check for overflow *) +val smlsuccint = + let val tmp = add(Long_val accu, litInt 1) + in assignAccu (Val_long tmp) + end + +(* FIXME: Here we should check for overflow *) +val smlpredint = + let val tmp = minus(Long_val accu, litInt 1) + in assignAccu (Val_long tmp) + end + +fun Trap_pc tp = tp +fun Trap_link tp = addreg tp 1 + +fun nameCont lbl = "_$_cont_"^Int.toString lbl + +fun pushtrap lbl = + Block [ decrWith "sp" 4 + , Assign(lvmem (Trap_pc sp), reg(nameCont lbl)) + , Assign(lvmem (Trap_link "sp"), memread(reg"trapsp")) + , assignSp 2 (reg"env") + , assignSp 3 (Val_long(reg"extra_arg")) + , Assign(lvmem(reg"trapsp"), sp) + ] + +val poptrap = + Block[ Assign(lvmem(reg"trapsp"), memread(Trap_link "sp")) + , incrWith "sp" 4 + ] + +val makeCut = + Block[ Assign(Var"sp", memread(reg"trapsp")) + , Assign(lvmem(reg"trapsp"), memread(Trap_link "sp")) + , Assign(Var"env", addreg "sp" 2) + , Assign(Var"extra_args", Long_val(addreg "sp" 3)) + , Cut(Trap_pc sp, [sp, accu, reg"env", reg"extra_args"], []) + ] + + +fun inttest tst lbl = + If(tst(readSp 0, accu), [incr "sp", Goto(makeLabel lbl)], + SOME[incr "sp"]) + + +fun switch lblarr = + let val len = Array.length lblarr + val range = SOME(0, len-1) + fun collect (i, lbl, []) = [(lbl, [i])] + | collect (i, lbl1, ((lbl2, ts) :: rest)) = + if lbl1 = lbl2 then (lbl2, i :: ts) :: rest + else (lbl2, ts) :: collect (i, lbl1, rest) + + val arms = Array.foldli collect [] lblarr + fun mkSwt (lbl, ts) = Swt(ts, [Goto(makeLabel lbl)]) + val swts = List.map mkSwt arms + in + Switch(accu ,range, swts) + end + + +fun emit_zam zam = + case zam of + Kquote(ATOMsc(INTscon i)) => assignAccuInt i + | Kquote(ATOMsc(WORDscon w)) => assignAccuWord w + | Kquote(ATOMsc(CHARscon c)) => assignAccuChar c + | Kquote(BLOCKsc(CONtag(t,_), [])) => assignAccu (Atom t) + + (* FIXME!*) + | Kget_global (qid, i) => + assignAccu (memread(reg(Const.showQualId qid))) + (*| Kquote sc => (out GETGLOBAL; slot_for_literal sc) + | Kget_global uid => (out GETGLOBAL; slot_for_get_global uid) + | Kset_global uid => (out SETGLOBAL; slot_for_set_global uid) + *) + | Kgetfield n => (checkFields n; getField n) + | Ksetfield n => (checkFields n; setField n) + | Kaccess n => (checkLocals n; assignAccu(readSp n)) + | Kenvacc m => + let val n = m + 1 + in + checkLocals n; + assignAccu(memread(addreg"env" n)) + end + | Kassign n => (checkLocals n; assignSp n accu) + | Kapply n => apply n + | Kappterm (n,z) => (checkLocals z; appterm n z) + | Kpush_retaddr _ => pushRetAddr + | Kpop n => (checkLocals n; incrWith "sp" n) + | Kpush => pushAccu + | Kreturn n => (checkLocals n; return n) + | Klabel lbl => + if lbl = Instruct.Nolabel then fatal "emit_zam: undefined label" + else Label(makeLabel lbl) + | Kname lbl => Label(makeLabel lbl) + + | Kmakeblock(tag,n) => makeblock tag n + + | Kcontinuation lbl => Continuation(nameCont lbl, + ["sp", "accu", "env", "extra_args"]) + | Kpushtrap lbl => pushtrap lbl + | Kpoptrap => poptrap + | Kraise => makeCut + + | Kclosure (lbl, sz) => closure lbl sz + | Kclosurerec (lbl, sz) => closrec lbl sz + | Knewrestart lbl => restart lbl + | Knewgrab (lbl, sz) => grab lbl sz + + | Kprim Prim.Psmladdint => smladdint + | Kprim Prim.Psmlsuccint => smlsuccint + | Kprim Prim.Psmlpredint => smlpredint + | Kprim Prim.Ptag_of => assignAccu (Val_long(Tag_val accu)) + + | Kbranch lbl => + Goto(makeLabel lbl) + | Kbranchif lbl => + If(ne(Tag_val accu, litInt 0), [Goto(makeLabel lbl)], NONE) + | Kbranchifnot lbl => + If(eq(Tag_val accu, litInt 0), [Goto(makeLabel lbl)], NONE) + | Kstrictbranchif lbl => + If(ne(Tag_val accu, litInt 0), [Goto(makeLabel lbl)], NONE) + | Kstrictbranchifnot lbl => + If(eq(Tag_val accu, litInt 0), [Goto(makeLabel lbl)], NONE) + | Kbranchinterval(low, high, lbl_low, lbl_high) => + let val setaccu = assignAccu (minus(accu, litInt(low + 1))) + in + Block[ readTop "accu" + , if low = high andalso lbl_low = lbl_high + then If(ne(accu, litInt low), + [Goto(makeLabel lbl_low)], NONE) + else Block[If(lt(accu, litInt low), + [Goto(makeLabel lbl_low)], NONE), + If(gt(accu, litInt high), + [Goto(makeLabel lbl_high)], NONE)] + , setaccu] + end + | Kswitch lblarr => switch lblarr + | Ktest(tst,lbl) => + let open Prim + in case tst of + Peq_test => inttest eq lbl + | Pnoteq_test => inttest ne lbl + | Pint_test PTeq => inttest eq lbl + | Pint_test PTnoteq => inttest ne lbl + | Pint_test PTlt => inttest lt lbl + | Pint_test PTle => inttest le lbl + | Pint_test PTgt => inttest gt lbl + | Pint_test PTge => inttest ge lbl + | _ => fatal"Ktest" + end + + | i => ( Misc.print "Unknown instruction: " + ; Pr_zam.printZamInstr i + ; Misc.print "\n" + ; raise fatal"emit_zam") + (* + | Ktest(tst,lbl) => + (case tst of + Peq_test => + (out BRANCHIFEQ; out_label lbl) + | Pnoteq_test => + (out BRANCHIFNEQ; out_label lbl) + | Pint_test(PTnoteqimm i) => + (out PUSH; out_push_int_const i; + out EQ; out POPBRANCHIFNOT; out_label lbl) + | Pint_test x => + (out_bool_test BRANCHIFEQ x; out_label lbl) + | Pfloat_test(PTnoteqimm f) => + (out PUSH; out PUSH_GETGLOBAL; + slot_for_literal (ATOMsc(REALscon f)); + out EQFLOAT; out POPBRANCHIFNOT; out_label lbl) + | Pfloat_test x => + (out_bool_test EQFLOAT x; out BRANCHIF; out_label lbl) + | Pstring_test(PTnoteqimm s) => + (out PUSH; out PUSH_GETGLOBAL; + slot_for_literal (ATOMsc(STRINGscon s)); + out EQSTRING; out POPBRANCHIFNOT; out_label lbl) + | Pstring_test x => + (out_bool_test EQSTRING x; out BRANCHIF; out_label lbl) + | Pword_test(PTnoteqimm w) => + (out PUSH; out_push_word_const w; + out EQUNSIGN; out POPBRANCHIFNOT; out_label lbl) + | Pword_test x => + (out_bool_test EQUNSIGN x; out BRANCHIF; out_label lbl) + | Pnoteqtag_test tag => + (out BRANCHIFNEQTAG; out_tag tag; out_label lbl) + ) + + | Kprim p => + (case p of + Pdummy n => + (checkLocals n; out DUMMY; out_short n) + | Ptest tst => + (case tst of + Peq_test => out EQ + | Pnoteq_test => out NEQ + | Pint_test tst => out_bool_test EQ tst + | Pfloat_test tst => out_bool_test EQFLOAT tst + | Pstring_test tst => out_bool_test EQSTRING tst + | Pword_test tst => out_bool_test EQUNSIGN tst + | _ => fatalError "emit_zam : Kprim, Ptest") + | Patom t => + if t < 10 then out (ATOM0 + t) else (out ATOM; out t) + | Pccall(name, arity) => + (if arity <= 5 then + out (C_CALL1 + arity - 1) + else + (out C_CALLN; out arity); + slot_for_c_prim name) + | Pfloatprim p => + out(opcode_for_float_primitive p) + | Pidentity => + () + | p => + out(opcode_for_primitive p) + ) + + | Kcheck_signals => out CHECK_SIGNALS + +fun emit zams = + case zams of + [] => () + | Kpush :: Kquote(ATOMsc(INTscon i)) :: C => + (out_push_int_const i; emit C) + | Kpush :: Kquote(ATOMsc(WORDscon w)) :: C => + (out_push_word_const w; emit C) + | Kpush :: Kquote(ATOMsc(CHARscon c)) :: C => + (out_push_int_const (Char.ord c); emit C) + | Kpush :: Kquote(BLOCKsc(CONtag(t,_), [])) :: C => + ((if t = 0 then out PUSHATOM0 else (out PUSHATOM; out t)); + emit C) + | Kpush :: Kquote sc :: C => (out PUSH_GETGLOBAL; slot_for_literal sc; emit C) + | Kpush :: Kaccess n :: C => + (checkLocals n; + if n < 8 then out(PUSHACC0 + n) else (out PUSHACC; out_short n); + emit C) + | Kpush :: Kenvacc 0 :: Kapply n :: C => + (checkArguments n; + if n < 5 then + out(PUSH_ENV1_APPLY1 + n - 1) + else + (out PUSHENV1; + out APPLY; out n); + emit C) + | Kpush :: Kenvacc 0 :: Kappterm (n,z) :: C => + ((if n < 5 then + out(PUSH_ENV1_APPTERM1 + n - 1) + else + (checkArguments n; out PUSHENV1; out APPTERM; out n)); + checkLocals z; out_short z; + emit C) + | Kpush :: Kenvacc m :: C => + let val n = m + 1 + in + checkLocals n; + if n < 8 then out(PUSHENV1 + m) else (out PUSHENVACC; out_short n); + emit C + end + | Kpush :: Kget_global uid :: Kapply n :: C => + (if n < 5 then + (out(PUSH_GETGLOBAL_APPLY1 + n - 1); + slot_for_get_global uid) + else + (checkArguments n; + out PUSH_GETGLOBAL; + slot_for_get_global uid; + out APPLY; out n); + emit C) + | Kpush :: Kget_global uid :: Kappterm (n,z) :: C => + (if n < 5 then + (out(PUSH_GETGLOBAL_APPTERM1 + n - 1); + checkLocals z; out_short z; + slot_for_get_global uid) + else + (checkArguments n; + out PUSH_GETGLOBAL; + slot_for_get_global uid; + out APPTERM; out n; + checkLocals z; + out_short z); + emit C) + | Kpush :: Kget_global uid :: C => + (out PUSH_GETGLOBAL; + slot_for_get_global uid; + emit C) + | Kgetfield 0 :: Kgetfield 0 :: C => + (out GETFIELD0_0; emit C) + | Kgetfield 0 :: Kgetfield 1 :: C => + (out GETFIELD0_1; emit C) + | Kgetfield 1 :: Kgetfield 0 :: C => + (out GETFIELD1_0; emit C) + | Kgetfield 1 :: Kgetfield 1 :: C => + (out GETFIELD1_1; emit C) + | zam :: C => + (emit_zam zam; emit C) +; + +*) +end +end diff -Nru mosml-2.01/src/compiler.cminusminus/CmmPrint.sig mosml-2.10.1/src/compiler.cminusminus/CmmPrint.sig --- mosml-2.01/src/compiler.cminusminus/CmmPrint.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/CmmPrint.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,11 @@ +(* Pretty print of C-- *) +(* Created by Ken Friis Larsen 2001-02-13 *) +signature CmmPrint = +sig + type 'a printer = 'a -> Wpp.doc + + val ppType : CmmAST.typ printer + val ppExp : CmmAST.expr printer + val ppStmt : CmmAST.stmt printer + val ppProgram : CmmAST.program printer +end diff -Nru mosml-2.01/src/compiler.cminusminus/CmmPrint.sml mosml-2.10.1/src/compiler.cminusminus/CmmPrint.sml --- mosml-2.01/src/compiler.cminusminus/CmmPrint.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/CmmPrint.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,198 @@ +(* Pretty print of C-- *) +(* Created by Ken Friis Larsen 2001-02-27 *) +structure CmmPrint :> CmmPrint = +struct + type 'a printer = 'a -> Wpp.doc + local open CmmAST Wpp in + infix ^^ ^+^ ^/^ o + fun f o g = fn x => f(g x) + + + + + (* Some convenience functions for pp *) + val $ = text + val ws = group(break 1 0) (* space or break*) + val br = break 0 0 + val sp = break 1 0 + val nl = break 100000 0 (* an almost certain forced newline *) + val comma = $"," ^^ ws + val semi = $";" + val colon = $":" ^^ ws + + fun x ^+^ y = x ^^ text" " ^^ y + fun x ^/^ y = x ^^ ws ^^ y + + + fun opr s = ws ^^ $s ^^ ws + val plus = opr "+" + + fun cseq ppr = seq comma ppr + + fun block i = nest i o group + val block1 = block 1 + + fun paren doc = $ "(" ^^ (block1 doc) ^^ $ ")" + fun cparen doc = $ "{" ^^ (block1 doc) ^^ $ "}" + fun bracket doc = $ "[" ^^ (block1 doc) ^^ $ "]" + + fun opt ppr NONE = Wpp.empty + | opt ppr (SOME x) = ppr x + + val isSymbol = Char.contains "+=!<>-/" + fun isInfix opr = List.all isSymbol (String.explode opr) + + + fun ppComment s = $"/*" ^/^ $s ^/^ $"*/" + + fun ppType (Bits8 ) = $"bits8" + | ppType (Bits16) = $"bits16" + | ppType (Bits32) = $"bits32" + | ppType (Bits64) = $"bits64" + + fun ppFormal (t,r) = ppType t ^+^ $r + + val ppFormals = cseq ppFormal + + fun ppConv Cmm = Wpp.empty + | ppConv Ccal = $"foreign \"C\" " + + exception can'tHandle + + fun ppAlign align = $"align" ^^ int align + + fun ppLvalue (Var name) = $name + | ppLvalue (Mem(t, exp, alignOpt)) = + ppType t ^^ opt(cparen o ppAlign) alignOpt ^^ bracket(ppExp exp) + + and ppExp exp = + case exp of + LitInt i => $ i + | LitFloat f => $ f + | LitChar c => $"'" ^^ $(String.translate Char.toCString c) ^^ $"'" + | Fetch lv => ppLvalue lv + | Prim(name, args) => ppPrim name args + | EComment(e, s) => ppExp e ^/^ ppComment s + + and ppPrim opr (args as [e1, e2]) = + if isInfix opr + then paren(ppExp e1 ^/^ $opr ^/^ ppExp e2) + else $opr ^^ paren(cseq ppExp args) + | ppPrim name args = $name ^^ paren(cseq ppExp args) + +(* fun ppRel rel = + case rel of + EQ s => $"==" ^^ $s + | NE s => $"!=" ^^ $s + | LT s => $"<" ^^ $s + | LE s => $"<=" ^^ $s + | GT s => $">" ^^ $s + | GE s => $">=" ^^ $s + + + fun ppCondExp (e1, rel, e2) = + (* we don't need the parentheses but I like them *) + paren(ppExp e1 ^/^ (ppRel rel) ^/^ ppExp e2) +*) + fun ppRange (low, high) = bracket(int low ^+^ $".." ^+^ int high) + + fun ppTargets [] = Wpp.empty + | ppTargets ts = $"targets" ^+^ cseq $ ts + + fun ppFlow flow = + case flow of + Aborts => $"also aborts" + | Cuts ns => $"also cuts to " ^^ nest 5 (cseq $ ns) + | Unwinds ns => $"also unwinds to " ^^ nest 5 (cseq $ ns) + | Returns ns => $"also returns to " ^^ nest 5 (cseq $ ns) + + val ppFlows = seq ws ppFlow + + fun ppStmt stmt = + (case stmt of + DeclReg f => + ppFormal f ^^ semi + | DeclStackData sd => raise can'tHandle + | Assign(lv, exp) => + ppLvalue lv ^^ $" = " ^^ ppExp exp ^^ semi + | If(cexp, stmts, stmtsOpt) => + $"if" ^^ ppExp cexp ^^ ppIndentedBlock stmts ^^ + (case stmtsOpt of + SOME stmts => + newline ^^ $"else "^^ ppIndentedBlock stmts ^^ semi + | NONE => semi) + | Switch(exp, rngOpt, swts) => + $"switch" ^+^ opt ppRange rngOpt ^+^ ppExp exp ^+^ + $"{" ^^ + block 2 (newline ^^ seq newline ppSwt swts)^^newline^^ $"}" ^^semi + | Label l => + $l ^^ colon + | Goto l => + $"goto " ^^ $l ^^ semi + | ComputedGoto(exp, ls) => + $"goto " ^^ ppExp exp ^+^ ppTargets ls ^^ semi + | Jump(conv, exp, args, ts) => + ppConv conv ^^ $"jump" ^+^ ppExp exp ^^ paren(cseq ppExp args) ^+^ + ppTargets ts ^^ semi + | Call(rs, conv, exp, args, targets, flow) => + (case rs of [] => Wpp.empty + | _ => cseq $ rs ^^ $" = ")^^ppConv conv ^^ ppExp exp ^^ + paren(cseq ppExp args) ^+^ ppTargets targets ^+^ + ppFlows flow ^^ semi + | Return(conv, exps) => + ppConv conv ^^ $"return" ^^ paren(cseq ppExp exps) ^^ semi + | Continuation(cont, rs) => + $"continuation " ^^ $cont ^^ paren(cseq $ rs) ^^ colon + | Cut(exp, exps, flow) => + $"cut to " ^^ ppExp exp ^^ paren(cseq ppExp exps) ^+^ + ppFlows flow ^^ semi + | Comment s => + ppComment s + | Block stmts => + seq newline ppStmt stmts + | SafePoint => Wpp.empty + | MarkStmt _ => Wpp.empty) + + + and ppIndentedBlock stmts = + $"{" ^^ group(nest 2 (sp ^^ seq nl ppStmt stmts) ^^sp) ^^ $"}" + + and ppSwt (Swt(xs, stmts)) = + $"case " ^^ (cseq int xs) ^+^ colon ^^ ppIndentedBlock stmts + | ppSwt (SwtDefault stmts) = $"default : " ^^ ppIndentedBlock stmts + + fun ppImp name = $name ^+^ $"as " + fun ppImport (nameOpt, name) = opt ppImp nameOpt ^^ $name + fun ppImports (ty, imps) = + $"import " ^^ ppType ty ^+^ cseq ppImport imps ^^ semi + + fun ppExpo name = $" as " ^^ $name + fun ppExport (name, nameOpt) = $name ^^ opt ppExpo nameOpt + fun ppExports (tyOpt, expos) = + $"export "^^ opt ppType tyOpt ^+^ cseq ppExport expos ^^ semi + + fun ppTypedef (old, new) = $"typedef " ^^ $old ^+^ $new ^^ semi + + fun ppTarget (memsize, byteorder) = + $"target" ^^ opt(fn i => $" memsize "^^ int i) memsize ^+^ + $"byteorder " ^^ (case byteorder of + Little => $"little" + | Big => $"big") ^^ semi + + fun ppToplevel toplevel = + case toplevel of + Imports imps => ppImports imps + | Exports expos => ppExports expos + | Typedef td => ppTypedef td + | Target tg => ppTarget tg + | Function{conv, name, formals, stmts} => + ppConv conv ^^ $name ^^ paren(ppFormals formals) ^^ + ppIndentedBlock stmts + | _ => raise can'tHandle + + fun ppProgram topdecls = + seq (newline ^^ newline) ppToplevel topdecls ^^ newline + + + end +end diff -Nru mosml-2.01/src/compiler.cminusminus/cmm-test/buildlist.sml mosml-2.10.1/src/compiler.cminusminus/cmm-test/buildlist.sml --- mosml-2.01/src/compiler.cminusminus/cmm-test/buildlist.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/cmm-test/buildlist.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,103 @@ +fun decr x = x - 1 + + + + +fun add1 x = let fun arg2 y = x + y in arg2 end +fun add2 (x,y) = x+y + +fun buildlist 0 = [] + | buildlist n = n :: buildlist(n-1) + + +fun for n = + let fun looploop f = + let fun loop i = if i = n then i + else loop (f i) + in loop 0 + end + in looploop + end + + +fun loop 0 = () + | loop n = loop(n-1) + +fun repeat f = + let fun loop x = loop(f x) + handle ?? => x + in loop + end + + +fun showint (i:int) = () +fun showintnl i = (showint i); + +fun f n = + let + fun loop () = (showint n; loop ()) + in + case n + of 0 => 0 + | _ => (loop() handle Interrupt => f (n-1)) + end; + +fun silly x = raise x + + + +fun toOrder n = + case n of + 0 => LESS + | 1 => EQUAL + | _ => GREATER + + +fun fromOrder order = + case order of + LESS => 100 + | GREATER => 200 + | _ => 300 + + +datatype foo = A | B | C | D of foo | E of int + +fun fromFoo foo = + case foo of + B => 100 + | D (D A) => 200 + | E 42 => 300 + | _ => 400 + +fun add5 a b c d e = a+b+c+d+e + +fun five x = add5 x x x x x + 1 + +fun map f [] = [] + | map f (h::t) = f h :: map f t + + +fun map1 f = + let fun map [] = [] + | map (h::t) = f h :: map t + in map + end + +val zero = 0 + +val one = 1 + +fun length [] = zero + | length (_::xs) = one + length xs + +fun rev [] acc = acc + | rev (h :: t) acc = rev t (h::acc) + +fun map2 f ls = + let fun iter [] acc = rev acc [] + | iter (x::xs) acc = iter xs (f x :: acc) + + in iter ls [] + end + +fun K x y = x diff -Nru mosml-2.01/src/compiler.cminusminus/Code_dec.sml mosml-2.10.1/src/compiler.cminusminus/Code_dec.sml --- mosml-2.01/src/compiler.cminusminus/Code_dec.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Code_dec.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,32 @@ +local + open Mixture Const; +in + +(* Relocation information *) + +datatype reloc_info = + Reloc_getglobal of (QualifiedIdent * int) (* reference to a global *) + | Reloc_literal of StructConstant (* structured constant *) + | Reloc_primitive of string (* C primitive number *) + | Reloc_setglobal of (QualifiedIdent * int) (* definition of a global *) +; + +type compiled_phrase = +{ + cph_pos: int, (* Position of start of code *) + cph_len: int, (* Length of code *) + (* What to patch *) + cph_reloc: (StructConstant * int list) list * (reloc_info * int) list, + cph_pure: bool (* Can be omitted or not *) +}; + +type compiled_unit_tables = +{ + cu_phrase_index: compiled_phrase list, + cu_exc_ren_list: (QualifiedIdent * (QualifiedIdent * int)) list, + cu_val_ren_list: (string * int) list, + cu_sig_stamp: SigStamp, + cu_mentions: (string, SigStamp) Hasht.t +}; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Compiler.sig mosml-2.10.1/src/compiler.cminusminus/Compiler.sig --- mosml-2.01/src/compiler.cminusminus/Compiler.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Compiler.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,20 @@ +local + open Mixture Globals Asynt; +in + +val createLexerStream : BasicIO.instream -> Lexing.lexbuf; + (* Create a lexer buffer on the given input channel. + [createLexerStream inchan] returns a lexer buffer which reads + from the input channel [inchan], at the current reading position. *) + + +val parseToplevelPhrase : Lexing.lexbuf -> Dec * bool; +val cleanEnv : (''_a, 'b) Env -> (''_a * 'b) list; +val reportFixityResult : string * InfixStatus -> unit; +val verbose : bool ref; +val printLambda : bool ref; +val printZam : bool ref; +val compileSignature : (string list) -> string -> Mode -> string -> unit; +val compileUnitBody : (string list) -> string -> Mode -> string -> unit; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Compiler.sml mosml-2.10.1/src/compiler.cminusminus/Compiler.sml --- mosml-2.01/src/compiler.cminusminus/Compiler.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Compiler.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,549 @@ +(* Compiler.sml *) + +open List Obj BasicIO Nonstdio Fnlib Mixture Const Globals Location Units; +open Types Smlperv Asynt Parser Ovlres Infixres Elab Sigmtch; +open Tr_env Front Back Pr_zam Emit_phr; + +(* Lexer of stream *) + +fun createLexerStream (is : BasicIO.instream) = + Lexing.createLexer (fn buff => fn n => Nonstdio.buff_input is buff 0 n) +; + +(* Parsing functions *) + +fun parsePhrase parsingFun lexingFun lexbuf = + let fun skip() = + (case lexingFun lexbuf of + EOF => () + | SEMICOLON => () + | _ => skip()) + handle LexicalError(_,_,_) => + skip() + in + parsingFun lexingFun lexbuf + handle + Parsing.ParseError f => + let val pos1 = Lexing.getLexemeStart lexbuf + val pos2 = Lexing.getLexemeEnd lexbuf + in + Lexer.resetLexerState(); + if f (Obj.repr EOF) orelse + f (Obj.repr SEMICOLON) + then () else skip(); + msgIBlock 0; + errLocation (Loc(pos1, pos2)); + errPrompt "Syntax error."; + msgEOL(); + msgEBlock(); + raise Toplevel + end + | LexicalError(msg, pos1, pos2) => + (msgIBlock 0; + if pos1 >= 0 andalso pos2 >= 0 then + errLocation (Loc(pos1, pos2)) + else (); + errPrompt "Lexical error: "; msgString msg; + msgString "."; msgEOL(); + msgEBlock(); + skip(); + raise Toplevel) + | Toplevel => + (skip (); + raise Toplevel) + end +; + +fun parsePhraseAndClear parsingFun lexingFun lexbuf = + let val phr = + parsePhrase parsingFun lexingFun lexbuf + handle x => (Lexer.resetLexerState(); Parsing.clearParser(); raise x) + in + Lexer.resetLexerState(); + Parsing.clearParser(); + phr + end; + +val parseToplevelPhrase = + parsePhraseAndClear Parser.ToplevelPhrase Lexer.Token +; + +val parseStructFile = fn umode => fn lexbuff => + case umode of + STRmode => + parsePhraseAndClear Parser.StructFile Lexer.Token lexbuff + | TOPDECmode => + parsePhraseAndClear Parser.TopDecFile Lexer.Token lexbuff +; + +val parseSigFile = fn umode => fn lexbuff => + case umode of + STRmode => + parsePhraseAndClear Parser.SigFile Lexer.Token lexbuff + | TOPDECmode => + parsePhraseAndClear Parser.TopSpecFile Lexer.Token lexbuff +; + +fun isInTable key tbl = + (Hasht.find tbl key; true) + handle Subscript => false +; + +fun filter p xs = + rev(foldL (fn x => fn acc => if p x then x::acc else acc) [] xs) +; + +fun filterExcRenList excRenList uVarEnv = + filter (fn ({qual, id = id}, _) => isInTable (longIdentAsIdent id "filterExnRenList") uVarEnv) excRenList +; + +fun filterValRenList valRenList uModEnv uFunEnv uVarEnv = + filter (fn (id, stamp) => + case unmangle id of + ValId vid => isInTable vid uVarEnv + | ModId mid => isInTable mid uModEnv + | FunId fid => isInTable fid uFunEnv) + valRenList +; + +fun cleanEnvAcc [] acc = acc + | cleanEnvAcc ((k, v) :: rest) acc = + if exists (fn (k', _) => k = k') acc then + cleanEnvAcc rest acc + else + cleanEnvAcc rest ((k, v) :: acc) +; + +fun cleanEnv env = + cleanEnvAcc (foldEnv (fn a => fn x => fn acc => (a,x)::acc) [] env) [] +; + + +(* Reporting the results of compiling a phrase *) + +val verbose = ref false; + + + +fun reportFixityResult (id, status) = +( + (case status of + NONFIXst => + msgString "nonfix " + | INFIXst i => + (msgString "infix "; + msgInt i; msgString " ") + | INFIXRst i => + (msgString "infixr "; + msgInt i; msgString " ")); + msgString id +); + + +fun reportEquOfType equ = + msgString + (case equ of + FALSEequ => "" + | TRUEequ => "eq" + | REFequ => "prim_EQ" + | _ => fatalError "reportEquOfType") +; + +fun reportLhsOfTypeResult (tyname : TyName) = + let val arity = case (#tnKind (!(#info tyname))) of + ARITYkind arity => arity + | _ => fatalError "reportLhsOfTypeResult" + val vs = newTypeVars arity + val lhs = type_con (map TypeOfTypeVar vs) tyname + in printType lhs end +; + +fun reportTypeResult tyname = + (msgString "toplevel reportTypeResult disabled"; + msgFlush()) + +local + fun prTopEnv prInfo env firstLine = + foldEnv (fn k => fn v => fn firstLine => + (msgIBlock 0; + prInfo k v; + msgEOL(); + msgEBlock(); + false)) firstLine env; + fun prVal {qualid,info=(sch,status)} = () +in +fun report_comp_results iBas (Env as EXISTS(T,(ME,FE,GE,VE,TE))) = + let + val _ = checkClosedExEnvironment Env; + val _ = collectTopVars Env; + val firstLine = + case T of + [] => true + | _ => (msgIBlock 0; + msgPrompt "New type names: "; + prTyNameSet T ","; + msgEOL(); + msgEBlock(); + false) + val firstLine = + prTopEnv (fn id => fn status => reportFixityResult (id,status)) iBas firstLine; + val firstLine = + prTopEnv prModInfo ME firstLine; + val firstLine = + prTopEnv prFunInfo FE firstLine; + val firstLine = + prTopEnv prSigInfo GE firstLine; + val firstLine = + prTopEnv prTyInfo TE firstLine; + val firstLine = + prTopEnv (prVarInfo prVal) VE firstLine + in + () + end +end; + +(* To write the signature of the unit currently compiled *) +(* The same value has to be written twice, because it's unclear *) +(* how to `open` a file in "read/write" mode in a Caml Light program. *) + +fun writeCompiledSignature filename_ui = + let val sigStamp = ref dummySigStamp + val sigLen = ref 0 + in + let val os = open_out_bin filename_ui in + (output_value os (!currentSig); + sigLen := pos_out os; + close_out os) + handle x => + (close_out os; + remove_file filename_ui; + raise x) + end; + let val is = open_in_bin filename_ui in + let val sigImage = input(is, !sigLen) + prim_val md5sum_ : string -> string = 1 "md5sum" + in + if size sigImage < !sigLen then raise Size else (); + close_in is; + remove_file filename_ui; + sigStamp := md5sum_ sigImage + end + handle x => + (close_in is; + remove_file filename_ui; + raise x) + end; + let val os = open_out_bin filename_ui in + (output(os, !sigStamp); + output_value os (!currentSig); + close_out os) + handle x => + (close_out os; + remove_file filename_ui; + raise x) + end; + !sigStamp + end; + +(* Checks and error messages for compiling units *) + +fun checkUnitId msg (locid as (loc, id)) uname = + if (Config.normalizedUnitName id) <> uname then + (msgIBlock 0; + errLocation loc; + errPrompt "Error: "; msgString msg; + msgString " name and file name are incompatible"; + msgEOL(); + msgEBlock(); + raise Toplevel) + else (); + +(* Check that there is a .ui file in the load_path: *) + +fun checkExists filename_ui filename_sig filename_sml = + (find_in_path filename_ui; ()) + handle Fail _ => + (msgIBlock 0; + errPrompt "File "; msgString filename_sig; + msgString " must be compiled before "; + msgString filename_sml; msgEOL(); + msgEBlock(); + raise Toplevel) + +fun checkNotExists filename_sig filename_sml = + if file_exists filename_sig then + (msgIBlock 0; + errPrompt "File "; msgString filename_sig; + msgString " exists, but there is no signature constraint in "; + msgString filename_sml; msgEOL(); + msgEBlock(); + raise Toplevel) + else (); + +(* Compiling a signature *) + +(* cvr: TODO this could be optimized by using checkNoRebindings, + and just calling the update functions instead of extendXXX, which + are then made redundant *) +fun compileSigExp sigexp = + let + val sigexp = resolveToplevelSigExp sigexp + val LAMBDA(T, RS) = elabToplevelSigExp sigexp + in + updateCurrentStaticT T; + (strOptOfSig (!currentSig)) := SOME RS; + let val S' = normStr (SofRecStr RS) (* cvr: we norm S so that calculated (sub)fields + are correct *) + in + extendCurrentStaticME (MEofStr S'); + extendCurrentStaticFE (FEofStr S'); + extendCurrentStaticGE (GEofStr S'); (* should actually be empty ... *) + extendCurrentStaticVE (VEofStr S'); + extendCurrentStaticTE (TEofStr S') + end; + if !verbose then + ((* report_comp_results iBas cBas VE TE; *) (*cvr: TODO*) + msgFlush()) + else () + end +; + +fun compileSpecPhrase elab spec = + let + val (iBas,spec) = resolveToplevelSpec spec + val LAMBDA(T, S) = elab spec + in + updateCurrentStaticT T; + extendCurrentStaticIBas iBas; + extendCurrentStaticS S; + let val S' = normStr S (* cvr: we norm S so that calculated (sub)fields + are correct *) + in + extendCurrentStaticME (MEofStr S'); + extendCurrentStaticFE (FEofStr S'); + extendCurrentStaticGE (GEofStr S'); + extendCurrentStaticVE (VEofStr S'); + extendCurrentStaticTE (TEofStr S') + end; + if !verbose then + ((* report_comp_results iBas cBas VE TE; *) (*cvr: TODO*) + msgFlush()) + else () + end +; + +fun compileSignature context uname umode filename = + let + val source_name = filename ^ ".sig" + val target_name = filename ^ ".ui" + (* val () = (msgIBlock 0; + msgString "[compiling file \""; msgString source_name; + msgString "\"]"; msgEOL(); msgEBlock();) *) + val restorePrState = savePrState() + val () = startCompilingUnit uname "" umode + val () = initInitialEnvironments context + val () = resetTypePrinter() + val is = open_in_bin source_name + val () = remove_file target_name; + val lexbuf = createLexerStream is + fun removeGEofSig () = + case (strOptOfSig(!currentSig)) of + ref NONE => () + | r as (ref (SOME RS)) => r := SOME (removeGEofRecStr RS) + fun compileSig (AnonSig specs) = + (* cvr: TODO warn *) + (app (compileSpecPhrase elabSigSpec) specs; + (#uIdent(!currentSig)):= uname; + Hasht.clear (iBasOfSig(!currentSig)); + Hasht.clear (sigEnvOfSig(!currentSig)); + removeGEofSig() + ) + | compileSig (NamedSig{locsigid as (_,sigid), sigexp}) = + (checkUnitId "signature" locsigid uname; + compileSigExp sigexp; + (#uIdent(!currentSig)):= sigid; + Hasht.clear (iBasOfSig(!currentSig)); + Hasht.clear (sigEnvOfSig(!currentSig)); + removeGEofSig()) + | compileSig (TopSpecs specs) = + app (compileSpecPhrase elabToplevelSpec) specs + in + input_name := source_name; + input_stream := is; + input_lexbuf := lexbuf; + extendCurrentStaticS (STRstr(NILenv,NILenv,NILenv,NILenv,NILenv)); + (* cvr: need the above to distinguish + an empty sig file + from a non-existent one *) + (compileSig (parseSigFile umode lexbuf); + ignore (rectifySignature ()); + ignore (writeCompiledSignature target_name); + close_in is; + restorePrState()) + handle x => (close_in is;restorePrState();raise x) + end +; + +(* Compiling an implementation *) + +(* This is written in tail-recursive form to ensure *) +(* that the intermediate results will be discarded. *) + +fun updateCurrentCompState ((iBas, ExEnv as EXISTS(T,(ME,FE,GE,VE, TE))), RE) = +( + updateCurrentInfixBasis iBas; + updateCurrentStaticT T; + updateCurrentStaticME ME; + updateCurrentStaticFE FE; + updateCurrentStaticGE GE; + updateCurrentStaticVE VE; + updateCurrentStaticTE TE; + updateCurrentRenEnv RE; + if !verbose then + (report_comp_results iBas ExEnv; + msgFlush()) + else () +); + +val printLambda = ref false +val printZam = ref false + +fun compLamPhrase os state (RE, lams) = +( + app + (fn (is_pure, lam) => + ( if !printLambda then (*KFL*) + ( msgIBlock 0 + ; msgString "--------- PRINT LAM ---------" + ; msgEOL() + ; Pr_lam.printLam lam + ; msgEOL() + ; msgEBlock() + ) else () + ; emit_phrase os + let val zam = compileLambda is_pure lam in + if !printZam then (*KFL*) + ( msgCBlock 0 + ; msgEOL() + ; msgString "--------- PRINT ZAM ---------" + ; msgEOL() + ; printZamPhrase zam + ; msgEBlock() + ; msgFlush() + ) else () + ; zam + end)) + lams; + updateCurrentCompState (state, RE) +); + +fun compResolvedDecPhrase os elab (iBas, dec) = + let val ExEnv = elab dec in + resolveOvlDec dec; + commit_free_typevar_names (); (* cvr: will never be rolled-back *) + compLamPhrase os (iBas, ExEnv) (translateToplevelDec dec) + end +; + +fun compileImplPhrase os elab dec = + let val (iBas,resdec) = resolveToplevelDec dec in + compResolvedDecPhrase os elab (iBas,resdec) + end +; + +fun compileAndEmit context uname uident umode filename specSig_opt elab decs = + let + val filename_ui = filename ^ ".ui" + val filename_uo = filename ^ ".uo" + (* val () = (msgIBlock 0; + msgString "[compiling file \""; msgString filename_sml; + msgString "\"]"; msgEOL(); msgEBlock()) *) + val restorePrState = savePrState(); (* cvr: *) + val () = startCompilingUnit uname uident umode + val () = initInitialEnvironments context + val () = extendInitialSigEnv specSig_opt + (* if in STRmode and the optional sig is there + then we add the signature to the environment of the body *) + val () = resetTypePrinter(); + val os = open_out_bin filename_uo + in + ( start_emit_phrase os; + app (compileImplPhrase os elab) decs; + (case umode of + STRmode => + (Hasht.clear (iBasOfSig(!currentSig)); + Hasht.clear (sigEnvOfSig(!currentSig))) + | TOPDECmode => ()); + let val (excRenList, valRenList) = rectifySignature() in + (case specSig_opt of + NONE => + (checkClosedCSig (!currentSig); + let val sigStamp = writeCompiledSignature filename_ui in + end_emit_phrase + excRenList valRenList + sigStamp (#uMentions (!currentSig)) + os + end) + | SOME specSig => + let val {uVarEnv,uModEnv,uFunEnv,uStamp, ...} = specSig + val valRenList = matchSignature os valRenList (!currentSig) specSig; + in + end_emit_phrase + (filterExcRenList excRenList uVarEnv) + (filterValRenList valRenList uModEnv uFunEnv uVarEnv) + (getOption (!uStamp)) (#uMentions (!currentSig)) + os + end); + close_out os; + restorePrState() + end + ) + handle x => (close_out os; remove_file filename_uo;restorePrState();raise x) + end; + +(* cvr: TODO + match modes *before* compiling, to catch this error early on + warn on deprecated syntax +*) + +fun compileUnitBody context uname umode filename = + let val filename_sig = filename ^ ".sig" + val filename_ui = filename ^ ".ui" + val filename_sml = filename ^ ".sml" + val is = open_in_bin filename_sml + val lexbuf = createLexerStream is + fun compileStruct (AnonStruct decs) = + (* cvr: TODO warn *) + if file_exists filename_sig then + (checkExists filename_ui filename_sig filename_sml; + compileAndEmit context uname uname umode filename (SOME (readSig uname)) elabStrDec decs) + else + (remove_file filename_ui; + compileAndEmit context uname uname umode filename NONE elabStrDec decs) + | compileStruct (NamedStruct{locstrid as (_,strid), locsigid = NONE, decs}) = + (checkUnitId "structure" locstrid uname; + checkNotExists filename_sig filename_sml; + remove_file filename_ui; + compileAndEmit context uname strid umode filename NONE elabStrDec decs) + (* cvr: TODO remove locsigid field from NamedStruct *) + | compileStruct (NamedStruct _) = fatalError "compileUnitBody" + | compileStruct (Abstraction{locstrid as (_,strid), locsigid, decs}) = + (checkUnitId "structure" locstrid uname; + checkUnitId "signature" locsigid uname; + checkExists filename_ui filename_sig filename_sml; + compileAndEmit context uname strid umode filename (SOME (readSig uname)) elabStrDec decs +) + | compileStruct (TopDecs decs) = + if file_exists filename_sig then + (checkExists filename_ui filename_sig filename_sml; + compileAndEmit context uname "" umode filename (SOME (readSig uname)) elabToplevelDec decs) + else + (remove_file filename_ui; + compileAndEmit context uname "" umode filename NONE elabToplevelDec decs) + in + input_name := filename_sml; + input_stream := is; + input_lexbuf := lexbuf; + (compileStruct (parseStructFile umode lexbuf)) + handle x => (close_in is; raise x) + end; diff -Nru mosml-2.01/src/compiler.cminusminus/Config.mlp mosml-2.10.1/src/compiler.cminusminus/Config.mlp --- mosml-2.01/src/compiler.cminusminus/Config.mlp 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Config.mlp 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,183 @@ +local open Fnlib in + +(* version string *) +val version = "2.00 (June 2000)"; + +(* Integer ranges *) + +val maxint_byte = 255 +and minint_byte = 0 +and maxint_short = 32767 +and minint_short = ~32768 +and maxint_int31 = 1073741823 +and minint_int31 = ~1073741824 +; + +(* The default name for executable bytecode files. *) + +#ifdef unix +val default_exec_name = "a.out"; +#endif +#ifdef macintosh +val default_exec_name = "Mosml.out"; +#endif +#if defined(msdos) || defined(win32) +val default_exec_name = "mosmlout.exe"; +#endif + +(* Prompts *) + +val toplevel_input_prompt = "- "; +val toplevel_output_prompt = "> "; +val toplevel_output_cont_prompt = " "; +val toplevel_error_prompt = "! "; +val batch_output_prompt = "> "; +val batch_output_cont_prompt = " "; +val batch_error_prompt = "! "; + +(* Run-time values: MUST AGREE with runtime/mlvalues.h *) + +val realTag = 254; +val stringTag = 253; +val refTag = 250; +val closureTag = 249 ; +val maxBlockTag = closureTag-1; + +(* Unit sets *) + +(* The empty "none" set is defined in Mainc.sml, Mainl.sml, and Maint.sml *) + +val reservedUnitNames = ["General", "Top", "Meta"]; +val pervasiveOpenedUnits = ["General"]; + +val fulllib = ["Option", "List", "ListPair", "Strbase", "Char", "String", + "StringCvt", "TextIO", "BasicIO", "Vector", + "Array", "VectorSlice", "ArraySlice", "Misc", "Substring", + "Bool", "Int", "Real", "Math", + "Word", "Word8", "Word8Vector", "Word8Array", + "Word8VectorSlice", "Word8ArraySlice", "Byte", + "BinIO", "CharVector", "CharArray", + "CharVectorSlice", "CharArraySlice", + "Time", "Timer", "Date", "Path", + "FileSys", "Process", "OS", + "Mosml", "PP", "CommandLine"] + +val preloadedUnitSets = [ + ("default", ["Option", "List", "Strbase", "Char", "String", + "StringCvt", "TextIO", "BasicIO", "Vector", + "Array", "Misc"]), + ("full", fulllib), + ("sml90", ["Option", "List", "Strbase", "Char", "String", + "StringCvt", "TextIO", "BasicIO", "Vector", + "Array", "Misc", "SML90"]), + ("nj93", ["Option", "List", "Strbase", "Char", "String", + "StringCvt", "TextIO", "BasicIO", "NJ93", "Vector", + "Array", "Misc"]) +]; + +val preopenedPreloadedUnitSets = [ + ("default", ["Misc"]), + ("full", ["Misc"]), + ("sml90", ["Misc", "SML90"]), + ("nj93", ["Misc", "NJ93"]) +]; + +#ifdef msdos + +val kosherUnitNames = [ + ("Arraysli", "ArraySlice"), + ("Basicio", "BasicIO"), + ("Binio", "BinIO"), + ("Chararra", "CharArray"), + ("Charvect", "CharVector"), + ("Commandl", "CommandLine"), + ("Filesys", "FileSys"), + ("Listpair", "ListPair"), + ("Nj93", "NJ93"), + ("Os", "OS"), + ("Pp", "PP"), + ("Sml90", "SML90"), + ("Stringcv", "StringCvt"), + ("Substrin", "Substring"), + ("Textio", "TextIO"), + ("Vectorsl", "VectorSlice"), + ("Word8arr", "Word8Array"), + ("Word8vec", "Word8Vector") +]; +#endif + +#ifdef win32 +val kosherUnitNames = [ + ("Arrayslice", "ArraySlice"), + ("Basicio", "BasicIO"), + ("Binio", "BinIO"), + ("Chararray", "CharArray"), + ("Chararrayslice", "CharArraySlice"), + ("Charvector", "CharVector"), + ("Charvectorslice", "CharVectorSlice") + ("Commandline", "CommandLine"), + ("Filesys", "FileSys"), + ("Listpair", "ListPair"), + ("Nj93", "NJ93"), + ("Os", "OS"), + ("Pp", "PP"), + ("Sml90", "SML90"), + ("Stringcvt", "StringCvt"), + ("Substring", "Substring"), + ("Textio", "TextIO"), + ("Vectorslice", "VectorSlice"), + ("Word8array", "Word8Array"), + ("Word8arrayslice", "Word8ArraySlice"), + ("Word8vector", "Word8Vector"), + ("Word8vectorslice", "Word8VectorSlice") +]; +#endif + +#if defined(msdos) || defined(win32) +local open CharVector; infix 9 sub; in + + fun normalizedFileName s = Fnlib.stringToLower s; + + fun normalizedUnitName s = + let val len = size s + val () = if len = 0 then raise SysErr("Empty unit name", NONE) + else () +#ifdef msdos + val len0 = if len>8 then 8 else len +#else + val len0 = len +#endif + val s0 = tabulate(len0, fn i => + (case i of 0 => Char.toUpper + | _ => Char.toLower) (s sub i)) + in + lookup s0 kosherUnitNames + handle Subscript => s0 + end; + +end; + +#else +fun normalizedFileName s = s; +fun normalizedUnitName s = s; +#endif + +(* To translate escape sequences *) + +val char_for_backslash = fn +#ifdef macintosh +(* *) #"n" => #"\013" +(* *) | #"r" => #"\010" +#else +(* *) #"n" => #"\010" +(* *) | #"r" => #"\013" +#endif +(* *) | #"a" => #"\007" +(* *) | #"b" => #"\008" +(* *) | #"t" => #"\009" +(* *) | #"v" => #"\011" +(* *) | #"f" => #"\012" +(* *) | c => c +; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Const.sml mosml-2.10.1/src/compiler.cminusminus/Const.sml --- mosml-2.01/src/compiler.cminusminus/Const.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Const.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,134 @@ +local + open Obj Fnlib Config Mixture +in + +(* Qualified identifiers *) + +type QualifiedIdent = +{ + id: string list, + qual: string +}; + +(* cvr: REVISE uses of this function should eventually be removed once we introduce a proper + distinction between short and long qualified idents *) + +fun longIdentAsIdent [id] _ = id + | longIdentAsIdent _ msg = fatalError msg +; + +(* Constants *) + +datatype SCon = + INTscon of int + | WORDscon of word + | CHARscon of char + | REALscon of real + | STRINGscon of string +; + +datatype BlockTag = + CONtag of int * int (* tag number & span *) +; + +datatype StructConstant = + ATOMsc of SCon + | BLOCKsc of BlockTag * StructConstant list + | QUOTEsc of obj ref +; + +val constUnit = + BLOCKsc(CONtag(0,1), []) +; + +fun intOfAtom (INTscon i) = i + | intOfAtom (WORDscon w) = (magic w) : int + | intOfAtom (CHARscon c) = Char.ord c + | intOfAtom _ = fatalError "intOfAtom" +; + +fun intOfAbsoluteTag (CONtag(i,_)) = i +; + +(* Id is used distinguish between name spaces + for compiled var, structure and functor values *) + +datatype Id = ModId of string | ValId of string | FunId of string + +(* (un)mangle valid's, modids and funids to disjoint subsets of string *) + +val mangle = fn + ValId s => s + | ModId s => "_"^s + | FunId s => "__"^s; + +val unmangle = fn s => + case Misc.explode s of + ((#"_")::(#"_")::fid) => FunId (Misc.implode fid) + | ((#"_")::mid) => ModId (Misc.implode mid) + | vid => ValId (Misc.implode vid); + + + + +(* Printing structured constants for debugging purposes *) + +fun printSeq printEl sep = + let fun loop [] = () + | loop [x] = printEl x + | loop (x :: xs) = (printEl x; msgString sep; loop xs) + in loop end +; + +local fun show_id [] = "" + | show_id [i] = i + | show_id (modid::modids) = + (show_id modids) ^ "." ^ modid +in +fun showQualId {qual="", id=id} = show_id id + | showQualId {qual=qual, id=id} = qual ^ "." ^ show_id id +end; + +local fun print_id [] = () + | print_id [i] = msgString i + | print_id (i::id) = + (print_id id; msgString "." ; msgString i) +in +fun printQualId {qual="", id=id} = + print_id id + | printQualId {qual=qual, id=id} = + (msgString qual; msgString "." ; print_id id) +end; + +prim_val sml_makestring_of_char : char -> string + = 1 "sml_makestring_of_char"; +prim_val sml_makestring_of_string : string -> string + = 1 "sml_makestring_of_string"; + +fun printSCon (INTscon i) = + msgInt i + | printSCon (WORDscon w) = + msgWord w + | printSCon (CHARscon c) = + msgString (sml_makestring_of_char c) + | printSCon (REALscon r) = + msgReal r + | printSCon (STRINGscon s) = + msgString (sml_makestring_of_string s) +; + +fun printCTag (CONtag(tag, span)) = + (msgInt tag; msgString ":"; msgInt span) +; + +fun printStrConst (ATOMsc scon) = + printSCon scon + | printStrConst (BLOCKsc(ct, consts)) = + (msgString "(BLOCK "; printCTag ct; msgString " "; + printSeq printStrConst " " consts; msgString ")") + | printStrConst (QUOTEsc rv) = + msgString "" +; + +end; + diff -Nru mosml-2.01/src/compiler.cminusminus/Elab.sig mosml-2.10.1/src/compiler.cminusminus/Elab.sig --- mosml-2.01/src/compiler.cminusminus/Elab.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Elab.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,12 @@ +local + open Globals Asynt; +in + +val elabStrDec: Dec -> (ModEnv * FunEnv * SigEnv * VarEnv * TyEnv) Existential + +val elabToplevelDec: Dec -> (ModEnv * FunEnv * SigEnv * VarEnv * TyEnv) Existential +val elabToplevelSigExp: SigExp -> RecStr Signature; +val elabToplevelSpec: Spec -> Str Signature; +val elabSigSpec: Spec -> Str Signature; + +end diff -Nru mosml-2.01/src/compiler.cminusminus/Elab.sml mosml-2.10.1/src/compiler.cminusminus/Elab.sml --- mosml-2.01/src/compiler.cminusminus/Elab.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Elab.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,3399 @@ +open List; +open Fnlib Config Mixture Const Smlexc; +open Globals Location Units Asynt Asyntfn Types; +open Primdec Smlprim; + + +type UEnv = (string * Type) list; (* Syntax TyVars to TypeVars *) + +val piRef = mkPrimInfo 1 MLPref; + +fun mkPrimStatus arity name = + PRIMname(mkPrimInfo arity (findPrimitive arity name)) +; + +(* --- Warning printing --- *) + +fun isFunType tau = + case normType tau of + ARROWt _ => true + | _ => false +; + +fun unitResultExpected exp tau = + if isFunType tau then + (msgIBlock 0; + errLocation (xLR exp); + errPrompt "Warning: function-type result is being discarded."; + msgEOL(); msgEOL(); + msgEBlock()) + else () +; + +(* --- Error printing --- *) + +fun typeClash tau1 tau2 reason = + under_binder + (fn (tau1,tau2,reason) => + let fun isEqVar tau = case normType tau of + VARt var => #tvEqu (!var) + | _ => false + fun isExVar tau = case normType tau of + VARt var => isExplicit var + | _ => false + fun msgTy tau = + if (case reason of + UnifyEquality => true + | _ => false) + andalso isEqVar tau then + (msgString "equality type "; printNextType tau) + else if (case reason of + UnifyExplicit => true + | UnifyOther => true + | UnifyEquality => true + | UnifyScope _ => true + | _ => false) + andalso isExVar tau then + (msgString "explicit type "; printNextType tau) + else + (msgString "type"; msgEOL(); + errPrompt " "; printNextType tau) + in + collectExplicitVars tau1; + collectExplicitVars tau2; + msgString " of "; msgTy tau1; msgEOL(); + errPrompt "cannot have "; msgTy tau2; msgEOL(); + (case reason of + UnifyCircular => + (errPrompt "because of circularity"; msgEOL()) + | UnifyEquality => () + | UnifyExplicit => () + | UnifyScope (var,TYNAMEsv tn) => + (errPrompt "because of a scope violation:"; + msgEOL(); + errPrompt "the type constructor "; + prTyName false tn; + msgString " is a parameter " ; + msgEOL(); + errPrompt "that is declared within \ + \the scope of "; + prTypeVar var; + msgEOL()) + | UnifyScope (var,TYPEVARsv tv) => + (errPrompt "because of a scope violation:"; + msgEOL(); + errPrompt "the type variable "; + prTypeVar tv; + msgString " is a parameter " ; + msgEOL(); + errPrompt "that is declared within \ + \the scope of "; + prTypeVar var; + msgEOL()) + | UnifyTup => + (errPrompt "because the tuple has the\ + \ wrong number of components"; + msgEOL()) + | UnifyRec lab => + (errPrompt "because record label "; + printLab lab; msgString " is missing"; msgEOL()) + | UnifyMod (reasonopt,reasonopt') => + (case reasonopt of + NONE => () + | SOME reason => + (errPrompt "because the first module type \ + \does not match the second module type ..."; + msgEOL(); + errMatchReason "first module type" "second module type" reason); + case reasonopt' of + NONE => () + | SOME reason => + (errPrompt "because the second module type \ + \does not match the first module type ..."; + msgEOL(); + errMatchReason "second module type" "first module type" reason)) + | UnifyOther => ()) + end) + (tau1,tau2,reason); + +fun typeClashId (ii : IdInfo) tau1 tau2 reason = + let val {qualid, info} = ii in + msgIBlock 0; + errLocation (#idLoc info); + errPrompt "Type clash: identifier "; msgString (showQualId qualid); + typeClash tau1 tau2 reason; + msgEBlock(); + raise Toplevel + end +; + +fun unifyId ii tau1 tau2 = + unify tau1 tau2 + handle Unify reason => typeClashId ii tau1 tau2 reason +; + +fun typeClashPat pat tau1 tau2 reason = +( + msgIBlock 0; + errLocation (xLR pat); + errPrompt "Type clash: pattern"; + typeClash tau1 tau2 reason; + msgEBlock(); + raise Toplevel +); + +fun unifyPat pat tau1 tau2 = + unify tau1 tau2 + handle Unify reason => typeClashPat pat tau1 tau2 reason +; + +fun typeClashExp exp tau1 tau2 reason = +( + msgIBlock 0; + errLocation (xLR exp); + errPrompt "Type clash: expression"; + typeClash tau1 tau2 reason; + msgEBlock(); + raise Toplevel +); + +fun unifyExp exp tau1 tau2 = + unify tau1 tau2 + handle Unify reason => typeClashExp exp tau1 tau2 reason +; + +fun unifyMatch mrules tau1 tau2 = + unify tau1 tau2 + handle Unify reason => + let val MRule(ref pats, exp) = hd mrules in + msgIBlock 0; + errLocation (xxLR (hd pats) exp); + errPrompt "Type clash: match rule"; + typeClash tau1 tau2 reason; + msgEBlock(); + raise Toplevel + end +; + +fun looksLikeInfixId (ii : IdInfo) = + case ii of + {qualid={qual="", id = [_]}, info={withOp=false, ...}} => true + | _ => false +; + +fun isPairPat (_, pat') = + case pat' of + RECpat(ref (RECrp(fs, NONE))) => isPairRow fs + | _ => false +; + +(* +fun looksLikeInfixExp (_, exp') = + case exp' of + VARexp(ref(RESve{qualid={qual=[],...}, info={withOp=false,...}})) + => true + | VARexp(ref(OVLve({qualid={qual=[],...}, info={withOp=false,...}}, _, _))) + => true + | _ => false +; +*) + +fun looksLikeInfixExp (_, exp') = + case exp' of + VIDPATHexp(ref(RESvidpath ({qualid={qual="",id=[_]}, info={withOp=false,...}}))) + => true + | VIDPATHexp(ref(OVLvidpath ({qualid={qual="",id=[_]}, info={withOp=false,...}}, _, _))) + => true + | _ => false +; + + + +fun isPairExp (_, exp') = + case exp' of + RECexp(ref (RECre fs)) => isPairRow fs + | _ => false +; + +fun newUnknownPair() = type_pair (newUnknown()) (newUnknown()); + +infix 6 U; infix 7 \\; + +fun list_union [] ys = ys + | list_union (x :: xs) ys = + if member x ys then (list_union xs ys) else (x :: list_union xs ys) + +fun list_subtract xs [] = xs + | list_subtract xs ys = + let fun h [] = [] + | h (x :: xs) = if member x ys then (h xs) else (x :: h xs) + in h xs end +; + +fun xs U ys = list_union xs ys; +fun U_map f = foldR_map list_union f []; +fun xs \\ ys = list_subtract xs ys; + +infix 7 without; + +fun xs without (tyvarseq:TyVarSeq) = + xs \\ (map (fn ii => hd(#id(#qualid ii))) tyvarseq); + +fun unguardedExp (_, exp') = + case exp' of + SCONexp _ => [] + | VIDPATHexp (ref (RESvidpath (_))) => [] + | VIDPATHexp (ref (OVLvidpath (_,ovlty,ty))) => [] + | RECexp(ref (RECre fields)) => + U_map (fn(_, e) => unguardedExp e) fields + | RECexp(ref (TUPLEre es)) => + U_map unguardedExp es + | VECexp es => + U_map unguardedExp es + | LETexp(dec, exp) => + unguardedDec dec U unguardedExp exp + | PARexp exp => unguardedExp exp + | APPexp(exp1, exp2) => + unguardedExp exp1 U unguardedExp exp2 + | INFIXexp (ref (UNRESinfixexp es)) => + U_map unguardedExp es + | INFIXexp (ref (RESinfixexp e)) => unguardedExp e + | TYPEDexp(exp, ty) => + unguardedExp exp U unguardedTy ty + | ANDALSOexp(exp1, exp2) => + unguardedExp exp1 U unguardedExp exp2 + | ORELSEexp(exp1, exp2) => + unguardedExp exp1 U unguardedExp exp2 + | HANDLEexp(exp, mrules) => + unguardedExp exp U U_map unguardedMRule mrules + | RAISEexp exp => + unguardedExp exp + | IFexp(e0, e1, e2) => + unguardedExp e0 U unguardedExp e1 U unguardedExp e2 + | FNexp mrules => + U_map unguardedMRule mrules + | WHILEexp(exp1, exp2) => + unguardedExp exp1 U unguardedExp exp2 + | SEQexp(exp1, exp2) => + unguardedExp exp1 U unguardedExp exp2 + | STRUCTUREexp(modexp,sigexp,_) => + unguardedModExp modexp U unguardedSigExp sigexp + | FUNCTORexp(modexp,sigexp,_) => + unguardedModExp modexp U unguardedSigExp sigexp +and unguardedMRule (MRule(ref pats, exp)) = + U_map unguardedPat pats U unguardedExp exp +and unguardedPat (_, pat') = + case pat' of + SCONpat _ => [] + | VARpat _ => [] + | WILDCARDpat => [] + | NILpat _ => [] + | CONSpat(_, p) => unguardedPat p + | EXNILpat _ => [] + | EXCONSpat(_,p) => unguardedPat p + | EXNAMEpat _ => fatalError "unguardedPat" +(* cvr: TODO review *) + | REFpat p => unguardedPat p + | RECpat(ref (RECrp(fs, _))) => + U_map (fn(_, p) => unguardedPat p) fs + | RECpat(ref (TUPLErp _)) => fatalError "unguardedPat" +(* cvr: TODO review *) + | VECpat ps => + U_map unguardedPat ps + | INFIXpat (ref (RESinfixpat p)) => unguardedPat p + | INFIXpat (ref (UNRESinfixpat _)) => fatalError "unguardedPat" +(* cvr: TODO review *) + | PARpat pat => unguardedPat pat + | TYPEDpat(pat, ty) => + unguardedPat pat U unguardedTy ty + | LAYEREDpat(pat1, pat2) => + unguardedPat pat1 U unguardedPat pat2 + +and unguardedDec (_, dec') = + case dec' of + VALdec _ => [] + | PRIM_VALdec _ => [] + | FUNdec (ref (UNRESfundec (tyvarseq, fvbds))) => fatalError "unguardedDec" +(* cvr: TODO review *) + | FUNdec (ref (RESfundec dec)) => unguardedDec dec + | TYPEdec tbds => + U_map unguardedTypBind tbds + | PRIM_TYPEdec _ => [] + | DATATYPEdec (dbds,SOME tbds) => + (U_map unguardedDatBind dbds) U + (U_map unguardedTypBind tbds) + | DATATYPEdec (dbds,NONE) => + U_map unguardedDatBind dbds + | DATATYPErepdec (tycon, tyconpath) => + unguardedTyConPath tyconpath + | ABSTYPEdec(dbds,SOME tbds,dec) => + (U_map unguardedDatBind dbds) U + (U_map unguardedTypBind tbds) U + unguardedDec dec + | ABSTYPEdec(dbds,NONE,dec) => + (U_map unguardedDatBind dbds) U + unguardedDec dec + | EXCEPTIONdec ebs => + U_map unguardedExBind ebs + | LOCALdec (dec1, dec2) => + unguardedDec dec1 U unguardedDec dec2 + | OPENdec _ => [] + | EMPTYdec => [] + | SEQdec (dec1, dec2) => + unguardedDec dec1 U unguardedDec dec2 + | FIXITYdec _ => [] + | STRUCTUREdec mbds => + U_map unguardedModBind mbds + | FUNCTORdec fbds => + U_map unguardedFunBind fbds + | SIGNATUREdec sbds => + U_map unguardedSigBind sbds +and unguardedExBind (EXDECexbind(_, SOME ty)) = unguardedTy ty + | unguardedExBind (EXDECexbind(_, NONE)) = [] + | unguardedExBind (EXEQUALexbind(_,_)) = [] +and unguardedValBind (ValBind(ref pat, exp)) = + unguardedPat pat U unguardedExp exp +and unguardedPrimValBindList (pbs) = + (U_map (fn (ii,ty,arity,n) => unguardedTy ty) pbs) +and unguardedValDec (pvbs, rvbs) = + (U_map unguardedValBind pvbs) U + (U_map unguardedValBind rvbs) +and unguardedTy (_, ty') = + case ty' of + TYVARty ii => [hd(#id(#qualid ii))] + | RECty fs => + U_map (fn(_, ty) => unguardedTy ty) fs + | CONty(tys, tyconpath) => + (U_map unguardedTy tys) U unguardedTyConPath tyconpath + | FNty(ty1, ty2) => + unguardedTy ty1 U unguardedTy ty2 + | PACKty(sigexp) => + unguardedSigExp sigexp + | PARty(ty) => + unguardedTy ty +and unguardedModBind (MODBINDmodbind(modid,modexp)) = + unguardedModExp modexp + | unguardedModBind (ASmodbind(modid,sigexp,exp)) = + (unguardedSigExp sigexp U + unguardedExp exp) +and unguardedSigBind (SIGBINDsigbind(sigid,sigexp)) = + unguardedSigExp sigexp +and unguardedFunBind (FUNBINDfunbind(funid,modexp)) = + unguardedModExp modexp + | unguardedFunBind (ASfunbind(funid,sigexp,exp)) = + (unguardedSigExp sigexp U + unguardedExp exp) +and unguardedModExp (_,(modexp,_)) = + case modexp of + DECmodexp dec => + unguardedDec dec + | LONGmodexp _ => [] + | LETmodexp (dec,modexp) => + unguardedDec dec U unguardedModExp modexp + | PARmodexp modexp => + unguardedModExp modexp + | CONmodexp (modexp,sigexp) => + unguardedModExp modexp U unguardedSigExp sigexp + | ABSmodexp (modexp,sigexp) => + unguardedModExp modexp U unguardedSigExp sigexp + | FUNCTORmodexp (_,modid,_, sigexp, modexp) => + unguardedSigExp sigexp U unguardedModExp modexp + | APPmodexp (modexp,modexp') => + unguardedModExp modexp U unguardedModExp modexp' + | RECmodexp (modid,_,sigexp, modexp) => + unguardedSigExp sigexp U unguardedModExp modexp +and unguardedSigExp (_,sigexp) = + case sigexp of + SPECsigexp spec => unguardedSpec spec + | SIGIDsigexp _ => [] + | WHEREsigexp (sigexp, tyvarseq, longtycon, ty) => + (unguardedSigExp sigexp U (unguardedTy ty without tyvarseq)) + | FUNSIGsigexp (_,modid, sigexp,sigexp') => + (unguardedSigExp sigexp U unguardedSigExp sigexp') + | RECsigexp (modid, sigexp,sigexp') => + (unguardedSigExp sigexp U unguardedSigExp sigexp') +and unguardedSpec (_, spec') = + case spec' of + VALspec _ => [] + | PRIM_VALspec _ => [] + | TYPEDESCspec _ => [] + | TYPEspec tbds => U_map unguardedTypBind tbds + | DATATYPEspec (dbds,SOME tbds) => + (U_map unguardedDatBind dbds) U + (U_map unguardedTypBind tbds) + | DATATYPEspec (dbds,NONE) => + U_map unguardedDatBind dbds + | DATATYPErepspec (tycon, tyconpath) => + unguardedTyConPath tyconpath + | EXCEPTIONspec eds => U_map unguardedExDesc eds + | LOCALspec(spec1, spec2) => + unguardedSpec spec1 U unguardedSpec spec2 + | OPENspec _ => [] + | EMPTYspec => [] + | SEQspec(spec1, spec2) => + unguardedSpec spec1 U unguardedSpec spec2 + | INCLUDEspec sigexp => + unguardedSigExp sigexp + | STRUCTUREspec moddescs => + U_map unguardedModDesc moddescs + | FUNCTORspec fundescs => + U_map unguardedFunDesc fundescs + | SHARINGTYPEspec (spec, longtycons) => + unguardedSpec spec + | SHARINGspec (spec, longmodids) => + unguardedSpec spec + | FIXITYspec _ => + [] + | SIGNATUREspec sigdescs => + U_map unguardedSigBind sigdescs +and unguardedModDesc (MODDESCmoddesc(modid,sigexp)) = + unguardedSigExp sigexp +and unguardedFunDesc (FUNDESCfundesc(funid,sigexp)) = + unguardedSigExp sigexp +and unguardedTyConPath (_,LONGtyconpath _) = [] + | unguardedTyConPath (_,WHEREtyconpath (_,_,modexp)) = + unguardedModExp modexp +and unguardedTypBind (tyvarseq,tycon,ty) = + unguardedTy ty without tyvarseq +and unguardedExDesc (_,SOME ty) = + unguardedTy ty + | unguardedExDesc (_,NONE) = [] +and unguardedDatBind (tyvarseq, tycon, cbds) = + (U_map unguardedConBind cbds) without tyvarseq +and unguardedConBind (ConBind (ii, NONE)) = [] + | unguardedConBind (ConBind (ii, SOME ty)) = unguardedTy ty +and unguardedValDescList (vds) = + (U_map (fn (ii,ty) => unguardedTy ty) vds) +; + +(* cvr: TODO the original definition of scopedTyVars appears to be wrong, + since a variable in pars will not be scoped, + if it is already scoped in UE +fun scopedTyVars UE pars unguardedTyVars = + list_subtract (pars U unguardedTyVars) (map fst UE) +; +*) +(* cvr: REVIEW I think the correct definitions should be: *) +fun scopedTyVars loc UE pars unguardedTyVars = + let val scopedtyvars = map fst UE + in + if (!currentCompliance) <> Liberal + then (app (fn v => + if member v scopedtyvars + then case !currentCompliance of + Orthodox => + (msgIBlock 0; + errLocation loc; + errPrompt "Compliance Error: ";msgEOL(); + errPrompt "The phrase, although accepted as a Moscow ML extension,";msgEOL(); + errPrompt "is not supported by the Definition of Standard ML:"; msgEOL(); + errPrompt "the explicit type variable ";msgEOL(); + errPrompt " "; msgString v;msgEOL(); + errPrompt "is already in scope and should not be redeclared"; + msgEOL(); + msgEBlock(); + raise Toplevel) + | Conservative => + (msgIBlock 0; + errLocation loc; + errPrompt "Compliance Warning: ";msgEOL(); + errPrompt "The phrase, although accepted as a Moscow ML extension,";msgEOL(); + errPrompt "is not supported by the Definition of Standard ML:"; msgEOL(); + errPrompt "the explicit type variable ";msgEOL(); + errPrompt " "; msgString v;msgEOL(); + errPrompt "is already in scope and should not be redeclared"; + msgEOL(); + msgEBlock()) + | _ => () + else ()) + pars) + else (); + (pars U (list_subtract unguardedTyVars scopedtyvars)) + end + +; + +fun incrUE tyvars = + map (fn tv => (tv, TypeOfTypeVar(newExplicitTypeVar tv))) tyvars +; + +(* Modified to allow more forms of non-expansive expressions: *) + +fun isExpansiveExp (_, exp') = + case exp' of + SCONexp _ => false + | VIDPATHexp (ref (RESvidpath (_))) => false + | VIDPATHexp (ref (OVLvidpath (_,ovlty,ty))) => false + | PARexp exp => isExpansiveExp exp + | TYPEDexp(exp,_) => isExpansiveExp exp + | FNexp _ => false + | RECexp (ref (RECre exprow)) => + exists (fn (_, e) => isExpansiveExp e) exprow + | RECexp (ref (TUPLEre explist)) => + exists isExpansiveExp explist + | APPexp((_, VIDPATHexp (ref(RESvidpath ii))), exp) => + isExpansiveExp exp orelse + let val {info = {idKind, ...}, ...} = ii + in case !idKind of + {info = CONik _, qualid = {id, qual}} => id = ["ref"] + | {info = EXCONik _, ...} => false + | _ => true + end + | APPexp((_,VIDPATHexp (ref(OVLvidpath(ii,_,_)))),exp) => + isExpansiveExp exp orelse + let val {info = {idKind, ...}, ...} = ii + in case !idKind of + {info = CONik _, qualid = {id, qual}} => id = ["ref"] + | {info = EXCONik _, ...} => false + | _ => true + end + | INFIXexp (ref (RESinfixexp e)) => + isExpansiveExp e + | INFIXexp (ref (UNRESinfixexp _)) => fatalError "isExpansiveExp: unresolved infix exp" + | STRUCTUREexp (modexp,_,_) => isExpansiveModExp modexp + | FUNCTORexp (modexp,_,_) => isExpansiveModExp modexp + | _ => true +and isExpansiveModExp (_, (modexp',_)) = + case modexp' of + DECmodexp _ => true + | LONGmodexp _ => false + | LETmodexp _ => true + | PARmodexp modexp => isExpansiveModExp modexp + | CONmodexp (modexp,_) => isExpansiveModExp modexp + | ABSmodexp (modexp,_) => isExpansiveModExp modexp + | FUNCTORmodexp _ => false + | APPmodexp _ => true + | RECmodexp (_,_,_, modexp) => isExpansiveModExp modexp +; + + +fun expansiveIdsInValBind (ValBind(ref pat, exp)) acc = + if (isExpansiveExp exp) then (domPatAcc pat acc) else acc +; + +fun closeValBindVE loc (pvbs: ValBind list) VE = + let val exIds = foldR expansiveIdsInValBind [] pvbs in + mapEnv (fn id => fn {qualid, info = (t,sc)} => + {qualid=qualid,info = (generalization (member id exIds) t,sc)}) VE + end +; + +fun findAndMentionStrSig loc i = + let val cu = findAndMentionSig loc i + in case modeOfSig cu of + STRmode => cu + | TOPDECmode => (* cvr: TODO in the near future this should be an error, not just a warning *) + ((msgIBlock 0; + errLocation loc; + errPrompt "Warning: this unit was compiled as a sequence of toplevel declarations,";msgEOL(); + errPrompt "but is being used as if it had been compiled as a structure.";msgEOL(); + msgEBlock()); + cu) + end +; + +fun findLongModIdForOpen ME loc q = + case q of + {qual, id = []} => fatalError "findLongModIdForOpen" + | {qual, id = [i] } => + (let val {qualid,info=RS} = lookupEnv ME i + val S = SofRecStr RS + in + ([],{qualid = qualid, + info = (MEofStr S, + FEofStr S, + NILenv, + VEofStr S, + TEofStr S)}) + end handle Subscript => + let val i = normalizedUnitName i (* cvr: REVIEW *) + in + if i = #uName(!currentSig) then + (msgIBlock 0; + errLocation loc; + errPrompt "the free structure identifier may not refer to the current unit: "; + printQualId q; msgEOL(); + msgEBlock(); + raise Toplevel) + else + let val cu = findAndMentionStrSig loc i (* cvr: REVIEW maybe findAndMention? *) + in + ([],{qualid = {qual = i,id = []}, + info = (bindTopInEnv NILenv (#uModEnv cu), + bindTopInEnv NILenv (#uFunEnv cu), + bindTopInEnv NILenv (#uSigEnv cu), + bindTopInEnv NILenv (#uVarEnv cu), + bindTopInEnv NILenv (#uTyEnv cu)) + }) + end + end) + | _ => let val (fields,{qualid,info=RS}) = findLongModId ME loc q + val S = SofRecStr RS + in + (fields,{qualid = qualid, + info = (MEofStr S, + FEofStr S, + NILenv, + VEofStr S, + TEofStr S)}) + end +and findLongModId ME loc q = + case q of + {qual, id = []} => fatalError "findLongModId" + | {qual, id = [i] } => + (let val modglobal = lookupEnv ME i + in ([],modglobal) + end handle Subscript => + let val i = normalizedUnitName i (* cvr: REVIEW *) + in + if i = #uName(!currentSig) then + (msgIBlock 0; + errLocation loc; + errPrompt "the free structure identifier may not refer to the current unit: "; + printQualId q; msgEOL(); + msgEBlock(); + raise Toplevel) + else + let val cu = findAndMentionStrSig loc i + in + ([],{qualid = {qual = i,id = []}, + info = + NONrec (STRstr(bindTopInEnv NILenv (#uModEnv cu), + bindTopInEnv NILenv (#uFunEnv cu), + bindTopInEnv NILenv (#uSigEnv cu), + bindTopInEnv NILenv (#uTyEnv cu), + bindTopInEnv NILenv (#uVarEnv cu))) + }) + end + end) + | {qual, id = i::id} => + let val (fields,{qualid = {qual = qual',id = id'}, info = RS}) = findLongModId ME loc {qual = qual , id = id} + in + let val (field,modglobal) = lookupMEofStr (SofRecStr RS) i + in if isGlobalName (#qualid modglobal) + then ([],modglobal) + else (field::fields, + {qualid = {qual = qual', id = i::id'}, + info = #info modglobal}) + end handle Subscript => + errorMsg loc ("Unbound structure component: "^(showQualId q)) + end +; + + +fun findLongVId ME VE loc q = + case q of + {qual, id = []} => fatalError "findLongVId" + | {qual, id = [i] } => + (([],lookupEnv VE i) + handle Subscript => + errorMsg loc ("Unbound value identifier: "^(showQualId q))) + | {qual, id = i::id} => + let val (fields,{qualid = {qual = qual', id = id'},info = RS}) = + findLongModId ME loc {qual = qual , id = id} + in + let val (field,info) = lookupVEofStr (SofRecStr RS) i + in if isGlobalName (#qualid info) + then ([],info) (* inline globals *) + else (field::fields, + {qualid = {qual = qual', id = i::id'}, + info = #info info}) + end handle Subscript => + errorMsg loc ("Unbound value component: "^(showQualId q)) + end +; + +fun findLongFunId ME FE loc q = + case q of + {qual, id = []} => fatalError "findLongFunId" + | {qual, id = [i] } => + (([],lookupEnv FE i) + handle Subscript => + errorMsg loc ("Unbound functor identifier: "^(showQualId q))) + | {qual, id = i::id} => + let val (fields,{qualid = {qual = qual', id = id'},info = RS}) = + findLongModId ME loc {qual = qual , id = id} + in + let val (field,info) = lookupFEofStr (SofRecStr RS) i + in if isGlobalName (#qualid info) + then ([],info) (* inline globals *) + else (field::fields, + {qualid = {qual = qual', id = i::id'}, + info = #info info}) + end handle Subscript => + errorMsg loc ("Unbound functor component: "^(showQualId q)) + end +; + +(* cvr: *) +fun findLongTyCon ME TE loc q = + case q of + {qual, id = []} => fatalError "findLongTyCon" + | {qual, id = [i] } => + ((lookupEnv TE i) + handle Subscript => + errorMsg loc ("Unbound type constructor: "^(showQualId q))) + | {qual, id = i::id} => + let val (_,{info = RS,...}) = findLongModId ME loc {qual = qual, id = id} + in + ((lookupEnv (TEofStr (SofRecStr RS)) i) + handle Subscript => + errorMsg loc ("Unbound type component: "^(showQualId q))) + end +; + +fun findLongModIdInStr S loc q = + case q of + {qual, id = []} => fatalError "findLongModIdInStr" + | {qual, id = [i] } => + (let val (field,modglobal) = lookupMEofStr S i + in if isGlobalName (#qualid modglobal) + then ([],modglobal) + else ([field],modglobal) + end handle Subscript => + errorMsg loc ("Unbound structure component: "^(showQualId q))) + | {qual, id = i::id} => + let val (fields,{qualid = {qual = qual',id = id'}, info = RS'}) = + findLongModIdInStr S loc {qual = qual,id = id} + in + let val (field,modglobal) = lookupMEofStr (SofRecStr RS') i + in if isGlobalName (#qualid modglobal) + then ([],modglobal) + else (field::fields, + {qualid = {qual = qual', id = i::id'}, + info = #info modglobal}) + end handle Subscript => + errorMsg loc ("Unbound structure component: "^(showQualId q)) + end +; + +fun findLongTyConInStr S loc q = + case q of + {qual, id = []} => fatalError "findLongTyConInStr" + | {qual, id = [i] } => + ((lookupEnv (TEofStr S) i) + handle Subscript => + errorMsg loc ("Unbound type component: "^(showQualId q))) + | {qual, id = i::id} => + let val (_,{info = RS',...}) = findLongModIdInStr S loc {qual = qual, id = id} + in + ((lookupEnv (TEofStr (SofRecStr RS')) i) + handle Subscript => + errorMsg loc ("Unbound type component: "^(showQualId q))) + end +; + + +fun findSigId GE loc sigid = + lookupEnv GE sigid + handle Subscript => + let val i = normalizedUnitName sigid (* cvr: TODO review *) + in + if i = #uName(!currentSig) then + (msgIBlock 0; + errLocation loc; + errPrompt "The free signature identifier may not refer to the current unit: "; + msgString sigid; msgEOL(); + msgEBlock(); + raise Toplevel) + else + let val cu = findAndMentionStrSig loc i + (* cvr: TODO review - using the unit's signature + probably shouldn't imply using its implementation *) + in + case !(strOptOfSig cu) of + NONE => + (msgIBlock 0; + errLocation loc; + errPrompt "The signature identifier\ + \ refers to a unit interface, \ + \ but the unit was not defined \ + \ with an explicit signature."; + msgEOL(); + msgEBlock(); + raise Toplevel) + | SOME RS => + {qualid = {qual = i,id = []}, + info = (* cvr: remove copySig [] [] *) + (LAMBDAsig(!(tyNameSetOfSig cu), + STRmod RS))} + end + end +; + +(* Expectations are used by elabModExp to resolve + ambiguous longmodid's either longstrids or longfunids +*) + +datatype Expectation = FUNexpected | STRexpected | MODexpected; + +fun expectMod (STRmod S) = STRexpected +| expectMod (FUNmod F) = FUNexpected +; + +fun resolveExpectation (MODexpected,true) = FUNexpected +| resolveExpectation (MODexpected,false) = STRexpected +| resolveExpectation (expectation,_) = expectation +; + +fun reportExpectation expectation ({info = {withOp,...},qualid}:LongModId) = + case expectation of + MODexpected => + let val (expected,intended) = + case withOp of + false => ("structure.","functor") + | true => ("functor.","structure") in + msgIBlock 0; + errPrompt "(In this context,\ + \ it is assumed that "; + msgEOL(); + errPrompt " "; + (if withOp then msgString "op " else ()); + msgString (showQualId qualid); + msgEOL(); + errPrompt " refers to a "; msgString expected; msgEOL(); + errPrompt " If you actually meant the "; + msgString intended; + msgString " of the same name,"; + msgEOL(); + errPrompt " you must use the syntax: "; + msgEOL(); + errPrompt " "; + (if withOp then () else msgString "op "); + msgString (showQualId qualid); + msgEOL(); + errPrompt " to indicate this.)";msgEOL(); + raise Toplevel + end + | _ => raise Toplevel +; + +fun lookup_VE (ME:ModEnv) (VE : VarEnv) (ii : IdInfo) = + let val {qualid, info} = ii + val {idLoc, ...} = info + in + let val (_,{ qualid = csqualid, info = (sch,_)}) = + findLongVId ME VE idLoc qualid + in + specialization(sch) + end + handle Subscript => + fatalError "lookup_VE" + end; + + +fun lookup_UE (UE : UEnv) loc (ii : IdInfo) = + let val id = hd(#id(#qualid ii)) in + lookup id UE + handle Subscript => errorMsg loc ("Unbound type variable: " ^ id) + end; + +fun lookup_VEForPat ME VE (ii : IdInfo) = + let val { qualid, info } = ii + val { idLoc = loc, ... } = info + in + case qualid of + {qual, id = []} => fatalError "lookup_VEForPat" + | {qual, id = [i] } => + (let val {qualid = csqualid, info = (_,cs)} = lookupEnv VE i + in ([],{qualid = csqualid, info = cs}) + end + (* Otherwise ii is being defined in the pattern... *) + handle Subscript => + ([],{ qualid = qualid, info=VARname REGULARo })) + | {qual, id = id as (_::_)} => + let val (fields,{qualid = csqualid, info = (_,cs)}) = + (findLongVId ME VE loc qualid) + in (fields,{qualid = csqualid, info = cs}) + end + end +; + +(* syntactic checks *) + +fun appOpt f u (SOME x) = f x + | appOpt f u NONE = u +; + +fun illegalVal id = + id = "true" orelse id = "false" + orelse id = "nil" orelse id = "::" orelse id = "ref" + +fun illegalCon id = illegalVal id orelse id = "it" + +fun checkRebinding illegal ({qualid={id=lid, ...}, info = {idLoc, ...}} : IdInfo) = + if illegal (longIdentAsIdent lid "checkRebinding") then + errorMsg idLoc "Illegal rebinding or respecification" + else + (); + +fun checkAsPatSource (loc, pat') = + case pat' of + VARpat _ => () + | TYPEDpat((_, VARpat _), _) => () + | INFIXpat (ref (UNRESinfixpat _)) => fatalError "checkAsPatSource" + | INFIXpat (ref (RESinfixpat p)) => + checkAsPatSource p + | _ => errorMsg loc "Ill-formed source of a layered pattern" +; + +fun checkRecTy (loc, fs) = + if duplicates (map fst fs) then + errorMsg loc "The same label is bound twice in a record type" + else () +; + + +fun checkRecPat (loc, fs) = + if duplicates (map fst fs) then + errorMsg loc "The same label is bound twice in a record pattern" + else () +; + +fun isFnExp (_, exp') = + case exp' of + PARexp exp => isFnExp exp + | TYPEDexp(exp, ty) => isFnExp exp + | FNexp _ => true + | _ => false +; + +fun checkFnExp exp = + if isFnExp exp then () else + errorMsg (xLR exp) "Non-functional rhs expression in val rec declaration" +; + +fun inIds (ii : IdInfo) (iis : IdInfo list) = + exists (fn ii' => #id(#qualid ii) = #id(#qualid ii')) iis; + + + +fun checkDuplIds (iis : IdInfo list) msg = + case iis of + [] => () + | ii :: iis' => + if inIds ii iis' then + errorMsg (#idLoc (#info ii)) msg + else checkDuplIds iis' msg +; + +fun checkAllIdsIn loc [] iis desc = () +| checkAllIdsIn loc (v::vs) iis desc = + (if exists (fn (ii':IdInfo) => [v] = #id(#qualid ii')) iis + then () + else (case (!currentCompliance) of + Orthodox => + (msgIBlock 0; + errLocation loc; + errPrompt "Compliance Error: ";msgEOL(); + errPrompt "The phrase, although accepted as a Moscow ML extension,";msgEOL(); + errPrompt "is not supported by the Definition of Standard ML:"; msgEOL(); + errPrompt "the type variable";msgEOL(); + errPrompt " "; msgString v;msgEOL(); + errPrompt "should be a parameter of the "; + msgString desc;msgEOL(); + msgEBlock(); + raise Toplevel) + | Conservative => + (msgIBlock 0; + errLocation loc; + errPrompt "Compliance Warning: ";msgEOL(); + errPrompt "The phrase, although accepted as a Moscow ML extension,";msgEOL(); + errPrompt "is not supported by the Definition of Standard ML:"; msgEOL(); + errPrompt "the type variable";msgEOL(); + errPrompt " "; msgString v;msgEOL(); + errPrompt "should be a parameter of the "; + msgString desc;msgEOL(); + msgEBlock(); + checkAllIdsIn loc (drop (fn v' => v = v') vs) iis desc) + | _ => ())) +; + +fun checkTypBind (tyvars, tycon, ty as (loc,_)) = +( checkDuplIds tyvars + "Duplicate parameter in a type binding"; + if (!currentCompliance) <> Liberal + then checkAllIdsIn loc (unguardedTy ty) tyvars "type binding" + else () +); + +fun checkDatBind (tyvars, tycon, cbs) = +( + app (fn ConBind(ii, SOME (ty as (loc,_))) => + (if (!currentCompliance)<> Liberal + then checkAllIdsIn loc (unguardedTy ty) tyvars "datatype binding" + else ()) + | ConBind(ii, NONE) => ()) + cbs; + checkDuplIds tyvars + "Duplicate parameter in a datatype binding" +); + +fun checkTypDesc (tyvars, tycon) = + checkDuplIds tyvars + "Duplicate parameter in a prim_type binding" +; + +(* checkApplicativeModExp dec is used to ensures that module values are + not opened at top-level within (both generative and applicative) functor bodies + (doing so is unsound in the presence of applicative functors). +*) +fun checkApplicativeModExp (_,(modexp,_)) = + case modexp of + DECmodexp dec => + checkApplicativeDec dec + | LONGmodexp _ => () + | LETmodexp (dec,modexp) => + (checkApplicativeDec dec; + checkApplicativeModExp modexp) + | PARmodexp modexp => + checkApplicativeModExp modexp + | CONmodexp (modexp,sigexp) => + checkApplicativeModExp modexp + | ABSmodexp (modexp,sigexp) => + checkApplicativeModExp modexp + | FUNCTORmodexp (_,modid,_, sigexp, modexp) => + () + (* checkApplicativeModExp modexp is already ensured by the + elaboration of modexp *) + | APPmodexp (modexp,modexp') => + (checkApplicativeModExp modexp; + checkApplicativeModExp modexp') + | RECmodexp (modid,_,sigexp, modexp) => + checkApplicativeModExp modexp +and checkApplicativeDec (loc,dec') = + case dec' of + ABSTYPEdec(_, _, dec2) => + checkApplicativeDec dec2 + | LOCALdec (dec1, dec2) => + (checkApplicativeDec dec1;checkApplicativeDec dec2) + | SEQdec (dec1, dec2) => + (checkApplicativeDec dec1;checkApplicativeDec dec2) + | STRUCTUREdec mbs => + app (fn ASmodbind ((loc,_),_,_) => + errorMsg loc "Illegal structure binding: \ + \a structure value cannot be opened in a functor body" + | MODBINDmodbind (_,modexp') => + checkApplicativeModExp modexp') + mbs + | FUNCTORdec fbs => + app (fn ASfunbind ((loc,_),_,_) => + errorMsg loc "Illegal functor binding: \ + \a functor value cannot be opened in a functor body" + | FUNBINDfunbind (_,modexp') => + checkApplicativeModExp modexp') + fbs + | _ => () +; + +(* semantic checks *) + +val bindOnceInEnv = fn env => fn (loc,id) => fn info => fn msg => + (lookupEnv env id; + errorMsg loc ("Illegal rebinding of "^id^": "^msg) + ) + handle Subscript => bindInEnv env id info +; + +local +(* cvr: TODO share code *) +fun checkNoRebindingsTyEnv loc ids VE msg = + foldEnv (fn id => fn _ => fn ids => + if member id ids + then (errorMsg loc + ("Illegal rebinding of type constructor "^id^": "^msg)) + else id::ids) ids VE +and checkNoRebindingsModEnv loc modids ME msg = + foldEnv (fn id => fn _ => fn ids => + if member id ids + then errorMsg loc ("Illegal rebinding of structure identifier "^id^": "^msg) + else id::ids) modids ME +and checkNoRebindingsVarEnv loc vids VE msg = + foldEnv (fn id => fn _ => fn ids => + if member id ids + then errorMsg loc ("Illegal rebinding of value identifier "^id^": "^msg) + else id::ids) vids VE +and checkNoRebindingsFunEnv loc funids FE msg = + foldEnv (fn id => fn _ => fn ids => + if member id ids + then errorMsg loc ("Illegal rebinding of functor identifier "^id^": "^msg) + else id::ids) funids FE +and checkNoRebindingsSigEnv loc sigids GE msg = + foldEnv (fn id => fn _ => fn ids => + if member id ids + then errorMsg loc ("Illegal rebinding of signature identifier "^id^": "^msg) + else id::ids) sigids GE +and checkNoRebindingsStr loc (modids,funids,sigids,tycons,vids) S msg = + case S of + STRstr (ME,FE,GE,TE,VE) => + (checkNoRebindingsModEnv loc modids ME msg, + checkNoRebindingsFunEnv loc funids FE msg, + checkNoRebindingsSigEnv loc sigids GE msg, + checkNoRebindingsTyEnv loc tycons TE msg, + checkNoRebindingsVarEnv loc vids VE msg) + | SEQstr (S,S') => + checkNoRebindingsStr loc (checkNoRebindingsStr loc (modids,funids,sigids,tycons,vids) S msg) S' msg +in + val checkNoRebindingsStr = fn loc => fn S => fn msg => (checkNoRebindingsStr loc ([],[],[],[],[]) S msg;()) + val checkNoRebindingsTyEnv = fn loc => fn TE => fn msg => (checkNoRebindingsTyEnv loc [] TE msg;()) + val checkNoRebindingsVarEnv = fn loc => fn VE => fn msg => (checkNoRebindingsVarEnv loc [] VE msg;()) +end +; + +fun errorVarAsCon (ii : IdInfo) = + errorMsg (#idLoc (#info ii)) "A constructor name expected" +; + +fun errorPrimAsCon (ii : IdInfo) = + errorMsg (#idLoc (#info ii)) "A constructor name expected" +; + +fun resolvePatCon ME VE (pat as (loc, pat')) = + case pat' of + SCONpat _ => pat + | VARpat ii => + let val (fields,cs) = lookup_VEForPat ME VE ii + val {qualid, info} = ii + in + case #info cs of + VARname _ => + (if #qual qualid <> "" orelse + case #id qualid of [_] => false | _ => true + then + errorMsg (#idLoc info) + "Variable names in patterns cannot be qualified" + else (); + pat) + | PRIMname _ => + (if #qual qualid <> "" orelse + case #id qualid of [_] => false | _ => true + then + errorMsg (#idLoc info) + "Variable names in patterns cannot be qualified" + else (); + pat) + | CONname ci => + (if #conArity(!ci) <> 0 then + errorMsg (#idLoc info) + "Unary constructor in the pattern needs an argument" + else (); + #idKind info := { qualid= #qualid cs, info=CONik ci }; + (loc, NILpat ii)) + | EXNname ei => + (if #exconArity(!ei) <> 0 then + errorMsg (#idLoc info) + "Unary exception constructor in the pattern needs an argument" + else (); + #idKind info := { qualid= #qualid cs, info=EXCONik ei }; + #idFields info := fields; + (loc, EXNILpat ii)) + | REFname => + errorMsg (#idLoc info) "`ref` is used as a variable" + end + | WILDCARDpat => pat + | NILpat ii => fatalError "resolvePatCon" + | CONSpat(ii, p) => + let val (fields,cs) = lookup_VEForPat ME VE ii + val {qualid, info} = ii + in + case #info cs of + VARname _ => errorVarAsCon ii + | PRIMname _ => errorPrimAsCon ii + | CONname ci => + (if #conArity(!ci) = 0 then + errorMsg (#idLoc info) + "Nullary constructor in a pattern cannot be applied" + else (); + #idKind info := { qualid= #qualid cs, info=CONik ci }; + (loc, CONSpat(ii, resolvePatCon ME VE p))) + | EXNname ei => + (#idKind info := { qualid= #qualid cs, info=EXCONik ei }; + #idFields info := fields; + (loc, EXCONSpat(ii, resolvePatCon ME VE p))) + | REFname => (loc, REFpat (resolvePatCon ME VE p)) + end + | EXNILpat _ => fatalError "resolvePatCon" + | EXCONSpat _ => fatalError "resolvePatCon" + | EXNAMEpat _ => fatalError "resolvePatCon" + | REFpat _ => fatalError "resolvePatCon" + | RECpat(ref (RECrp(fs, dots))) => + (loc, RECpat(ref (RECrp(map_fields (resolvePatCon ME VE) fs, dots)))) + | RECpat(ref (TUPLErp _)) => fatalError "resolvePatCon" + | VECpat ps => + (loc, VECpat (map (resolvePatCon ME VE) ps)) + | PARpat p => + (loc, PARpat (resolvePatCon ME VE p)) + | INFIXpat (ref (UNRESinfixpat _)) => fatalError "resolvePatCon" + | INFIXpat (ref (RESinfixpat p)) => + resolvePatCon ME VE p + | TYPEDpat(p,t) => + (loc, TYPEDpat(resolvePatCon ME VE p, t)) + | LAYEREDpat(pat1, pat2) => + (loc, LAYEREDpat(resolvePatCon ME VE pat1, resolvePatCon ME VE pat2)) +; + + +fun resolvePatConRec ME VE (pat as (loc, pat')) = + case pat' of + VARpat ii => + let val {qualid, info} = ii + in + if #qual qualid <> "" orelse + case #id qualid of [_] => false | _ => true + then + errorMsg (#idLoc info) + "Variable names in patterns cannot be qualified" + else + (checkRebinding illegalVal ii; + pat) + end + | WILDCARDpat => + pat + | PARpat p => + (loc, PARpat (resolvePatConRec ME VE p)) + | TYPEDpat(p,t) => + (loc, TYPEDpat(resolvePatConRec ME VE p, t)) + | LAYEREDpat(pat1, pat2) => + (loc, LAYEREDpat(resolvePatConRec ME VE pat1, resolvePatConRec ME VE pat2)) + | INFIXpat (ref (RESinfixpat p)) => + resolvePatConRec ME VE p + (* Other errors will be caught later by Synchk.checkRecFnPat *) + | _ => errorMsg loc "Ill-formed left hand side in recursive binding"; + + +local (* to implement the derived form for structure sharing, + adapted from the MLKit + *) + (* cvr: TODO the error messages could be further + improved by highlighting the + location of the longmodid that causes the error *) + fun update(a,b,m) = (let val bs = lookupEnv m a + in + bindInEnv m a (b::bs) + end) + handle Subscript => bindInEnv m a [b]; + + (* We first collect a list of tyname lists which must be identified. *) + + fun collect_TE (loc,T0 : TyName list, path, TEs, acc) : TyName list list = + let val tcmap = foldL (fn TE => fn acc => + foldEnv (fn tycon => fn tystr => fn acc => + update(tycon,tystr,acc)) + acc + TE) + NILenv + TEs + + (* Eliminate entries with less than two component, check + * arities and flexibility of involved tynames. Further, + * extract tynames from type structures. *) + + in + foldEnv (fn tycon => fn tystrs => fn acc => + case tystrs of + [] => acc + | [tystr] => acc + | tystrs => + let fun tystr_to_tyname (tyfun,_) = + (choose (equalsTyFunTyName tyfun) T0) + handle Subscript => + errorMsg loc + ("Illegal sharing abbreviation: \ + \the type constructor "^ + (showQualId {qual="",id=tycon::path})^ + " does not denote an opaque type in each equated structure") + val tynames = map tystr_to_tyname tystrs + val kind = case tynames of + tn :: _ => kindTyName tn + | _ => fatalError "collect_TE:2" + (* we know that there are more than zero *) + val _ = app (fn tn => if kindTyName tn = kind + then + () + else errorMsg loc + ("Illegal sharing abbreviation: \ + \the type constructor "^ + (showQualId {qual="",id=tycon::path})^ + " does not have the same arity in \ + \each equated structure")) + tynames + in tynames::acc + end) acc tcmap + end + + fun collect_S (loc,T0, path, Ss, acc) : TyName list list = + let val (MEs, TEs) = foldL(fn RS => fn (MEs, TEs) => + let val S = SofRecStr RS + val ME = MEofStr S + val TE = TEofStr S + in (ME::MEs,TE::TEs) + end) ([],[]) Ss + val acc = collect_ME(loc,T0,path, MEs, acc) + in collect_TE(loc,T0, path, TEs, acc) + end + + and collect_ME (loc, T0, path, MEs, acc) : TyName list list = + let val smap = foldL (fn ME => + fn acc => + foldEnv (fn modid => + fn {qualid,info=S} => + fn acc => + update(modid,S,acc) + ) + acc + ME) + NILenv + MEs + in + foldEnv (fn strid => fn Ss => fn acc => + case Ss of + [] => acc (* Eliminate entries with *) + | [S] => acc (* less than two components. *) + | Ss => collect_S(loc,T0, strid::path,Ss,acc)) + acc smap + end + + + (* Collapse tynames set if any candidates identify two such *) + + fun emptyIntersection T = fn [] => true + | (tn::T') => not(exists (isEqTN tn) T) + andalso emptyIntersection T T' + fun union T = fn [] => T + | tn::T' => if exists (isEqTN tn) T + then union T T' + else union (tn::T) T' + + fun collapse ([], Ts) : TyName list list = Ts + | collapse (T::Ts, Ts') = + let fun split ([], no, yes) = (no, yes) + | split (T'::Ts'', no, yes) = + if emptyIntersection T' T then split(Ts'',T'::no, yes) + else split(Ts'',no, T'::yes) + in case split(Ts,[],[]) + of (no, []) => collapse(no, T::Ts') + | (no, yes) => + let val Tnew = foldL union T yes (*cvr: ?*) + in collapse(Tnew::no, Ts') + end + end + + (* build the realisation *) + + fun build T0 Ts : TyName list = + case Ts of + [] => [] + | (T::Ts) => let val T = (* cvr: re-order T as T0 *) + foldR (fn tn => fn acc => + (((choose (isEqTN tn) T)::acc) + handle Subscript => acc)) + [] + T0 + val (tn,T') = case T of + [] => fatalError "build" + | tn::T' => (tn,T') + val equ = foldR (fn tn => fn equ => + if (#tnEqu (!(#info tn))) <> FALSEequ + then TRUEequ (* cvr: TODO should we worry about REFequ? *) + else equ) + FALSEequ + T + val _ = setTnEqu (#info tn) equ + val () = app (fn {qualid,info} => setTnSort info (REAts (APPtyfun (NAMEtyapp(tn))))) T' + (* cvr: TODO revise - + can't we identify type names + just by identifying their info + fields? *) + val T'' = build T0 Ts + in T' @ T'' + end +in + fun share (loc,T0:TyName list, Ss : RecStr list) : TyName list = + let val Ts = collect_S (loc,T0,[],Ss,[]) + val Ts : TyName list list = collapse(Ts,[]) + val T = build T0 Ts + in + drop (fn t => exists (isEqTN t) T) T0 + end +end; + +val elabModExpRef = + let fun dummyElabModExp (e:Expectation) (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) (TE:TyEnv) (modexp:ModExp) : Globals.ExMod = fatalError "dummyElabModExp" + in ref dummyElabModExp + end; + +fun elabTyConPath ME FE GE UE VE TE (loc,tyconpath') = + case tyconpath' of + LONGtyconpath longtycon => + findLongTyCon ME TE loc (#qualid longtycon) + | WHEREtyconpath (longtycon,(_,modid),modexp) => + let + val EXISTSexmod(T,M) = + (!elabModExpRef) STRexpected ME FE GE UE VE TE modexp + val S = case M of + FUNmod _ => errorMsg loc "Illegal projection: this module expression should be\ + \ a structure but is actually a functor" + | STRmod S => S + val modidinfo = {qualid = mkLocalName modid, info = S} val tyStr = findLongTyCon (bindInEnv ME modid modidinfo) + TE loc (#qualid longtycon) + val (fns,_,_) = freeVarsTyStr [] [] ([],[],[]) tyStr + in + app (fn tn => + if exists (isEqTN tn) T + then errorMsg loc "Illegal projection: this projection\ + \ causes an existential type constructor\ + \ to escape its scope" else ()) fns; + tyStr + end; +; + +fun applyTyConPath ME FE GE UE VE TE ((tyconpath as (loc,_)) : TyConPath) ts = + let val (tyfun,_) = elabTyConPath ME FE GE UE VE TE tyconpath + val arity = List.length ts + in + if kindTyFun tyfun <> (ARITYkind arity) then + errorMsg loc ("Arity mismatch! ") + else (); + case tyfun of + APPtyfun tyapp => + CONt(ts, tyapp) + | TYPEtyfun(pars, body) => + type_subst (zip2 pars ts) body +(* cvr: TODO would this improve sharing? *) +(* | TYPEtyfun(pars, body) => + let val tyname = + {qualid = {qual="",id = [""]}, + info = ref {tnKind = ARITYkind arity, + tnEqu = TRUEequ, (* cvr: TODO revise *) + tnSort = REAts tyfun, + tnStamp = newTyNameStamp(), + tnLevel = currentBindingLevel(), + tnConEnv = ref NONE}} + in + CONt(ts, NAMEtyapp tyname) + end +*) +(* cvr: end *) + | LAMtyfun _ => fatalError "applyTyConpath" + end; + +val elabSigExpRef = + let fun dummyElabSigExp (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) (TE:TyEnv) (sigexp:SigExp) : Globals.Sig = fatalError "dummyElabSigExp" + in ref dummyElabSigExp + end; + + +fun elabTy (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE:VarEnv) (TE : TyEnv) (loc, ty') = + case ty' of + TYVARty ii => + lookup_UE UE loc ii + | RECty fs => + (checkRecTy (loc,fs); + type_rigid_record (map_fields (elabTy ME FE GE UE VE TE) fs)) + | CONty(ty_list,tyconpath) => + applyTyConPath ME FE GE UE VE TE tyconpath + (map (elabTy ME FE GE UE VE TE) ty_list) + | FNty(ty,ty') => + type_arrow (elabTy ME FE GE UE VE TE ty) + (elabTy ME FE GE UE VE TE ty') + | PACKty(sigexp) => + let val LAMBDAsig (T,M) = (!elabSigExpRef) ME FE GE UE VE TE sigexp + in + PACKt (EXISTSexmod(T,M)) + end + | PARty(ty) => + elabTy ME FE GE UE VE TE ty +; + +fun elabSCon (INTscon i, _ ) = type_int + | elabSCon (CHARscon c, _ ) = type_char + | elabSCon (WORDscon c, tyOptRef) = + let val ty = VARt (newTypeVar false false true) + (* nonequ nonimp overloaded *) + in tyOptRef := SOME ty; ty end + | elabSCon (REALscon r, _ ) = type_real + | elabSCon (STRINGscon s, _ ) = type_string +; + +fun elabPat (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) (pat as (loc, pat')) (pat_t : Type) (PE : VarEnv) = + case pat' of + SCONpat scon => + (unifyPat pat (elabSCon scon) pat_t; PE) + | VARpat ii => + (case ii of + {qualid = {id = [id],...}, info={idLoc,...}} => + let val q = (* mkName onTop *) mkLocalName id + val vi = { qualid=q, info=REGULARo } + in bindOnceInEnv PE (idLoc,id) + {qualid=q, info= (trivial_scheme pat_t,VARname REGULARo)} + "the same value identifier is bound twice in a pattern" + end + | {qualid = {id = _,...},...} => fatalError "elabPat: VARpat") + (* longvid variables are illegal *) + | WILDCARDpat => PE + | NILpat ii => (unifyPat pat (lookup_VE ME VE ii) pat_t; PE) + | CONSpat(ii, p) => + let val id_t = lookup_VE ME VE ii + val p_t = newUnknown() + val res_t = newUnknown() + in + unifyId ii id_t (type_arrow p_t res_t); + if (looksLikeInfixId ii) andalso (isPairPat p) then + (unify p_t (newUnknownPair()) + handle Unify reason => + typeClashId ii id_t (type_arrow (newUnknownPair()) res_t) reason) + else (); + unifyPat pat res_t pat_t; + elabPat ME FE GE UE VE TE p p_t PE + end + | EXNILpat ii => + let val id_t = lookup_VE ME VE ii + in + unifyId ii id_t type_exn; + unifyPat pat type_exn pat_t; + PE + end + | EXCONSpat(ii, p) => + let val id_t = lookup_VE ME VE ii + val p_t = newUnknown() + in + unifyId ii id_t (type_arrow p_t type_exn); + if looksLikeInfixId ii andalso isPairPat p then + (unify p_t (newUnknownPair()) + handle Unify reason => + typeClashId ii id_t (type_arrow (newUnknownPair()) type_exn) reason) + else (); + unifyPat pat type_exn pat_t; + elabPat ME FE GE UE VE TE p p_t PE + end + | EXNAMEpat _ => fatalError "elabPat:1" + | REFpat p => + let val p_t = newUnknown() in + unifyPat pat (type_ref p_t) pat_t; + elabPat ME FE GE UE VE TE p p_t PE + end + | RECpat(ref (RECrp(fs, dots))) => + let val _ = checkRecPat (loc,fs) + val ls = map fst fs + val ps = map snd fs + val ts = map (fn _ => newUnknown()) ps + val fs_t = zip2 ls ts + fun reportClash isRigid reason = + let val ts' = map (fn _ => newUnknown()) ps + val fs_t' = zip2 ls ts' + in + if isRigid then + typeClashPat pat (type_rigid_record fs_t') pat_t reason + else + typeClashPat pat + (type_flexible_record fs_t' (fresh3DotType())) pat_t reason + end + in + (case dots of + NONE => (unify (type_rigid_record fs_t) pat_t + handle Unify reason => reportClash true reason) + | SOME rho => (unify (type_flexible_record fs_t rho) pat_t + handle Unify reason => reportClash false reason)); + foldL_zip (elabPat ME FE GE UE VE TE ) PE ps ts + end + | RECpat(ref (TUPLErp _)) => fatalError "elabPat:2" + | VECpat ps => + let val p_t = newUnknown() in + unifyPat pat (type_vector p_t) pat_t; + foldL (fn p => fn PE => elabPat ME FE GE UE VE TE p p_t PE) PE ps + end + | PARpat p => + elabPat ME FE GE UE VE TE p pat_t PE + | INFIXpat _ => fatalError "elabPat:3" + | TYPEDpat(p,ty) => + let val ty_t = elabTy ME FE GE UE VE TE ty + val PE' = elabPat ME FE GE UE VE TE p pat_t PE + in + unifyPat p pat_t ty_t; + PE' + end + | LAYEREDpat(p1,p2) => + (checkAsPatSource p1; + elabPat ME FE GE UE VE TE p2 pat_t + (elabPat ME FE GE UE VE TE p1 pat_t PE)) +; + + +fun freshTyName tycon kind = + ({qualid = mkLocalName tycon, + info = ref {tnKind = kind, + tnStamp = newTyNameStamp(), + tnEqu = TRUEequ, + tnSort = PARAMETERts, + tnLevel = currentBindingLevel(), + tnConEnv = ref NONE + } + } + : TyName) +; + +fun makeTyName tyvar_list tycon = + let val arity = List.length tyvar_list + in freshTyName tycon (ARITYkind arity) end +; + +fun initialDatBindTE (dbs : DatBind list)= + foldL + (fn (datbind as (tyvar_list, loctycon as (loc,tycon), _)) => fn (LAMBDA(T,env)) => + let val _ = checkDatBind datbind + val tyname = makeTyName tyvar_list tycon + in + LAMBDA(tyname::T, + bindOnceInEnv env loctycon + (APPtyfun (NAMEtyapp tyname),ConEnv []) + "the same type constructor is bound twice\ + \ in a datatype declaration or specification") + end) + (LAMBDA([],NILenv)) dbs +; + +fun absTE (TE : TyEnv) = + mapEnv + (fn id => + (fn (APPtyfun (NAMEtyapp tyname),ConEnv CE) => + let val {info, ...} = tyname in + case !(#tnConEnv(!info)) of + SOME (ConEnv CE) => + (setTnEqu info FALSEequ; + #tnConEnv(!info):= NONE; + (APPtyfun (NAMEtyapp tyname),ConEnv [])) + | _ => fatalError "absTE:1" + end + | _ => fatalError "absTE:2")) + TE +; + +fun elabTypBind (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) + (TE : TyEnv) (tb as (tyvars, loctycon, ty) : TypBind) = + let val _ = checkTypBind tb + val (_,id) = loctycon + val pars = map (fn tyvar => hd(#id(#qualid tyvar))) tyvars + val _ = incrBindingLevel(); + val vs = map (fn tv => newExplicitTypeVar tv) pars + val us = map TypeOfTypeVar vs + val UE' = (zip2 pars us) @ UE + val ty = elabTy ME FE GE UE' VE TE ty + val _ = decrBindingLevel(); + val tyname = makeTyName tyvars id + val tyfun = APPtyfun (NAMEtyapp(tyname)) + in + setTnSort (#info tyname) (REAts (TYPEtyfun(vs, ty))); + (loctycon, (tyfun,ConEnv [])) + end +; + +fun elabTypBindList (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) + (TE : TyEnv) (tbs : TypBind list) = + foldL_map (fn (locid, tyname) => fn env => + bindOnceInEnv env locid tyname + "the same type constructor is bound twice in a type declaration") + (elabTypBind ME FE GE UE VE TE) NILenv tbs +; + +fun elabTypBindList_opt (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) (TE : TyEnv) = fn + SOME tbs => elabTypBindList ME FE GE UE VE TE tbs + | NONE => NILenv +; + +fun elabPrimTypBind equ (typdesc as (tyvars, loctycon) : TypDesc) = + let val _ = checkTypDesc typdesc + val (_,id) = loctycon + val tyname = makeTyName tyvars id + val tyfun = APPtyfun (NAMEtyapp(tyname)) + in + setTnEqu (#info tyname) equ; + LAMBDA([tyname],(loctycon, (tyfun, ConEnv []))) + end; + +fun elabPrimTypBindList equ (tbs : TypDesc list) = + foldL_map (fn LAMBDA(T',(locid, tystr)) => fn (LAMBDA(T,env)) => + LAMBDA(T@T',bindOnceInEnv env locid tystr + "The same tycon is bound twice\ + \ in a prim_type declaration")) + (elabPrimTypBind equ) (LAMBDA([],NILenv)) tbs +; + +fun closeEE EE = + mapEnv (fn excon => fn {qualid, info =(t,csd)} => + {qualid = qualid, info = (generalization true t,csd)}) EE +; + +fun openVE VE = + mapEnv (fn id => fn {qualid, info = (sch,csd)} => + {qualid=qualid, info = (TypeOfScheme sch,csd)}) VE +; + +fun isRecTy (loc, ty') = + case ty' of + RECty [] => false + | RECty _ => true + | _ => false +; + +fun arityOfRecTy (loc, ty') = + case ty' of + RECty fs => List.length fs + | _ => fatalError "arityOfRecTy" +; + + +fun elabConBind (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) tvs res_t = fn + ConBind(ii, SOME ty) => + let val _ = checkRebinding illegalCon ii; + val {qualid, info} = ii + val ci = getConInfo ii + val _ = setConArity ci 1 + val arg_t = (elabTy ME FE GE UE VE TE ty) + in + setConType ci + (mkScheme tvs (type_arrow arg_t res_t)); + if #conSpan(!ci) <> 1 andalso isRecTy ty then + (setConArity ci (arityOfRecTy ty); + setConIsGreedy ci true) + else (); + { qualid= #qualid(!(#idKind(#info ii))), info=ci } + end + | ConBind(ii, NONE) => + let val _ = checkRebinding illegalCon ii; + val {qualid, info} = ii + val ci = getConInfo ii + val _ = setConArity ci 0 + in + setConType ci + (mkScheme tvs res_t); + { qualid= #qualid(!(#idKind(#info ii))), info=ci } + end +; + + +fun setEquality (TE :TyEnv) = + traverseEnv + (fn _ => fn (tyfun,_) => + case tyfun of + APPtyfun (NAMEtyapp tyname) => + let val {info, ...} = tyname in + case #tnSort (!info) of + REAts tyfun => + setTnEqu info (EqualityOfTyFun tyfun) + | VARIABLEts => fatalError "setEquality" + | PARAMETERts => fatalError "setEquality" + end + | _ => fatalError "setEquality") + TE +; + +val equAttrReset = ref false; + +fun maximizeEquality (TE : TyEnv) = +( + equAttrReset := true; + while !equAttrReset do + (equAttrReset := false; + traverseEnv + (fn _ => fn tystr => + (case tystr of + (APPtyfun (NAMEtyapp tyname),ConEnv CE) => + let val {info, ...} = tyname in + case #tnEqu(!info) of + FALSEequ => () + | TRUEequ => + if exists (fn ci => schemeViolatesEquality + (#conType (!(#info ci)))) + CE + then + (setTnEqu info FALSEequ; equAttrReset := true) + else () + | _ => fatalError "maximizeEquality:1" + end + | _ => fatalError "maximizeEquality:2") + ) + TE) +); + + +fun setTags (cbs : ConBind list) = + let prim_val string_of_int : int -> string = 1 "sml_string_of_int"; + val span = List.length cbs + fun loop n = fn + [] => () + | (ConBind(ii, _)) :: rest => + let val {qualid = {id = lid,...},info} = ii + val id = longIdentAsIdent lid "setTags:1" + val {idLoc,...} = info + val _ = app (fn (ConBind ({qualid = {id = lid',...},info = {idLoc=idLoc',...}},_)) => + if id = (longIdentAsIdent lid' "setTags:2") then + errorMsg idLoc' "Illegal constructor specification: \ + \the constructor cannot be specified twice \ + \for the same datatype" + else ()) + rest (* cvr: should this check go elsewhere ? *) + val () = + if n > maxBlockTag then + errorMsg idLoc ("Implementation restriction:\n \ + \A datatype cannot declare more than "^ + string_of_int (maxBlockTag + 1) ^ + " constructors.") + else (); + val ci = mkConInfo() + val q = mkGlobalName id + val _ = #idKind info := { qualid=q, info=CONik ci } + in + setConTag ci n; + setConSpan ci span; + loop (n+1) rest + end + in loop 0 cbs end +; + + +fun cons x xs = x :: xs; + +fun elabDatBind (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) (TE:TyEnv) + (datbind as (tyvars, loctycon as (loc,tycon), conbind_list) : DatBind) = + let val pars = map (fn ii => hd(#id(#qualid ii))) tyvars + val conbind_list = + Sort.sort (fn ConBind(ii,_) => fn ConBind(ii',_) => + hd(#id(#qualid ii))<=hd(#id(#qualid ii'))) conbind_list + val () = setTags conbind_list + val () = incrBindingLevel() + val vs = map (fn tv => newExplicitTypeVar tv) pars + val us = map TypeOfTypeVar vs + val UE' = (zip2 pars us) @ UE + val (tyfun,_) = lookupEnv TE tycon + val tyname = case tyfun of + APPtyfun(NAMEtyapp tyname) => tyname + | _ => fatalError "elabDatBind" + val t = type_con us tyname + val CE = ConEnv (foldR_map cons (elabConBind ME FE GE UE' VE TE vs t) [] conbind_list) + in + decrBindingLevel(); + setTnConEnv (#info tyname) (ref (SOME CE)); + (VEofCE CE,(loctycon,(tyfun,CE))) + end +; + +fun elabDatBindList (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) (TE : TyEnv) (dbs : DatBind list) = + foldL_map (fn (VE',(loctycon,tystr)) => fn (VE,TE) => + (plusEnv VE VE', + bindOnceInEnv TE loctycon tystr + "The same type constructor is declared twice in a\ + \ datatype declaration")) + (elabDatBind ME FE GE UE VE TE) (NILenv,NILenv) dbs +; + +fun elabExBind (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) onTop = fn + EXDECexbind(ii, SOME ty) => + let val _ = checkRebinding illegalCon ii + val {qualid, info = {idLoc,idKind,...}} = ii + val id = longIdentAsIdent (#id qualid) "elabExBind" + val ei = mkExConInfo() + val q = (* mkName onTop *) mkLocalName id + val _ = idKind := { qualid=q, info=EXCONik ei }; + val _ = setExConArity ei 1 +(* ps: val _ = if onTop then + setExConTag ei (SOME (q, newExcStamp())) + else () +*) + val arg_t = (elabTy ME FE GE UE VE TE ty) + in + if typeIsImperative arg_t then () + else errorMsg (xLR ty) "Non-imperative exception type"; +(* ps: if isExConStatic ei andalso isRecTy ty then + (setExConArity ei (arityOfRecTy ty); + setExConIsGreedy ei true) + else (); +*) + ((idLoc,id), {qualid = q,info = (type_arrow arg_t type_exn, EXNname ei)}) + end + | EXDECexbind(ii, NONE) => + let val _ = checkRebinding illegalCon ii + val {qualid, info = {idLoc,idKind,...}} = ii + val id = longIdentAsIdent (#id qualid) "elabDec:EXDECexbind" + val ei = mkExConInfo() + val q = (* mkName onTop *) mkLocalName id + val _ = idKind := { qualid=q, info=EXCONik ei }; + val _ = setExConArity ei 0 +(* ps: val _ = if onTop then + setExConTag ei (SOME (q, newExcStamp())) + else () +*) + in + ((idLoc,id), {qualid = q, info = (type_exn, EXNname ei)}) + end + | EXEQUALexbind(ii, ii') => + let val _ = checkRebinding illegalCon ii + val {qualid, info={idLoc,idKind,...}} = ii + val id = longIdentAsIdent (#id qualid) "elabDec:EXEQUALexbind" + val {qualid=qualid', info=info'} = ii' + val {idLoc=loc', ...} = info' + val (fields,{qualid = csqualid, info = (sigma,cs)}) = findLongVId ME VE loc' qualid' + in + case cs of + VARname _ => errorMsg loc' + ("Variable "^showQualId qualid' ^" is used as an exception name") + | PRIMname _ => errorMsg loc' + ("Primitive "^showQualId qualid' ^" is used as an exception name") + | CONname _ => errorMsg loc' + ("Constructor "^showQualId qualid' ^" is used as an exception name") + | REFname => errorMsg loc' + "`ref' is used as an exception name" + | EXNname ei' => (* cvr: TODO review *) + let val q = (* mkName onTop *) mkLocalName id in + #idKind info' := { qualid= csqualid, info=EXCONik ei' }; + #idFields info' := fields; + idKind := { qualid= q, info=EXCONik ei' }; + ((idLoc,id), {qualid = q, info = (specialization(sigma), EXNname ei')}) + end + + end +; + +fun elabExBindList (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) onTop ebs = + closeEE (foldL_map (fn (locid, tau) => fn env => + bindOnceInEnv env locid tau + "The same exception constructor is declared\ + \ twice in an exception declaration" ) + (elabExBind ME FE GE UE VE TE onTop) NILenv ebs) +; + +(* OVL1TXXo is not a true overloaded type, *) +(* because it needn't be resolved to `int', `real', or `string'. *) +(* This is only a hack to catch the type inferred by the *) +(* type-checker... Thus the attribute `overloaded' mustn't be *) +(* turned on in the type variable. *) +(* The same is true of OVL1TPUo (installPP) and OVL2EEBo (=, <>). *) + +fun elabOvlExp t ovltype = + case ovltype of + REGULARo => + fatalError "elabOvlExp" + | OVL1NNo => + (setCurrentBindingLevel true t; + type_arrow t t) + | OVL1NSo => + (setCurrentBindingLevel true t; + type_arrow t type_string) + | OVL2NNBo => + (setCurrentBindingLevel true t; + type_arrow (type_pair t t) type_bool) + | OVL2NNNo => + (setCurrentBindingLevel true t; + type_arrow (type_pair t t) t) + | OVL1TXXo => + (setCurrentBindingLevel false t; + type_arrow t t) + | OVL1TPUo => + (setCurrentBindingLevel false t; + type_arrow + (type_arrow type_ppstream (type_arrow t type_unit)) + type_unit) + | OVL2EEBo => + (setCurrentBindingLevel false t; + makeEquality t; + type_arrow (type_pair t t) type_bool) +; + +fun elabExp (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) + (exp as (loc, exp')) exp_t = + case exp' of + SCONexp scon => + unifyExp exp (elabSCon scon) exp_t +(* cvr: TODO + | VARexp(ref (RESve ii)) => + unifyExp exp (lookup_VE VE ii) exp_t + | VARexp(ref (OVLve(_, ovltype, tau))) => + unifyExp exp (elabOvlExp tau ovltype) exp_t +*) + | VIDPATHexp (r as (ref (RESvidpath ii))) => + let + val {qualid, info} = ii + val {idKind, idFields,... } = info + val (fields,{qualid = csqualid, info = (scheme,cs)}) = + findLongVId ME VE loc qualid + val tau = specialization(scheme) + in + case cs of + VARname REGULARo => + (idKind := { qualid=csqualid, info=VARik }; + idFields := fields; + unifyExp exp tau exp_t) + | VARname ovltype => + let val tau = newUnknown() in + r := OVLvidpath (ii, ovltype, tau); + unifyExp exp (elabOvlExp tau ovltype) exp_t + end + | PRIMname pi => + (idKind := { qualid=csqualid, info=PRIMik pi }; + idFields := fields; + unifyExp exp tau exp_t) + | CONname ci => + (idKind := { qualid=csqualid, info=CONik ci }; + idFields := fields; + unifyExp exp tau exp_t) + | EXNname ei => + (idKind := { qualid=csqualid, info=EXCONik ei }; + idFields := fields; + unifyExp exp tau exp_t) + | REFname => + (idKind := { qualid=csqualid, info=PRIMik piRef }; + idFields := fields; + unifyExp exp tau exp_t) + end + | VIDPATHexp (ref (OVLvidpath _)) => + fatalError "elabExp" + | FNexp mrules => + elabMatch ME FE GE UE VE TE mrules exp_t + | APPexp(func, arg) => + let val func_t = newUnknown() + val () = elabExp ME FE GE UE VE TE func func_t + val arg_t = newUnknown() + val res_t = newUnknown() + in + unifyExp func func_t (type_arrow arg_t res_t); + if looksLikeInfixExp func andalso isPairExp arg then + (unify arg_t (newUnknownPair()) + handle Unify reason => + typeClashExp func func_t (type_arrow (newUnknownPair()) res_t) + reason) + else (); + unifyExp exp res_t exp_t; + elabExp ME FE GE UE VE TE arg arg_t + end + | LETexp(dec, body) => + let val EXISTS(T,(ME',FE',GE', VE', TE')) = + elabDec ME FE GE UE VE TE false dec + val () = incrBindingLevel(); + val () = refreshTyNameSet PARAMETERts T; + val tau = + elabExp (plusEnv ME ME') (plusEnv FE FE') (plusEnv GE GE') UE + (plusEnv VE VE') (plusEnv TE TE') body exp_t + in decrBindingLevel() + end + | RECexp(ref (RECre fs)) => + let val ls = map fst fs + val _ = if duplicates ls then + errorMsg loc "The same label is bound twice in a record expression" + else () + val es = map snd fs + val ts = map (fn _ => newUnknown()) es + val fs_t = zip2 ls ts + in + (unify (type_rigid_record fs_t) exp_t + handle Unify reason => + let val ts' = map (fn _ => newUnknown()) es + val fs_t' = zip2 ls ts' + in typeClashExp exp (type_rigid_record fs_t') exp_t reason end); + app2 (elabExp ME FE GE UE VE TE) es ts + end + | RECexp(ref (TUPLEre _)) => fatalError "elabExp" + | VECexp es => + let val e_t = newUnknown() in + app (fn e => elabExp ME FE GE UE VE TE e e_t) es; + unifyExp exp (type_vector e_t) exp_t + end + | PARexp e => + elabExp ME FE GE UE VE TE e exp_t + | INFIXexp (ref (RESinfixexp e)) => + elabExp ME FE GE UE VE TE e exp_t + | INFIXexp (ref (UNRESinfixexp _)) => fatalError "elabExp: unresolved infix exp" + | TYPEDexp(e,ty) => + let val ty_t = elabTy ME FE GE UE VE TE ty in + elabExp ME FE GE UE VE TE e exp_t; + unifyExp e exp_t ty_t + end + | ANDALSOexp(e1, e2) => + (elabExp ME FE GE UE VE TE e1 type_bool; + elabExp ME FE GE UE VE TE e2 type_bool; + unifyExp exp type_bool exp_t) + | ORELSEexp(e1, e2) => + (elabExp ME FE GE UE VE TE e1 type_bool; + elabExp ME FE GE UE VE TE e2 type_bool; + unifyExp exp type_bool exp_t) + | HANDLEexp(e, mrules) => + (elabExp ME FE GE UE VE TE e exp_t; + elabMatch ME FE GE UE VE TE mrules (type_arrow type_exn exp_t)) + | RAISEexp e => + elabExp ME FE GE UE VE TE e type_exn + | IFexp(e0, e1, e2) => + (elabExp ME FE GE UE VE TE e0 type_bool; + elabExp ME FE GE UE VE TE e1 exp_t; + elabExp ME FE GE UE VE TE e2 exp_t) + | WHILEexp(e1, e2) => + let val e2_t = newUnknown() in + elabExp ME FE GE UE VE TE e1 type_bool; + elabExp ME FE GE UE VE TE e2 e2_t; + unitResultExpected e2 e2_t; + unifyExp exp type_unit exp_t + end + | SEQexp(e1, e2) => + let val e1_t = newUnknown() in + elabExp ME FE GE UE VE TE e1 e1_t; + unitResultExpected e1 e1_t; + elabExp ME FE GE UE VE TE e2 exp_t + end + | STRUCTUREexp(modexp,sigexp,r) => + let val EXISTSexmod(T,M) = elabModExp STRexpected ME FE GE UE VE TE modexp + val _ = case M of STRmod S => () + | _ => errorMsg loc + "The encapsulated module expression should be\ + \ a structure but is actually a functor" + val LAMBDAsig(T',M') = elabSigExp ME FE GE UE VE TE sigexp + val _ = case M' of STRmod _ => () + | _ => errorMsg loc + "The signature expression should specify\ + \ a structure but actually specifies a functor" + in + incrBindingLevel(); + refreshTyNameSet PARAMETERts T; + refreshTyNameSet VARIABLEts T'; + (matchMod M M' + handle MatchError matchReason => + (msgIBlock 0; + errLocation loc; + errPrompt "Signature mismatch: \ + \the structure does not match the signature ..."; + msgEOL(); + msgEBlock(); + errMatchReason "structure" "signature" matchReason; + raise Toplevel)); + refreshTyNameSet PARAMETERts T'; (* forget the realisation *) + decrBindingLevel(); + let val X' = EXISTSexmod(T',normMod M') (* re-introduce the quantifier *) + in + r := SOME X'; + unifyExp exp (PACKt (EXISTSexmod(T',M'))) exp_t + (* ^^^^^^^^^^^^^^^^^^^^^^^^^^^ + this type should *not* be normed + because it will be used to match against + *) + end + end + | FUNCTORexp(modexp,sigexp,r) => + let val EXISTSexmod(T,M) = elabModExp FUNexpected ME FE GE UE VE TE modexp + val _ = case M of FUNmod _ => () + | _ => errorMsg loc + "The encapsulated module expression should be\ + \ a functor but is actually a structure" + val LAMBDAsig(T',M') = elabSigExp ME FE GE UE VE TE sigexp + val _ = case M' of FUNmod _ => () + | _ => errorMsg loc + "The signature expression should specify\ + \ a functor but actually specifies a structure" + in + incrBindingLevel(); + refreshTyNameSet PARAMETERts T; + refreshTyNameSet VARIABLEts T'; + (matchMod M M' + handle MatchError matchReason => + (msgIBlock 0; + errLocation loc; + errPrompt "Signature mismatch: \ + \the functor does not match the signature ..."; + msgEOL(); + msgEBlock(); + errMatchReason "functor" "signature" matchReason; + raise Toplevel)); + refreshTyNameSet PARAMETERts T'; (* forget the realisation *) + decrBindingLevel(); + let val X' = EXISTSexmod(T',normMod M') (* re-introduce the quantifier *) + in + r := SOME X'; + unifyExp exp (PACKt (EXISTSexmod(T',M'))) exp_t + (* ^^^^^^^^^^^^^^^^^^^^^^^^^^^ + this type should *not* be normed + because it will be used to match against + *) + end + end + +and elabExpSeq (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) + (TE : TyEnv) es ts = + let fun loop [] [] = () + | loop (e :: es) (t :: ts) = + (elabExp ME FE GE UE VE TE e t; loop es ts) + | loop _ _ = fatalError "elabExpSeq" + in loop es ts end + +and elabMatch (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) + (TE : TyEnv) mrules match_t = + let val _ = app (fn MRule(r as ref pats, _) => + r := map (resolvePatCon ME VE) pats) + mrules + val MRule(ref pats1,_) = hd mrules + val arg_ts = map (fn pat => newUnknown()) pats1 + val res_t = newUnknown() + in + unifyMatch mrules (foldR type_arrow res_t arg_ts) match_t; + app (fn MRule(ref pats, exp) => elabMRule ME FE GE UE VE TE exp res_t pats arg_ts) + mrules + end + +and elabMRule (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) + (TE : TyEnv) exp res_t pats arg_ts = + case (pats, arg_ts) of + ([], []) => elabExp ME FE GE UE VE TE exp res_t + | (pat :: pats', arg_t :: arg_ts') => + let val VE' = elabPat ME FE GE UE VE TE (* false *) pat arg_t NILenv + in elabMRule ME FE GE UE (plusEnv VE VE') TE exp res_t pats' arg_ts' end + | (_, _) => fatalError "elabMRule" + +and elabDatatypeReplication (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) + (UE:UEnv) (VE:VarEnv) (TE : TyEnv) + (loc,((_,tycon),tyconpath)) = + let val tyStr as (tyfun,CE) = + elabTyConPath ME FE GE UE VE TE tyconpath + in (VEofCE CE,mk1Env tycon tyStr) + end +and elabDec (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) + (TE : TyEnv) (onTop : bool) (loc, dec') = + case dec' of + VALdec (tvs, (pvbs, rvbs)) => + let val _ = checkDuplIds tvs "Duplicate explicit type variable" + val pars = map (fn ii => hd(#id(#qualid ii))) tvs + val tyvars = scopedTyVars loc UE pars (unguardedValDec (pvbs, rvbs)) + val () = incrBindingLevel() + val UE' = incrUE tyvars @ UE + val VE' = elabValBind ME FE GE UE' VE TE pvbs + val VE'' = elabRecValBind ME FE GE UE' VE TE rvbs + in + decrBindingLevel(); + EXISTS([],(NILenv,NILenv,NILenv,closeValBindVE loc pvbs (plusEnv VE' VE''), NILenv)) + end + | PRIM_VALdec (tyvarseq,pbs) => + let val _ = checkDuplIds tyvarseq "Duplicate explicit type variable" + val pars = map (fn ii => hd(#id(#qualid ii))) tyvarseq + val tyvars = scopedTyVars loc UE pars (unguardedPrimValBindList pbs) + val () = incrBindingLevel() + val tvs = map (fn tv => newExplicitTypeVar tv) tyvars + val UE' = (zip2 tyvars (map TypeOfTypeVar tvs)) @ UE + val VE' = + foldL_map (fn(locid, info) => fn acc => + bindOnceInEnv acc locid info + "the same primitive is declared twice\ + \ in a prim_val declaration") + (elabPrimValBind ME FE GE UE' VE TE tvs) + NILenv pbs + in decrBindingLevel(); + EXISTS([],(NILenv, NILenv, NILenv, VE',NILenv)) + end + | FUNdec (ref (UNRESfundec _)) => fatalError "elabDec" + | FUNdec (ref (RESfundec dec)) => elabDec ME FE GE UE VE TE onTop dec + | TYPEdec tbs => + let val tbsTE = elabTypBindList ME FE GE UE VE TE tbs + in + setEquality tbsTE; + EXISTS([],(NILenv,NILenv,NILenv,NILenv, tbsTE)) + end + | PRIM_TYPEdec(equ, tbs) => + let val LAMBDA(T',TE') = elabPrimTypBindList equ tbs + in + EXISTS(T',(NILenv,NILenv,NILenv,NILenv,TE')) + end + | DATATYPEdec(dbs, tbs_opt) => + let val LAMBDA(T,dbsTE) = initialDatBindTE dbs + val _ = incrBindingLevel(); + val _ = refreshTyNameSet PARAMETERts T; + val tbsTE = elabTypBindList_opt ME FE GE UE VE (plusEnv TE dbsTE) tbs_opt + (* Here dbsTE will get destructively updated too. *) + val _ = checkNoRebindingsTyEnv loc (plusEnv dbsTE tbsTE) + "the same type constructur is defined twice in this datatype declaration" + val (VE',dbsTE') = elabDatBindList ME FE GE UE VE (plusEnv (plusEnv TE dbsTE) tbsTE) dbs + val _ = checkNoRebindingsVarEnv loc VE' + "the same constructor is defined twice in this datatype declaration" + in + maximizeEquality dbsTE'; + setEquality tbsTE; + decrBindingLevel(); + EXISTS(T,(NILenv,NILenv,NILenv,VE', plusEnv dbsTE' tbsTE)) + end + | DATATYPErepdec rep => + let val (VE,TE) = elabDatatypeReplication ME FE GE UE VE TE (loc,rep) + in + EXISTS([],(NILenv,NILenv,NILenv,VE,TE)) + end + | ABSTYPEdec(dbs, tbs_opt, dec2) => + let val LAMBDA(T1,dbsTE) = initialDatBindTE dbs + val _ = incrBindingLevel(); + val _ = refreshTyNameSet PARAMETERts T1; + val tbsTE = elabTypBindList_opt ME FE GE UE VE (plusEnv TE dbsTE) tbs_opt + (* Here dbsTE will get destructively updated too. *) + val _ = checkNoRebindingsTyEnv loc (plusEnv dbsTE tbsTE) + "the same type constructur is defined twice in this abstype declaration" + val (VE',dbsTE') = elabDatBindList ME FE GE UE VE (plusEnv (plusEnv TE dbsTE) tbsTE) dbs + val _ = checkNoRebindingsVarEnv loc VE' + "the same constructor is bound twice in this abstype declaration" + val () = maximizeEquality dbsTE' + val () = setEquality tbsTE; + val EXISTS(T2,(ME2,FE2,GE2,VE2, TE2)) = + elabDec ME FE GE UE (plusEnv VE VE') + (plusEnv (plusEnv TE dbsTE') tbsTE) onTop dec2 + in + (* Now let's destructively update the equality attributes *) + (* and the lists of constructors! *) + (* Here VE2 and TE2 will be implicitly influenced too. *) + let val dbsTE2 = absTE dbsTE'; + in + setEquality tbsTE; + decrBindingLevel(); + EXISTS(T1@T2,(ME2,FE2,GE2,VE2, plusEnv(plusEnv dbsTE2 tbsTE) TE2)) + end + (* cvr: *) + end + | EXCEPTIONdec ebs => + EXISTS([],(NILenv,NILenv,NILenv,(elabExBindList ME FE GE UE VE TE onTop ebs), NILenv)) + | LOCALdec (dec1, dec2) => + let val EXISTS(T',(ME',FE',GE',VE', TE')) = + elabDec ME FE GE UE VE TE onTop dec1; + val _ = incrBindingLevel(); + val _ = refreshTyNameSet PARAMETERts T'; + val EXISTS(T'',(ME'', FE'', GE'', VE'',TE'')) = + elabDec (plusEnv ME ME') (plusEnv FE FE') (plusEnv GE GE') UE (plusEnv VE VE') (plusEnv TE TE') onTop dec2 + in decrBindingLevel(); + EXISTS(T'@T'',(ME'', FE'', GE'', VE'', TE'')) + end + | OPENdec longmodidinfos => + EXISTS([], + foldL (fn (longmodid,envoptref) => fn (ME',FE',GE',VE',TE') => + let val {qualid,info} = longmodid + val {idKind, idFields,idLoc,... } = info + val (fields,{qualid = csqualid, + info = Env as (ME'',FE'',GE'',VE'',TE'')}) = + findLongModIdForOpen ME idLoc qualid + in + idKind := { qualid=csqualid, info=STRik }; + idFields := fields; + envoptref := SOME Env; + (plusEnv ME' ME'', + plusEnv FE' FE'', + plusEnv GE' GE'', + plusEnv VE' VE'', + plusEnv TE' TE'') + end) + (NILenv,NILenv,NILenv,NILenv,NILenv) + longmodidinfos) + | EMPTYdec => EXISTS([],(NILenv, NILenv,NILenv,NILenv, NILenv)) + | SEQdec (dec1, dec2) => + let val EXISTS(T',(ME',FE',GE',VE', TE')) = + elabDec ME FE GE UE VE TE onTop dec1 + val _ = incrBindingLevel(); + val _ = refreshTyNameSet PARAMETERts T'; + val EXISTS(T'',(ME'', FE'', GE'', VE'',TE'')) = + elabDec (plusEnv ME ME') (plusEnv FE FE') (plusEnv GE GE') UE (plusEnv VE VE') (plusEnv TE TE') onTop dec2 + in (decrBindingLevel(); + EXISTS(T'@T'',(plusEnv ME' ME'', plusEnv FE' FE'',plusEnv GE' GE'',plusEnv VE' VE'', plusEnv TE' TE''))) + end + | FIXITYdec _ => EXISTS([],(NILenv,NILenv,NILenv,NILenv,NILenv)) + | STRUCTUREdec mbs => + let val EXISTS(T,ME') = elabModBindList ME FE GE UE VE TE mbs + in EXISTS(T,(ME',NILenv,NILenv,NILenv, NILenv)) + end + | FUNCTORdec fbs => + let val EXISTS(T,FE') = elabFunBindList ME FE GE UE VE TE fbs + in EXISTS(T,(NILenv,FE',NILenv,NILenv, NILenv)) + end + | SIGNATUREdec sbs => + let val GE' = elabSigBindList ME FE GE UE VE TE sbs + in EXISTS([],(NILenv,NILenv,GE',NILenv, NILenv)) + end +and elabModBindList (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) + (VE : VarEnv) (TE : TyEnv) mbs = + foldL_map + (fn EXISTS(T',(locmodid,M')) => fn (EXISTS(T,ME)) => + EXISTS(T@T', bindOnceInEnv ME locmodid M' + "the same structure identifier is declared twice\ + \ in a structure declaration")) + (elabModBind ME FE GE UE VE TE ) (EXISTS([],NILenv)) mbs +and elabModBind (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) + (VE : VarEnv) (TE : TyEnv) + (MODBINDmodbind (locmodid as (loc,modid),modexp as (loc',_))) = + let val EXISTSexmod(T,M) = elabModExp STRexpected ME FE GE UE VE TE modexp + val S = case M of + STRmod S => S + | FUNmod _ => + errorMsg loc' + "This module expression is actually a functor \ + \but should be a structure" + in + EXISTS(T,(locmodid,{qualid = (* mkName onTop *) mkLocalName modid, info = S})) + end + | elabModBind (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) + (VE : VarEnv) (TE : TyEnv) (ASmodbind (locmodid as (loc,modid),sigexp as (loc',_),exp)) = + let val LAMBDAsig(T,M) = elabSigExp ME FE GE UE VE TE sigexp + val S = case M of FUNmod _ => errorMsg loc' "This signature should specify a structure but actually specifies a functor" + | STRmod S => normRecStr S + val tau = elabExp ME FE GE UE VE TE exp (PACKt(EXISTSexmod(T,M))) + in + EXISTS(T,(locmodid,{qualid = (* mkName onTop *) mkLocalName modid, info = S})) + end +and elabFunBindList (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) + (VE : VarEnv) (TE : TyEnv) mbs = + foldL_map + (fn EXISTS(T',(locfunid,F')) => fn (EXISTS(T,FE)) => + EXISTS(T@T', bindOnceInEnv FE locfunid F' + "the same functor identifier is declared twice\ + \ in a functor declaration")) + (elabFunBind ME FE GE UE VE TE ) (EXISTS([],NILenv)) mbs +and elabFunBind (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) + (FUNBINDfunbind (locfunid as (loc,funid),modexp as (loc',_))) = + let val EXISTSexmod(T,M) = elabModExp FUNexpected ME FE GE UE VE TE modexp + val F = case M of + FUNmod F => F + | STRmod _ => + errorMsg loc' + "This module expression is actually a structure \ + \but should be a functor" + in + EXISTS(T,(locfunid,{qualid = (* mkName onTop *) mkLocalName funid, info = F})) + end +| elabFunBind (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) + (ASfunbind (locfunid as (loc,funid),sigexp as (loc',_),exp)) = + let val LAMBDAsig(T,M) = elabSigExp ME FE GE UE VE TE sigexp + val F = case M of + STRmod _ => errorMsg loc' "This signature should specify a functor but actually specifies a structure" + | FUNmod F => F + val tau = elabExp ME FE GE UE VE TE exp (PACKt(EXISTSexmod(T,M))) + in + EXISTS(T,(locfunid,{qualid = (* mkName onTop *) mkLocalName funid, info = F})) + end +and elabSigBindList (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) + (VE : VarEnv) (TE : TyEnv) sbs = + foldL_map (fn (locsigid,G) => fn GE => + bindOnceInEnv GE locsigid G + "the same signature identifier is declared twice\ + \ in a signature declaration") + (elabSigBind ME FE GE UE VE TE ) NILenv sbs +and elabSigBind (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) + (VE : VarEnv) (TE : TyEnv) (SIGBINDsigbind (locsigid as (loc,sigid),sigexp)) = + let val G = elabSigExp ME FE GE UE VE TE sigexp + in + (locsigid, {qualid = mkLocalName sigid, info = G}) + end +and elabModExp expectation (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) + (VE : VarEnv) (TE : TyEnv) (loc,(modexp',r)) = + case modexp' of + DECmodexp dec => + let + val EXISTS(T',(ME',FE',GE',VE',TE')) = elabDec ME FE GE UE VE TE false dec + val exmod = EXISTSexmod(T',(STRmod (NONrec (STRstr (sortEnv ME', + sortEnv FE', + NILenv, + sortEnv TE', + sortEnv VE'))))) + in + r := SOME exmod; + exmod + end + | LONGmodexp (ii as {info={withOp,...},qualid}) => + ((case resolveExpectation(expectation,withOp) of + STRexpected => + let val {qualid, info} = ii + val {idKind, idFields,... } = info + val (fields,{qualid=resqualid,info=S}) = + findLongModId ME loc qualid + val X = EXISTSexmod([],STRmod ((* cvr: avoid*) copyRecStr [] [] S)) + in + idKind := {qualid = resqualid, info = STRik}; + idFields := fields; + r := SOME X; + X + end + | FUNexpected => + let val {qualid, info} = ii + val {idKind, idFields,... } = info + val (fields,{qualid=resqualid,info=F}) = + findLongFunId ME FE loc qualid + val X = EXISTSexmod([],FUNmod ((* cvr: avoid*) copyGenFun [] [] F)) + in + idKind := {qualid = resqualid, info = FUNik}; + idFields := fields; + r := SOME X; + X + end + | _ => fatalError "elabModExp:resolveExpectation") + handle Toplevel => reportExpectation expectation ii) + | CONmodexp (modexp,sigexp) => + let + val LAMBDAsig(T',M') = elabSigExp ME FE GE UE VE TE sigexp + val EXISTSexmod(T,M) = elabModExp (expectMod M') ME FE GE UE VE TE modexp + in + incrBindingLevel(); + refreshTyNameSet PARAMETERts T; + refreshTyNameSet VARIABLEts T'; + ((matchMod M M') + handle MatchError matchReason => + (msgIBlock 0; + errLocation loc; + errPrompt "Signature mismatch: \ + \the module does not match the signature ..."; + msgEOL(); + msgEBlock(); + errMatchReason "module" "signature" matchReason; + raise Toplevel)); + decrBindingLevel(); + let val X' = EXISTSexmod(T,normMod M') + in + r := SOME X'; + X' + end + end + | ABSmodexp (modexp,sigexp) => + let val LAMBDAsig(T',M') = elabSigExp ME FE GE UE VE TE sigexp + val EXISTSexmod(T,M) = elabModExp (expectMod M') ME FE GE UE VE TE modexp + in + incrBindingLevel(); + refreshTyNameSet PARAMETERts T; + refreshTyNameSet VARIABLEts T'; + ((matchMod M M') + handle MatchError matchReason => + (msgIBlock 0; + errLocation loc; + errPrompt "Signature mismatch: \ + \the module does not match the signature ..."; + msgEOL(); + msgEBlock(); + errMatchReason "module" "signature" matchReason; (* cvr: TODO improve descs*) + raise Toplevel)); + refreshTyNameSet PARAMETERts T'; (* forget the realisation *) + (* cvr: REVIEW forgetting the realisation *only* works if + we haven't done path compression on any realised type names in M that + pointed to T' (usually because of sharing constraints), otherwise + those names won't have their realisations forgotten *) + decrBindingLevel(); + let val X' = EXISTSexmod(T',normMod M') (* re-introduce the quantifier *) + in + r := SOME X'; + X' + end + end + | LETmodexp (dec, modexp) => + let + val EXISTS(T',(ME',FE',GE',VE', TE')) = + elabDec ME FE GE UE VE TE false dec; + val _ = incrBindingLevel(); + val _ = refreshTyNameSet PARAMETERts T'; + val EXISTSexmod(T'',M) = + elabModExp expectation (plusEnv ME ME') (plusEnv FE FE') (plusEnv GE GE') UE (plusEnv VE VE') (plusEnv TE TE') modexp + in decrBindingLevel(); + let val X' = EXISTSexmod(T'@T'',M) (* re-introduce the quantifier *) + in + r := SOME X'; + X' + end + end + | FUNCTORmodexp (Generative standard,(loc,modid),idKindDescRef,sigexp,modexp) => + let val _ = checkApplicativeModExp modexp + val LAMBDAsig (T,M) = elabSigExp ME FE GE UE VE TE sigexp + val (ME',FE') = case M of + STRmod S => + (idKindDescRef := STRik; + (bindInEnv ME modid {qualid=mkLocalName modid, + info = normRecStr S}, + FE)) + | FUNmod F => + (idKindDescRef := FUNik; + (ME, + bindInEnv FE modid {qualid=mkLocalName modid, + info = F})) + val _ = incrBindingLevel(); + val _ = refreshTyNameSet PARAMETERts T; + val X = elabModExp MODexpected ME' FE' GE UE VE TE modexp + in + decrBindingLevel(); + let val X' = EXISTSexmod([],FUNmod(T,M,X)) + in + r := SOME X'; + X' + end + end + | FUNCTORmodexp (Applicative,(loc,modid),idKindDescRef,sigexp,modexp) => + let val LAMBDAsig (T,M) = elabSigExp ME FE GE UE VE TE sigexp + val (ME',FE') = case M of + STRmod S => + (idKindDescRef := STRik; + (bindInEnv ME modid {qualid=mkLocalName modid, + info = normRecStr S}, + FE)) + | FUNmod F => + (idKindDescRef := FUNik; + (ME, + bindInEnv FE modid {qualid=mkLocalName modid, + info = F})) + val _ = incrBindingLevel(); (* cvr: TODO review *) + val _ = incrBindingLevel(); + val _ = refreshTyNameSet PARAMETERts T; + val EXISTSexmod(T',M') = elabModExp MODexpected ME' FE' GE UE VE TE modexp + in + decrBindingLevel(); + let + val (T'',T'toT'') = parameteriseTyNameSet T' T + val X' = EXISTSexmod(T'',FUNmod(T,M,EXISTSexmod([],copyMod T'toT'' [] M'))) + in + decrBindingLevel(); + r := SOME X'; + X' + end + end + | APPmodexp (funmodexp as (loc',_),modexp) => + let + val EXISTSexmod(T,M) = elabModExp FUNexpected ME FE GE UE VE TE funmodexp + val (T',M',X) = case M of + FUNmod F => copyGenFun [] [] F + | STRmod _ => errorMsg loc' "Illegal application: this module expression \ + \is a structure but should be a functor" + val EXISTSexmod(T'',M'') = elabModExp (expectMod M') ME FE GE UE VE TE modexp + + in + incrBindingLevel(); + refreshTyNameSet PARAMETERts T; + refreshTyNameSet VARIABLEts T'; + refreshTyNameSet PARAMETERts T''; + (matchMod M'' M' + handle MatchError matchReason => + (msgIBlock 0; + errLocation loc; + errPrompt "Signature mismatch: \ + \the argument module does not match the functor's domain ..."; + msgEOL(); + msgEBlock(); + errMatchReason "actual argument" "formal argument" matchReason; + raise Toplevel)); + decrBindingLevel(); + let val X' = let val EXISTSexmod(T''',M''') = X + in + EXISTSexmod(T@T''@T''',normMod M''') + end + in + r := SOME X'; + X' + end + end + | PARmodexp modexp => + let val X = elabModExp expectation ME FE GE UE VE TE modexp + in r:= SOME X; + X + end + | RECmodexp ((loc,modid),inforef, + sigexp as (locsigexp,_), + modexp as (locmodexp,_)) => + let val LAMBDAsig (T,M) = elabSigExp ME FE GE UE VE TE sigexp + val (ME',RS) = case M of + STRmod RS => + (let val normRS = normRecStr RS + in + inforef := SOME normRS; + (bindInEnv ME modid {qualid=mkLocalName modid, + info = normRS}, + RS) + end) + | FUNmod F => + errorMsg locsigexp "Illegal recursive structure: \ + \the forward specification should specify \ + \a structure but actually specifies a functor" + val _ = incrBindingLevel(); + val _ = refreshTyNameSet PARAMETERts T; + val EXISTSexmod(T',M') = elabModExp STRexpected ME' FE GE UE VE TE modexp + val RS' = case M' of + STRmod RS' => + RS' + | FUNmod F => + errorMsg locmodexp "Illegal recursive structure: \ + \the body should be \ + \a structure but is actually a functor" + val _ = refreshTyNameSet PARAMETERts T'; + val _ = matchMod (STRmod RS') (STRmod RS) + handle MatchError matchReason => + (msgIBlock 0; + errLocation loc; + errPrompt "Illegal recursive structure: \ + \the body does not enrich the forward specification..."; + msgEOL(); + msgEBlock(); + errMatchReason "body" "forward specification" matchReason; + raise Toplevel) + in + decrBindingLevel(); + let val X' = EXISTSexmod(T@T',STRmod (normRecStr RS')) + in + r := SOME X'; + X' + end + end + +and elabValBind (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) + (TE : TyEnv) (vbs : ValBind list) = + let val _ = app (fn ValBind(r as ref p, e) => + r := resolvePatCon ME VE p) + vbs + val ps = map (fn ValBind(ref p,e) => p) vbs + val es = map (fn ValBind(ref p,e) => e) vbs + val pts = map (fn _ => newUnknown()) ps + val VE' = foldL_zip (elabPat ME FE GE UE VE TE ) NILenv ps pts + val VE'' = mkHashEnv (length ps) VE' + in + app2 (elabExp ME FE GE UE VE TE) es pts; + openVE VE'' + end + +and elabRecValBind (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) (vbs : ValBind list) = + let val _ = app (fn ValBind(r as ref p, e) => + r := resolvePatConRec ME VE p) + vbs + val ps = map (fn ValBind(ref p,e) => p) vbs + val es = map (fn ValBind(ref p,e) => e) vbs + val _ = app checkFnExp es + val pts = map (fn _ => newUnknown()) ps + val VE' = foldL_zip (elabPat ME FE GE UE VE TE ) NILenv ps pts + val VE'' = mkHashEnv (length ps) VE' + val rec_VE = plusEnv VE VE'' + in + app2 (elabExp ME FE GE UE rec_VE TE) es pts; + openVE VE'' + end +and elabPrimValBind ME FE GE UE VE TE tvs (ii, ty, arity, n) = + let (* cvr: REVIEW val _ = checkRebinding illegalVal ii + *) + val ty_t = elabTy ME FE GE UE VE TE ty + val {qualid, info = {idLoc,...}} = ii + val pid = longIdentAsIdent (#id qualid) "elabPrimValBind" + val q = (* mkName onTop *) mkLocalName pid + in ((idLoc,pid), + {qualid =q, + info=(mkScheme tvs ty_t,mkPrimStatus arity n)}) + end + + + + +and elabValDesc (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) (TE : TyEnv) tvs ((ii, ty) : ValDesc) = + let val _ = checkRebinding illegalVal ii + val ty_t = elabTy ME FE GE UE VE TE ty + val {qualid, info = {idLoc,...}} = ii + val vid = longIdentAsIdent (#id qualid) "elabValDesc" + val q = (* mkGlobalName *) mkLocalName vid + in ((idLoc,vid), {qualid = q, info = (mkScheme tvs ty_t,VARname (REGULARo))}) end + +and elabExDesc (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) onTop + ((ii, ty_opt) : ExDesc) = + let val _ = checkRebinding illegalCon ii + val {qualid, info = {idLoc,idKind,...}} = ii + val eid = longIdentAsIdent (#id qualid) "elabExDesc" + val ei = mkExConInfo() + val q = (* mkGlobalName *) mkLocalName eid + in + idKind := { qualid=q, info=EXCONik ei }; + (case ty_opt of + SOME _ => setExConArity ei 1 + | NONE => setExConArity ei 0); + case ty_opt of + SOME ty => + let + val arg_t = (elabTy ME FE GE UE VE TE ty) + in + if typeIsImperative arg_t then () + else errorMsg (xLR ty) "Non-imperative exception type"; + ((idLoc,eid), {qualid = q, info =(type_arrow arg_t type_exn, EXNname ei)}) + end + | NONE => + ((idLoc,eid), {qualid = q, info = (type_exn,EXNname ei)}) + end + +and elabExDescList (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) + (VE : VarEnv) (TE : TyEnv) onTop eds = + closeEE (foldL_map (fn (locid, tau) => fn env => + bindOnceInEnv env locid tau + "the same exception constructor is specified twice\ + \ in an exception specification") + (elabExDesc ME FE GE UE VE TE onTop) NILenv eds) + + +and elabSigExp (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) (TE:TyEnv) + (loc, sigexp) = + (case sigexp of + SPECsigexp spec => + let val LAMBDA(T,S) = elabSpec ME FE GE UE VE TE false spec + val _ = checkNoRebindingsStr loc S + "the same identifier is specified twice in the body of this signature" + in LAMBDAsig (T,STRmod (NONrec (removeGEofStr S))) + end + | SIGIDsigexp (loc,sigid) => + let val {qualid,info = G} = findSigId GE loc sigid + in copySig [] [] G + end + | FUNSIGsigexp (Generative standard,(loc,modid),sigexp,sigexp') => + let val LAMBDAsig(T,M) = elabSigExp ME FE GE UE VE TE sigexp + val (ME',FE') = case M of + STRmod S => + (bindInEnv ME modid {qualid=mkLocalName modid, + info = normRecStr S}, + FE) + | FUNmod F => + (ME, + bindInEnv FE modid {qualid=mkLocalName modid, + info = F}) + val _ = incrBindingLevel(); + val _ = refreshTyNameSet PARAMETERts T; + val LAMBDAsig(T',M') = elabSigExp ME' FE' GE UE VE TE sigexp' + in + (decrBindingLevel(); + LAMBDAsig([],FUNmod (T,M,(EXISTSexmod(T',M'))))) + end + | FUNSIGsigexp (Applicative,(loc,modid),sigexp,sigexp') => + let val LAMBDAsig(T,M) = elabSigExp ME FE GE UE VE TE sigexp + val (ME',FE') = case M of + STRmod S => + (bindInEnv ME modid {qualid=mkLocalName modid, + info = normRecStr S}, + FE) + | FUNmod F => + (ME, + bindInEnv FE modid {qualid=mkLocalName modid, + info = F}) + val _ = incrBindingLevel(); + val _ = incrBindingLevel(); + val _ = refreshTyNameSet PARAMETERts T; + val LAMBDAsig(T',M') = elabSigExp ME' FE' GE UE VE TE sigexp' + val _ = decrBindingLevel(); + val (T'',T'toT'') = parameteriseTyNameSet T' T + in decrBindingLevel(); + (LAMBDAsig(T'',FUNmod (T,M,(EXISTSexmod([],copyMod T'toT'' [] M'))))) + end + | WHEREsigexp (sigexp, tyvarseq, longtycon,ty) => (* cvr: TODO review *) + (* Unlike SML, we reject where type constraints that construct inconsistent signatures + by equating a specified datatype with an non-equivalent type or datatype. + In SML, an inconsitent signature can never be implemented, but in Mosml it + can, by using a recursive structure, so we have to rule out inconsitent signatures from + the start. + *) + (case (elabSigExp ME FE GE UE VE TE sigexp) of + (LAMBDAsig(_,FUNmod _)) => + errorMsg loc "Illegal where constraint: the constrained signature specifies a functor but should specify a structure" + | (LAMBDAsig(T,STRmod RS)) => + let val S = SofRecStr RS + val _ = incrBindingLevel(); + val _ = refreshTyNameSet PARAMETERts T; + val _ = checkDuplIds tyvarseq "Duplicate type parameter" + val pars = map (fn tyvar => hd(#id(#qualid tyvar))) tyvarseq + val vs = map (fn tv => newExplicitTypeVar tv) pars + val us = map TypeOfTypeVar vs + val UE' = zip2 pars us + val {qualid = qualid,info={idLoc,...}} = longtycon + val tycon = hd (#id qualid) + val tau = elabTy ME FE GE (UE' @ UE) VE TE ty + val infTyFun = TYPEtyfun(vs,tau) + val infTyStr = (infTyFun,ConEnv []) + val _ = decrBindingLevel(); + val specTyStr = findLongTyConInStr S idLoc qualid + val specTyFun = normTyFun (#1 specTyStr) + val tn = (choose (equalsTyFunTyName specTyFun) T) + handle Subscript => + (msgIBlock 0; + errLocation loc; + errPrompt "Illegal where constraint: the type constructor "; printQualId qualid;msgEOL(); + errPrompt "refers to a transparent type specification";msgEOL(); + errPrompt "but should refer to an opaque type or datatype specification";msgEOL(); + msgEBlock(); + raise Toplevel) + exception IllFormed + in + setTnSort (#info tn) (VARIABLEts); + ((realizeLongTyCon qualid infTyStr specTyStr) + handle MatchError matchReason => + (msgIBlock 0; + errLocation loc; + errPrompt "Illegal where constraint: the type constructor "; printQualId qualid;msgEOL(); + errPrompt "cannot be constrained in this way because ...";msgEOL(); + msgEBlock(); + errMatchReason "constraint" "signature" matchReason; + raise Toplevel)); + ((case !(#tnConEnv(!(#info(tn)))) of (* check well-formedness *) + NONE => () (* nothing to check *) + | SOME specConEnv => + (case normType tau of (* eta-equivalent to a type application? *) + CONt(ts,tyapp) => + let fun equal_args [] [] = () + | equal_args ((VARt w)::ts) (v::vs) = + if w = v + then equal_args ts vs + else raise IllFormed + | equal_args _ _ = raise IllFormed + in + equal_args ts vs; + case conEnvOfTyApp tyapp of + NONE => raise IllFormed + | SOME infConEnv => (* equivalent conenvs ? *) + let + val infMod = + STRmod (NONrec (STRstr + (NILenv,NILenv,NILenv, + mk1Env tycon (infTyFun,infConEnv), + (VEofCE infConEnv)))) + val specMod = copyMod [(tn,tyapp)] [] + (STRmod (NONrec (STRstr + (NILenv,NILenv,NILenv, + mk1Env tycon (specTyFun,specConEnv), + (VEofCE specConEnv))))) + in + ((matchMod infMod specMod) + handle MatchError matchReason => + (msgIBlock 0; + errLocation loc; + errPrompt "Illegal where constraint: the datatype constructor "; + printQualId qualid;msgEOL(); + errPrompt "cannot be constrained in this way because ";msgEOL(); + errPrompt "the constraint's constructor environment \ + \does not match the specification's constructor environment";msgEOL(); + msgEBlock(); + errMatchReason "constraint" "specification" matchReason; + raise Toplevel); + (matchMod specMod infMod) + handle MatchError matchReason => + (msgIBlock 0; + errLocation loc; + errPrompt "Illegal where constraint: the datatype constructor "; + printQualId qualid;msgEOL(); + errPrompt "cannot be constrained in this way because ";msgEOL(); + errPrompt "the specification's constructor environment \ + \does not match the constraint's constructor environment";msgEOL(); + msgEBlock(); + errMatchReason "specification" "constraint" matchReason; + raise Toplevel)) + end + end + | _ => raise IllFormed)) + handle IllFormed => + (msgIBlock 0; + errLocation loc; + errPrompt "Illegal where constraint: the type constructor ";printQualId qualid;msgEOL(); + errPrompt "is specified as a datatype"; msgEOL(); + errPrompt "but its constraint is not a datatype";msgEOL(); + msgEBlock(); + raise Toplevel)); + LAMBDAsig(remove tn T,STRmod RS) + end) + | RECsigexp ((_,modid),sigexp as (locforward,_),sigexp' as (locbody,_)) => + let val LAMBDAsig(T,M) = elabSigExp ME FE GE UE VE TE sigexp + val (ME',RS) = + case M of STRmod RS => + (bindInEnv ME modid {qualid=mkLocalName modid, + info = normRecStr RS}, + RS) + | FUNmod F => + errorMsg locforward + "Illegal recursive signature: \ + \the forward specification should specify \ + \a structure but actually specifies a functor" + val _ = incrBindingLevel(); + val _ = refreshTyNameSet PARAMETERts T; + val LAMBDAsig(T',M') = elabSigExp ME' FE GE UE VE TE sigexp' + val RS' = + case M' of + STRmod RS' => RS' + | FUNmod F => + errorMsg locbody + "Illegal recursive signature: \ + \the body should specify a structure \ + \but actually specifies a functor" + val _ = refreshTyNameSet VARIABLEts T; + val _ = refreshTyNameSet PARAMETERts T'; + val _ = matchMod (STRmod RS') (STRmod RS) + handle MatchError matchReason => + (msgIBlock 0; + errLocation loc; + errPrompt "Illegal recursive signature: \ + \the body does not match the \ + \forward specification..."; + msgEOL(); + msgEBlock(); + errMatchReason "body" "forward specification" matchReason; + raise Toplevel) + in + (decrBindingLevel(); + LAMBDAsig(T',STRmod (RECrec(RS,RS')))) + end) + +and elabModDesc (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) (TE : TyEnv) (MODDESCmoddesc (locmodid as (loc,modid), sigexp as (loc',_)) : ModDesc)= + let val LAMBDAsig(T,M) = elabSigExp ME FE GE UE VE TE sigexp + val S = case M of + STRmod S => S + | FUNmod _ => + errorMsg loc' + "This signature actually specifies a functor \ + \but should specify a structure" + in LAMBDA(T,(locmodid,{qualid = mkLocalName modid, info = S})) end + +and elabModDescList (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) (TE : TyEnv) mds = + foldL_map + (fn (LAMBDA(T',(locmodid,M))) => fn LAMBDA(T,ME) => + LAMBDA(T@T', bindOnceInEnv ME locmodid M + "the same structure identifier is specified twice\ + \ in a structure specification")) + (elabModDesc ME FE GE UE VE TE ) (LAMBDA([],NILenv)) mds +and elabFunDesc (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) (TE : TyEnv) + (FUNDESCfundesc (locmodid as (loc,modid), sigexp as (loc',_)) : FunDesc)= + let val LAMBDAsig(T,M) = elabSigExp ME FE GE UE VE TE sigexp + val F = case M of + FUNmod F => F + | STRmod _ => + errorMsg loc' + "This signature actually specifies a structure \ + \but should specify a functor" + in LAMBDA(T,(locmodid,{qualid = mkLocalName modid, info = F})) end + +and elabFunDescList (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE:UEnv) (VE:VarEnv) (TE : TyEnv) mds = + foldL_map + (fn (LAMBDA(T',(locfunid,F))) => fn LAMBDA(T,FE) => + LAMBDA(T@T', bindOnceInEnv FE locfunid F + "the same functor identifier is specified twice\ + \ in a functor specification")) + (elabFunDesc ME FE GE UE VE TE ) (LAMBDA([],NILenv)) mds +and elabSpec (ME:ModEnv) (FE:FunEnv) (GE:SigEnv) (UE : UEnv) (VE : VarEnv) (TE : TyEnv) onTop (loc, spec') = + case spec' of + VALspec (tyvarseq,vds) => + let val _ = checkDuplIds tyvarseq "Duplicate explicit type variable" + val pars = map (fn ii => hd(#id(#qualid ii))) tyvarseq + val tyvars = scopedTyVars loc UE pars (unguardedValDescList vds) + val () = incrBindingLevel() + val tvs = map (fn tv => newExplicitTypeVar tv) tyvars + val UE' = (zip2 tyvars (map TypeOfTypeVar tvs)) @ UE + val VE' = + foldL_map (fn(locid, info) => fn acc => + bindOnceInEnv acc locid info + "the same value identifier is specified twice\ + \ in a value specification") + (elabValDesc ME FE GE UE' VE TE tvs) + NILenv vds + in decrBindingLevel(); + LAMBDA([],STRstr (NILenv, NILenv,NILenv, NILenv, VE')) + end + | PRIM_VALspec (tyvarseq,pbs) => + let val _ = checkDuplIds tyvarseq "Duplicate explicit type variable" + val pars = map (fn ii => hd(#id(#qualid ii))) tyvarseq + val tyvars = scopedTyVars loc UE pars (unguardedPrimValBindList pbs) + val () = incrBindingLevel() + val tvs = map (fn tv => newExplicitTypeVar tv) tyvars + val UE' = (zip2 tyvars (map TypeOfTypeVar tvs)) @ UE + val VE' = + foldL_map (fn(locid, info) => fn acc => + bindOnceInEnv acc locid info + "the same value identifier is specified twice\ + \ in a value specification") + (elabPrimValBind ME FE GE UE' VE TE tvs) + NILenv pbs + in decrBindingLevel(); + LAMBDA([],STRstr (NILenv, NILenv,NILenv, NILenv, VE')) + end + | TYPEDESCspec(equ, tds) => + let val LAMBDA(T',TE') = elabPrimTypBindList equ tds + in + LAMBDA(T',STRstr(NILenv, NILenv, NILenv, TE',NILenv)) + end + | TYPEspec tbs => + let val tbsTE = elabTypBindList ME FE GE UE VE TE tbs + in + setEquality tbsTE; + LAMBDA([],STRstr(NILenv, NILenv, NILenv, tbsTE, NILenv)) + end + | DATATYPEspec(dbs, tbs_opt) => + let val LAMBDA(T,dbsTE) = initialDatBindTE dbs + val _ = incrBindingLevel(); + val _ = refreshTyNameSet PARAMETERts T; + val tbsTE = elabTypBindList_opt ME FE GE UE VE (plusEnv TE dbsTE) tbs_opt + (* Here dbsTE will get destructively updated too. *) + val _ = checkNoRebindingsTyEnv loc (plusEnv dbsTE tbsTE) + "the same type constructur is specified twice in this datatype specification" + val (VE',dbsTE') = elabDatBindList ME FE GE UE VE (plusEnv (plusEnv TE dbsTE) tbsTE) dbs + val _ = checkNoRebindingsVarEnv loc VE' + "the same constructor is specified twice in this datatype declaration" + in + maximizeEquality dbsTE'; + setEquality tbsTE; + decrBindingLevel(); + LAMBDA(T,STRstr(NILenv, NILenv, NILenv, plusEnv dbsTE' tbsTE,VE')) + end + | DATATYPErepspec rep => + let val (VE,TE) = elabDatatypeReplication ME FE GE UE VE TE (loc,rep) + in + LAMBDA([],STRstr(NILenv, NILenv, NILenv, TE, VE)) + end + | EXCEPTIONspec eds => + (if U_map unguardedExDesc eds <> [] then + errorMsg loc "Type variables in an exception description" + else (); (* cvr: TODO can be relaxed? *) + LAMBDA([],STRstr(NILenv, NILenv, NILenv, NILenv,elabExDescList ME FE GE [] VE TE onTop eds))) + | STRUCTUREspec mds => + let val LAMBDA(T,ME') = elabModDescList ME FE GE UE VE TE mds + in LAMBDA(T,STRstr (ME', NILenv, NILenv, NILenv, NILenv)) end + | FUNCTORspec mds => + let val LAMBDA(T,FE') = elabFunDescList ME FE GE UE VE TE mds + in LAMBDA(T,STRstr (NILenv, FE', NILenv, NILenv, NILenv)) end + | LOCALspec (spec1, spec2) => + let val (ME',FE',GE',VE', TE') = elabLocalSpec ME FE GE UE VE TE spec1 + in + elabSpec (plusEnv ME ME') (plusEnv FE FE') (plusEnv GE GE') UE (plusEnv VE VE') (plusEnv TE TE') onTop spec2 + end + | EMPTYspec => LAMBDA([],STRstr(NILenv, NILenv, NILenv, NILenv, NILenv)) + | INCLUDEspec sigexp => + let val LAMBDAsig(T,M) = elabSigExp ME FE GE UE VE TE sigexp + in case M of (* cvr: TODO revise to deal properly with onTop since this may kill static exception status *) + FUNmod _ => + errorMsg loc "Illegal include: the included \ + \signature must specify a structure, not a functor" + | STRmod (NONrec S) => LAMBDA(T,S) + | _ => errorMsg loc "Illegal include: the included \ + \signature may not be recursive" + end + | SHARINGTYPEspec (spec,longtyconlist) => + let val LAMBDA(T,S) = elabSpec ME FE GE UE VE TE onTop spec + val _ = incrBindingLevel(); + val _ = refreshTyNameSet PARAMETERts T; + val LocTyFunOfLongTyCon = + let val S' = STRstr(MEofStr S,FEofStr S,GEofStr S,TEofStr S,VEofStr S) + (* this step flattens S' once, instead of once for each find *) + in + fn longtycon as {qualid,info = {idLoc,...},...} => + (idLoc,#1 (findLongTyConInStr S' idLoc qualid)) + end + val LocTyFuns = map LocTyFunOfLongTyCon longtyconlist + fun orderAsT LocT = foldR (fn tn => fn acc => + ((choose (fn (loc,tn') => isEqTN tn tn') LocT)::acc) + handle Subscript => acc) + [] T + val LocT' (* as ((loc,tn)::LocT'') *) = + orderAsT + (map (fn (loc,tyfun) => + ((loc,choose (equalsTyFunTyName tyfun) T) + handle Subscript => + errorMsg loc "Illegal sharing spec: \ + \this type constructor does not denote \ + \an opaque type of the specification")) + LocTyFuns) + val ((loc,tn),LocT'') = case LocT' of + (loctn::LocT'') => (loctn,LocT'') + | _ => fatalError "elabSpec" + val kind = kindTyName tn + val _ = app (fn (loc,tn'') => + if kindTyName tn'' = kind + then () + else errorMsg loc "Illegal sharing spec: \ + \the arity of this type constructor differs from the preceding ones") + (LocT'') + val TminusT'' = foldR (fn (loc,tn) => fn TminusT'' => + remove tn TminusT'') + T LocT'' + val equ = foldR (fn (_,tn) => fn equ => + if (#tnEqu (!(#info tn))) <> FALSEequ + then TRUEequ (* cvr: TODO should we worry about REFequ? *) + else equ) + FALSEequ LocT' + val _ = setTnEqu (#info tn) equ + val _ = app (fn (_,tn'') => setTnSort (#info tn'') + (REAts (APPtyfun(NAMEtyapp tn)))) + LocT'' + in + decrBindingLevel(); + LAMBDA(TminusT'', S) + end + | SEQspec (spec1, spec2) => + let val LAMBDA(T',S) = elabSpec ME FE GE UE VE TE onTop spec1 + val _ = incrBindingLevel(); + val _ = refreshTyNameSet PARAMETERts T'; + val LAMBDA(T'',S') = + elabSpec (plusEnv ME (MEofStr S)) + (plusEnv FE (FEofStr S)) + (plusEnv GE (GEofStr S)) + UE + (plusEnv VE (VEofStr S)) + (plusEnv TE (TEofStr S)) + onTop + spec2 + in decrBindingLevel(); + LAMBDA(T'@T'',SEQstr(S,S')) + end + | SHARINGspec (spec1, (loc',longmodids)) => + let val LAMBDA(T, S) = elabSpec ME FE GE UE VE TE onTop spec1 + val _ = incrBindingLevel(); + val _ = refreshTyNameSet PARAMETERts T; + val Ss = + foldR + (fn longmodid as {qualid,info={idLoc,...}} => + (fn Ss => + let val (_,{info = S_i,qualid}) = findLongModIdInStr S idLoc qualid + in + S_i::Ss + end)) + [] longmodids + in let val T' = share (loc',T,Ss) + in + decrBindingLevel(); + LAMBDA(T', S) + end + end + | FIXITYspec _ => + LAMBDA([],STRstr (NILenv,NILenv,NILenv,NILenv, NILenv)) + | SIGNATUREspec sigbinds => + let val GE' = elabSigBindList ME FE GE UE VE TE sigbinds + in LAMBDA([],STRstr(NILenv,NILenv,GE',NILenv, NILenv)) + end + | _ => errorMsg loc "Illegal specification: this form of specification can only \ + \ appear within a local specification" +and elabLocalSpec ME FE GE UE VE TE (loc,spec) = + case spec of + EMPTYspec => (NILenv,NILenv,NILenv,NILenv, NILenv) + | SEQspec (spec1, spec2) => + let val (ME',FE',GE',VE',TE') = + elabLocalSpec ME FE GE UE VE TE spec1 + val (ME'',FE'',GE'',VE'',TE'') = + elabLocalSpec (plusEnv ME ME') (plusEnv FE FE') + (plusEnv GE GE') UE + (plusEnv VE VE') (plusEnv TE TE') spec2 + in (plusEnv ME' ME'', plusEnv FE' FE'', plusEnv GE' GE'', + plusEnv VE' VE'', plusEnv TE' TE'') end + | OPENspec longmodidinfos => + foldL (fn (longmodid,envoptref) => fn (ME',FE',GE',VE',TE') => + let val {qualid,info} = longmodid + val {idKind, idFields,... } = info + val (fields,{qualid = csqualid, + info = Env as (ME'',FE'',GE'',VE'',TE'')}) = + findLongModIdForOpen ME loc qualid + in + idKind := { qualid=csqualid, info=VARik }; + idFields := fields; + (* this should be unnecessary + envoptref := SOME Env; *) + (plusEnv ME' ME'', + plusEnv FE' FE'', + plusEnv GE' GE'', + plusEnv VE' VE'', + plusEnv TE' TE'') + end) + (NILenv,NILenv,NILenv,NILenv,NILenv) + longmodidinfos + | TYPEspec tbs => + let val tbsTE = elabTypBindList ME FE GE UE VE TE tbs in + setEquality tbsTE; + (NILenv,NILenv,NILenv,NILenv, tbsTE) + end + | LOCALspec (spec1, spec2) => + let val (ME',FE',GE',VE', TE') = elabLocalSpec ME FE GE UE VE TE spec1 + in + elabLocalSpec (plusEnv ME ME') (plusEnv FE FE') (plusEnv GE GE') UE (plusEnv VE VE') (plusEnv TE TE') spec2 + end + | _ => errorMsg loc "Illegal local specification: this form of specification cannot \ + \ appear as a local specification" +; + + +fun elabToplevelDec (dec : Dec) = +( + if unguardedDec dec <> [] then + errorMsg (xLR dec) "Unguarded type variables at the top-level" + else (); + resetBindingLevel(); + let val EXISTS(T',(ME',FE',GE',VE',TE')) = + elabDec (mkGlobalME()) (mkGlobalFE()) (mkGlobalGE()) [] + (mkGlobalVE()) (mkGlobalTE()) (* ps: true *) false dec + val _ = if (!currentCompliance) <> Liberal + then Synchk.compliantTopDec dec + else () + in EXISTS(T',(cleanEnv ME', + cleanEnv FE', + cleanEnv GE', + cleanEnv VE', + cleanEnv TE')) + end +); + +fun elabStrDec (dec : Dec) = +( + if unguardedDec dec <> [] then + errorMsg (xLR dec) "Unguarded type variables at the top-level" + else (); + resetBindingLevel(); + let val EXISTS(T',(ME',FE',GE',VE',TE')) = + elabDec (mkGlobalME()) (mkGlobalFE()) (mkGlobalGE()) [] + (mkGlobalVE()) (mkGlobalTE()) (* ps: true *) false dec + val _ = if (!currentCompliance) <> Liberal + then Synchk.compliantStrDec dec + else () + in + EXISTS(T',(cleanEnv ME', + cleanEnv FE', + cleanEnv GE', + cleanEnv VE', + cleanEnv TE')) + end +); + +fun elabToplevelSigExp (sigexp as (loc,_) : SigExp) = + (resetBindingLevel(); + let val LAMBDAsig(T,M) = + elabSigExp (mkGlobalME()) + (mkGlobalFE()) + (mkGlobalGE()) + [] + (mkGlobalVE()) + (mkGlobalTE()) + sigexp + in case M of + FUNmod _ => + errorMsg loc "Illegal unit signature: the signature \ + \must specify a structure, not a functor" + | STRmod RS => + (if (!currentCompliance) <> Liberal + then Synchk.compliantSigExp sigexp + else (); + LAMBDA(T,RS)) + end); + +fun elabToplevelSpec (spec : Spec) = + (resetBindingLevel(); + let val StrSig = + elabSpec (mkGlobalME()) (mkGlobalFE()) + (mkGlobalGE()) [] + (mkGlobalVE()) (mkGlobalTE()) + (* ps: true *) false spec + in + (* we could, but don't, check compliance since toplevel-mode .sig files don't need to be ported + if (!currentCompliance) <> Liberal + then Synchk.compliantTopSpec spec + else (); *) + StrSig + end ) +; + +fun elabSigSpec (spec : Spec) = + (resetBindingLevel(); + let val StrSig = + elabSpec (mkGlobalME()) (mkGlobalFE()) + (mkGlobalGE()) [] + (mkGlobalVE()) (mkGlobalTE()) + (* ps: true *) false spec + in + if (!currentCompliance) <> Liberal + then Synchk.compliantSpec spec + else (); + StrSig + end ) +; + + + +(* tie the knot *) + +(* cvr: TODO remove in favour of mutual recursion *) + +val () = elabSigExpRef := elabSigExp; +val () = elabModExpRef := elabModExp; + + + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Emitcode.sig mosml-2.10.1/src/compiler.cminusminus/Emitcode.sig --- mosml-2.01/src/compiler.cminusminus/Emitcode.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Emitcode.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1 @@ +val emit : Instruct.ZamInstruction list -> unit; diff -Nru mosml-2.01/src/compiler.cminusminus/Emitcode.sml mosml-2.10.1/src/compiler.cminusminus/Emitcode.sml --- mosml-2.01/src/compiler.cminusminus/Emitcode.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Emitcode.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,325 @@ +open + Obj Fnlib Config Mixture Const Instruct Prim + Opcodes Prim_opc Buffcode Labels Reloc +; + +(* 1996.07.13 -- e *) + +prim_val lshift_ : int -> int -> int = 2 "shift_left"; +prim_val rshiftsig_ : int -> int -> int = 2 "shift_right_signed"; +prim_val rshiftuns_ : int -> int -> int = 2 "shift_right_unsigned"; + + +(* Generation of bytecode for .uo files *) + +fun tooManyError kind = + (msgIBlock 0; + errPrompt ("Too many " ^ kind ^ "; unable to generate bytecode"); + msgEOL(); + msgEBlock(); + raise Toplevel); + +fun checkArguments n = + if n > maxint_byte then tooManyError "arguments" else () + +(* This won't happen unless there's a bug in the switch compilation: *) +fun checkBranches n = + if n > maxint_byte then tooManyError "switch branches" else () + +fun checkGlobals n = + if n > 0xFFFF then tooManyError "globals" else () + +fun checkLocals n = + if n > 0xFFFF then tooManyError "local variables" else () + +fun checkFields n = + if n > 0xFFFF then tooManyError "fields" else () + +fun out_bool_test tst = + fn PTeq => out tst + | PTnoteq => out (tst + 1) + | PTlt => out (tst + 2) + | PTgt => out (tst + 3) + | PTle => out (tst + 4) + | PTge => out (tst + 5) + | _ => fatalError "out_bool_test" +; + +fun out_int_const i = + if i >= minint_short andalso i <= maxint_short then + if i >= 0 andalso i <= 3 + then + out (CONST0 + i) + else + let val ii1 = i+i+1 in + if ii1 >= minint_byte andalso ii1 <= maxint_byte then + (out CONSTBYTE; out (ii1)) + else if ii1 >= minint_short andalso ii1 <= maxint_short then + (out CONSTSHORT; out_short (ii1)) + else + (out CONSTINT; out_long i) + end + else if i >= minint_int31 andalso i <= maxint_int31 then + (out CONSTINT; out_long i) + else (* This happens only in a 64 bit runtime system: *) + (out GETGLOBAL; slot_for_literal (ATOMsc(INTscon i))); +fun out_word_const w = + let prim_val w2i : word -> int = 1 "identity" + in out_int_const (w2i w) end; + +fun out_push_int_const i = + if i >= minint_short andalso i <= maxint_short then + if i >= 0 andalso i <= 3 + then + out (PUSHCONST0 + i) + else + let val ii1 = i+i+1 in + if ii1 >= minint_byte andalso ii1 <= maxint_byte then + (out PUSH; out CONSTBYTE; out (ii1)) + else if ii1 >= minint_short andalso ii1 <= maxint_short then + (out PUSH; out CONSTSHORT; out_short (ii1)) + else + (out PUSHCONSTINT; out_long i) + end + else if i >= minint_int31 andalso i <= maxint_int31 then + (out PUSHCONSTINT; out_long i) + else (* This happens only in a 64 bit runtime system: *) + (out PUSH_GETGLOBAL; slot_for_literal (ATOMsc(INTscon i))); + +fun out_push_word_const w = + let prim_val w2i : word -> int = 1 "identity" + in out_push_int_const (w2i w) end; + +fun out_tag (CONtag(t,_)) = out t; + +fun out_header (n, tag) = +( + out_tag tag; + out (lshift_ n 2); + out (rshiftuns_ n 6); + out (rshiftuns_ n 14) +); + +fun emit_zam zam = + case zam of + Kquote(ATOMsc(INTscon i)) => out_int_const i + | Kquote(ATOMsc(WORDscon w)) => out_word_const w + | Kquote(ATOMsc(CHARscon c)) => out_int_const (Char.ord c) + | Kquote(BLOCKsc(CONtag(t,_), [])) => + if t < 10 then out (ATOM0 + t) else (out ATOM; out t) + | Kquote sc => (out GETGLOBAL; slot_for_literal sc) + | Kget_global uid => (out GETGLOBAL; slot_for_get_global uid) + | Kset_global uid => (out SETGLOBAL; slot_for_set_global uid) + | Kgetfield n => + (checkFields n; + if n < 4 then out (GETFIELD0 + n) + else (out GETFIELD; out_short n)) + | Ksetfield n => + (checkFields n; + if n < 4 then out (SETFIELD0 + n) + else (out SETFIELD; out_short n)) + | Kaccess n => + (checkLocals n; + if n < 8 then out(ACC0 + n) else (out ACCESS; out_short n)) + | Kenvacc m => + let val n = m + 1 + in + checkLocals n; + if n < 8 then out(ENV1 + m) else (out ENVACC; out_short n) + end + | Kassign n => + (checkLocals n; out ASSIGN; out_short n) + | Kapply n => + (checkArguments n; + if n < 5 then out(APPLY1 + n - 1) else (out APPLY; out n)) + | Kappterm (n,z) => + (checkArguments n; + if n < 5 then out(APPTERM1 + n - 1) else (out APPTERM; out n); + checkLocals z; + out_short z) + | Kpop n => (checkLocals n; out POP; out_short n) + | Kgrab n => (checkArguments n; out GRAB; out n) + | Kreturn n => + (checkLocals n; + if n < 3 then out(RETURN1 + n - 1) else (out RETURN; out_short n)) + | Kmakeblock(tag,n) => + (if n <= 0 then + fatalError "emit_zam : Kmakeblock" + else if n < 5 then + (out (MAKEBLOCK1 + n - 1); + out_tag tag) + else + (out MAKEBLOCK; + out_header(n, tag))) + | Klabel lbl => + if lbl = Nolabel then fatalError "emit_zam: undefined label" + else (define_label lbl) + | Kclosure (lbl,sz) => (out CLOSURE; out sz; out_label lbl) + | Kclosurerec (lbl,sz) => (out CLOSREC; out (sz - 1); out_label lbl) + | Kpushtrap lbl => (out PUSHTRAP; out_label lbl) + | Kpush_retaddr lbl => (out PUSH_RETADDR; out_label lbl) + | Kbranch lbl => (out BRANCH; out_label lbl) + | Kbranchif lbl => (out BRANCHIF; out_label lbl) + | Kbranchifnot lbl => (out BRANCHIFNOT; out_label lbl) + | Kstrictbranchif lbl => (out BRANCHIF; out_label lbl) + | Kstrictbranchifnot lbl => (out BRANCHIFNOT; out_label lbl) + | Kswitch lblvect => + let val len = Array.length lblvect + val () = out SWITCH; + val () = out len; + val orig = !out_position + in + checkBranches len; + for (fn i => out_label_with_orig orig (Array.sub(lblvect, i))) + 0 (len-1) + end + | Ktest(tst,lbl) => + (case tst of + Peq_test => + (out BRANCHIFEQ; out_label lbl) + | Pnoteq_test => + (out BRANCHIFNEQ; out_label lbl) + | Pint_test(PTnoteqimm i) => + (out PUSH; out_push_int_const i; + out EQ; out POPBRANCHIFNOT; out_label lbl) + | Pint_test x => + (out_bool_test BRANCHIFEQ x; out_label lbl) + | Pfloat_test(PTnoteqimm f) => + (out PUSH; out PUSH_GETGLOBAL; + slot_for_literal (ATOMsc(REALscon f)); + out EQFLOAT; out POPBRANCHIFNOT; out_label lbl) + | Pfloat_test x => + (out_bool_test EQFLOAT x; out BRANCHIF; out_label lbl) + | Pstring_test(PTnoteqimm s) => + (out PUSH; out PUSH_GETGLOBAL; + slot_for_literal (ATOMsc(STRINGscon s)); + out EQSTRING; out POPBRANCHIFNOT; out_label lbl) + | Pstring_test x => + (out_bool_test EQSTRING x; out BRANCHIF; out_label lbl) + | Pword_test(PTnoteqimm w) => + (out PUSH; out_push_word_const w; + out EQUNSIGN; out POPBRANCHIFNOT; out_label lbl) + | Pword_test x => + (out_bool_test EQUNSIGN x; out BRANCHIF; out_label lbl) + | Pnoteqtag_test tag => + (out BRANCHIFNEQTAG; out_tag tag; out_label lbl) + ) + | Kbranchinterval(low, high, lbl_low, lbl_high) => + (out_push_int_const low; + if low <> high then out_push_int_const high else out PUSH; + out BRANCHINTERVAL; + out_label lbl_low; + out_label lbl_high + ) + | Kprim p => + (case p of + Pdummy n => + (checkLocals n; out DUMMY; out_short n) + | Ptest tst => + (case tst of + Peq_test => out EQ + | Pnoteq_test => out NEQ + | Pint_test tst => out_bool_test EQ tst + | Pfloat_test tst => out_bool_test EQFLOAT tst + | Pstring_test tst => out_bool_test EQSTRING tst + | Pword_test tst => out_bool_test EQUNSIGN tst + | _ => fatalError "emit_zam : Kprim, Ptest") + | Patom t => + if t < 10 then out (ATOM0 + t) else (out ATOM; out t) + | Pccall(name, arity) => + (if arity <= 5 then + out (C_CALL1 + arity - 1) + else + (out C_CALLN; out arity); + slot_for_c_prim name) + | Pfloatprim p => + out(opcode_for_float_primitive p) + | Pidentity => + () + | p => + out(opcode_for_primitive p) + ) + | Kpush => out PUSH + | Kraise => out RAISE + | Krestart => out RESTART + | Kpoptrap => out POPTRAP + | Kcheck_signals => out CHECK_SIGNALS +; + +fun emit zams = + case zams of + [] => () + | Kpush :: Kquote(ATOMsc(INTscon i)) :: C => + (out_push_int_const i; emit C) + | Kpush :: Kquote(ATOMsc(WORDscon w)) :: C => + (out_push_word_const w; emit C) + | Kpush :: Kquote(ATOMsc(CHARscon c)) :: C => + (out_push_int_const (Char.ord c); emit C) + | Kpush :: Kquote(BLOCKsc(CONtag(t,_), [])) :: C => + ((if t = 0 then out PUSHATOM0 else (out PUSHATOM; out t)); + emit C) + | Kpush :: Kquote sc :: C => (out PUSH_GETGLOBAL; slot_for_literal sc; emit C) + | Kpush :: Kaccess n :: C => + (checkLocals n; + if n < 8 then out(PUSHACC0 + n) else (out PUSHACC; out_short n); + emit C) + | Kpush :: Kenvacc 0 :: Kapply n :: C => + (checkArguments n; + if n < 5 then + out(PUSH_ENV1_APPLY1 + n - 1) + else + (out PUSHENV1; + out APPLY; out n); + emit C) + | Kpush :: Kenvacc 0 :: Kappterm (n,z) :: C => + ((if n < 5 then + out(PUSH_ENV1_APPTERM1 + n - 1) + else + (checkArguments n; out PUSHENV1; out APPTERM; out n)); + checkLocals z; out_short z; + emit C) + | Kpush :: Kenvacc m :: C => + let val n = m + 1 + in + checkLocals n; + if n < 8 then out(PUSHENV1 + m) else (out PUSHENVACC; out_short n); + emit C + end + | Kpush :: Kget_global uid :: Kapply n :: C => + (if n < 5 then + (out(PUSH_GETGLOBAL_APPLY1 + n - 1); + slot_for_get_global uid) + else + (checkArguments n; + out PUSH_GETGLOBAL; + slot_for_get_global uid; + out APPLY; out n); + emit C) + | Kpush :: Kget_global uid :: Kappterm (n,z) :: C => + (if n < 5 then + (out(PUSH_GETGLOBAL_APPTERM1 + n - 1); + checkLocals z; out_short z; + slot_for_get_global uid) + else + (checkArguments n; + out PUSH_GETGLOBAL; + slot_for_get_global uid; + out APPTERM; out n; + checkLocals z; + out_short z); + emit C) + | Kpush :: Kget_global uid :: C => + (out PUSH_GETGLOBAL; + slot_for_get_global uid; + emit C) + | Kgetfield 0 :: Kgetfield 0 :: C => + (out GETFIELD0_0; emit C) + | Kgetfield 0 :: Kgetfield 1 :: C => + (out GETFIELD0_1; emit C) + | Kgetfield 1 :: Kgetfield 0 :: C => + (out GETFIELD1_0; emit C) + | Kgetfield 1 :: Kgetfield 1 :: C => + (out GETFIELD1_1; emit C) + | zam :: C => + (emit_zam zam; emit C) +; diff -Nru mosml-2.01/src/compiler.cminusminus/Emit_phr.sml mosml-2.10.1/src/compiler.cminusminus/Emit_phr.sml --- mosml-2.01/src/compiler.cminusminus/Emit_phr.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Emit_phr.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,76 @@ +(* Emitting phrases *) + +local + open CmmAST CmmEmitcode CmmPrint; +in + +val abs_out_position = ref 0; + +val compiled_phrase_index = ref ([] : Code_dec.compiled_phrase list); + +fun start_emit_phrase os = () + +fun emit_phrase os (phr : Instruct.ZamPhrase) = + let val funcs = #kph_funcs phr + fun makeFun instr = + let val _ = resetTemp() + val s = List.map emit_zam instr + val name = getLetName instr + in Function{conv = Cmm, + name = name, + formals = [(bits32,"sp"), (bits32,"accu"), + (bits32,"env"), (bits32,"extra_args")], + stmts = s} + end + val cfuns = List.map makeFun funcs + val pp = ppProgram cfuns + in Wpp.toOutStream 74 TextIO.stdOut pp + end + +fun end_emit_phrase + excRenList valRenList sigStamp mentions os = () +(*fun start_emit_phrase os = +( + output_binary_int os 0; + abs_out_position := 4; + compiled_phrase_index := [] +); + +fun emit_phrase os (phr : ZamPhrase) = +( + reloc_reset(); + init_out_code(); + Labels.reset_label_table(); + if #kph_funcs phr = [] then + emit (#kph_inits phr) + else + (emit (#kph_inits phr); + emit [Kbranch 0]; + emit (#kph_funcs phr); + emit [Klabel 0]); + buff_output os (!out_buffer) 0 (!out_position); + compiled_phrase_index := + { cph_pos = !abs_out_position, + cph_len = !out_position, + cph_reloc = get_reloc_info(), + cph_pure = #kph_is_pure phr} + :: !compiled_phrase_index; + abs_out_position := !abs_out_position + !out_position +); + +fun end_emit_phrase + excRenList valRenList sigStamp mentions os = +( + output_value os + { cu_phrase_index = !compiled_phrase_index, + cu_exc_ren_list = excRenList, + cu_val_ren_list = valRenList, + cu_sig_stamp = sigStamp, + cu_mentions = mentions }; + compiled_phrase_index := []; + seek_out os 0; + output_binary_int os (!abs_out_position) +); +*) + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Exec_phr.sig mosml-2.10.1/src/compiler.cminusminus/Exec_phr.sig --- mosml-2.01/src/compiler.cminusminus/Exec_phr.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Exec_phr.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,5 @@ +val execToplevelPhrase: Asynt.Dec -> unit; +val quietdec : bool ref + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Exec_phr.sml mosml-2.10.1/src/compiler.cminusminus/Exec_phr.sml --- mosml-2.01/src/compiler.cminusminus/Exec_phr.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Exec_phr.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,160 @@ +(* Exec_phr.sml *) +open Const +open List BasicIO Nonstdio Miscsys Fnlib Mixture Globals Units Types Asynt; +open Infixst Ovlres Infixres Elab Pr_zam Tr_env Front Back Compiler; +open Symtable Rtvals Load_phr; + +(* Will successful evaluation results be reported in the top-level system: *) + +val quietdec = ref false ; + +(* Executing a top-level declaration. *) + +local + fun prTopEnv prInfo env firstLine = + foldEnv (fn k => fn v => fn firstLine => + (msgIBlock 0; + (if firstLine then msgPrompt "" + else msgContPrompt ""); + prInfo k v; + msgEOL(); + msgEBlock(); + false)) firstLine env; + fun prVal {qualid,info=(sch,status)} = + let val qualid = if #qual qualid = "" + then {qual = currentUnitName(), id = #id qualid} (* cvr: rectify on the fly *) + else qualid + in + msgString " ="; msgBreak(1, 4); + (case status of + VARname REGULARo => + let val slot = get_slot_for_variable (lookupRenEnv ValId qualid) + val v = getGlobalVal slot + in + printVal sch v + end + | VARname _ => msgString "(overloaded)" + | PRIMname pi => + if #primArity pi = 0 then + msgString "-" + else msgString "fn" + | CONname ci => + if #conArity(!ci) = 0 then + printVQ qualid + else msgString "fn" + | EXNname ei => + if #exconArity(!ei) = 0 then + printVQ qualid + else msgString "fn" + | REFname => msgString "fn"); + msgBreak(0, 4) + end +in +fun report_results iBas (Env as EXISTS(T,(ME,FE,GE,VE,TE))) = + let + val _ = checkClosedExEnvironment Env; + val _ = collectTopVars Env; + val firstLine = + case T of + [] => true + | _ => (msgIBlock 0; + msgPrompt "New type names: "; + prTyNameSet T ","; + msgEOL(); + msgEBlock(); + false) + val firstLine = + prTopEnv (fn id => fn status => reportFixityResult (id,status)) iBas firstLine; + val firstLine = + prTopEnv prModInfo ME firstLine; + val firstLine = + prTopEnv prFunInfo FE firstLine; + val firstLine = + prTopEnv prSigInfo GE firstLine; + val firstLine = + prTopEnv prTyInfo TE firstLine; + val firstLine = + prTopEnv (prVarInfo prVal) VE firstLine + in + () + end; +end +; + + + +(* This is written in tail-recursive form to ensure *) +(* that the intermediate results will be discarded. *) + +fun updateCurrentState ((iBas, (Env as EXISTS(T,(ME,FE,GE,VE, TE)))), RE) = +( + catch_interrupt false; + updateCurrentInfixBasis iBas; + updateCurrentStaticT T; + updateCurrentStaticME ME; + updateCurrentStaticFE FE; + updateCurrentStaticGE GE; + updateCurrentStaticTE TE; + updateCurrentStaticVE VE; + updateCurrentRenEnv RE; + catch_interrupt true; + if not (!quietdec) then + (report_results iBas Env; + msgFlush()) + else () +); + +fun execLamPhrase state (RE, tlams) = +( + app + (fn (is_pure, lam) => + ( (* msgIBlock 0; Pr_lam.printLam lam; msgEOL(); msgEBlock(); *) + (* msgIBlock 0; Pr_lam.printLam lam; msgEOL(); msgEBlock();msgFlush(); *) (* cvr: TODO remove *) + ignore (loadZamPhrase + let val zam = compileLambda is_pure lam in + (* printZamPhrase zam; msgFlush(); *) + zam + end) + )) + tlams; + updateCurrentState (state, RE) +); + +fun execResolvedDecPhrase (iBas, dec) = + + let (* val _ = Asyntfn.printDec dec (* cvr: *) *) + val ExEnv = + let val ExEnv = elabToplevelDec dec + in + resolveOvlDec dec; + commit_free_typevar_names (); + ExEnv + end + handle e => (rollback_free_typevar_names (); + raise e) + in + execLamPhrase (iBas, ExEnv) (translateToplevelDec dec) + end +; + +fun execToplevelPhrase dec = + let val _ = checkpoint_free_typevar_names (); + val (iBas,resdec) = resolveToplevelDec dec in + execResolvedDecPhrase (iBas,resdec) + end +; + + + + + + + + + + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Filename.mlp mosml-2.10.1/src/compiler.cminusminus/Filename.mlp --- mosml-2.01/src/compiler.cminusminus/Filename.mlp 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Filename.mlp 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,167 @@ +(* filename.mlp *) + +(* open CharVector; *) + +fun extract arg = Substring.string(Substring.extract arg) + +fun check_suffix name suff = + let val name_len = size name + val suff_len = size suff + in + name_len >= suff_len andalso + extract(name, name_len - suff_len, SOME suff_len) = suff + end; + +fun chop_suffix name suff = + extract(name, 0, SOME (size name - size suff)) +; + +#ifdef unix +val current_dir_name = "."; + +fun concat dirname filename = + let val len = size dirname + val x = if len = 0 then "/" else extract(dirname, len-1, SOME 1) + in + case x of + "/" => dirname ^ filename + | _ => dirname ^ "/" ^ filename + end; + +fun is_absolute n = + let val len = size n in + (len >= 1 andalso extract(n, 0, SOME 1) = "/") orelse + (len >= 2 andalso extract(n, 0, SOME 2) = "./") orelse + (len >= 3 andalso extract(n, 0, SOME 3) = "../") + end; + +fun slash_pos s = + let fun pos i = + if i < 0 then NONE else + case extract(s, i, SOME 1) of + "/" => SOME i + | _ => pos (i - 1) + in pos (size s - 1) end +; + +fun basename name = + case slash_pos name of + SOME p => + extract(name, p+1, NONE) + | NONE => name +; + +fun dirname name = + if name = "/" then name else + case slash_pos name of + SOME p => extract(name, 0, SOME p) + | NONE => "." +; +#endif + +#ifdef macintosh +val current_dir_name = ":"; + +fun is_absolute n = + let val len = size n + fun h i = + if i >= len then false + else if extract(n, i, SOME 1) = ":" then true + else h (i+1) + in h 0 end; + +fun concat dirname filename = + let val dirname1 = + if is_absolute dirname + then dirname + else ":" ^ dirname + val l = size dirname1 - 1 + val dirname2 = + if l < 0 orelse extract(dirname1, l, SOME 1) = ":" + then dirname1 + else dirname1 ^ ":" + val len = size filename + val filename2 = + if len > 0 andalso extract(filename, 0, SOME 1) = ":" + then extract(filename, 1, NONE) + else filename + in dirname2 ^ filename2 end +; + +fun colon_pos s = + let fun pos i = + if i < 0 then NONE else + case extract(s, i, SOME 1) of + ":" => SOME i + | _ => pos (i - 1) + in pos (size s - 1) end +; + +fun basename name = + case colon_pos name of + SOME p => + extract(name, p+1, NONE) + | NONE => name +; + +fun dirname name = + if name = ":" then name else + case colon_pos name of + SOME p => extract(name, 0, SOME p) + | NONE => ":" +; +#endif + +#if defined(msdos) || defined(win32) +val current_dir_name = "."; + +fun concat dirname filename = + let val len = size dirname + val x = if len = 0 then "\\" else extract(dirname, len-1, SOME 1) + in + case x of + "\\" => dirname ^ filename + | ":" => dirname ^ filename + | _ => dirname ^ "\\" ^ filename + end; + +fun is_absolute n = + let val len = size n in + (len >= 2 andalso extract(n, 1, SOME 1) = ":") orelse + (len >= 1 andalso extract(n, 0, SOME 1) = "\\") orelse + (len >= 2 andalso extract(n, 0, SOME 2) = ".\\") orelse + (len >= 3 andalso extract(n, 0, SOME 3) = "..\\") + end; + +fun sep_pos s = + let fun pos i = + if i < 0 then NONE else + case extract(s, i, SOME 1) of + "/" => SOME i + | "\\" => SOME i + | ":" => SOME i + | _ => pos (i - 1) + in pos (size s - 1) end +; + +fun basename name = + case sep_pos name of + SOME p => + extract(name, p+1, NONE) + | NONE => name +; + +fun dirname name = + let val len = size name in + if len >= 2 andalso extract(name, 1, SOME 1) = ":" then + extract(name, 0, SOME 2) ^ + dirname (extract(name, 2, NONE)) + else if name = "/" orelse name = "\\" then + name + else + case sep_pos name of + SOME p => extract(name, 0, SOME p) + | NONE => "." + end; + +#endif diff -Nru mosml-2.01/src/compiler.cminusminus/Filename.sig mosml-2.10.1/src/compiler.cminusminus/Filename.sig --- mosml-2.01/src/compiler.cminusminus/Filename.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Filename.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,28 @@ +(* Operations on file names *) + +val current_dir_name : string; + (* The conventional name for the current directory + (e.g. [.] in Unix). *) +val concat : string -> string -> string; + (* [concat dir file] returns a file name that designates file + [file] in directory [dir]. *) +val is_absolute : string -> bool; + (* Return [true] if the file name is absolute or starts with an + explicit reference to the current directory ([./] or [../] in + Unix), and [false] if it is relative to the current directory. *) +val check_suffix : string -> string -> bool; + (* [check_suffix name suff] returns [true] if the filename [name] + ends with the suffix [suff]. *) +val chop_suffix : string -> string -> string; + (* [chop_suffix name suff] removes the suffix [suff] from + the filename [name]. The behavior is undefined if [name] does not + end up with the suffix [suff]. *) +val basename : string -> string; +val dirname : string -> string; + (* Split a file name into directory name / base file name. + [concat (dirname name) (basename name)] returns a file name + which is equivalent to [name]. Moreover, after setting the + current directory to [dirname name] (with [sys__chdir]), + references to [basename name] (which is a relative file name) + designate the same file as [name] before the call to [chdir]. *) +;; diff -Nru mosml-2.01/src/compiler.cminusminus/Fnlib.sig mosml-2.10.1/src/compiler.cminusminus/Fnlib.sig --- mosml-2.01/src/compiler.cminusminus/Fnlib.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Fnlib.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,44 @@ +(* Fnlib.sig *) + +exception Impossible of string; +val fatalError : string -> 'a; + +val getOption : 'a option -> 'a; + +val fst : 'a * 'b -> 'a; +val snd : 'a * 'b -> 'b; + +val incr : int ref -> unit; +val decr : int ref -> unit; + +val mapFrom: (int -> 'a -> 'b) -> int -> 'a list -> 'b list; +val map2: ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list; +val appFrom: (int -> 'a -> unit) -> int -> 'a list -> unit; +val app2: ('a -> 'b -> unit) -> 'a list -> 'b list -> unit; +val revApp: ('a -> unit) -> 'a list -> unit; +val foldL: ('a -> 'b -> 'b) -> 'b -> 'a list -> 'b; +val foldL_zip : ('a -> 'b -> 'c -> 'c) -> 'c -> 'a list -> 'b list -> 'c; +val foldL_map : ('a -> 'b -> 'b) -> ('c -> 'a) -> 'b -> 'c list -> 'b; +val foldR: ('a -> 'b -> 'b) -> 'b -> 'a list -> 'b; +val foldR1: ('a -> 'a -> 'a) -> 'a list -> 'a; +val foldR_map: ('a -> 'b -> 'b) -> ('c -> 'a) -> 'b -> 'c list -> 'b; +val map_fields : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list; +val all_fields : ('a -> bool) -> ('b * 'a) list -> bool; +val exists_field : ('a -> bool) -> ('b * 'a) list -> bool; +val app_field : ('a -> unit) -> ('b * 'a) list -> unit; +val member : ''a -> ''a list -> bool +val remove : ''a -> ''a list -> ''a list +val drop : ('a -> bool) -> 'a list -> 'a list +val lookup : ''a -> (''a * 'b) list -> 'b (* May raise Subscript *) +val binlookup : string -> (string * 'b) Vector.vector -> 'b (* Subscript *) +val exists: ('a -> bool) -> 'a list -> bool +val choose: ('a -> bool) -> 'a list -> 'a (* May raise Subscript *) +val find : ('a -> bool) -> ('a * 'b) list -> 'b (* May raise Subscript *) +val foldInt : (int -> 'b -> 'b) -> 'b -> int -> 'b +val duplicates : ''a list -> bool; +val stringToLower : string -> string; + +val for : (int -> unit) -> int -> int -> unit; + +val zip2 : 'a list -> 'b list -> ('a * 'b) list; + diff -Nru mosml-2.01/src/compiler.cminusminus/Fnlib.sml mosml-2.10.1/src/compiler.cminusminus/Fnlib.sml --- mosml-2.01/src/compiler.cminusminus/Fnlib.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Fnlib.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,158 @@ +(* Fnlib.sml. Library functions *) + +exception Impossible of string; + +fun fatalError s = raise(Impossible s); + +fun getOption NONE = fatalError "getOption" + | getOption (SOME a) = a +; + +fun fst (x, y) = x; +fun snd (x, y) = y; + +fun incr r = r := !r + 1; +fun decr r = r := !r - 1; + +fun mapFrom f n [] = [] + | mapFrom f n (x :: xs) = f n x :: mapFrom f (n+1) xs +; + +fun map2 f [] [] = [] + | map2 f (x :: xs) (y :: ys) = f x y :: map2 f xs ys + | map2 f _ _ = fatalError "map2: lists of different length" +; + +fun appFrom f n [] = () + | appFrom f n (x :: xs) = (f n x : unit; appFrom f (n+1) xs) +; + +fun app2 f [] [] = () + | app2 f (x::xs) (y::ys) = (f x y : unit; app2 f xs ys) + | app2 f _ _ = fatalError "app2: lists of different length" +; + +fun revApp f [] = () + | revApp f (h::t) = (revApp f t;f h) +; + +fun foldL f a [] = a + | foldL f a (x::xs) = foldL f (f x a) xs +; + +fun foldL_zip f a [] [] = a + | foldL_zip f a (x::xs) (y::ys) = foldL_zip f (f x y a) xs ys + | foldL_zip f a _ _ = fatalError "foldL_zip: lists of different length" +; + +fun foldL_map f g a [] = a + | foldL_map f g a (x::xs) = foldL_map f g (f (g x) a) xs +; + +fun foldR f a [] = a + | foldR f a (x::xs) = f x (foldR f a xs) +; + +fun foldR1 f [] = fatalError "foldR1: an empty argument" + | foldR1 f [x] = x + | foldR1 f (x::xs) = f x (foldR1 f xs) +; + +fun foldR_map f g e [] = e + | foldR_map f g e (x::xs) = f (g x) (foldR_map f g e xs) +; + +fun map_fields f [] = [] + | map_fields f ((lab, t) :: xs) = (lab, f t) :: map_fields f xs +; + +fun all_fields f [] = true + | all_fields f ((_, t) :: xs) = + (f t) andalso all_fields f xs +; + +fun exists_field f [] = false + | exists_field f ((_, t) :: xs) = + (f t) orelse exists_field f xs +; + +fun app_field f [] = () + | app_field f ((_, t) :: xs) = (f t : unit; app_field f xs) +; + +fun member k [] = false + | member k (x :: xs) = + if k = x then true else member k xs +; + +fun exists p [] = false + | exists p (a::xs) = p a orelse exists p xs +; + +fun remove k [] = [] + | remove k (x :: xs) = + if k = x then xs else x :: (remove k xs) +; + +fun drop p [] = [] + | drop p (x :: xs) = + if p x then (drop p xs) else x :: (drop p xs) +; + +fun lookup k [] = raise Subscript + | lookup k ((a, v) :: xs) = + if k = a then v else lookup k xs +; + + +(* The vector vec must be sorted *) + +fun binlookup (name : string) (vec : (string * 'a) Vector.vector) = + let fun search a b = + if a > b then raise Subscript + else + let val i = (a+b) div 2 + val (key, v) = Vector.sub(vec, i) + in + if name < key then search a (i-1) + else if key < name then search (i+1) b + else v + end + in search 0 (Vector.length vec - 1) end; + + +fun choose p [] = raise Subscript + | choose p (a::xs) = + if p a then a else choose p xs +; + +fun find p [] = raise Subscript + | find p ((a, v) :: xs) = + if p a then v else find p xs +; + +fun foldInt f a n = if n <= 0 then a else f n (foldInt f a (n-1)) +; + +fun duplicates [] = false + | duplicates (x :: xs) = member x xs orelse duplicates xs +; +fun stringToLower s = + CharVector.tabulate(size s, fn i => Char.toLower(CharVector.sub(s, i))); + +fun for f i j = + if i > j then () else (f i : unit; for f (i+1) j) +; + +fun zip2 [] [] = [] + | zip2 [] (y :: ys) = fatalError "zip2" + | zip2 (x :: xs) [] = fatalError "zip2" + | zip2 (x :: xs) (y :: ys) = (x, y) :: zip2 xs ys +; + + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Front.sig mosml-2.10.1/src/compiler.cminusminus/Front.sig --- mosml-2.01/src/compiler.cminusminus/Front.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Front.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,15 @@ +local + open Lambda Smlprim Globals Asynt Tr_env +in + +val trConVar : ConInfo -> Lambda; +val trTopDynExConVar : ExConInfo -> Lambda -> Lambda; +val trPrimVar : SMLPrim -> Lambda; +val coerceMod : Lambda -> Mod -> Mod -> Lambda; +val coerceStr : Lambda -> Str -> Str -> Lambda; +val coerceRecStr : Lambda -> RecStr -> RecStr -> Lambda; +val coerceFun : Lambda -> GenFun -> GenFun -> Lambda; + +val translateToplevelDec: Dec -> RenEnv * (bool * Lambda) list; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Front.sml mosml-2.10.1/src/compiler.cminusminus/Front.sml --- mosml-2.01/src/compiler.cminusminus/Front.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Front.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,1358 @@ +(* front.ml : translation abstract syntax -> extended lambda-calculus. *) + +open Misc List Obj Fnlib Config Mixture Const Smlexc Prim Lambda Smlprim; +open Globals Location Units Types Asynt Asyntfn Tr_env Match; + + +datatype SMLPrimImpl = + GVprim of QualifiedIdent + | VMprim of int * primitive + | VMPprim of int * primitive + | GVTprim of QualifiedIdent * obj +; + +val getPrimImpl = fn + MLPeq => VMPprim(1, Pccall("sml_equal", 2)) + | MLPnoteq => VMPprim(1, Pccall("sml_not_equal", 2)) + | MLPeq_c => VMprim (2, Pccall("sml_equal", 2)) + | MLPnoteq_c => VMprim (2, Pccall("sml_not_equal", 2)) + | MLPref => VMprim (1, Pmakeblock (CONtag(refTag, 1))) + | MLPsetref => VMPprim(1, Psetfield 0) + | MLPsetref_c => VMprim (2, Psetfield 0) + | MLPadd_int => VMPprim(1, Psmladdint) + | MLPsub_int => VMPprim(1, Psmlsubint) + | MLPmul_int => VMPprim(1, Psmlmulint) + | MLPdiv_int => VMPprim(1, Psmldivint) + | MLPmod_int => VMPprim(1, Psmlmodint) + | MLPquot_int => VMPprim(1, Psmlquotint) + | MLPrem_int => VMPprim(1, Psmlremint) + | MLPeq_int => VMPprim(1, Ptest(Pint_test PTeq)) + | MLPnoteq_int => VMPprim(1, Ptest(Pint_test PTnoteq)) + | MLPlt_int => VMPprim(1, Ptest(Pint_test PTlt)) + | MLPgt_int => VMPprim(1, Ptest(Pint_test PTgt)) + | MLPle_int => VMPprim(1, Ptest(Pint_test PTle)) + | MLPge_int => VMPprim(1, Ptest(Pint_test PTge)) + | MLPadd_int_c => VMprim (2, Psmladdint) + | MLPsub_int_c => VMprim (2, Psmlsubint) + | MLPmul_int_c => VMprim (2, Psmlmulint) + | MLPdiv_int_c => VMprim (2, Psmldivint) + | MLPmod_int_c => VMprim (2, Psmlmodint) + | MLPquot_int_c => VMprim (2, Psmlquotint) + | MLPrem_int_c => VMprim (2, Psmlremint) + | MLPeq_int_c => VMprim (2, Ptest(Pint_test PTeq)) + | MLPnoteq_int_c => VMprim (2, Ptest(Pint_test PTnoteq)) + | MLPlt_int_c => VMprim (2, Ptest(Pint_test PTlt)) + | MLPgt_int_c => VMprim (2, Ptest(Pint_test PTgt)) + | MLPle_int_c => VMprim (2, Ptest(Pint_test PTle)) + | MLPge_int_c => VMprim (2, Ptest(Pint_test PTge)) + | MLPadd_real => VMPprim(1, Pfloatprim Psmladdfloat) + | MLPsub_real => VMPprim(1, Pfloatprim Psmlsubfloat) + | MLPmul_real => VMPprim(1, Pfloatprim Psmlmulfloat) + | MLPdiv_real => VMPprim(1, Pfloatprim Psmldivfloat) + | MLPlt_real => VMPprim(1, Ptest(Pfloat_test PTlt)) + | MLPgt_real => VMPprim(1, Ptest(Pfloat_test PTgt)) + | MLPle_real => VMPprim(1, Ptest(Pfloat_test PTle)) + | MLPge_real => VMPprim(1, Ptest(Pfloat_test PTge)) + | MLPadd_real_c => VMprim (2, Pfloatprim Psmladdfloat) + | MLPsub_real_c => VMprim (2, Pfloatprim Psmlsubfloat) + | MLPmul_real_c => VMprim (2, Pfloatprim Psmlmulfloat) + | MLPdiv_real_c => VMprim (2, Pfloatprim Psmldivfloat) + | MLPlt_real_c => VMprim (2, Ptest(Pfloat_test PTlt)) + | MLPgt_real_c => VMprim (2, Ptest(Pfloat_test PTgt)) + | MLPle_real_c => VMprim (2, Ptest(Pfloat_test PTle)) + | MLPge_real_c => VMprim (2, Ptest(Pfloat_test PTge)) + | MLPlt_string => VMPprim(1, Ptest(Pstring_test PTlt)) + | MLPgt_string => VMPprim(1, Ptest(Pstring_test PTgt)) + | MLPle_string => VMPprim(1, Ptest(Pstring_test PTle)) + | MLPge_string => VMPprim(1, Ptest(Pstring_test PTge)) + | MLPconcat => VMPprim(1, Pccall("sml_concat", 2)) + | MLPlt_string_c => VMprim (2, Ptest(Pstring_test PTlt)) + | MLPgt_string_c => VMprim (2, Ptest(Pstring_test PTgt)) + | MLPle_string_c => VMprim (2, Ptest(Pstring_test PTle)) + | MLPge_string_c => VMprim (2, Ptest(Pstring_test PTge)) + | MLPconcat_c => VMprim(2, Pccall("sml_concat", 2)) + | MLPadd_word => VMPprim(1, Paddint) + | MLPsub_word => VMPprim(1, Psubint) + | MLPmul_word => VMPprim(1, Pmulint) + | MLPdiv_word => VMPprim(1, Pdivint) + | MLPmod_word => VMPprim(1, Pmodint) + | MLPadd_word_c => VMprim (2, Paddint) + | MLPsub_word_c => VMprim (2, Psubint) + | MLPmul_word_c => VMprim (2, Pmulint) + | MLPdiv_word_c => VMprim (2, Pdivint) + | MLPmod_word_c => VMprim (2, Pmodint) + | MLPeq_word => VMPprim(1, Ptest(Pword_test PTeq)) + | MLPnoteq_word => VMPprim(1, Ptest(Pword_test PTnoteq)) + | MLPlt_word => VMPprim(1, Ptest(Pword_test PTlt)) + | MLPgt_word => VMPprim(1, Ptest(Pword_test PTgt)) + | MLPle_word => VMPprim(1, Ptest(Pword_test PTle)) + | MLPge_word => VMPprim(1, Ptest(Pword_test PTge)) + | MLPeq_word_c => VMprim (2, Ptest(Pword_test PTeq)) + | MLPnoteq_word_c => VMprim (2, Ptest(Pword_test PTnoteq)) + | MLPlt_word_c => VMprim (2, Ptest(Pword_test PTlt)) + | MLPgt_word_c => VMprim (2, Ptest(Pword_test PTgt)) + | MLPle_word_c => VMprim (2, Ptest(Pword_test PTle)) + | MLPge_word_c => VMprim (2, Ptest(Pword_test PTge)) + | MLPprim(arity, prim) => VMprim(arity, prim) + | MLPccall(arity, name) => VMprim(arity, Pccall(name, arity)) + | MLPgv qualid => GVprim qualid + | MLPgvt(qualid, ref sc) => GVTprim(qualid, sc) +; + +val curriedPrimVersion = fn + MLPeq => SOME MLPeq_c + | MLPnoteq => SOME MLPnoteq_c + | MLPsetref => SOME MLPsetref_c + | MLPadd_int => SOME MLPadd_int_c + | MLPsub_int => SOME MLPsub_int_c + | MLPmul_int => SOME MLPmul_int_c + | MLPdiv_int => SOME MLPdiv_int_c + | MLPmod_int => SOME MLPmod_int_c + | MLPquot_int => SOME MLPquot_int_c + | MLPrem_int => SOME MLPrem_int_c + | MLPeq_int => SOME MLPeq_int_c + | MLPnoteq_int => SOME MLPnoteq_int_c + | MLPlt_int => SOME MLPlt_int_c + | MLPgt_int => SOME MLPgt_int_c + | MLPle_int => SOME MLPle_int_c + | MLPge_int => SOME MLPge_int_c + | MLPadd_real => SOME MLPadd_real_c + | MLPsub_real => SOME MLPsub_real_c + | MLPmul_real => SOME MLPmul_real_c + | MLPdiv_real => SOME MLPdiv_real_c + | MLPlt_real => SOME MLPlt_real_c + | MLPgt_real => SOME MLPgt_real_c + | MLPle_real => SOME MLPle_real_c + | MLPge_real => SOME MLPge_real_c + | MLPlt_string => SOME MLPlt_string_c + | MLPgt_string => SOME MLPgt_string_c + | MLPle_string => SOME MLPle_string_c + | MLPge_string => SOME MLPge_string_c + | MLPconcat => SOME MLPconcat_c + | MLPadd_word => SOME MLPadd_word_c + | MLPsub_word => SOME MLPsub_word_c + | MLPmul_word => SOME MLPmul_word_c + | MLPdiv_word => SOME MLPdiv_word_c + | MLPmod_word => SOME MLPmod_word_c + | MLPeq_word => SOME MLPeq_word_c + | MLPnoteq_word => SOME MLPnoteq_word_c + | MLPlt_word => SOME MLPlt_word_c + | MLPgt_word => SOME MLPgt_word_c + | MLPle_word => SOME MLPle_word_c + | MLPge_word => SOME MLPge_word_c + | _ => NONE +; + +(* Translation of expressions *) + +exception Not_constant; + +fun extractConstant (Lconst cst) = cst + | extractConstant _ = raise Not_constant; + +fun mkDynexn1 exnname arg = Lprim(Pmakeblock (CONtag(0,1)), [exnname, arg]) +fun mkDynexn0 exnname = mkDynexn1 exnname (Lconst constUnit) + +(* ps: TODO perhaps share the code for raising Bind and Match *) + +val bindExn = + mkDynexn0 (Lprim(Pget_global ({qual="General", id=["exn_bind"]}, 0), [])); +val matchExn = + mkDynexn0 (Lprim(Pget_global ({qual="General", id=["exn_match"]}, 0), [])) +val bindRaiser = Lprim(Praise, [bindExn]); +val matchRaiser = Lprim(Praise, [matchExn]); + +fun partial_fun (loc as Loc(start,stop)) () = + (msgIBlock 0; + errLocation loc; + errPrompt "Warning: pattern matching is not exhaustive"; + msgEOL(); msgEOL(); + msgEBlock(); + matchRaiser); + +fun partial_let (onTop : bool) (loc as Loc(start,stop)) () = + (if not onTop then + (msgIBlock 0; + errLocation loc; + errPrompt "Warning: pattern matching is not exhaustive"; + msgEOL(); msgEOL(); + msgEBlock()) + else (); + bindRaiser); + +fun partial_try () = Lprim(Praise, [Lvar 0]); + +fun extract_fields arity = + let fun loop i = + if i >= arity then [] + else + Lprim(Pfield i, [Lvar 0]) :: loop (i+1) + in loop 0 end +; + +fun normApp (func as (_, func')) args = + case func' of + PARexp e => normApp e args + | TYPEDexp(e,_) => normApp e args + | APPexp(e1,e2) => normApp e1 (e2 :: args) + | _ => (func, args) +; + +fun extractPairArg (_, exp') = + case exp' of + PARexp e => extractPairArg e + | TYPEDexp(e,_) => extractPairArg e + | RECexp(ref (TUPLEre [e1,e2])) => SOME (e1, e2) + | _ => NONE +; + +fun canSplitFirstArg (Lvar n :: args) = true + | canSplitFirstArg (Lprim(Pget_global _, []) :: args) = true + | canSplitFirstArg _ = false +; + +fun splitFirstArg (arg :: args) = + Lprim(Pfield 0, [arg]) :: Lprim(Pfield 1, [arg]) :: args + | splitFirstArg _ = fatalError "splitFirstArg" +; + +(* An expression is "safe", if evaluating it can't produce *) +(* side-effects, i.e. I/O, exceptions, etc. *) +(* The following is a crude approximation... *) + +fun isSafe (_, exp') = + case exp' of + SCONexp _ => true + | VIDPATHexp (ref (RESvidpath _))=> true + | VIDPATHexp (ref (OVLvidpath _)) => fatalError "isSafe:1" + | FNexp _ => true + | APPexp(e1,e2) => false + | RECexp(ref (RECre fs)) => + all (fn (_, e) => isSafe e) fs + | RECexp(ref (TUPLEre es)) => + all isSafe es + | VECexp es => + all isSafe es + | PARexp e => isSafe e + | LETexp (dec,exp) => false + | INFIXexp (ref (UNRESinfixexp e)) => fatalError "isSafe:2" + | INFIXexp (ref (RESinfixexp e)) => isSafe e + | TYPEDexp(e,ty) => isSafe e + | ANDALSOexp(e1,e2) => + isSafe e1 andalso isSafe e2 + | ORELSEexp(e1,e2) => + isSafe e1 andalso isSafe e2 + | HANDLEexp(e, mrules) => false + | RAISEexp e => false + | IFexp(e0,e1,e2) => + isSafe e0 andalso isSafe e1 andalso isSafe e2 + | WHILEexp(e1,e2) => + isSafe e1 andalso isSafe e2 + | SEQexp(e1,e2) => + isSafe e1 andalso isSafe e2 + | STRUCTUREexp (modexp,_,_) => isSafeModExp modexp + | FUNCTORexp (modexp,_,_) => isSafeModExp modexp +and isSafeModExp (_, (modexp',_)) = + case modexp' of + DECmodexp _ => false + | LONGmodexp _ => true + | LETmodexp (dec,modexp) => false + | PARmodexp modexp => isSafeModExp modexp + | CONmodexp (modexp,sigexp) => isSafeModExp modexp + | ABSmodexp (modexp,sigexp) => isSafeModExp modexp + | FUNCTORmodexp (_,modid,_, sigexp, modexp) => true + | APPmodexp (modexp,modexp') => false + | RECmodexp (modid,_,sigexp, modexp) => false +; + +(* All unsafe arguments must be lifted, except the rightmost one, *) +(* in order to preserve the evaluation order. *) + +datatype AppArgs = + SAFEarg of Exp + | CONSTarg of Lambda + | UNSAFEarg +; + +fun trConVar (ci : ConInfo) = + let val {conArity, conIsGreedy, conTag, conSpan, ...} = !ci in + case (conIsGreedy, conArity, conSpan) of + (true, _, _) => + Lfn(Lprim( + Pmakeblock(CONtag(conTag,conSpan)), extract_fields conArity)) + | (false, 0, _) => + Lconst(BLOCKsc(CONtag(conTag,conSpan), [])) + | (false, _, 1) => + Lfn(Lvar 0) + | (false, _, _) => + Lfn(Lprim(Pmakeblock(CONtag(conTag,conSpan)), [(Lvar 0)])) + end; + +fun trExConVar (env as (rho, depth)) (ii : IdInfo) (ei:ExConInfo) = + let val {exconArity, ...} = !ei + val en = translateLongAccess ValId env ii + in + if exconArity = 0 then mkDynexn0 en + else Llet([en], Lfn(mkDynexn1 (Lvar 1) (Lvar 0))) + end + +fun trTopDynExConVar (ei : ExConInfo) (en:Lambda) = + let val {exconArity,...} = !ei + in if exconArity = 0 then + mkDynexn0 en + else + Llet([en], Lfn(mkDynexn1 (Lvar 1) (Lvar 0))) + end; + +fun trPrimVar prim = + case getPrimImpl prim of + GVprim globalName => + Lprim(Pget_global (globalName, 0), []) + | VMprim(arity, p) => + let fun make_fn n args = + if n >= arity + then Lprim(p, args) + else Lfn(make_fn (n+1) (Lvar n :: args)) + in make_fn 0 [] end + | VMPprim(arity, p) => + let fun make_fn n args = + if n >= arity + then Lprim(p, splitFirstArg args) + else Lfn(make_fn (n+1) (Lvar n :: args)) + in make_fn 0 [] end + | GVTprim(globalName, sc) => + Lfn(Lapply( + Lprim(Pget_global (globalName, 0), []), + [Lconst(QUOTEsc (ref sc)), Lvar 0])) +; + +fun trVar (env as (rho, depth)) (ii : IdInfo) = + let val {info={idKind,...}, ...} = ii + val {info,qualid} = !idKind + in + (case info of + VARik => + translateLongAccess ValId env ii + | STRik => + translateLongAccess ModId env ii + | FUNik => + translateLongAccess FunId env ii + | PRIMik pi => + trPrimVar (#primOp pi) + | CONik ci => + trConVar ci + | EXCONik ei => + trExConVar env ii ei) + end; + + +(* coercion *) + +fun getGlobal asId {qual,id} = + Lprim(Pget_global ({qual=qual,id = [mangle (asId (longIdentAsIdent id "getGlobal"))]},0),[]) +; + +fun coerceVarEnv S VE' = + let val lookupVEofS = lookupVEofStr S + in foldEnv + (fn id => fn {info = (_,cs'),...} => fn tr_VE => + case cs' of + VARname _ => + (let val (field,{qualid,info=(_,cs)}) = lookupVEofS id + in case cs of + VARname _ => + if isGlobalName qualid + then (Lprim(Pget_global(qualid,0),[]))::tr_VE + else + (Lprim(Pfield field,[Lvar 0]))::tr_VE + | PRIMname pi => (trPrimVar (#primOp pi))::tr_VE + | CONname ci => (trConVar ci)::tr_VE + | EXNname ei => + (let val {exconArity, ...} = !ei + val en = + if isGlobalName qualid then + getGlobal ValId qualid + else Lprim(Pfield field,[Lvar 0]) + in + if exconArity = 0 then + mkDynexn0 en + else + Llet([en], Lfn(mkDynexn1 (Lvar 1) (Lvar 0))) + end + :: tr_VE) + | REFname => fatalError "coerceVarEnv:1" + end) + | EXNname ei' => + let val (field,{qualid,info = (_,cs)}) = lookupVEofS id + in case cs of + EXNname ei => + (let val {exconArity, ...} = !ei + in + if isGlobalName qualid then getGlobal ValId qualid + else Lprim(Pfield field, [Lvar 0]) + end + :: tr_VE) + | _ => fatalError "coerceVarEnv:3" + end + | _ (* PRIMname pi' | CONname ci' | REFname *) => + tr_VE) + [] + VE' + end +and coerceFunEnv S FE' tr_VE = + let val lookupFEofS = lookupFEofStr S + in foldEnv + (fn id => fn {info = F',...} => fn tr_FE_VE => + let val (field,{qualid,info = F}) = lookupFEofS id + val trF = if isGlobalName qualid + then getGlobal FunId qualid + else Lprim(Pfield field, [Lvar 0]) + + in + (coerceFun trF F F')::tr_FE_VE + end) + tr_VE + FE' + end +and coerceModEnv S ME' tr_FE_VE = + let val lookupMEofS = lookupMEofStr S + in foldEnv + (fn id => fn {info = RS',...} => fn tr_ME_FE_VE => + let val (field,{qualid,info = RS}) = lookupMEofS id + val trM = if isGlobalName qualid + then getGlobal ModId qualid + else Lprim(Pfield field, [Lvar 0]) + + in + (coerceRecStr trM RS RS')::tr_ME_FE_VE + end) + tr_FE_VE + ME' + end +and coerceStr lam S S' = + case S' of + STRstr(ME',FE',GE',TE',VE') => + let val tr_VE = coerceVarEnv S VE' + val tr_FE_VE = coerceFunEnv S FE' tr_VE + val tr_ME_FE_VE = coerceModEnv S ME' tr_FE_VE + in + if isIdentityCoercion S 0 tr_ME_FE_VE + then lam + else + Llet([lam],Lstruct tr_ME_FE_VE) + end + | _ => fatalError "coerceStr" +and isIdentityCoercion S pos (Lprim(Pfield field, [Lvar 0])::lams) = + (pos = field) andalso isIdentityCoercion S (pos+1) lams + | isIdentityCoercion S pos (_::lams) = false + | isIdentityCoercion S pos [] = (sizeOfStr S) = pos +and coerceRecStr lam (NONrec S) (NONrec S') = coerceStr lam S S' + | coerceRecStr lam RS (RECrec (_,RS')) = coerceRecStr lam RS RS' + | coerceRecStr lam (RECrec (_,RS)) RS' = coerceRecStr lam RS RS' +and coerceMod lam (STRmod RS) (STRmod RS') = coerceRecStr lam RS RS' + | coerceMod lam (FUNmod F) (FUNmod F') = coerceFun lam F F' + | coerceMod _ _ _ = fatalError "coerceMod" +and coerceFun lam (_,M1,EXISTSexmod(_,M1')) (_,M2,EXISTSexmod(_,M2')) = + let val domCoercion = coerceMod (Lvar 0) (normMod M2) (normMod M1) + val rngCoercion = coerceMod (Lvar 0) (normMod M1') (normMod M2') + in case (domCoercion,rngCoercion) of + (Lvar 0, Lvar 0) => lam + | (Lvar 0, _) => + Llet([lam], + Lfn(Llet([Lapply(Lvar 1,[Lvar 0])],rngCoercion))) + | (_, Lvar 0) => + Llet([lam], + Lfn(Llet([domCoercion], + Lapply(Lvar 2,[Lvar 0])))) + | (_,_) => + Llet([lam], + Lfn(Llet([domCoercion], + Llet([Lapply(Lvar 2,[Lvar 0])], + rngCoercion)))) + end; + + +fun coerceDecVarEnv (env as (rho,depth)) VE VE' = + foldEnv + (fn id => fn {info = (_,cs'),...} => fn tr_VE => + case cs' of + VARname _ => + (let val {qualid,info=(_,cs)} = lookupEnv VE id + in case cs of + VARname _ => + if isGlobalName qualid + then (Lprim(Pget_global(qualid,0),[]))::tr_VE + else + (translateLocalAccess ValId env id)::tr_VE + | PRIMname pi => (trPrimVar (#primOp pi))::tr_VE + | CONname ci => (trConVar ci)::tr_VE + | EXNname ei => + (let val {exconArity, ...} = !ei + val en = + if isGlobalName qualid then + getGlobal ValId qualid + else + translateLocalAccess ValId env id + in + if exconArity = 0 then + mkDynexn0 en + else + Llet([en],Lfn(mkDynexn1 (Lvar 1) (Lvar 0))) + end + :: tr_VE) + | REFname => fatalError "coerceDecVarEnv:1" + end) + | EXNname ei' => + let val {qualid,info = (_,cs)} = lookupEnv VE id + in + case cs of + EXNname ei => + (let val {exconArity, ...} = !ei + in + if isGlobalName qualid then getGlobal ValId qualid + else translateLocalAccess ValId env id + end + :: tr_VE) + | _ => fatalError "coerceDecVarEnv:3" + end + | _ (* PRIMname pi' | CONname ci' | REFname *) => + tr_VE) + [] + VE' +and coerceDecFunEnv env FE FE' tr_VE = + foldEnv + (fn id => fn {info = F',...} => fn tr_FE_VE => + let val {qualid,info = F} = lookupEnv FE id + val trF = if isGlobalName qualid + then getGlobal FunId qualid + else translateLocalAccess FunId env id + + in + (coerceFun trF F F')::tr_FE_VE + end) + tr_VE + FE' +and coerceDecModEnv env ME ME' tr_FE_VE = + foldEnv + (fn id => fn {info = RS',...} => fn tr_ME_FE_VE => + let val {qualid,info = RS} = lookupEnv ME id + val trM = if isGlobalName qualid + then getGlobal ModId qualid + else translateLocalAccess ModId env id + in + (coerceRecStr trM RS RS')::tr_ME_FE_VE + end) + tr_FE_VE + ME' +(* +and coerceDec env (STRstr(ME,FE,TE,VE)) (STRstr(ME',FE',TE',VE')) = + let val tr_VE = coerceDecVarEnv env VE VE' + val tr_FE_VE = coerceDecFunEnv env FE FE' tr_VE + val tr_ME_FE_VE = coerceDecModEnv env ME ME' tr_FE_VE + in + Lstruct tr_ME_FE_VE + end; +*) +and coerceDec env RS RS' = + let val (ME,FE,_,_,VE) = + case SofRecStr RS of + STRstr ES => ES + | _ => fatalError "coerceDec:1" + val (ME',FE',_,_,VE') = + case SofRecStr RS' of + STRstr ES' => ES' + | _ => fatalError "coerceDec:2" + val tr_VE = coerceDecVarEnv env VE VE' + val tr_FE_VE = coerceDecFunEnv env FE FE' tr_VE + val tr_ME_FE_VE = coerceDecModEnv env ME ME' tr_FE_VE + in + Lstruct tr_ME_FE_VE + end; + +fun trExp (env as (rho, depth)) (exp as (loc, exp')) = + case exp' of + SCONexp (scon, _) => + Lconst (ATOMsc scon) + | VIDPATHexp (ref (RESvidpath ii))=> + trVar env ii + | VIDPATHexp (ref (OVLvidpath _)) => fatalError "trExp:1" + | FNexp [] => + fatalError "trExp:2" + | FNexp(mrules as MRule(ref pats ,_)::_) => + foldR (fn pat => fn lam => Lfn lam) + (trMatch loc env (partial_fun loc) mrules) + pats + | APPexp(e1,e2) => + (case normApp e1 [e2] of + (func as (loc, FNexp mrules), args) => + if curriedness mrules = List.length args then + Llet(trLetArgs env args, + trMatch loc env (partial_fun loc) mrules) + else + let val (env', tr_args, envelope) = trArgs env args + in envelope(Lapply(trExp env' func, tr_args)) end + | (func as (_,VIDPATHexp(ref (RESvidpath ii))),args)=> + trVarApp env ii args + | (func, args) => + let val (env', tr_args, envelope) = trArgs env (func :: args) + in envelope(Lapply(hd tr_args, tl tr_args)) end) + | RECexp(ref (RECre fs)) => + trRec env (CONtag(0,1)) fs + | RECexp(ref (TUPLEre es)) => + trTuple env (CONtag(0,1)) es + | VECexp es => + trTuple env (CONtag(0,1)) es + | PARexp e => trExp env e + | LETexp (dec,exp) => + let val ((rho', depth'), envelope) = trDec env dec + val env'' = (plusEnv rho rho', depth') + in envelope(trExp env'' exp) end + | INFIXexp (ref (UNRESinfixexp es)) => fatalError "trExp:3" + | INFIXexp (ref (RESinfixexp e)) => trExp env e + | TYPEDexp(e,ty) => trExp env e + | ANDALSOexp(e1,e2) => + Landalso(trExp env e1, trExp env e2) + | ORELSEexp(e1,e2) => + Lorelse(trExp env e1, trExp env e2) + | HANDLEexp(e, mrules) => + Lhandle(trExp env e, trMatch loc env partial_try mrules) + | RAISEexp e => + Lprim(Praise, [trExp env e]) + | IFexp(e0,e1,e2) => + Lif(trExp env e0, trExp env e1, trExp env e2) + | WHILEexp(e1,e2) => + Lwhile(trExp env e1, trExp env e2) + | SEQexp(e1,e2) => + Lseq(trExp env e1, trExp env e2) + | STRUCTUREexp(modexp,sigexp, ref (SOME (EXISTSexmod(_,M')))) => + trConstrainedModExp env modexp M' + | STRUCTUREexp(modexp,sigexp,_) => + fatalError "trExp:4" + | FUNCTORexp(modexp,sigexp, ref (SOME (EXISTSexmod(_,M')))) => + trConstrainedModExp env modexp M' + | FUNCTORexp (modexp,sigexp, _) => + fatalError "trExp:5" +and trVarApp env (ii : IdInfo) args = + let val {info={idKind, ...},...} = ii in + case #info(!idKind) of + VARik => + let val (env', tr_args, envelope) = trArgs env args + in envelope(Lapply(translateLongAccess ValId env' ii, tr_args)) end + | PRIMik pi => + let val {primOp, ...} = pi in + case curriedPrimVersion primOp of + NONE => trPrimApp env primOp args + | SOME prim_c => + (case extractPairArg (hd args) of + NONE => trPrimApp env primOp args + | SOME(arg', arg'') => + trPrimApp env prim_c (arg'::arg''::(tl args))) + end + | CONik ci => + let val {conArity, conIsGreedy, conTag, conSpan, ...} = !ci in + if List.length args <> 1 then + fatalError "trVarApp: unary con requires 1 arg" + else (); + case (conIsGreedy, conArity, conSpan) of + (true, _, _) => + (case (hd args) of + (_, RECexp(ref (RECre fs))) => + trRec env (CONtag(conTag,conSpan)) fs + | (_, RECexp(ref (TUPLEre es))) => + trTuple env (CONtag(conTag,conSpan)) es + | _ => + Llet([trExp env (hd args)], + Lprim(Pmakeblock(CONtag(conTag,conSpan)), + extract_fields conArity))) + | (false, 0, _) => + fatalError "trVarApp: nullary con in app" + | (false, _, 1) => + trExp env (hd args) + | (false, _, _) => + (* Normal unary con, in the end... *) + let val tr_arg = trExp env (hd args) in + Lconst(BLOCKsc(CONtag(conTag,conSpan), + [extractConstant tr_arg])) + handle Not_constant => + Lprim(Pmakeblock(CONtag(conTag,conSpan)), [tr_arg]) + end + end + | EXCONik ei => + let val {exconArity, ...} = !ei + in + if List.length args <> 1 then + fatalError "trVarApp: unary excon requires 1 arg" + else (); + if exconArity = 0 then + fatalError "trVarApp: nullary excon in app" + else (); + let val en = translateLongAccess ValId env ii + val tr_arg = trExp env (hd args) + in mkDynexn1 en tr_arg end + end + | STRik => fatalError "trVarApp: STRik" + | FUNik => fatalError "trVarApp: FUNik" + end + +and trPrimApp env prim args = + case getPrimImpl prim of + GVprim globalName => + let val (env', tr_args, envelope) = trArgs env args + in envelope(Lapply(trPrimVar prim, tr_args)) end + | VMprim(arity, p) => + if arity <> List.length args then + let val (env', tr_args, envelope) = trArgs env args + in envelope(Lapply(trPrimVar prim, tr_args)) end + else + Lprim(p, map (trExp env) args) + | VMPprim(arity, p) => + let val (env', tr_args, envelope) = trArgs env args + in + if (arity <> List.length tr_args) then + envelope(Lapply(trPrimVar prim, tr_args)) + else if canSplitFirstArg tr_args then + envelope(Lprim(p, splitFirstArg tr_args)) + else if arity = 1 then + Llet(tr_args, Lprim(p, splitFirstArg [Lvar 0])) + else + envelope(Lapply(trPrimVar prim, tr_args)) + end + | GVTprim(globalName, sc) => + let val (env', tr_args, envelope) = trArgs env args + in + envelope(Lapply(Lprim(Pget_global (globalName, 0), []), + Lconst(QUOTEsc (ref sc))::tr_args)) + end + +and trRec env tag fs = + let val labs = map fst fs and es = map snd fs + val (env', tr_es, envelope) = trArgs env es + val tr_es' = map snd (sortRow (zip2 labs tr_es)) + in + (envelope(Lconst(BLOCKsc(tag, map extractConstant tr_es')))) + handle Not_constant => envelope(Lprim(Pmakeblock tag, tr_es')) + end + +and trTuple env tag es = + let val tr_es = map (trExp env) es in + (Lconst(BLOCKsc(tag, map extractConstant tr_es))) + handle Not_constant => Lprim(Pmakeblock tag, tr_es) + end + +(* We recognize constant arguments only upon translating them, *) +(* to avoid repeated traversals of the abstract syntax tree. *) + +and classifyArgs (env as (rho, depth)) unsafe safe = fn + [] => (unsafe, safe) + | arg :: args => + if isSafe arg then + classifyArgs env unsafe ((SAFEarg arg) :: safe) args + else + let val lam = trExp env arg in + case lam of + Lconst _ => + classifyArgs env unsafe ((CONSTarg lam) :: safe) args + | _ => + classifyArgs (rho, depth+1) (lam :: unsafe) + (UNSAFEarg :: safe) args + end + +and adjustHeadArgs env pos acc = fn + [] => acc + | SAFEarg exp :: rest => + adjustHeadArgs env pos (trExp env exp :: acc) rest + | CONSTarg lam :: rest => + adjustHeadArgs env pos (lam :: acc) rest + | UNSAFEarg :: rest => + adjustHeadArgs env (pos+1) (Lvar pos :: acc) rest + +(* The rightmost unsafe expression needn't be lifted, *) +(* as it can't do any harm. *) + +and adjustArgs env quasisafe acc = fn + [] => fatalError "adjustArgs" + | SAFEarg exp :: rest => + adjustArgs env quasisafe (trExp env exp :: acc) rest + | CONSTarg lam :: rest => + adjustArgs env quasisafe (lam :: acc) rest + | UNSAFEarg :: rest => + adjustHeadArgs env 0 (quasisafe :: acc) rest + +and trArgs (env as (rho, depth)) args = + case classifyArgs env [] [] args of + ([], safe) => (env, adjustHeadArgs env 0 [] safe, fn lam => lam) + | (quasisafe :: unsafe, safe) => + let val num = List.length unsafe + val env' = (rho, depth + num) + in + (env', + adjustArgs env' quasisafe [] safe, + if num = 0 then fn lam => lam + else fn lam => Llet(rev unsafe, lam)) + end +and trOpenLongStrIdInfo depth ((_,ref NONE):LongModIdInfo) = + fatalError "trOpenLongStrIdInfo:1" + | trOpenLongStrIdInfo depth ((longstrid,ref(SOME (ME,FE,_,VE,_))):LongModIdInfo) = + let val {info={idKind,...}, ...} = longstrid + val {qualid, ...} = !idKind + val _ = if isUnitName qualid then fatalError "trOpenLongStrIdInfo:2" else () + in + let val (rhoME,posME) = + foldEnv (fn id => fn {qualid,...} => fn cont => fn pos => + if isGlobalName qualid + then cont pos + else let val (rhoME,posME) = cont (pos + 1) + in + (bindInEnv rhoME (ModId id) + (Path_son (pos, Path_local depth)), + posME) + end) + (fn pos => (NILenv,pos)) + ME + 0 + val (rhoMEFE,posMEFE) = + foldEnv (fn id => fn {qualid,...} => fn cont => fn pos => + if isGlobalName qualid + then cont pos + else let val (rhoMEFE,posMEFE) = cont (pos + 1) + in (bindInEnv rhoMEFE (FunId id) + (Path_son (pos, Path_local depth)), + posMEFE) + end) + (fn pos => (rhoME,pos)) + FE + posME + val (rhoMEFEVE,posMEFEVE) = + foldEnv (fn id => fn {qualid,info = (_,cs)} => fn cont => fn pos => + case cs of + VARname _ => (* cvr: review *) + if isGlobalName qualid + then cont pos + else + let val (rhoMEFEVE,posMEFEVE) = cont (pos + 1) + in + (bindInEnv rhoMEFEVE (ValId id) + (Path_son (pos, Path_local depth)), + posMEFEVE) + end + | EXNname ei => + if isGlobalName qualid then cont pos + else + let val (rhoMEFEVE,posMEFEVE) = cont (pos + 1) + in + (bindInEnv rhoMEFEVE (ValId id) + (Path_son (pos, Path_local depth)), + posMEFEVE) + end + | _ => cont pos) + (fn pos => (rhoMEFE,pos)) + VE + posMEFE + in rhoMEFEVE + end + end +and trValDec onTop (env as (rho, depth)) pvbs rvbs = + let val ((rho', depth'), envelope' ) = + trValBind onTop env pvbs + val ((rho'', depth''), envelope'') = + trRecValBind (rho, depth') rvbs + in + ((plusEnv rho' rho'', depth''), envelope' o envelope'') + end +and trDec (env as (rho, depth)) (loc, dec') = + case dec' of + VALdec (_, (pvbs, rvbs)) => + trValDec false env pvbs rvbs + | PRIM_VALdec _ => ((NILenv, depth), fn lam => lam) + | FUNdec (ref (UNRESfundec _)) => fatalError "trDec" + | FUNdec (ref (RESfundec dec)) => trDec env dec + | TYPEdec _ => ((NILenv, depth), fn lam => lam) + | PRIM_TYPEdec _ => ((NILenv, depth), fn lam => lam) + | DATATYPEdec(dbs, _) => ((NILenv, depth), fn lam => lam) + | DATATYPErepdec _ => ((NILenv, depth), fn lam => lam) + | ABSTYPEdec(dbs, _, dec2) => + trDec env dec2 + | EXCEPTIONdec ebs => + trExBindList env ebs + | LOCALdec(dec1,dec2) => + let val ((rho', depth'), envelope') = + trDec env dec1 + val ((rho'', depth''), envelope'') = + trDec ((plusEnv rho rho'), depth') dec2 + in ((rho'', depth''), envelope' o envelope'') end + | OPENdec longmodidinfos => + trOpenLongModIdInfos env longmodidinfos + | EMPTYdec => ((NILenv, depth), fn lam => lam) + | SEQdec(dec1,dec2) => + let val ((rho', depth'), envelope') = + trDec env dec1 + val ((rho'', depth''), envelope'') = + trDec ((plusEnv rho rho'), depth') dec2 + in ((plusEnv rho' rho'', depth''), envelope' o envelope'') end + | FIXITYdec _ => + ((NILenv, depth), fn lam => lam) + | STRUCTUREdec mbs => + trModBindList env mbs + | FUNCTORdec fbs => + trFunBindList env fbs + | SIGNATUREdec _ => + ((NILenv, depth), fn lam => lam) +and trModBindList (env as (rho, depth)) mbs = + let val id_path_list = + mapFrom (fn depth => + fn (MODBINDmodbind((loc,mid), _)) => + (mid, Path_local depth) + | (ASmodbind((loc,mid), _,_)) => + (mid, Path_local depth)) + depth mbs + and len = List.length mbs + and args = mapFrom (fn i => fn mb => trModBind (rho, i) mb) depth mbs + val rho' = foldR (fn (id, path) => fn rho => bindInEnv rho (ModId id) path) + NILenv id_path_list + in ((rho', depth+len), fn lam => Llet(args, lam)) + end +and trOpenLongModIdInfos (env as (rho, depth)) longmodidinfos = + let val longstridinfos = + drop (fn ({info={idKind,...}, ...},_) => + let val {qualid, ...} = !idKind + in isUnitName qualid + end) longmodidinfos + val rhos = mapFrom trOpenLongStrIdInfo depth longstridinfos + and len = List.length longstridinfos + and args = + mapFrom (fn depth => fn (longstrid,_) => + translateLongAccess ModId (rho,depth) longstrid) + depth + longstridinfos + val rho' = foldR (fn rho => fn rho' => plusEnv rho rho') NILenv rhos + in ((rho', depth+len), fn lam => Llet(args, lam)) + end +and trModBind env = fn + MODBINDmodbind(_, modexp) => + trModExp env modexp + | ASmodbind(_,_,exp) => + trExp env exp +and trFunBind env = fn + FUNBINDfunbind(funid, modexp) => + trModExp env modexp + | ASfunbind(_,_,exp) => + trExp env exp +and trFunBindList (env as (rho, depth)) fbs = + let val id_path_list = + mapFrom (fn depth => + fn (FUNBINDfunbind((loc,funid), _)) => + (funid, Path_local depth) + | (ASfunbind((loc,funid), _,_)) => + (funid, Path_local depth)) + depth fbs + and len = List.length fbs + and args = + mapFrom (fn depth => fn mb => trFunBind (rho, depth) mb) + depth + fbs + val rho' = foldR (fn (id, path) => fn rho => bindInEnv rho (FunId id) path) + NILenv id_path_list + in ((rho', depth+len), fn lam => Llet(args, lam)) end +and trModExp (env as (rho,depth)) (_, (modexp,r)) = + (* cvr: consider setting r to NONE to free up space *) + case (modexp,!r) of + (DECmodexp dec, SOME (EXISTSexmod (_, STRmod RS))) => + let val (ME,FE,_,_,VE) = + case SofRecStr RS of + STRstr ES => ES + | _ => fatalError "trModExp:1" + val (env as (rho', depth'), envelope') = trDec env dec + val tr_VE = + foldEnv (fn id => fn {qualid,info = (_,cs)} => fn tr_VE => + case cs of + VARname _ => + if isGlobalName qualid + then tr_VE + else (translateLocalAccess ValId env id) :: tr_VE + | EXNname ei => + if isGlobalName qualid then tr_VE + else (translateLocalAccess ValId env id) :: tr_VE + | _ => tr_VE (* PRIMname,CONname & REFname cases *) ) + [] + VE + val tr_FE_VE = foldEnv (fn id => fn {qualid,...} => fn tr_FE_VE => + if isGlobalName qualid then + tr_FE_VE + else (translateLocalAccess FunId env id):: tr_FE_VE) + tr_VE + FE + val tr_ME_FE_VE = foldEnv (fn id => fn {qualid,...} => fn tr_ME_FE_VE => + if isGlobalName qualid then + tr_ME_FE_VE + else (translateLocalAccess ModId env id):: tr_ME_FE_VE) + tr_FE_VE + ME + in + envelope' (Lstruct tr_ME_FE_VE) + end + | (LONGmodexp ii, _) => + trVar env ii + | (CONmodexp (modexp',sigexp), SOME (EXISTSexmod(_,M'))) => + trConstrainedModExp env modexp' M' + | (ABSmodexp (modexp',sigexp), SOME (EXISTSexmod(_,M'))) => + trConstrainedModExp env modexp' M' + | (LETmodexp (dec,modexp),SOME _) => + let val ((rho', depth'), envelope) = trDec env dec + val env'' = (plusEnv rho rho', depth') + in envelope(trModExp env'' modexp) end + | (FUNCTORmodexp(_,(_,funid),ref FUNik,_,modexp),SOME _) => + Lfn(trModExp (bindInEnv rho (FunId funid) (Path_local depth), + depth+1) + modexp) + | (FUNCTORmodexp(_,(_,strid),ref STRik,_,modexp),SOME _) => + Lfn(trModExp (bindInEnv rho (ModId strid) (Path_local depth), + depth+1) + modexp) +(* | (APPmodexp (funmodexp,modexp), SOME _) => + (case funmodexp of + (_,(_,ref (SOME (EXISTSexmod(_,FUNmod(T,M,X)))))) => + Lapply(trModExp env funmodexp, + [trConstrainedModExp env modexp (normMod M)]) + | _ => fatalError "trModExp:2") *) + | (APPmodexp (funmodexp,modexp), SOME _) => + (case funmodexp of + (_,(_,ref (SOME (EXISTSexmod(_,FUNmod(T,M,X)))))) => + (case (isSafeModExp funmodexp, isSafeModExp modexp) of + (true,_) => + Lapply(trModExp env funmodexp, + [trConstrainedModExp env modexp (normMod M)]) + | (false,true) => + Lapply(trModExp env funmodexp, + [trConstrainedModExp env modexp (normMod M)]) + | (false,false) => + let val (rho,depth) = env + in + Llet([trModExp env funmodexp, + trConstrainedModExp (rho,depth+ 1) modexp (normMod M)], + Lapply(Lvar 1, [Lvar 0])) + end) + | _ => fatalError "trModExp:2") + | (PARmodexp modexp,SOME _) => trModExp env modexp +(* cvr: unsafe version that works but doesn't check for definedness + | (RECmodexp((_,strid),ref (SOME RS'),sigexp,modexp), + SOME (EXISTSexmod(_,STRmod RS)))=> + Llet([Lprim(Pmakeblock(CONtag(refTag, 1)), [Lconst constUnit])], + Llet([trModExp (bindInEnv rho (ModId strid) (Path_son (0,Path_local depth)),depth+1) modexp], + Lseq(Lprim(Psetfield 0,[Lvar 1,coerceRecStr (Lvar 0) RS RS']), + Lvar 0))) +*) + | (RECmodexp((_,strid),ref (SOME RS'),sigexp,modexp), + SOME (EXISTSexmod(_,STRmod RS)))=> + Llet([Lprim(Pmakeblock(CONtag(refTag, 1)), + [Lprim(Pmakeblock(CONtag(0, 2)),[Lconst constUnit])])], + Llet([trModExp (bindInEnv rho (ModId strid) (Path_rec depth),depth+1) + modexp], + Lseq(Lprim(Psetfield 0, + [Lvar 1, + (Lprim(Pmakeblock(CONtag(1, 2)), + [coerceRecStr (Lvar 0) RS RS']))]), + Lvar 0))) + | (_,_) => fatalError "trModExp:3" +and trConstrainedModExp env (modexp as (_, (modexp',ref (SOME (EXISTSexmod ((_,M))))))) M' = + (case (modexp',M,M') of + (DECmodexp dec,STRmod RS,STRmod RS') => + let val (env', envelope') = trDec env dec + in + envelope' (coerceDec env' RS RS') + end + | _ => coerceMod (trModExp env modexp) M M') + | trConstrainedModExp _ _ _ = fatalError "trConstrainedModExp" +and tr1ValBind onTop (env as (rho, depth)) (ValBind(ref pat, arg)) = + let val (env', add_lets) = mkEnvOfPats depth [pat] + val tr_arg = trExp env arg + val m_env = (rho, depth+1) + val loc = xLR pat + fun envelope lam = + Llet([tr_arg], + translateMatch m_env (partial_let onTop loc) loc + [([pat], add_lets lam)]) + in (env', envelope) end + +and trValBind onTop (env as (rho, depth)) = fn + [] => ((NILenv, depth), fn lam => lam) + | [vb] => + tr1ValBind onTop env vb + | vb :: vbs => + let val (env' as (rho', depth'), envelope') = + tr1ValBind onTop env vb + val (env'' as (rho'', depth''), envelope'') = + trValBind onTop (rho, depth') vbs + in ((plusEnv rho' rho'', depth''), envelope' o envelope'') end + +and trRecValBind (env as (rho, depth)) = fn + [] => ((NILenv, depth), fn lam => lam) + | vbs => + let val pats = map (fn ValBind(ref p, _) => p) vbs + val args = map (fn ValBind(_, e) => e) vbs + val (rho', depth') = mkEnvOfRecPats depth pats + val rho'' = mkHashEnv (length pats) rho' + val new_env = (plusEnv rho rho'', depth') + val tr_bindings = map (trExp new_env) args + fun envelope lam = Lletrec(tr_bindings, lam) + in ((rho'', depth'), envelope) end + +and trMatch loc (env as (rho, depth)) failure_code mrules = + let val m_env = (rho, depth + curriedness mrules) + fun trMRule (MRule(ref pats, exp)) = + let val ((rho', depth'), add_lets) = mkEnvOfPats depth pats + val new_env = (plusEnv rho rho', depth') + in (pats, add_lets (trExp new_env exp)) end + in translateMatch m_env failure_code loc (map trMRule mrules) end + +and trLetArgs (env as (rho, depth)) = fn + [] => [] + | exp :: exps => + trExp env exp :: trLetArgs (rho, depth+1) exps + +and trBindings (env as (rho, depth)) = fn + [] => [] + | (pat, exp) :: rest => + trExp env exp :: trBindings (rho, depth+1) rest + +and trExBindList (env as (rho, depth)) ebs = + let val id_path_list = + mapFrom (fn depth => + fn + (EXDECexbind(ii, _)) => + (hd(#id(#qualid ii)), Path_local depth) + | (EXEQUALexbind(ii, _)) => + (hd(#id (#qualid ii)), Path_local depth)) + depth ebs + and len = List.length ebs + and args = mapFrom (fn i => fn eb => trExBind (rho, i) eb) depth ebs + val rho' = foldR (fn (id, path) => fn rho => bindInEnv rho (ValId id) path) + NILenv id_path_list + in ((rho', depth+len), fn lam => Llet(args, lam)) end + +and trExBind env = fn + EXDECexbind(ii, _) => + let val uname = ATOMsc(STRINGscon(currentUnitName())) + val exid = ATOMsc(STRINGscon (hd(#id (#qualid ii)))) + val en = exid (* ps: TODO: BLOCKsc(CONtag(0,1), [exid, uname]) *) + in Lprim(Pmakeblock(CONtag(refTag, 1)), [Lconst en]) end + | EXEQUALexbind(ii, ii') => + translateExName env ii'; + +(* Translation of toplevel declarations *) + +fun makeSeq f [] = Lunspec + | makeSeq f [x] = f x + | makeSeq f (x::rest) = Lseq(f x, makeSeq f rest) +; + +fun lookupLocalRenEnv asId renEnv id = + let val mangled_id = mangle (asId id) + in + mkUniqueGlobalName (mangled_id, lookup mangled_id renEnv) + handle Subscript => fatalError "lookupLocalRenEnv" + end +; + +fun storeGlobal asId renEnv env var = + Lprim(Pset_global (lookupLocalRenEnv asId renEnv var), + [translateLocalAccess asId env var]) +; + + + +fun equGlobal asId renEnv var0 var = + Lprim(Pset_global (lookupLocalRenEnv asId renEnv var), + [Lprim(Pget_global (lookupLocalRenEnv asId renEnv var0), [])]) +; + +fun tr1ToplevelRecValBind renEnv rho = fn + ([], exp) => Lunspec + | ([var], exp) => + Lprim(Pset_global (lookupLocalRenEnv ValId renEnv var), [trExp (rho, 0) exp]) + | (var :: vars, exp) => + Lseq(Lprim(Pset_global (lookupLocalRenEnv ValId renEnv var), + [trExp (rho, 0) exp]), + makeSeq (equGlobal ValId renEnv var) vars) +; + +fun revWithoutDuplicates [] acc = acc + | revWithoutDuplicates (x :: xs) acc = + if member x acc then + revWithoutDuplicates xs acc + else + revWithoutDuplicates xs (x :: acc) +; + +datatype TopLambda = + NILtlam + | SEQtlam of TopLambda * TopLambda + | LAMtlam of bool * Lambda +; + +fun flattenTLam tlam acc = + case tlam of + NILtlam => acc + | SEQtlam(tlam1, tlam2) => + flattenTLam tlam1 (flattenTLam tlam2 acc) + | LAMtlam(is_pure, lam) => (is_pure, lam) :: acc +; + +fun trToplevelDec rho (dec as (_, dec')) = + case dec' of + VALdec (_, ([ValBind(ref (_,VARpat ii), exp)], [])) => + let val id = hd(#id(#qualid ii)) + val id' = mkUniqueGlobalName (renameId (mangle (ValId id))) + in + (mk1Env (ValId id) (Path_global id'), + LAMtlam(isSafe exp, + Lprim(Pset_global id', [trExp (rho, 0) exp]))) + end + | VALdec (_, ([], rvbs)) => + let val ves = map (fn ValBind(ref p, e) => (domPat p, e)) rvbs + val vars = foldL (fn (vs, _) => fn acc => vs @ acc) [] ves + val renEnv = map (renameId o mangle o ValId) vars + val rho' = + foldR (fn (vid,(id' as (id, _))) => fn rho => + bindInEnv rho (ValId vid) (Path_global (mkUniqueGlobalName id'))) + NILenv (zip2 vars renEnv) + val rho'' = mkHashEnv (length vars) rho' + in + (rho'', + LAMtlam(true, + makeSeq (tr1ToplevelRecValBind renEnv (plusEnv rho rho'')) ves)) + end + | VALdec (_, (pvbs, rvbs)) => + let val ((rho', depth'), envelope) = + trValDec true (rho, 0) pvbs rvbs + val vars = foldEnv (fn (ValId id) => (fn _ => fn vars => id :: vars) + | _ => fatalError "trTopLevelDec:1") + [] + rho' + val n = length vars + val rho'' = mkHashEnv n rho' + val renEnv = map (renameId o mangle o ValId) vars + val renrho = + foldR (fn (vid,(id' as (id,_))) => fn rho => + bindInEnv rho (ValId vid) (Path_global (mkUniqueGlobalName id'))) + NILenv (zip2 vars renEnv) + in + (mkHashEnv n renrho, + LAMtlam( + all (fn ValBind(_, e) => isSafe e) pvbs, + envelope (makeSeq (storeGlobal ValId renEnv (rho'', depth')) + (revWithoutDuplicates vars [])))) + end + | PRIM_VALdec _ => (NILenv, NILtlam) + | FUNdec (ref (UNRESfundec _)) => fatalError "trToplevelDec:2" + | FUNdec (ref (RESfundec dec)) => trToplevelDec rho dec + | TYPEdec _ => (NILenv, NILtlam) + | PRIM_TYPEdec _ => (NILenv, NILtlam) + | DATATYPEdec(dbs, _) => (NILenv, NILtlam) + | DATATYPErepdec _ => (NILenv, NILtlam) + | ABSTYPEdec(dbs, _, dec2) => + trToplevelDec rho dec2 + | EXCEPTIONdec mbs => + let val ((rho',depth'), envelope) = trExBindList (rho,0) mbs + val vars = foldEnv (fn (ValId id) => (fn _ => fn vars => id :: vars) + | _ => fatalError "trToplevelDec:3") + [] + rho' + val n = length vars + val rho'' = mkHashEnv n rho' + val renEnv = map (renameId o mangle o ValId) vars + val renrho = + foldR (fn (eid,(id' as (id,_))) => fn rho => + bindInEnv rho (ValId eid) (Path_global (mkUniqueGlobalName id'))) + NILenv (zip2 vars renEnv) + in + (mkHashEnv n renrho, + LAMtlam( + false, (* cvr: TODO I don't think this can be safe coz it might create new references *) + envelope (makeSeq (storeGlobal ValId renEnv (rho'', depth')) + (revWithoutDuplicates vars [])))) + end + | LOCALdec(dec1,dec2) => + let val (rho' , tlam') = trToplevelDec rho dec1 + val (rho'', tlam'') = trToplevelDec (plusEnv rho rho') dec2 + in (rho'', SEQtlam(tlam', tlam'')) end + | OPENdec longmodidinfos => + let val ((rho',depth'), envelope) = + trOpenLongModIdInfos (rho,0) longmodidinfos + val vars = foldEnv (fn Id => fn _ => fn vars => Id :: vars) [] rho' + val n = length vars + val rho'' = mkHashEnv n rho' + val renEnv = map (renameId o mangle) vars + val renrho = + foldR (fn (Id,(id' as (id,_))) => fn rho => + bindInEnv rho Id (Path_global (mkUniqueGlobalName id'))) + NILenv (zip2 vars renEnv) + in + (mkHashEnv n renrho, + LAMtlam( + true, + envelope (makeSeq (fn ValId vid => storeGlobal ValId renEnv (rho'', depth') vid + | ModId mid => storeGlobal ModId renEnv (rho'', depth') mid + | FunId fid => storeGlobal FunId renEnv (rho'', depth') fid) + (revWithoutDuplicates vars [])))) + end + | EMPTYdec => (NILenv, NILtlam) + | SEQdec(dec1,dec2) => + let val (rho' , tlam') = trToplevelDec rho dec1 + val (rho'', tlam'') = trToplevelDec (plusEnv rho rho') dec2 + in (plusEnv rho' rho'', SEQtlam(tlam', tlam'')) end + | FIXITYdec _ => (NILenv, NILtlam) + | STRUCTUREdec mbs => + let val ((rho',depth'), envelope) = trModBindList (rho,0) mbs + val vars = foldEnv (fn (ModId id) => (fn _ => fn vars => id :: vars) + | _ => fatalError "trToplevelDec:4") [] rho' + val n = length vars + val rho'' = mkHashEnv n rho' + val renEnv = map (renameId o mangle o ModId) vars + val renrho = + foldR (fn (mid,(id' as (id,_))) => fn rho => + bindInEnv rho (ModId mid) (Path_global (mkUniqueGlobalName id'))) + NILenv (zip2 vars renEnv) + in + (mkHashEnv n renrho, + LAMtlam( + all (fn MODBINDmodbind(_, modexp) => isSafeModExp modexp + | ASmodbind(_,_,exp) => isSafe exp) + mbs, + envelope (makeSeq (storeGlobal ModId renEnv (rho'', depth')) + (revWithoutDuplicates vars [])))) + end + | FUNCTORdec fbs => + let val ((rho',depth'), envelope) = trFunBindList (rho,0) fbs + val vars = foldEnv (fn (FunId id) => (fn _ => fn vars => id :: vars) + | _ => fatalError "trToplevelDec:5") [] rho' + val n = length vars + val rho'' = mkHashEnv n rho' + val renEnv = map (renameId o mangle o FunId) vars + val renrho = + foldR (fn (funid,(id' as (id,_))) => fn rho => + bindInEnv rho (FunId funid) (Path_global (mkUniqueGlobalName id'))) + NILenv (zip2 vars renEnv) + in + (mkHashEnv n renrho, + LAMtlam( + all (fn FUNBINDfunbind (_,modexp) => isSafeModExp modexp + | ASfunbind(_,_,exp) => isSafe exp) + fbs, + envelope (makeSeq (storeGlobal FunId renEnv (rho'', depth')) + (revWithoutDuplicates vars [])))) + end + | SIGNATUREdec _ => (NILenv, NILtlam) +; + +fun REofRho1 id (Path_global (_, stamp)) re = (mangle id, stamp) :: re + | REofRho1 _ _ _ = fatalError "REofRho1" + +fun REofRho rho = + foldEnv REofRho1 [] rho +; + +fun translateToplevelDec dec = + let val (rho, tlam) = trToplevelDec NILenv dec + in (REofRho rho, flattenTLam tlam []) end +; + diff -Nru mosml-2.01/src/compiler.cminusminus/.gitignore mosml-2.10.1/src/compiler.cminusminus/.gitignore --- mosml-2.01/src/compiler.cminusminus/.gitignore 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/.gitignore 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,8 @@ +*.uo *.ui +Config.sml +Filename.sml +Lexer.sml +Opcodes.sml +Parser.sig +Parser.sml +mosmlcmmc diff -Nru mosml-2.01/src/compiler.cminusminus/Globals.sml mosml-2.10.1/src/compiler.cminusminus/Globals.sml --- mosml-2.01/src/compiler.cminusminus/Globals.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Globals.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,384 @@ +local + open Fnlib Mixture Const Smlprim; +in + +(* Internally, a global is represented by its fully qualified name, + plus associated information. *) + +type 'a global = +{ + info: 'a, (* Description *) + qualid: QualifiedIdent (* Full name *) +}; + +datatype InfixStatus = + NONFIXst + | INFIXst of int + | INFIXRst of int +; + +type InfixBasis = (string, InfixStatus) Env; + +type PrimInfo = +{ + primArity: int, + primOp: SMLPrim +}; + +datatype OvlType = + REGULARo (* Non-overloaded *) + | OVL1NNo (* numtext -> num *) + | OVL1NSo (* numtext -> string *) + | OVL2NNBo (* numtext * numtext -> bool *) + | OVL2NNNo (* num * num -> num *) + | OVL1TXXo (* printVal: pseudopoly 'a -> 'a *) + | OVL1TPUo (* installPP: pseudopoly *) + | OVL2EEBo (* =, <>: ''a * ''a -> bool *) +; + +datatype TyNameEqu = + FALSEequ + | TRUEequ + | REFequ + | ARROWequ of TyNameEqu * TyNameEqu; + +datatype TyApp = + NAMEtyapp of TyName + | APPtyapp of TyApp * TyFun +and TyFun = + TYPEtyfun of TypeVar list * Type + | LAMtyfun of TyName * TyFun + | APPtyfun of TyApp +and Kind = + ARITYkind of int + | ARROWkind of Kind * Kind +and TnSort = + REAts of TyFun + | VARIABLEts + | PARAMETERts +and Type = + VARt of TypeVar + | ARROWt of Type * Type + | CONt of Type list * TyApp + | RECt of { fields: (Lab * Type) list, rho: RowType } ref + | PACKt of ExMod +and TypeVarKind = + Explicit of string + | NoLink + | LinkTo of Type +and RowTypeKind = + NILrow + | VARrow of RowVar + | LINKrow of RowType + | FIELDrow of Lab * Type * RowType +and TypeScheme = TypeScheme of +{ + tscParameters: TypeVar list, + tscBody: Type +} +and ConStatusDesc = + VARname of OvlType + | PRIMname of PrimInfo + | CONname of ConInfo + | EXNname of ExConInfo + | REFname +and ConEnv = ConEnv of (ConInfo global list) (* cvr: ConEnv should be renamed for consistency...*) + | LAMconenv of TyName * ConEnv +and ExMod = EXISTSexmod of TyName list * Mod +and Mod = + STRmod of RecStr + | FUNmod of TyName list * Mod * ExMod +and Str = STRstr of ModEnv * + (string, (TyName list * Mod * ExMod) global) Env * + (*cvr:ugly, but FunEnv needs to be inlined because of the reference to TyName (defined below) *) + SigEnv * + TyEnv * + VarEnv + | SEQstr of Str * Str (* hack for matching algorithm *) +and RecStr = RECrec of RecStr * RecStr + | NONrec of Str +and Sig = LAMBDAsig of TyName list * Mod +withtype ModEnv = (string, RecStr global) Env +and TyStr = TyFun * ConEnv +and TyEnv = (string, (TyFun * ConEnv)) Env +and VarEnv = (string,(TypeScheme * ConStatusDesc) global) Env +and SigEnv = (string, Sig global) Env +and TyName = +{ + tnKind: Kind, + tnEqu: TyNameEqu, + tnStamp: (string *int), (* unit name * stamp *) + tnSort: TnSort, + tnLevel: int, + tnConEnv: (ConEnv option) ref +} ref global +and ConInfo = +{ + conArity: int, + conIsGreedy: bool, + conSpan: int, + conTag: int, + conType : TypeScheme +} ref +and ExConInfo = +{ + exconArity: int +} ref +and TypeVar = +{ + tvEqu : bool, + tvImp : bool, + tvKind : TypeVarKind, + tvLevel : int, + tvOvl : bool +} ref +and RowType = RowTypeKind ref +and RowVar = +{ + rvEqu : bool, + rvImp : bool, + rvLevel : int +} ref +; + +(* export the type abbreviations local to the datatype *) +(* +type TyName = +{ + tnKind: Kind, + tnEqu: TyNameEqu, + tnStamp: (string*int), + tnSort: TnSort, + tnLevel: int, + tnConEnv: (ConEnv option) ref +} ref global +and ConInfo = +{ + conArity: int, + conIsGreedy: bool, + conSpan: int, + conTag: int, + conType : TypeScheme +} ref +and ExConInfo = +{ + exconArity: int, + exconIsGreedy: bool, + exconTag : (QualifiedIdent * int) option +} ref +and TypeVar = +{ + tvEqu : bool, + tvImp : bool, + tvKind : TypeVarKind, + tvLevel : int, + tvOvl : bool +} ref +and RowType = RowTypeKind ref +and RowVar = +{ + rvEqu : bool, + rvImp : bool, + rvLevel : int +} ref +; +*) + +type TyNameSet = TyName list +type GenFun = TyNameSet * Mod * ExMod + +type VarInfo = (TypeScheme * ConStatusDesc) global +and TyInfo = (TyFun * ConEnv) +and ModInfo = RecStr global +and FunInfo = GenFun global +and SigInfo = Sig global +; + +type VarEnv = (string,VarInfo) Env +and TyEnv = (string, TyInfo) Env +and ModEnv = (string, ModInfo) Env +and FunEnv = (string, FunInfo) Env +and SigEnv = (string, SigInfo) Env +; + +datatype 'a Signature = + LAMBDA of TyName list * 'a +and 'a Existential = + EXISTS of TyName list * 'a; + +type Environment = ModEnv * FunEnv * SigEnv * VarEnv * TyEnv; +type ExEnvironment = Environment Existential; + +type RecType = { fields: (Lab * Type) list, rho: RowType } ref; + + + +type ConStatus = ConStatusDesc global; + + + + + +(* Updaters *) + + +fun setTnStamp r new_stamp = + let val { tnStamp=stamp, tnKind=kind, tnEqu=equ, tnSort=sort, tnLevel=level, + tnConEnv=tnConEnv} = !r in + r := { tnStamp=new_stamp, tnKind=kind, tnEqu=equ, tnSort=sort, tnLevel=level, + tnConEnv = tnConEnv} + end; + +fun setTnKind r new_kind = + let val { tnStamp=stamp, tnKind=kind, tnEqu=equ, tnSort=sort, tnLevel=level, + tnConEnv=tnConEnv} = !r in + r := { tnStamp=stamp, tnKind=new_kind, tnEqu=equ, tnSort=sort,tnLevel=level, + tnConEnv = tnConEnv} + end; + +fun setTnEqu r new_equ = + let val { tnStamp=stamp, tnKind=kind, tnEqu=equ, tnSort=sort, tnLevel=level, + tnConEnv=tnConEnv} = !r in + r := { tnStamp=stamp, tnKind=kind, tnEqu=new_equ, tnSort=sort, tnLevel=level, + tnConEnv=tnConEnv} + end; + +fun setTnSort r new_sort = + let val { tnStamp=stamp, tnKind=kind, tnEqu=equ, tnSort=sort, tnLevel=level, + tnConEnv=tnConEnv} = !r in + r := { tnStamp=stamp, tnKind=kind, tnEqu=equ, tnSort=new_sort, tnLevel=level, + tnConEnv=tnConEnv} + end; + + +fun setTnLevel r new_level = + let val { tnStamp=stamp, tnKind=kind, tnEqu=equ, tnSort=sort, tnLevel=level, + tnConEnv=tnConEnv} = !r in + r := { tnStamp=stamp, tnKind=kind, tnEqu=equ, tnSort=sort, tnLevel=new_level, + tnConEnv=tnConEnv} + end; + +fun setTnConEnv r new_conenv = + let val { tnStamp=stamp, tnKind=kind, tnEqu=equ, tnSort=sort, tnLevel=level, + tnConEnv=tnConEnv} = !r in + r := { tnStamp=stamp, tnKind=kind, tnEqu=equ, tnSort=sort, tnLevel=level, + tnConEnv=new_conenv} + end; + + +fun setConArity r new_arity = + let val { conArity=arity, conIsGreedy=isGreedy, + conTag=tag, conSpan=span, conType=typ } + = !r + in r := + { conArity=new_arity, conIsGreedy=isGreedy, + conTag=tag, conSpan=span, conType=typ } + end; + +fun setConIsGreedy r new_isGreedy = + let val { conArity=arity, conIsGreedy=isGreedy, + conTag=tag, conSpan=span, conType=typ } + = !r + in r := + { conArity=arity, conIsGreedy=new_isGreedy, + conTag=tag, conSpan=span, conType=typ } + end; + +fun setConTag r new_tag = + let val { conArity=arity, conIsGreedy=isGreedy, + conTag=tag, conSpan=span, conType=typ } + = !r + in r := + { conArity=arity, conIsGreedy=isGreedy, + conTag=new_tag, conSpan=span, conType=typ } + end; + +fun setConSpan r new_span = + let val { conArity=arity, conIsGreedy=isGreedy, + conTag=tag, conSpan=span, conType=typ } + = !r + in r := + { conArity=arity, conIsGreedy=isGreedy, + conTag=tag, conSpan=new_span, conType=typ } + end; + +fun setConType (r : ConInfo) new_typ = + let val { conArity=arity, conIsGreedy=isGreedy, + conTag=tag, conSpan=span, conType=typ } + = !r + in r := + { conArity=arity, conIsGreedy=isGreedy, + conTag=tag, conSpan=span, conType=new_typ } + end; + +fun setExConArity r new_arity = + r := { exconArity=new_arity } + +fun setTvKind r new_kind = + let val { tvKind=kind, tvLevel=level, tvEqu=equ, tvImp=imp, tvOvl=ovl } + = !r + in r := + { tvKind=new_kind, tvLevel=level, tvEqu=equ, tvImp=imp, tvOvl=ovl } + end; + +fun setTvLevel r new_level = + let val { tvKind=kind, tvLevel=level, tvEqu=equ, tvImp=imp, tvOvl=ovl } + = !r + in r := + { tvKind=kind, tvLevel=new_level, tvEqu=equ, tvImp=imp, tvOvl=ovl } + end; + +fun setTvEqu r new_equ = + let val { tvKind=kind, tvLevel=level, tvEqu=equ, tvImp=imp, tvOvl=ovl } + = !r + in r := + { tvKind=kind, tvLevel=level, tvEqu=new_equ, tvImp=imp, tvOvl=ovl } + end; + +fun setTvImp r new_imp = + let val { tvKind=kind, tvLevel=level, tvEqu=equ, tvImp=imp, tvOvl=ovl } + = !r + in r := + { tvKind=kind, tvLevel=level, tvEqu=equ, tvImp=new_imp, tvOvl=ovl } + end; + +fun setTvOvl r new_ovl = + let val { tvKind=kind, tvLevel=level, tvEqu=equ, tvImp=imp, tvOvl=ovl } + = !r + in r := + { tvKind=kind, tvLevel=level, tvEqu=equ, tvImp=imp, tvOvl=new_ovl } + end; + +fun setRtFields r new_fields = + let val { fields=fields, rho=rho } = !r in + r := { fields=new_fields, rho=rho } + end; + +fun setRtRho r new_rho = + let val { fields=fields, rho=rho } = !r in + r := { fields=fields, rho=new_rho } + end; + +fun setRvEqu r new_equ = + let val { rvEqu=equ, rvImp=imp, rvLevel=level } = !r in + r := { rvEqu=new_equ, rvImp=imp, rvLevel=level } + end; + +fun setRvImp r new_imp = + let val { rvEqu=equ, rvImp=imp, rvLevel=level } = !r in + r := { rvEqu=equ, rvImp=new_imp, rvLevel=level } + end; + +fun setRvLevel r new_level = + let val { rvEqu=equ, rvImp=imp, rvLevel=level } = !r in + r := { rvEqu=equ, rvImp=imp, rvLevel=new_level } + end; + +end; + + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Hasht.sig mosml-2.10.1/src/compiler.cminusminus/Hasht.sig --- mosml-2.01/src/compiler.cminusminus/Hasht.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Hasht.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,69 @@ +(* Hasht.sig *) + +(* Hash tables and hash functions *) + +(* Hash tables are hashed association tables, with in-place modification. *) + +type ('a, 'b) t; + (* The type of hash tables from type ['a] to type ['b]. *) + +val new : int -> ('_a, '_b) t; + (* [new n] creates a new, empty hash table, with initial size [n]. + The table grows as needed, so [n] is just an initial guess. + Better results are said to be achieved when [n] is a prime + number. *) + +val clear : ('a, 'b) t -> unit; + (* Empty a hash table. *) + +val insert : (''_a, '_b) t -> ''_a -> '_b -> unit; + (* [insert tbl x y] adds a binding of [x] to [y] in table [tbl]. + The previous binding for [x] is removed (if any). *) + +val find : (''a, 'b) t -> ''a -> 'b; + (* [find tbl x] returns the current binding of [x] in [tbl], + or raises [Subscript] if no such binding exists. *) + +val peek : (''a, 'b) t -> ''a -> 'b option; + (* [peek tbl x] returns SOME v, where v is the current binding of + x in tbl, if any; otherwise returns NONE. *) + +val remove : (''a, 'b) t -> ''a -> unit; + (* [remove tbl x] removes the current binding of [x] in [tbl]. + It does nothing if [x] is not bound in [tbl]. *) + +val apply : ('a -> 'b -> unit) -> ('a, 'b) t -> unit; + (* [apply f tbl] applies [f] to all bindings in table [tbl]. + [f] receives the key as first argument, and the associated + value as second argument. The order in which the bindings + are passed to [f] is unpredictable. *) + +val fold : ('a -> 'b -> 'c -> 'c) -> 'c -> ('a, 'b) t -> 'c + (* [fold f e tbl] computes f k1 d1 (f k2 d2 (...(f kn dn c)...)) + where (k1, d1), (k2, d2), ..., (kn, dn) are the bindings of + tbl in some unpredictable order. *) + +(*** The polymorphic hash primitive *) + +val hash : 'a -> int; + (* [hash x] associates a positive integer to any value of + any type. It is guaranteed that + if [x = y], then [hash x = hash y]. + Moreover, [hash] always terminates, even on cyclic + structures. *) + +prim_val hash_param : int -> int -> 'a -> int = 3 "hash_univ_param"; + (* [hash_param n m x] computes a hash value for [x], with the + same properties as for [hash]. The two extra parameters + [n] and [m] give more precise control over hashing. + Hashing performs a depth-first, right-to-left traversal of + the structure [x], stopping after [n] meaningful nodes + were encountered, or [m] nodes, meaningful or not, were + encountered. Meaningful nodes are: integers; + floating-point numbers; strings; characters; booleans; and + constant constructors. Larger values of [m] and [n] means + that more nodes are taken into account to compute the + final hash value, and therefore collisions are less likely + to happen. However, hashing takes longer. The parameters + [m] and [n] govern the tradeoff between accuracy and + speed. *) diff -Nru mosml-2.01/src/compiler.cminusminus/Hasht.sml mosml-2.10.1/src/compiler.cminusminus/Hasht.sml --- mosml-2.01/src/compiler.cminusminus/Hasht.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Hasht.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,162 @@ +(* Hasht.sml *) + +(* Hash tables *) + +(* We do dynamic hashing, and we double the size of the table when + buckets become too long, but without re-hashing the elements. *) + +open Array; +infix 9 sub; + +datatype ('a, 'b) bucketlist = + Cons of 'a * int * 'b * ('a, 'b) bucketlist + | Empty +; + +type ('a, 'b) TCell = + { max_len: int, (* max length of a bucket *) + data: ('a, 'b) bucketlist array } (* the buckets *) +; + +type ('a, 'b) t = ('a, 'b) TCell ref; + +fun forup f a b = + let fun loop i = if i > b then () else (f i; loop (i+1)) + in loop a end +; + +fun new initial_size = + ref { max_len = 3, data = array(initial_size, Empty) } +; + +fun clear h = + let val {data, max_len} = !h in + forup (fn i => update(data, i, Empty)) + 0 (Array.length data - 1) + end +; + +fun resize h = + let val {data, max_len} = !h + val len = Array.length data + val newlen = len+len+1 + val newdata = array(newlen, Empty) + fun dispatch Empty = () + | dispatch (Cons(k, c, v, rest)) = + let val () = dispatch rest + val i = c mod newlen + in update(newdata, i, Cons(k, c, v, newdata sub i)) end + in + forup (fn i => dispatch(data sub i)) 0 (len-1); + h := { data = newdata, max_len = 2 * max_len}; + () + end +; + +fun bucket_too_long n bucket = + if n < 0 then true else + case bucket of + Empty => false + | Cons(_, _, _, rest) => bucket_too_long (n-1) rest +; + +prim_val hash_param : int -> int -> 'a -> int = 3 "hash_univ_param"; + +fun hash x = hash_param 50 500 x; + +fun insert h key value = + let val {data, max_len} = !h + val code = hash_param 10 100 key + fun insert_bucket Empty = + Cons(key, code, value, Empty) + | insert_bucket (Cons(k, c, v, next)) = + if code = c andalso k = key then + Cons(key, code, value, next) + else Cons(k, c, v, insert_bucket next) + val i = code mod (Array.length data) + val bucket = insert_bucket (data sub i) + in + update(data, i, bucket); + if bucket_too_long max_len bucket then resize h else () + end +; + +fun remove h key = + let val {data, max_len : int} = !h + val code = hash_param 10 100 key + fun remove_bucket Empty = Empty + | remove_bucket (Cons(k, c, v, next)) = + if code = c andalso k = key then + next + else Cons(k, c, v, remove_bucket next) + val i = code mod (Array.length data) + in update(data, i, remove_bucket (data sub i)) end +; + +fun find h key = + let val {data, max_len : int} = !h + val code = (hash_param 10 100 key) + in + case data sub (code mod (Array.length data)) of + Empty => raise Subscript + | Cons(k1, c1, d1, rest1) => + if code = c1 andalso key = k1 then d1 else + case rest1 of + Empty => raise Subscript + | Cons(k2, c2, d2, rest2) => + if code = c2 andalso key = k2 then d2 else + case rest2 of + Empty => raise Subscript + | Cons(k3, c3, d3, rest3) => + if code = c3 andalso key = k3 then d3 else + let fun find Empty = raise Subscript + | find (Cons(k, c, d, rest)) = + if code = c andalso key = k then d else find rest + in find rest3 end + end; + +fun peek h key = + let val {data, max_len : int} = !h + val code = (hash_param 10 100 key) + in + case data sub (code mod (Array.length data)) of + Empty => NONE + | Cons(k1, c1, d1, rest1) => + if code = c1 andalso key = k1 then SOME d1 else + case rest1 of + Empty => NONE + | Cons(k2, c2, d2, rest2) => + if code = c2 andalso key = k2 then SOME d2 else + case rest2 of + Empty => NONE + | Cons(k3, c3, d3, rest3) => + if code = c3 andalso key = k3 then SOME d3 else + let fun peek Empty = NONE + | peek (Cons(k, c, d, rest)) = + if code = c andalso key = k then SOME d + else peek rest + in peek rest3 end + end; + +fun apply f h = + let val {data, max_len : int} = !h + val len = Array.length data + in + forup (fn i => + let fun scan_bucket Empty = () + | scan_bucket (Cons(k, c, d, rest)) = + ( f k d : unit; scan_bucket rest ) + in scan_bucket (data sub i) end) + 0 (len - 1) + end +; + +fun fold f e h = + let val {data, max_len : int} = !h + fun fold_bucket (Empty, res) = res + | fold_bucket (Cons(k, c, d, rest), res) = + fold_bucket (rest, f k d res) + in + Array.foldl fold_bucket e data + end +; diff -Nru mosml-2.01/src/compiler.cminusminus/Infixres.sig mosml-2.10.1/src/compiler.cminusminus/Infixres.sig --- mosml-2.01/src/compiler.cminusminus/Infixres.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Infixres.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,10 @@ +local + open Globals Asynt; +in + +val resolveToplevelSigExp : SigExp -> SigExp; +val resolveToplevelSpec : Spec -> InfixBasis * Spec; +val resolveToplevelDec : Dec -> InfixBasis * Dec; + + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Infixres.sml mosml-2.10.1/src/compiler.cminusminus/Infixres.sml --- mosml-2.01/src/compiler.cminusminus/Infixres.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Infixres.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,534 @@ +open List Fnlib Mixture Const Smlexc Smlprim Globals Location; +open Units Types Asynt Asyntfn Primdec Infixst; + +fun checkInfixIds loc ids msg = + if duplicates ids then + errorMsg loc msg + else () +; + +fun lookup_iBas (iBas : InfixBasis) id = + lookupEnv iBas id + handle Subscript => NONFIXst +; + +fun asId_Exp (_, VIDPATHexp(ref (RESvidpath ii))) = + let val { qualid, info } = ii in + if #qual qualid <> "" + orelse #withOp info + orelse case (#id qualid) of [_] => false | _ => true + then NONE + else SOME ii + end + | asId_Exp (_, _) = NONE +; + +fun applyId_Exp (ii : IdInfo) exp = + let val { qualid, info } = ii + val { idLoc, ... } = info + in + (xLR exp, APPexp((idLoc, VIDPATHexp(ref (RESvidpath ii))), exp)) + end +; + + +fun applyObj_Exp exp1 exp2 = (xxLR exp1 exp2, APPexp(exp1, exp2)); + +val theExpStack = +{ + pair=pairExp, asId=asId_Exp, + applyId=applyId_Exp, applyObj=applyObj_Exp +}; + +fun resolveInfixExp (iBas : InfixBasis) loc exps = + resolveInfix theExpStack (lookup_iBas iBas) exps + handle WrongInfix => + errorMsg loc "Ill-formed infix expression" + | MixedAssociativity => + errorMsg loc "Mixed left- and right-associative operators of equal precedence" +; + +fun asId_Pat (_, VARpat ii) = + let val { qualid, info } = ii in + if #qual qualid <> "" + orelse #withOp info + orelse case #id qualid of [_] => false | _ => true + then NONE else SOME ii + end + | asId_Pat (_, _) = NONE +; + +fun applyId_Pat ii pat = (xLR pat, CONSpat(ii, pat )); + +fun applyObj_Pat pat1 pat2 = + case pat1 of + (_, VARpat ii) => (xxLR pat1 pat2, CONSpat(ii, pat2)) + | (loc, _) => errorMsg loc "Non-identifier applied to a pattern" +; + +val thePatStack = + { + pair=pairPat, asId=asId_Pat, + applyId=applyId_Pat, applyObj=applyObj_Pat + } +; + +fun resolveInfixPat iBas loc pats = + resolveInfix thePatStack (lookup_iBas iBas) pats + handle WrongInfix => + errorMsg loc "Ill-formed infix pattern" + | MixedAssociativity => + errorMsg loc "Mixed left- and right-associative operators of equal precedence" +; + + + +fun isInfix iBas id = + case lookup_iBas iBas id of + INFIXst _ => true + | INFIXRst _ => true + | NONFIXst => false +; + +fun patOfIdent (ii : IdInfo) = + (#idLoc (#info ii), VARpat ii) +; + +fun checkNoInfixes iBas (loc, pat') = + case pat' of + VARpat{qualid={qual="", id=[id]}, info={withOp=false, ...}} => + if isInfix iBas id then + errorMsg loc "Ill-placed infix in a fun clause" + else () + | _ => () +; + +fun mergeFCIds [] = fatalError "mergeFCIds" + | mergeFCIds [(ii, cl)] = (ii, [cl]) + | mergeFCIds ((ii, cl) :: rest) = + let val (ii', cls) = mergeFCIds rest in + if #id(#qualid ii) <> #id(#qualid ii') then + errorMsg (#idLoc (#info ii')) "Different function names in clauses" + else (); + (ii : IdInfo, cl::cls) + end +; + +datatype 'a Category = INFIXED of 'a | OTHER; + +fun categorize iBas (_, pat') = + case pat' of + VARpat {info={withOp=true, ...}, ...} => OTHER + | VARpat (ii as {qualid={qual="", id=[id]}, info={withOp=false, ...}}) => + if (isInfix iBas id) then (INFIXED ii) else OTHER + | _ => OTHER +; + + +fun resolveFClauseArgs iBas (pats : Pat list) = + case map (categorize iBas) pats of + [OTHER, INFIXED ii, OTHER] => + (* SUCCESS: case (4) *) + (case pats of + [ap1,_,ap2] => (ii, [pairPat ap1 ap2]) + | _ => fatalError "resolveFClauseArgs") + | OTHER :: _ => + (* Try for cases (1)/(2)/(3) *) + (case pats of + (_, PARpat(_, INFIXpat (ref (UNRESinfixpat ([ap1,ap2,ap3]))))) :: rest => + (* Try for case (3) *) + (case categorize iBas ap2 of + INFIXED ii => + (* SUCCESS: case (3) *) + (ii, pairPat ap1 ap3 :: rest) + | OTHER => + (* `fun ( )' *) + errorMsg (xLR ap2) + "Expecting infixed identifier") + | fst :: snd :: rest => + (* Try for cases (1)/(2)... *) + (case fst of + (_, VARpat ii) => + (* ii can't be an infix, because it matches OTHER *) + (ii, snd :: rest) + | (_, _) => + (* `fun ...' *) + errorMsg (xxLR fst snd) "Ill-formed clause start") + | _ => + (* `fun = ...' *) + errorMsg (xLR (hd pats)) + "Ill-formed left hand side of a clause") + | _ => + (* `fun +' or something *) + errorMsg (xLR (hd pats)) + "Expecting function name or infix pattern" +; + +fun resolvePatOp (iBas : InfixBasis) (pat as (loc, pat')) = + case pat' of + SCONpat _ => () + | VARpat _ => () + | WILDCARDpat => () + | NILpat _ => fatalError "resolvePatOp" + | CONSpat(ii, p) => resolvePatOp iBas p + | EXNILpat _ => fatalError "resolvePatOp" + | EXCONSpat _ => fatalError "resolvePatOp" + | EXNAMEpat _ => fatalError "resolvePatOp" + | REFpat _ => fatalError "resolvePatOp" + | RECpat(ref (RECrp(fs, dots))) => + app_field (resolvePatOp iBas) fs + | RECpat(ref (TUPLErp _)) => fatalError "resolvePatOp" + | VECpat ps => app (resolvePatOp iBas) ps + | PARpat p => resolvePatOp iBas p + | INFIXpat (InfixPat as ref (UNRESinfixpat ps)) => + let val () = app (resolvePatOp iBas) ps + val pat = resolveInfixPat iBas loc ps + in + InfixPat := RESinfixpat pat + end + | INFIXpat (ref (RESinfixpat _)) => fatalError "resolvePatOp" + | TYPEDpat(p,ty) => + (resolvePatOp iBas p;resolveTyOp iBas ty) + | LAYEREDpat(pat1, pat2) => + (resolvePatOp iBas pat1;resolvePatOp iBas pat2) + +and resolveFClause iBas (FClause(ref pats, exp)) = + let val (ii, args) = resolveFClauseArgs iBas pats + val () = app (checkNoInfixes iBas) args + val () = app (resolvePatOp iBas) args + val () = resolveExpOp iBas exp + in (ii, MRule(ref args, exp)) end + +and resolveFClauseList iBas fclauses = + mergeFCIds (map (resolveFClause iBas) fclauses) + +and resolveFValBind iBas (loc, fclauses) = + let val (ii, (mrules : Match)) = + resolveFClauseList iBas fclauses + val numArgs = curriedness mrules + in + app (fn MRule(ref pats,_) => + if numArgs <> List.length pats then + errorMsg loc "Mismatch in the number of curried arguments" + else ()) + mrules; + ValBind(ref (patOfIdent ii), (loc, FNexp mrules)) + end + +and resolveVIdPathInfoOp iBas (RESvidpath vidpath') = + resolveVIdPath'Op iBas vidpath' + | resolveVIdPathInfoOp iBas (OVLvidpath _) = + fatalError "resolveVIdPathInfo" +and resolveExpOp iBas (exp as (loc, exp')) = + case exp' of + SCONexp _ => () + | VIDPATHexp (ref vidpathinfo) => + resolveVIdPathInfoOp iBas vidpathinfo + | FNexp mrules => + app (resolveMRuleOp iBas) mrules + | APPexp(e1, e2) => + (resolveExpOp iBas e1; + resolveExpOp iBas e2) + | LETexp(dec, body) => + let val iBas' = resolveDecOp iBas dec in + resolveExpOp (plusEnv iBas iBas') body + end + | RECexp(ref (RECre fs)) => + (app_field (resolveExpOp iBas) fs) + | RECexp(ref (TUPLEre _)) => + fatalError "resolveExpOp" + | VECexp es => + app (resolveExpOp iBas) es + | PARexp e => + resolveExpOp iBas e + | INFIXexp (infixexp as ref (UNRESinfixexp es)) => + let val _ = app (resolveExpOp iBas) es + val exp = resolveInfixExp iBas loc es + in infixexp := RESinfixexp exp + end + | INFIXexp (infixexp as ref (RESinfixexp e)) => + fatalError "resolveExpOp" + | TYPEDexp(e, ty) => + (resolveExpOp iBas e; + resolveTyOp iBas ty) + | ANDALSOexp(e1, e2) => + (resolveExpOp iBas e1; resolveExpOp iBas e2) + | ORELSEexp(e1, e2) => + (resolveExpOp iBas e1; resolveExpOp iBas e2) + | HANDLEexp(e, mrules) => + (resolveExpOp iBas e; + app (resolveMRuleOp iBas) mrules) + | RAISEexp e => + resolveExpOp iBas e + | IFexp(e0, e1, e2) => + (resolveExpOp iBas e0; + resolveExpOp iBas e1; + resolveExpOp iBas e2) + | WHILEexp(e1, e2) => + (resolveExpOp iBas e1; resolveExpOp iBas e2) + | SEQexp(e1,e2) => + (resolveExpOp iBas e1; resolveExpOp iBas e2) + | STRUCTUREexp(modexp,sigexp,_) => + (resolveModExpOp iBas modexp;resolveSigExpOp iBas sigexp) + | FUNCTORexp(modexp,sigexp,_) => + (resolveModExpOp iBas modexp;resolveSigExpOp iBas sigexp) + +and resolveMRuleOp iBas (MRule(ref pats,exp)) = + (app (resolvePatOp iBas) pats; resolveExpOp iBas exp) + +and resolveDecOp (iBas : InfixBasis) (dec as (loc, dec')) = + case dec' of + VALdec (tvs, (pvbs, rvbs)) => + (app (resolveValBindOp iBas) pvbs; + app (resolveValBindOp iBas) rvbs; + NILenv) + | PRIM_VALdec (tvs,pvbs) => + (app (fn (idinfo,ty,i,s) => resolveTyOp iBas ty) pvbs; + NILenv) + | FUNdec (fundec as (ref (UNRESfundec (tvs, fvbs)))) => + let val rvbs = map (resolveFValBind iBas) fvbs + in + fundec := RESfundec (loc, VALdec (tvs,([],rvbs))); + NILenv + end + | FUNdec (ref (RESfundec _)) => fatalError "resolveDecOp" + | TYPEdec tbds => (app (resolveTypBindOp iBas) tbds;NILenv) + | PRIM_TYPEdec (tynamequ, typdescs) => NILenv + | DATATYPEdec (dbds,SOME tbds) => (app (resolveDatBindOp iBas) dbds; app (resolveTypBindOp iBas) tbds;NILenv) + | DATATYPEdec (dbds,NONE) => (app (resolveDatBindOp iBas) dbds;NILenv) + | DATATYPErepdec (tycon, tyconpath) => + (resolveTyConPathOp iBas tyconpath; + NILenv) + | ABSTYPEdec(dbds, SOME tbds, dec2) => + (app (resolveDatBindOp iBas) dbds; + app (resolveTypBindOp iBas) tbds; + resolveDecOp iBas dec2) + | ABSTYPEdec(dbds, NONE, dec2) => + (app (resolveDatBindOp iBas) dbds; + resolveDecOp iBas dec2) + | EXCEPTIONdec ebs => (app (resolveExBindOp iBas) ebs; NILenv) + | LOCALdec(dec1, dec2) => + let val iBas' = resolveDecOp iBas dec1 + val iBas'' = resolveDecOp (plusEnv iBas iBas') dec2 + in iBas'' end + | OPENdec modids => NILenv + | EMPTYdec => NILenv + | SEQdec(dec1, dec2) => + let val iBas' = resolveDecOp iBas dec1 + val iBas'' = resolveDecOp (plusEnv iBas iBas') dec2 + in plusEnv iBas' iBas'' end + | FIXITYdec(status, ids) => + (checkInfixIds loc ids "An identifier appears twice in a fixity declaration"; + (foldL (fn id => fn env => bindInEnv env id status) NILenv ids)) + | STRUCTUREdec modbinds => + (app (resolveModBindOp iBas) modbinds; + NILenv) + | FUNCTORdec funbinds => + (app (resolveFunBindOp iBas) funbinds; + NILenv) + | SIGNATUREdec sigbinds => + (app (resolveSigBindOp iBas) sigbinds; + NILenv) + +and resolveValBindOp iBas (ValBind(ref pat, exp)) = + (resolvePatOp iBas pat;resolveExpOp iBas exp) +and resolveExBindOp iBas (EXDECexbind (ii, SOME ty)) = + resolveTyOp iBas ty + | resolveExBindOp iBas _ = () +and resolveTyOp iBas (_,ty') = + case ty' of + TYVARty _ => () + | RECty tyrow => (app_field (resolveTyOp iBas) tyrow) + | CONty (tys,tyconpath) => + (app (resolveTyOp iBas) tys; + resolveTyConPathOp iBas tyconpath) + | FNty (ty1,ty2) => + (resolveTyOp iBas ty1; resolveTyOp iBas ty2) + | PACKty sigexp => resolveSigExpOp iBas sigexp + | PARty ty => resolveTyOp iBas ty + +and resolveTyConPathOp iBas (_,tyconpath) = + case tyconpath of + LONGtyconpath _ => () + | WHEREtyconpath (_,_,modexp) => + resolveModExpOp iBas modexp +and resolveVIdPath'Op iBas vidpath = () +and resolveModExpOp iBas (_,(modexp,_)) = + case modexp of + DECmodexp dec => + (resolveDecOp iBas dec; ()) + | LONGmodexp _ => () + | LETmodexp (dec,modexp) => + let val iBas' = resolveDecOp iBas dec + in + resolveModExpOp (plusEnv iBas iBas') modexp + end + | PARmodexp modexp => resolveModExpOp iBas modexp + | CONmodexp (modexp,sigexp) => + (resolveModExpOp iBas modexp; resolveSigExpOp iBas sigexp) + | ABSmodexp (modexp,sigexp) => + (resolveModExpOp iBas modexp; resolveSigExpOp iBas sigexp) + | FUNCTORmodexp (_,modid,_, sigexp, modexp) => + (resolveSigExpOp iBas sigexp;resolveModExpOp iBas modexp) + | APPmodexp (modexp,modexp') => + (resolveModExpOp iBas modexp;resolveModExpOp iBas modexp') + | RECmodexp (modid,_,sigexp,modexp) => + (resolveSigExpOp iBas sigexp;resolveModExpOp iBas modexp) +and resolveModBindOp iBas (MODBINDmodbind(modid,modexp)) = + resolveModExpOp iBas modexp + | resolveModBindOp iBas (ASmodbind(modid,sigexp,exp)) = + (resolveSigExpOp iBas sigexp; + resolveExpOp iBas exp) +and resolveSigBindOp iBas (SIGBINDsigbind(sigid,sigexp)) = + resolveSigExpOp iBas sigexp +and resolveFunBindOp iBas (FUNBINDfunbind(funid,modexp)) = + resolveModExpOp iBas modexp + | resolveFunBindOp iBas (ASfunbind(funid,sigexp,exp)) = + (resolveSigExpOp iBas sigexp; + resolveExpOp iBas exp) +and resolveSigExpOp iBas (loc,sigexp) = + case sigexp of + SPECsigexp spec => + (foldEnv (fn id => fn _ => fn ids => + if member id ids + then (errorMsg loc + ("Illegal duplicate fixity specification for identifier "^id)) + else id::ids) [] (resolveSpecOp iBas spec); + ()) + | SIGIDsigexp _ => () + | WHEREsigexp (sigexp, tyvarseq, longtycon, ty) => + (resolveSigExpOp iBas sigexp; resolveTyOp iBas ty) + | FUNSIGsigexp (_,modid, sigexp,sigexp') => + (resolveSigExpOp iBas sigexp;resolveSigExpOp iBas sigexp') + | RECsigexp (modid, sigexp,sigexp') => + (resolveSigExpOp iBas sigexp;resolveSigExpOp iBas sigexp') +and resolveSpecOp (iBas : InfixBasis) (spec as (loc, spec')) = + case spec' of + VALspec (tvs, vds) => + (app (fn (ii,ty) => resolveTyOp iBas ty) vds; + NILenv) + | PRIM_VALspec (tvs,pvbs) => + (app (fn (idinfo,ty,i,s) => resolveTyOp iBas ty) pvbs; + NILenv) + | TYPEDESCspec _ => + NILenv + | TYPEspec tbds => + (app (resolveTypBindOp iBas) tbds; + NILenv) + | DATATYPEspec (dbds,SOME tbd) => + (app (resolveDatBindOp iBas) dbds; + app (resolveTypBindOp iBas) tbd; + NILenv) + | DATATYPEspec (dbds,NONE) => + (app (resolveDatBindOp iBas) dbds; + NILenv) + | DATATYPErepspec (tycon, tyconpath) => + (resolveTyConPathOp iBas tyconpath; + NILenv) + | EXCEPTIONspec eds => + (app (resolveExDescOp iBas) eds; + NILenv) + | LOCALspec(spec1, spec2) => + (resolveSpecOp iBas spec1; + resolveSpecOp iBas spec2; + NILenv) + | OPENspec _ => + NILenv + | EMPTYspec => + NILenv + | SEQspec(spec1, spec2) => + let val iBas' = resolveSpecOp iBas spec1 + val iBas'' = resolveSpecOp (plusEnv iBas iBas') spec2 + in plusEnv iBas' iBas'' end + | INCLUDEspec sigexp => + (resolveSigExpOp iBas sigexp; + NILenv) + | STRUCTUREspec moddescs => + (app (resolveModDescOp iBas) moddescs; + NILenv) + | FUNCTORspec fundescs => + (app (resolveFunDescOp iBas) fundescs; + NILenv) + | SHARINGTYPEspec (spec, longtycons) => + (resolveSpecOp iBas spec; + NILenv) + | SHARINGspec (spec, longmodids) => + (resolveSpecOp iBas spec; + NILenv) + | FIXITYspec(status, ids) => + (checkInfixIds loc ids "An identifier appears twice in a fixity specification"; + (foldL (fn id => fn env => bindInEnv env id status) NILenv ids)) + | SIGNATUREspec sigdescs => + (app (resolveSigBindOp iBas) sigdescs; + NILenv) +and resolveModDescOp iBas (MODDESCmoddesc(modid,sigexp)) = + resolveSigExpOp iBas sigexp +and resolveFunDescOp iBas (FUNDESCfundesc(funid,sigexp)) = + resolveSigExpOp iBas sigexp +and resolveTypBindOp iBas (ii,tycon,ty) = + resolveTyOp iBas ty +and resolveExDescOp iBas (ii,SOME ty) = + resolveTyOp iBas ty + | resolveExDescOp iBas (ii,NONE) = () +and resolveDatBindOp iBas (tyvarseq, tycon, cbds) = + app (resolveConBindOp iBas) cbds +and resolveConBindOp iBas (ConBind (ii, NONE)) = () + | resolveConBindOp iBas (ConBind (ii, SOME ty)) = resolveTyOp iBas ty +; + +(* --- resolveToplevelSpec --- *) + +fun resolveToplevelSigExp sigexp = + let val () = resolveSigExpOp (mkGlobalInfixBasis()) sigexp + in sigexp end +; + +fun resolveToplevelSpec spec = + let val iBas' = resolveSpecOp (mkGlobalInfixBasis()) spec + in (cleanEnv iBas', spec) end +; + +(* --- resolveToplevelDec --- *) + + +fun resolveToplevelDec dec = + let val iBas' = resolveDecOp (mkGlobalInfixBasis()) dec + in (cleanEnv iBas', dec) + end +; + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Infixst.sig mosml-2.10.1/src/compiler.cminusminus/Infixst.sig --- mosml-2.01/src/compiler.cminusminus/Infixst.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Infixst.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,19 @@ +local + open Fnlib Mixture Globals Location Asynt; +in + +exception WrongInfix and MixedAssociativity; + +type 'Obj InfixStackStr = { + applyId : IdInfo -> 'Obj -> 'Obj, + applyObj : 'Obj -> 'Obj -> 'Obj, + asId : 'Obj -> IdInfo option, + pair : 'Obj -> 'Obj -> 'Obj +}; + +val resolveInfix : + 'Obj InfixStackStr -> (string -> InfixStatus) -> + 'Obj list -> 'Obj +; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Infixst.sml mosml-2.10.1/src/compiler.cminusminus/Infixst.sml --- mosml-2.01/src/compiler.cminusminus/Infixst.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Infixst.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,103 @@ +(* This file has been derived from the ML Kit. *) + +open Fnlib Mixture Const Globals Location Asynt; + +exception WrongInfix; +exception MixedAssociativity; + +type 'Obj InfixStackStr = { + applyId : IdInfo -> 'Obj -> 'Obj, + applyObj : 'Obj -> 'Obj -> 'Obj, + asId : 'Obj -> IdInfo option, + pair : 'Obj -> 'Obj -> 'Obj +}; + +datatype StackEntry = + INFIXentry of IdInfo * int + | INFIXRentry of IdInfo * int + | APPentry +; + +datatype LastObj = ARG | OPER | VOID; + +fun resolveInfix (iStackStr : 'Obj InfixStackStr) statusOfId objs = + + let + val { pair, asId, applyId, applyObj } = iStackStr + + fun apply entry (o2 :: o1 :: rest) = + let val thePair = pair o1 o2 in + ( case entry of + INFIXentry(ii, n) => applyId ii thePair + | INFIXRentry(ii, n) => applyId ii thePair + | APPentry => applyObj o1 o2 + ) :: rest + end + | apply entry output = + raise WrongInfix + + and assocLeft APPentry _ = true + | assocLeft _ APPentry = false + | assocLeft op1 op2 = + let fun extract (INFIXentry(_, n)) = (n, true) + | extract (INFIXRentry(_, n)) = (n, false) + | extract _ = raise WrongInfix + val (prec1, left1) = extract op1 + val (prec2, left2) = extract op2 + in + if prec1 > prec2 then true + else if prec1 < prec2 then false + else if left1 = left2 then left1 + else raise MixedAssociativity + end + + and flushHigher entry stack output = + case stack of + [] => ([], output) + | top :: rest => + if assocLeft top entry then + flushHigher entry rest (apply top output) + else + (stack, output) + + and flushAll stack output = + case stack of + [] => ( case output of + [item] => item + | _ => raise WrongInfix ) + | top :: rest => flushAll rest (apply top output) + + and process input stack last output = + case input of + [] => + flushAll stack output + | this :: rest => + ( case asId this of + SOME ii => + ( case statusOfId (List.hd (#id(#qualid ii))) of + INFIXst n => + operator (INFIXentry(ii,n)) + rest stack output + | INFIXRst n => + operator (INFIXRentry(ii,n)) + rest stack output + | NONFIXst => + ( case last of + ARG => operator APPentry + input stack output + | _ => process rest stack ARG + (this :: output) ) ) + | NONE => + ( case last of + ARG => + operator APPentry input stack output + | _ => + process rest stack ARG (this :: output) + ) ) + + and operator entry input stack output = + let val (stack', output') = flushHigher entry stack output + in process input (entry :: stack') OPER output' end + + in process objs [] VOID [] end +; diff -Nru mosml-2.01/src/compiler.cminusminus/Instruct.sml mosml-2.10.1/src/compiler.cminusminus/Instruct.sml --- mosml-2.01/src/compiler.cminusminus/Instruct.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Instruct.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,56 @@ +(* The type of the instructions of the abstract machine *) + +(* 1996.07.05 -- e *) + +open Config Const Prim; + +datatype ZamInstruction = + Kquote of StructConstant + | Kget_global of QualifiedIdent * int + | Kset_global of QualifiedIdent * int + | Kaccess of int + | Kenvacc of int (* new *) + | Kassign of int (* newer *) + | Kgetfield of int (* new *) + | Ksetfield of int (* new *) + | Kpush + | Kpop of int (* added arg *) + | Krestart (* new *) + | Kgrab of int (* added arg *) + | Kapply of int (* added arg *) + | Kappterm of int * int (* added args and renamed *) + | Kpush_retaddr of int (* new *) + | Kcheck_signals + | Kreturn of int (* added arg *) + | Kclosure of int * int (* added arg *) + | Kclosurerec of int * int (* new *) + | Kraise (* new *) + | Kmakeblock of BlockTag * int + | Kprim of primitive + | Kpushtrap of int + | Kpoptrap + | Klabel of int + | Kbranch of int + | Kbranchif of int + | Kbranchifnot of int + | Kstrictbranchif of int + | Kstrictbranchifnot of int + | Ktest of bool_test * int + | Kbranchinterval of int * int * int * int + | Kswitch of int Array.array + + (* C-- additions *) + | Kname of int (* function label *) + | Kcontinuation of int (* handle label *) + | Knewgrab of int * int (* (restart label, req args) *) + | Knewrestart of int (* grap label *) +; + +type ZamPhrase = +{ + kph_funcs: ZamInstruction list list, (* code for functions *) + kph_inits: ZamInstruction list, (* initialization code *) + kph_is_pure: bool (* pure = no side effects *) +}; + +val Nolabel = ~1; diff -Nru mosml-2.01/src/compiler.cminusminus/Labels.sml mosml-2.10.1/src/compiler.cminusminus/Labels.sml --- mosml-2.01/src/compiler.cminusminus/Labels.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Labels.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,67 @@ +(* Handlings of local labels and backpatching *) + +local + open Fnlib Instruct Buffcode +in + +datatype label_definition = + Label_defined of int + | Label_undefined of (int * int) list +; + +val label_table = ref (Array.fromList [] : label_definition Array.array) +; + +fun reset_label_table () = + label_table := Array.array(16, Label_undefined []) +; + +fun extend_label_table needed = + let val old = Array.length (!label_table) + val new_table = + Array.array((needed div old + 1) * old, Label_undefined []) + in + Array.copy { src= !label_table, dst= new_table, di=0 }; + label_table := new_table + end; + +fun define_label lbl = +( + if lbl < Array.length (!label_table) then () else + extend_label_table lbl; + case Array.sub(!label_table, lbl) of + Label_defined _ => + fatalError "define_label : already defined" + | Label_undefined L => + let val currpos = !out_position in + Array.update(!label_table, lbl, Label_defined currpos); + case L of + [] => () + | _ => (* Backpatching the list L of pending labels: *) + (List.app (fn (pos,orig) => + (out_position := pos; + out_long (currpos - orig))) + L; + out_position := currpos) + end +); + +fun out_label_with_orig orig lbl = +( + if lbl = Nolabel then + fatalError "out_label: undefined label" + else if lbl >= Array.length (!label_table) then + extend_label_table lbl + else (); + case Array.sub(!label_table, lbl) of + Label_defined def => + out_long (def - orig) + | Label_undefined L => + (Array.update(!label_table, lbl, + Label_undefined ((!out_position, orig) :: L)); + out_long 0) +); + +fun out_label l = out_label_with_orig (!out_position) l; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Lambda.sml mosml-2.10.1/src/compiler.cminusminus/Lambda.sml --- mosml-2.01/src/compiler.cminusminus/Lambda.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Lambda.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,39 @@ +(* The intermediate language: extended lambda-calculus in de + Bruijn's notation *) + +local + open Const Prim; +in + +datatype Lambda = + Lvar of int + | Lconst of StructConstant + | Lapply of Lambda * Lambda list + | Lfn of Lambda + | Llet of Lambda list * Lambda + | Lletrec of Lambda list * Lambda + | Lprim of primitive * Lambda list + | Lcase of Lambda * (SCon * Lambda) list + | Lswitch of int * Lambda * (BlockTag * Lambda) list + | Lstaticfail + | Lstatichandle of Lambda * Lambda + | Lhandle of Lambda * Lambda + | Lif of Lambda * Lambda * Lambda + | Lseq of Lambda * Lambda + | Lwhile of Lambda * Lambda + | Landalso of Lambda * Lambda + | Lorelse of Lambda * Lambda + | Lunspec + | Lshared of Lambda ref * int ref + | Lassign of int * Lambda +; + +fun shared_lambda lam = + Lshared( ref lam, ref Instruct.Nolabel ) +; + + +fun Lstruct [] = Lconst(BLOCKsc(CONtag(0,1),[])) +| Lstruct lams = Lprim(Pmakeblock(CONtag(0,1)), lams) + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Lexer.lex mosml-2.10.1/src/compiler.cminusminus/Lexer.lex --- mosml-2.01/src/compiler.cminusminus/Lexer.lex 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Lexer.lex 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,469 @@ +{ +open Fnlib Memory Config Mixture Const Parser; + +(* For Quote/Antiquote --- object language embedding. *) + +val quotation = ref false + +datatype lexingMode = + NORMALlm + | QUOTElm + | ANTIQUOTElm + +val lexingMode = ref NORMALlm + +val parCount = Stack.new() : int Stack.t + +fun resetLexerState() = +( + lexingMode := NORMALlm; + Stack.clear parCount +) + +(* For nesting comments *) + +val comment_depth = ref 0 + +(* The table of keywords *) + +val keyword_table = (Hasht.new 53 : (string,token) Hasht.t) + +val () = +List.app (fn (str,tok) => Hasht.insert keyword_table str tok) +[ + ("abstype", ABSTYPE), + ("and", AND), + ("andalso", ANDALSO), + ("as", AS), + ("case", CASE), + ("datatype", DATATYPE), + ("do", DO), + ("else", ELSE), + ("eqtype", EQTYPE), + ("end", END), + ("exception", EXCEPTION), + ("fn", FN), + ("fun", FUN), + ("functor", FUNCTOR), + ("handle", HANDLE), + ("if", IF), + ("in", IN), + ("include", INCLUDE), + ("infix", INFIX), + ("infixr", INFIXR), + ("let", LET), + ("local", LOCAL), + ("nonfix", NONFIX), + ("of", OF), + ("op", OP), + ("open", OPEN), + ("orelse", ORELSE), + ("prim_eqtype", PRIM_EQTYPE), + ("prim_EQtype", PRIM_REFTYPE), + ("prim_type", PRIM_TYPE), + ("prim_val", PRIM_VAL), + ("raise", RAISE), + ("rec", REC), + ("sharing", SHARING), + ("sig", SIG), + ("signature", SIGNATURE), + ("struct", STRUCT), + ("structure", STRUCTURE), + ("then", THEN), + ("type", TYPE), + ("val", VAL), + ("where", WHERE), + ("while", WHILE), + ("with", WITH), + ("withtype", WITHTYPE), + ("#", HASH), + ("->", ARROW), + ("|", BAR), + (":>", COLONGT), + (":", COLON), + ("=>", DARROW), + ("=", EQUALS), + ("*", STAR) +] + +fun mkKeyword lexbuf = + let val s = getLexeme lexbuf in + Hasht.find keyword_table s + handle Subscript => ID s + end + +val savedLexemeStart = ref 0 + +val initial_string_buffer = CharArray.array(256, #"\000") +val string_buff = ref initial_string_buffer +val string_index = ref 0 + +fun reset_string_buffer() = +( + string_buff := initial_string_buffer; + string_index := 0; + () +) + +fun store_string_char c = + let open CharArray + val len = length (!string_buff) + in + if !string_index >= len then + let val new_buff = array(len * 2, #"\000") in + copy { src = !string_buff, dst = new_buff, di = 0 }; + string_buff := new_buff + end + else (); + update(!string_buff, !string_index, c); + incr string_index + end + +fun get_stored_string() = + let open CharArraySlice + val s = vector(slice(!string_buff, 0, SOME (!string_index))) + in + string_buff := initial_string_buffer; + s + end + +(* cvr: NOTE normalizeUnitName done elsewhere now *) +fun splitQualId s = + let open CharVectorSlice + val len' = size s + fun parse i n acc = + if n >= len' then + vector(slice(s, i, SOME (len' - i))) :: acc + else if CharVector.sub(s, n) = #"." then + parse (n+1) (n+1) (vector(slice(s, i, SOME (n - i)))::acc) + else + parse i (n+1) acc + in parse 0 0 [] end + + + +fun mkQualId lexbuf = + let val id = splitQualId(getLexeme lexbuf) in + if id = ["*"] then + QUAL_STAR { qual="", id=id } + else + QUAL_ID { qual="", id=id } + end + +fun charCodeOfDecimal lexbuf i = + 100 * (Char.ord(getLexemeChar lexbuf i) - 48) + + 10 * (Char.ord(getLexemeChar lexbuf (i+1)) - 48) + + (Char.ord(getLexemeChar lexbuf (i+2)) - 48) + + +fun charCodeOfHexadecimal lexbuf i = + let fun hexval c = + if #"0" <= c andalso c <= #"9" then Char.ord c - 48 + else (Char.ord c - 55) mod 32; + in + 4096 * hexval(getLexemeChar lexbuf (i+1)) + + 256 * hexval(getLexemeChar lexbuf (i+2)) + + 16 * hexval(getLexemeChar lexbuf (i+3)) + + hexval(getLexemeChar lexbuf (i+4)) + end + +fun lexError msg lexbuf = +( + resetLexerState(); + raise LexicalError(msg, getLexemeStart lexbuf, getLexemeEnd lexbuf) +) + +fun constTooLarge msg lexbuf = +( + resetLexerState(); + lexError (msg ^ " constant is too large") lexbuf +) + +prim_val sml_word_of_string : string -> word = 1 "sml_word_of_dec" +prim_val sml_word_of_hexstring : string -> word = 1 "sml_word_of_hex" + +fun notTerminated msg lexbuf = +( + resetLexerState(); + raise LexicalError (msg ^ " not terminated", + !savedLexemeStart, getLexemeEnd lexbuf) +) + +fun skipString msg skip lexbuf = + let + val pos1 = getLexemeStart lexbuf + val pos2 = getLexemeEnd lexbuf + in + skip lexbuf; + resetLexerState(); + raise (LexicalError(msg, pos1, pos2)) + end + +fun scanString scan lexbuf = +( + reset_string_buffer(); + savedLexemeStart := getLexemeStart lexbuf; + scan lexbuf; + setLexStartPos lexbuf (!savedLexemeStart - getLexAbsPos lexbuf) +) + +} + +rule Token = parse + [^ `\000`-`\255`] + { lexError "this will be never called!" lexbuf } + | "" + { case !lexingMode of + NORMALlm => + TokenN lexbuf + | QUOTElm => + (scanString Quotation lexbuf; + case !lexingMode of + NORMALlm => + QUOTER (get_stored_string()) + | ANTIQUOTElm => + QUOTEM (get_stored_string()) + | QUOTElm => + fatalError "Token") + | ANTIQUOTElm => + AntiQuotation lexbuf + } + +and TokenN = parse + [` ` `\n` `\r` `\t` `\^L`] { TokenN lexbuf } + | "(*" + { savedLexemeStart := getLexemeStart lexbuf; + comment_depth := 1; Comment lexbuf; TokenN lexbuf + } + | "*)" + { lexError "unmatched comment bracket" lexbuf } + | "'" [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]+ + { TYVAR (getLexeme lexbuf) } + | "0" { ZDIGIT 0 } + | [`1`-`9`] { NZDIGIT (sml_int_of_string(getLexeme lexbuf)) } + | "0" [`0`-`9`]+ + { ZPOSINT2 (sml_int_of_string(getLexeme lexbuf)) + handle Fail _ => constTooLarge "integer" lexbuf + } + | [`1`-`9`] [`0`-`9`]+ + { NZPOSINT2 (sml_int_of_string(getLexeme lexbuf)) + handle Fail _ => constTooLarge "integer" lexbuf + } + | "~" [`0`-`9`]+ + { NEGINT (sml_int_of_string(getLexeme lexbuf)) + handle Fail _ => constTooLarge "integer" lexbuf + } + | "~"? "0x" [`0`-`9` `a`-`f` `A`-`F`]+ + { NEGINT (sml_hex_of_string(getLexeme lexbuf)) + handle Fail _ => constTooLarge "integer" lexbuf + } + | "0w" [`0`-`9`]+ + { WORD (sml_word_of_string(getLexeme lexbuf)) + handle Fail _ => constTooLarge "word" lexbuf + } + | "0wx" [`0`-`9` `a`-`f` `A`-`F`]+ + { WORD (sml_word_of_hexstring(getLexeme lexbuf)) + handle Fail _ => constTooLarge "word" lexbuf + } + | "~"? [`0`-`9`]+ (`.` [`0`-`9`]+)? ([`e` `E`] `~`? [`0`-`9`]+)? + { REAL (sml_float_of_string (getLexeme lexbuf)) + handle Fail _ => constTooLarge "real" lexbuf + } + | "\"" + { scanString String lexbuf; + STRING (get_stored_string()) + } + | "#\"" + { scanString String lexbuf; + let val s = get_stored_string() in + if size s <> 1 then + lexError "ill-formed character constant" lexbuf + else (); + CHAR (CharVector.sub(s, 0)) + end } + | "_" { UNDERBAR } + | "," { COMMA } + | "..." { DOTDOTDOT } + | "{" { LBRACE } + | "}" { RBRACE } + | "[" { LBRACKET } + | "#[" { HASHLBRACKET } + | "]" { RBRACKET } + | "(" + { if not(Stack.null parCount) then + Stack.push (Stack.pop parCount + 1) parCount + else (); + LPAREN + } + | ")" + { if not(Stack.null parCount) then + let val count = Stack.pop parCount - 1 in + if count = 0 then + (lexingMode := QUOTElm; Token lexbuf) + else + (Stack.push count parCount; RPAREN) + end + else + RPAREN + } + | ";" { SEMICOLON } + | (eof | `\^Z`) { EOF } + | "" { if !quotation then TokenIdQ lexbuf else TokenId lexbuf } + +and TokenId = parse + ( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]* + | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\` + `~` `\`` `^` `|` `*`]+ ) + { mkKeyword lexbuf } + | (( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]* + | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\` + `~` `\`` `^` `|` `*`]+ ) + ".")+ + ( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]* + | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\` + `~` `\`` `^` `|` `*`]+ ) + { mkQualId lexbuf } + | _ + { lexError "ill-formed token" lexbuf } + +and TokenIdQ = parse + ( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]* + | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\` + `~` `^` `|` `*`]+ ) + { mkKeyword lexbuf } + | (( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]* + | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\` + `~` `^` `|` `*`]+ ) + ".")+ + ( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]* + | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\` + `~` `^` `|` `*`]+ ) + { mkQualId lexbuf } + | "`" + { lexingMode := QUOTElm; QUOTEL } + | _ + { lexError "ill-formed token" lexbuf } + +and Comment = parse + "(*" + { (incr comment_depth; Comment lexbuf) } + | "*)" + { (decr comment_depth; + if !comment_depth > 0 then Comment lexbuf else ()) } + | (eof | `\^Z`) + { notTerminated "comment" lexbuf } + | _ + { Comment lexbuf } + +and String = parse + `"` + { () } + | `\\` [`\\` `"` `a` `b` `t` `n` `v` `f` `r`] + { store_string_char(char_for_backslash(getLexemeChar lexbuf 1)); + String lexbuf } + | `\\` [` ` `\t` `\n` `\r`]+ `\\` + { String lexbuf } + | `\\` `^` [`@`-`_`] + { store_string_char( + Char.chr(Char.ord(getLexemeChar lexbuf 2) - 64)); + String lexbuf } + | `\\` [`0`-`9`] [`0`-`9`] [`0`-`9`] + { let val code = charCodeOfDecimal lexbuf 1 in + if code >= 256 then + skipString "character code is too large" SkipString lexbuf + else (); + store_string_char(Char.chr code); + String lexbuf + end } + | "\\u" [`0`-`9``a`-`f``A`-`F`] [`0`-`9``a`-`f``A`-`F`] + [`0`-`9``a`-`f``A`-`F`] [`0`-`9``a`-`f``A`-`F`] + { let val code = charCodeOfHexadecimal lexbuf 1 in + if code >= 256 then + skipString "character code is too large" SkipString lexbuf + else (); + store_string_char(Char.chr code); + String lexbuf + end } + | `\\` + { skipString "ill-formed escape sequence" SkipString lexbuf } + | (eof | `\^Z`) + { notTerminated "string" lexbuf } + | [`\n` `\r`] + { skipString "newline not permitted in string" SkipString lexbuf } + | [`\^A`-`\^Z` `\127` `\255`] + { skipString "invalid character in string" SkipString lexbuf } + | _ + { (store_string_char(getLexemeChar lexbuf 0); + String lexbuf) } + +and SkipString = parse + `"` + { () } + | `\\` [`\\` `"` `n` `t`] + { SkipString lexbuf } + | `\\` [` ` `\t` `\n` `\r`]+ `\\` + { SkipString lexbuf } + | (eof | `\^Z`) + { notTerminated "string" lexbuf } + | _ + { SkipString lexbuf } + +and Quotation = parse + "`" + { lexingMode := NORMALlm } + | `^` + { lexingMode := ANTIQUOTElm } + | `\r` + { Quotation lexbuf } + | [`\t` `\n`] + { (store_string_char(getLexemeChar lexbuf 0); + Quotation lexbuf) } + | (eof | `\^Z`) + { lexingMode := NORMALlm; + notTerminated "quotation" lexbuf + } + | [`\^A`-`\^Z` `\127` `\255`] + { skipString "invalid character in quotation" SkipQuotation lexbuf } + | _ + { (store_string_char(getLexemeChar lexbuf 0); + Quotation lexbuf) } + +and SkipQuotation = parse + "`" + { lexingMode := NORMALlm } + | (eof | `\^Z`) + { lexingMode := NORMALlm; + notTerminated "quotation" lexbuf + } + | _ + { SkipQuotation lexbuf } + +and AntiQuotation = parse + ( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]* + | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\` + `~` `|` `*`]+ ) + { lexingMode := QUOTElm; + mkKeyword lexbuf + } + | "(" + { Stack.push 1 parCount; lexingMode := NORMALlm; + TokenN lexbuf + } + | "`" + { lexingMode := NORMALlm; + lexError "antiquotation is missing" lexbuf + } + | (eof | `\^Z`) + { lexingMode := NORMALlm; + notTerminated "antiquotation" lexbuf + } + | _ + { lexingMode := QUOTElm; + lexError "ill-formed antiquotation" lexbuf + } +; + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Lexer.sig mosml-2.10.1/src/compiler.cminusminus/Lexer.sig --- mosml-2.01/src/compiler.cminusminus/Lexer.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Lexer.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,3 @@ +val quotation : bool ref; +val resetLexerState : unit -> unit; +val Token : Lexing.lexbuf -> Parser.token; diff -Nru mosml-2.01/src/compiler.cminusminus/Link.sig mosml-2.10.1/src/compiler.cminusminus/Link.sig --- mosml-2.01/src/compiler.cminusminus/Link.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Link.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,6 @@ +val write_symbols : bool ref; +val no_header : bool ref; +val stand_alone : bool ref; +val autolink : bool ref +val verbose : bool ref +val link : string list -> string -> unit; diff -Nru mosml-2.01/src/compiler.cminusminus/Link.sml mosml-2.10.1/src/compiler.cminusminus/Link.sml --- mosml-2.01/src/compiler.cminusminus/Link.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Link.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,265 @@ +(* Production of a bytecode executable file *) + +open Misc BasicIO Nonstdio Miscsys Obj Fnlib Const Mixture Config; +open Code_dec Symtable Patch Tr_const; + +val autolink = ref true +val verbose = ref false + +(* First pass: check the consistency of files *) + +fun read_file name = + let val truename = find_in_path name + val is = open_in_bin truename + val tables = + let val n = input_binary_int is in + seek_in is n; + input_value is : compiled_unit_tables + end + handle x => + (close_in is; + msgIBlock 0; + errPrompt "Error on file "; + msgString truename; msgEOL(); + msgEBlock(); + raise x) + val _ = close_in is + in (truename, tables) end + +exception WrongStamp and NotYet + +fun check_file name stampOpt pending processed = + let val simplename = Filename.chop_suffix name ".uo" + val uname = normalizedUnitName(Filename.basename simplename) + val () = + if member uname pending then + raise Fail ("Unit " ^ name ^ " depends on itself") + else () + val () = + if member uname reservedUnitNames then + raise Fail ("Unit "^uname^" is built-in, and cannot be linked") + else () + + val already = (SOME (Hasht.find (!watchDog) uname)) + handle Subscript => NONE + + fun needs subuname substamp processed = + (check_file (subuname ^ ".uo") (SOME substamp) + (uname :: pending) processed) + handle WrongStamp => + raise Fail ("Compiled body of unit " ^ uname + ^ " is incompatible with unit "^ subuname) + | NotYet => + raise Fail ("Unit " ^ subuname ^ " is mentioned by " + ^ uname ^ " but not yet linked") + in + case already of + SOME stamp' => + (case stampOpt of + SOME stamp => + if stamp <> stamp' then raise WrongStamp + else processed + | NONE => + (msgIBlock 0; + errPrompt "Warning: unit "; + msgString uname; + msgString " is needed by a unit preceding it"; + msgEOL(); + msgEBlock(); + processed)) + | NONE => let val implicit = case stampOpt of NONE => false | _ => true + val _ = if not(!autolink) andalso implicit + then raise NotYet else () + val (truename, tables) = read_file name + val precedingUnits = + Hasht.fold needs processed (#cu_mentions tables) + in + Hasht.insert (!watchDog) uname (#cu_sig_stamp tables); + (uname, truename, tables) :: precedingUnits + end + end + +val check_file = fn name => fn processed => check_file name NONE [] processed + + +(* Second pass: determine which phrases are required *) + +val missing_globals = + ref (Hasht.new 1 : (QualifiedIdent * int, unit) Hasht.t) +; + +fun is_in_missing g = + (Hasht.find (!missing_globals) g; true) + handle Subscript => false +; + +fun remove_from_missing g = + Hasht.remove (!missing_globals) g +; + +fun add_to_missing g = + Hasht.insert (!missing_globals) g () +; + +fun is_required (Reloc_setglobal g, _) = is_in_missing g + | is_required _ = false +; + +fun remove_required (Reloc_setglobal g, _) = remove_from_missing g + | remove_required _ = () +; + +fun add_required (Reloc_getglobal g, _) = add_to_missing g + | add_required _ = () +; + +fun scan_val uname (id, stamp) tolink = + let val q = {qual=uname, id=[id]} in + if is_in_missing (q, 0) then + (remove_from_missing (q, 0); + add_to_missing (q, stamp); + (id, stamp) :: tolink) + else + tolink + end; + +fun scan_phrase (phr : compiled_phrase) tolink = + let val (_, otherlist) = #cph_reloc phr + in + if not (#cph_pure phr) orelse List.exists is_required otherlist then + (List.app remove_required otherlist; + List.app add_required otherlist; + phr :: tolink) + else + tolink + end; + +fun scan_file (uname, truename, (tables : compiled_unit_tables)) tolink = + let val exportedE = #cu_exc_ren_list tables + val valRenList = #cu_val_ren_list tables + val exportedV = foldL (scan_val uname) [] valRenList + val phraseIndex = #cu_phrase_index tables + val required = foldL scan_phrase [] phraseIndex + in + (uname, truename, required, exportedE, exportedV) :: tolink + end; + +(* Third pass : link in the required phrases. *) + +fun link_object os (uname, truename, required, exportedE, exportedV) = + let val is = open_in_bin truename in + (List.app + (fn (phr : compiled_phrase) => + let val () = seek_in is (#cph_pos phr) + val buff = input(is, #cph_len phr) + val () = if size buff < #cph_len phr + then raise Size else () + in + patch_object buff 0 (#cph_reloc phr); + output(os, buff) + end) + required; + exportPublicNames uname exportedE exportedV; + close_in is) + handle x => + (close_in is; + msgIBlock 0; + errPrompt "Error while linking file "; + msgString truename; msgEOL(); + msgEBlock(); + raise x) + end; + +(* To build the initial table of globals *) + +local + prim_val vector_ : int -> '_a -> '_a vector = 2 "make_vect" + prim_val sub_ : 'a vector -> int -> 'a = 2 "get_vect_item" + prim_val update_ : 'a vector -> int -> 'a -> unit = 3 "set_vect_item" +in + + fun emit_data os = + let val len = number_of_globals() + val globals = vector_ len (repr 0) + in + List.app + (fn (n,sc) => update_ globals n (translStructuredConst sc)) + (!literal_table); + output_value os globals + end; + +end; + +(* To build a bytecode executable file *) + +val write_symbols = ref false; +val no_header = ref false; +val stand_alone = ref false; (* cvr: 144 merge *) + +fun reportLinked toscan = + let fun reportUnit (uname, _, _) = (msgString uname; msgString ".uo ") + in + msgIBlock 0; + msgString "Linking: "; + List.app reportUnit (rev toscan); + msgEOL(); msgEBlock() + end + +fun link unit_list exec_name = + let val _ = missing_globals := (* 04Sep95 e *) + (Hasht.new 263 : (QualifiedIdent * int, unit) Hasht.t) + val toscan = foldL check_file [] unit_list + val _ = if !verbose then reportLinked toscan else () + val tolink = foldL scan_file [] toscan + val os = if !no_header andalso not (!stand_alone) then + open_out_bin exec_name + else + open_out_exe exec_name + fun copy name = + let val buff = CharArray.array(4096, #"\000") + val is = open_in_bin (Filename.concat (!path_library) name) + fun loop () = + case buff_input is buff 0 4096 of + 0 => () + | n => (buff_output os buff 0 n; loop ()) + in + (loop (); close_in is) handle x => (close_in is; raise x) + end + in + ((* Prepend the runtime system? *) + if !stand_alone then copy "camlrunm" else (); + (* Prepend the header? *) + if !no_header orelse !stand_alone then () else copy "header"; + missing_globals := (* for gc -- 04Sep95 e *) + (Hasht.new 1 : (QualifiedIdent * int, unit) Hasht.t); + (* The bytecode *) + let val pos1 = pos_out os + val () = List.app (link_object os) tolink + val () = output_byte os Opcodes.STOP; + (* The table of global data *) + val pos2 = pos_out os + val () = emit_data os + (* Linker tables *) + val pos3 = pos_out os + val () = + if !write_symbols then save_linker_tables os + else (); + (* Debugging info (none, presently) *) + val pos4 = pos_out os + in + (* The trailer *) + output_binary_int os (pos2 - pos1); + output_binary_int os (pos3 - pos2); + output_binary_int os (pos4 - pos3); + output_binary_int os 0; + output(os, "ML08"); + close_out os + end + ) handle x => + (close_out os; + remove_file exec_name; + raise x) + end; + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Load_phr.sig mosml-2.10.1/src/compiler.cminusminus/Load_phr.sig --- mosml-2.01/src/compiler.cminusminus/Load_phr.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Load_phr.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,4 @@ +(* Load_phr.sig *) + +val do_code: bool -> string -> int -> int -> Obj.obj; +val loadZamPhrase: Instruct.ZamPhrase -> Obj.obj; diff -Nru mosml-2.01/src/compiler.cminusminus/Load_phr.sml mosml-2.10.1/src/compiler.cminusminus/Load_phr.sml --- mosml-2.01/src/compiler.cminusminus/Load_phr.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Load_phr.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,68 @@ +(* To load in-core a compiled bytecode phrase, and execute it *) + +open List Obj Memory Fnlib Mixture Const Instruct Types; +open Symtable Patch Tr_const Opcodes Buffcode Reloc Emitcode Rtvals; + +fun do_code may_free code entrypoint len = +( + if number_of_globals() >= Vector.length global_data then + realloc_global_data(number_of_globals()) + else (); + app + (fn (n, sc) => setGlobalVal n (translStructuredConst sc)) + (!literal_table); + literal_table := []; + let val res = + interprete may_free code entrypoint len + handle x => + ((case x of + Interrupt => raise x + | Toplevel => raise x + | Impossible _ => raise x + | Out_of_memory => gc_full_major() + | _ => + ()); + msgIBlock 0; + errPrompt "Uncaught exception: "; msgEOL(); errPrompt ""; + printVal (trivial_scheme type_exn) (repr x); + msgEOL(); + msgEBlock(); + raise Toplevel) + in + res + end +); + +fun loadZamPhrase (phr : ZamPhrase) = +( + reloc_reset(); + init_out_code(); + Labels.reset_label_table(); + literal_table := []; + (* It is essential to emit the initialization code *) + (* before the function bodies, in order for all Pset_global *) + (* to appear before all the Pget_global. *) + let val entrypoint = !out_position + val () = emit (#kph_inits phr) + val () = out STOP + val () = emit (#kph_funcs phr) + val len = !out_position + val out_buffer_ = !(magic (!out_buffer) : string ref) + in + patch_object out_buffer_ 0 (get_reloc_info()); + do_code (case (#kph_funcs phr) of [] => true | _ => false) + out_buffer_ entrypoint len + end +); + + + + + + + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Location.sig mosml-2.10.1/src/compiler.cminusminus/Location.sig --- mosml-2.01/src/compiler.cminusminus/Location.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Location.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,20 @@ +datatype Location = + Loc of int (* Position of the first character *) + * int (* Position of the next character following the last one *) +; + +val getCurrentLocation : unit -> Location +and mkLoc : 'a -> Location * 'a +and xLR : Location * 'a -> Location +and xL : Location * 'a -> int +and xR : Location * 'a -> int +and xxLR : Location * 'a -> Location * 'b -> Location +and xxRL : Location * 'a -> Location * 'b -> Location +and nilLocation : Location +and errLocation : Location -> unit +and errInputName : unit -> unit +and input_name : string ref +and input_stream : BasicIO.instream ref +and input_lexbuf : Lexing.lexbuf ref +and errorMsg : Location -> string -> 'a +; diff -Nru mosml-2.01/src/compiler.cminusminus/Location.sml mosml-2.10.1/src/compiler.cminusminus/Location.sml --- mosml-2.01/src/compiler.cminusminus/Location.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Location.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,199 @@ +(* Printing a location in the source program *) + +open BasicIO Nonstdio Lexing Parsing Fnlib Config Mixture; + +datatype Location = + Loc of int (* Position of the first character *) + * int (* Position of the next character following the last one *) +; + +val input_name = ref "" (* Input file name *) +and input_stream = ref std_in (* Current input channel *) +and input_lexbuf = (* Current lexbuf *) + ref(createLexer(fn s => fn n => 0)) +; + +val nilLocation = Loc(0,0); + +fun getCurrentLocation () = + Loc(symbolStart(), symbolEnd()) +; + +fun mkLoc x = (getCurrentLocation(), x); + +fun xLR (loc, _) = loc +and xL (Loc(l,r), _) = l +and xR (Loc(l,r), _) = r +; + +fun xxLR (Loc(l,_), _) (Loc(_,r),_) = Loc(l,r); +fun xxRL (Loc(_,r), _) (Loc(l,_),_) = Loc(r,l); + +fun errLines char1 char2 charline1 line1 line2 = + case !msgStyle of + "default" => + ( + msgString ", line "; msgInt line1; + if line2 <> line1 then ( msgString "-"; msgInt line2 ) else (); + msgString ", characters "; + msgInt (char1-charline1); msgString "-"; msgInt (char2-charline1); + msgString ":" + ) + | "msdev" => + ( + msgString "("; msgInt line1; + if line2 <> line1 then ( msgString "-"; msgInt line2 ) else (); + msgString "): characters "; + msgInt (char1-charline1); msgString "-"; msgInt (char2-charline1); + msgString ":" + ) + | _ => + raise Impossible ("errLines: " ^ !msgStyle) +; + +fun msgChars n c = + if n > 0 then (msgChar c; msgChars (n-1) c) else () +; + +fun errLoc input seek line_flag (Loc(pos1, pos2)) = + let + fun skipLine () = + (case input() of #"\^Z" => () | #"\n" => () | _ => skipLine()) + handle Size => () + and copyLine () = + (case input() of + #"\^Z" => raise Size + | #"\n" => msgEOL() + | c => (msgChar c; copyLine())) + handle Size => (msgString ""; msgEOL()) + and tr_line first len ch = + let + val c = ref #" " + val f = ref first + val l = ref len + fun loop f l = + (case input() of + #"\^Z" => raise Size + | #"\n" => () + | c => + if f > 0 then + (msgChar(if c = #"\t" then c else #" "); loop (f-1) l) + else if l > 0 then + (msgChar(if c = #"\t" then c else ch); loop f (l-1)) + else loop f l) + handle Size => msgChars 5 ch + in loop first len end + val pos = ref 0 + val line1 = ref 1 + val line1_pos = ref 0 + val line2 = ref 1 + val line2_pos = ref 0 + in + seek 0; + (while !pos < pos1 do + (incr pos; + case input() of + #"\^Z" => raise Size + | #"\n" => (incr line1; line1_pos := !pos) + | _ => ())) + handle Size => (); + line2 := !line1; + line2_pos := !line1_pos; + (while !pos < pos2 do + (incr pos; + case input() of + #"\^Z" => raise Size + | #"\n" => (incr line2; line2_pos := !pos) + | _ => ())) + handle Size => (); + if line_flag then + errLines pos1 pos2 (!line1_pos) (!line1) (!line2) + else (); + msgEOL(); + if !line1 = !line2 then + (seek (!line1_pos); + errPrompt ""; copyLine (); + seek (!line1_pos); + errPrompt ""; tr_line (pos1 - !line1_pos) (pos2 - pos1) #"^"; + msgEOL()) + else + ( + seek (!line1_pos); + errPrompt ""; tr_line 0 (pos1 - !line1_pos) #"."; + seek pos1; + copyLine(); + if !line2 - !line1 <= 8 then + (for (fn i => (errPrompt ""; copyLine())) + (!line1 + 1) (!line2 - 1)) + else + (for (fn i => (errPrompt ""; copyLine())) + (!line1 + 1) (!line1 + 3); + errPrompt ".........."; msgEOL(); + for (fn i => skipLine()) + (!line1 + 4) (!line2 - 4); + for (fn i => (errPrompt ""; copyLine())) + (!line2 - 3) (!line2 - 1)); + errPrompt ""; + (for (fn i => msgChar(input())) + (!line2_pos) (pos2 - 1); + tr_line 0 100 #".") + handle Size => msgString ""; + msgEOL() + ) + end; + +fun errFileName() = + case !msgStyle of + "default" => + ( + msgString "File \""; msgString (!input_name); msgString "\"" + ) + | "msdev" => + msgString( FileSys.fullPath (!input_name) ) + | _ => + raise Impossible ("errFileName: " ^ !msgStyle) +; + +fun errLocation loc = + if size (!input_name) > 0 then + let val p = pos_in (!input_stream) in + errFileName(); + errLoc (fn () => input_char (!input_stream)) (seek_in (!input_stream)) + true loc; + seek_in (!input_stream) p + end + else + let + val curr_pos = ref 0 + fun input () = + let val c = + if !curr_pos >= 2048 then + raise Size + else if !curr_pos >= 0 then + CharVector.sub(getLexBuffer(!input_lexbuf), !curr_pos) + else + #"." + in incr curr_pos; c end + and seek pos = + curr_pos := pos - getLexAbsPos(!input_lexbuf) + in + errPrompt "Toplevel input:"; + errLoc input seek false loc + end +; + +fun errInputName () = +( + errFileName(); + msgString ", line 1:"; + msgEOL() +); + +fun errorMsg loc msg = +( + msgIBlock 0; + errLocation loc; + errPrompt msg; msgEOL(); + msgEBlock(); + raise Toplevel +); diff -Nru mosml-2.01/src/compiler.cminusminus/Mainc.sig mosml-2.10.1/src/compiler.cminusminus/Mainc.sig --- mosml-2.01/src/compiler.cminusminus/Mainc.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Mainc.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,3 @@ +(* Main.sig *) + +(* Nothing to export! *) diff -Nru mosml-2.01/src/compiler.cminusminus/Mainc.sml mosml-2.10.1/src/compiler.cminusminus/Mainc.sml --- mosml-2.01/src/compiler.cminusminus/Mainc.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Mainc.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,214 @@ +open List Fnlib Config Mixture Location Units Smlperv Compiler; +open Types; (* cvr *) + +(* Compile a file *) + +fun compileFile (context,s,mode) = + let (* val s = normalizedFileName s *) in + if Filename.check_suffix s ".sig" then + let val filename = Filename.chop_suffix s ".sig" in + compileSignature context + (normalizedUnitName (Filename.basename filename)) + mode + filename + end + else if Filename.check_suffix s ".sml" then + let val filename = Filename.chop_suffix s ".sml" in + compileUnitBody context + (normalizedUnitName (Filename.basename filename)) + mode + filename + end + else + raise (Fail "unknown file name extension") + end +; + +val initialMode = ref (!currentMode); + +val initialContext = ref ([] : string list); + +val initialFiles = ref ([] : (string list * string * Mode) list); + +fun anonymous s = + let val s = normalizedFileName s in + if Filename.check_suffix s ".sig" then + let val filename = Filename.chop_suffix s ".sig" + in + (initialFiles := + (!initialFiles) @ + [(!initialContext,s,!initialMode)]; + initialContext := (!initialContext) @ [filename]) + end + else if Filename.check_suffix s ".sml" then + let val filename = Filename.chop_suffix s ".sml" + in + (initialFiles := + (!initialFiles) @ + [(remove filename (!initialContext), + (* we remove filename to avoid a circular dependency on + the .sig file, if any *) + s, + !initialMode)]; + initialContext := (!initialContext) @ [filename]) + end + else if Filename.check_suffix s ".ui" then + let val filename = Filename.chop_suffix s ".ui" + in + initialContext := (!initialContext) @ [filename] + end (* cvr: this implies that the .ui file must be on the load path *) + else + raise (Fail "unknown file name extension") + end +; + +fun set_stdlib p = + path_library := p; +; + +fun set_value_polymorphism b _ = + value_polymorphism := b; +; + +fun add_include d = + load_path := (!load_path) @ [d] +; + +fun perv_set set' = + let val set = Fnlib.stringToLower set' + in + if set = "none" then + (preloadedUnits := []; preopenedPreloadedUnits := []) + else + (preloadedUnits := lookup set preloadedUnitSets; + preopenedPreloadedUnits := lookup set preopenedPreloadedUnitSets) + handle Subscript => + raise Arg.Bad ("Unknown preloaded unit set " ^ set) + end + +fun set_msgstyle p = + if exists (fn x => x = p) ["default", "msdev"] then + msgStyle := p + else + raise Arg.Bad ("Unknown message style " ^ p) +; + +fun show_version() = +( + msgIBlock 0; + msgString ("Moscow ML compiler version "^Config.version); + msgEOL(); + msgString "Based in part on Caml Light and the ML Kit"; + msgEOL(); + msgEBlock(); + msgFlush(); + BasicIO.exit 0 +); + +fun show_inferred_types() = + verbose := true +; + +fun printLambda () = + Compiler.printLambda := true + +fun printZam () = + Compiler.printZam := true + + + +fun enable_quotation() = + Lexer.quotation := true +; + +fun topdec_mode () = + initialMode := TOPDECmode; + +fun str_mode () = + initialMode := STRmode; + +fun orthodox () = currentCompliance := Orthodox; +fun conservative () = currentCompliance := Conservative; +fun liberal () = currentCompliance := Liberal; + + +fun main () = +( + perv_set "default"; + load_path := []; + toplevel := true; + (* Choose the default (value polymorphism or imperative types) here: *) + value_polymorphism := true; + (* Choose the default SML compliance checks here *) + currentCompliance := Liberal; + Arg.parse [("-stdlib", Arg.String set_stdlib), + ("-I", Arg.String add_include), + ("-include", Arg.String add_include), + ("-P", Arg.String perv_set), + ("-perv", Arg.String perv_set), + ("-v", Arg.Unit show_version), + ("-version", Arg.Unit show_version), + ("-i", Arg.Unit show_inferred_types), + ("-quotation", Arg.Unit enable_quotation), + ("-q", Arg.Unit enable_quotation), + ("-imptypes", Arg.Unit (set_value_polymorphism false)), + ("-valuepoly", Arg.Unit (set_value_polymorphism true)), + ("-msgstyle", Arg.String set_msgstyle), + ("-m", Arg.String set_msgstyle), + ("-structure", Arg.Unit str_mode), + ("-toplevel", Arg.Unit topdec_mode), + ("-orthodox", Arg.Unit orthodox), + ("-conservative", Arg.Unit conservative), + ("-liberal", Arg.Unit liberal), + ("-dlambda", Arg.Unit printLambda), + ("-dzam" , Arg.Unit printZam) + ] + anonymous; + if !path_library <> "" then + load_path := !load_path @ [!path_library] + else (); + initPervasiveEnvironments(); + resetTypePrinter(); (* cvr *) + Miscsys.catch_interrupt true; + if null (!initialFiles) then show_version() else (); + app compileFile (!initialFiles); + msgFlush() +) +handle + Toplevel => + (msgFlush(); + BasicIO.exit 2) + | Interrupt => + (msgIBlock 0; + errPrompt "Interrupted."; msgEOL(); + msgEBlock(); + msgFlush(); + BasicIO.exit 3) + | Impossible msg => + (msgIBlock 0; + errPrompt "Internal error: "; msgString msg; msgEOL(); + msgEBlock(); + msgFlush(); + BasicIO.exit 4) + | SysErr(msg, _) => + (msgIBlock 0; + errPrompt "I/O operation failed: "; + msgString msg; msgEOL(); + msgEBlock(); + msgFlush(); + BasicIO.exit 2) + | Fail msg => + (msgIBlock 0; + errPrompt "Compilation failed: "; msgEOL(); + errPrompt msg; msgEOL(); + msgEBlock(); + msgFlush(); + BasicIO.exit 2) +; + +val () = Printexc.f main (); + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Mainl.sml mosml-2.10.1/src/compiler.cminusminus/Mainl.sml --- mosml-2.01/src/compiler.cminusminus/Mainl.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Mainl.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,143 @@ +(* The Caml Light linker. Command-line parsing. *) + +local + open List Fnlib Config Mixture Symtable Link; +in + +val object_files = ref ([] : string list); +val exec_file = ref default_exec_name; + +fun anonymous s = + let val name = + if Filename.check_suffix s ".sml" then + Filename.chop_suffix s ".sml" ^ ".uo" + else if Filename.check_suffix s ".uo" then + s + else + raise Arg.Bad ("Don't know what to do with file "^s) + in + object_files := name :: !object_files + end; + +fun set_stdlib p = + path_library := p; +; + +fun add_include d = + load_path := !load_path @ [d] +; + +fun perv_set set' = + let val set = Fnlib.stringToLower set' + in + if set = "none" then + preloadedUnits := [] + else + (preloadedUnits := lookup set preloadedUnitSets) + handle Subscript => + raise Arg.Bad ("Unknown preloaded unit set " ^ set) + end; + +fun set_debug () = + write_symbols := true +; + +fun set_noheader () = + no_header := true +; + +fun set_standalone () = + stand_alone := true +; + +fun unset_autolink () = + Link.autolink := false +; + +fun set_verbose () = + Link.verbose := true +; + +fun set_exec_file e = + exec_file := e +; + +fun show_version() = +( + msgIBlock 0; + msgString ("Moscow ML linker version "^Config.version); + msgEOL(); + msgString "Based in part on Caml Light"; + msgEOL(); + msgEBlock(); + msgFlush(); + BasicIO.exit 0 +); + +fun process_include filename = + List.app anonymous (Readword.from_file filename) +; + +fun main() = +( + Miscsys.catch_interrupt true; + perv_set "default"; + load_path := []; + reset_linker_tables(); + Arg.parse [("-stdlib", Arg.String set_stdlib), + ("-I", Arg.String add_include), + ("-include", Arg.String add_include), + ("-P", Arg.String perv_set), + ("-perv", Arg.String perv_set), + ("-noautolink", Arg.Unit unset_autolink), + ("-i", Arg.Unit set_verbose), + ("-g", Arg.Unit set_debug), + ("-debug", Arg.Unit set_debug), + ("-noheader", Arg.Unit set_noheader), + ("-standalone", Arg.Unit set_standalone), + ("-o", Arg.String set_exec_file), + ("-exec", Arg.String set_exec_file), + ("-v", Arg.Unit show_version), + ("-version", Arg.Unit show_version), + ("-files", Arg.String process_include), + ("-", Arg.String anonymous) + ] anonymous; + if !path_library <> "" then + load_path := !load_path @ [!path_library] + else (); + if null (!object_files) then + show_version() + else (); + object_files := + (map (fn uname => uname ^".uo") (!preloadedUnits)) + @ (rev (!object_files)); + link (!object_files) (!exec_file); + msgFlush(); + BasicIO.exit 0 + +) handle + Toplevel => + (msgFlush(); BasicIO.exit 2) + | Interrupt => + (msgIBlock 0; + errPrompt "Interrupted."; msgEOL(); + msgEBlock(); + msgFlush(); + BasicIO.exit 3) + | Impossible msg => + (msgIBlock 0; + errPrompt "Internal error: "; msgString msg; msgEOL(); + msgEBlock(); + msgFlush(); + BasicIO.exit 4) + | Fail msg => + (msgIBlock 0; + errPrompt msg; msgEOL(); + msgEBlock(); + msgFlush(); + BasicIO.exit 2) +; + +val () = Printexc.f main (); + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Maint.sig mosml-2.10.1/src/compiler.cminusminus/Maint.sig --- mosml-2.01/src/compiler.cminusminus/Maint.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Maint.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,3 @@ +(* Main.sig *) + +(* Nothing to export! *) diff -Nru mosml-2.01/src/compiler.cminusminus/Maint.sml mosml-2.10.1/src/compiler.cminusminus/Maint.sml --- mosml-2.01/src/compiler.cminusminus/Maint.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Maint.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,170 @@ +(* Main.sml *) + +open List BasicIO Nonstdio; +open Miscsys Memory Fnlib Config Mixture Location Units Smlperv Rtvals Smltop; +open Types (* cvr *); +val initialFiles = ref ([] : string list); + +(* Initial loop *) + +fun initial_loop () = + while true do + let in + msgFlush(); + (case !initialFiles of + [] => + raise Toplevel + | filename :: rest => + (initialFiles := rest; + evalUse filename)) + handle + Toplevel => + (msgFlush(); + raise EndOfFile) + | Interrupt => + (msgIBlock 0; + msgPrompt "Interrupted."; msgEOL(); + msgEBlock(); + msgFlush(); + raise EndOfFile) + | x => + (msgFlush(); + raise x) + end +; + +(* Main loop *) + +fun main_loop () = + while true do + let in + msgFlush(); + if !Exec_phr.quietdec then () else outputc std_out toplevel_input_prompt; + flush_out std_out; + let val isLast = loadToplevelPhrase (!input_lexbuf) in + if isLast then raise EndOfFile else () + end + handle + EndOfFile => + (msgIBlock 0; msgEOL(); msgEBlock (); + msgFlush(); BasicIO.exit 0) + | Toplevel => + msgFlush() + | Interrupt => + (msgIBlock 0; + msgPrompt "Interrupted."; + msgEOL(); msgEBlock(); msgFlush()) + | x => + (msgFlush(); + raise x) + end +; + +fun anonymous s = + initialFiles := !initialFiles @ [s]; + +fun set_stdlib p = + path_library := p; + +fun set_value_polymorphism b _ = + value_polymorphism := b; + +fun set_quietdec b _ = + Exec_phr.quietdec := b; + +fun add_include d = + load_path := !load_path @ [d]; + +fun perv_set set' = + let val set = Fnlib.stringToLower set' + in + if set = "none" then + (preloadedUnits := []; preopenedPreloadedUnits := []) + else + (preloadedUnits := + lookup set preloadedUnitSets @ ["Help"]; + preopenedPreloadedUnits := + lookup set preopenedPreloadedUnitSets @ ["Help"]) + handle Subscript => + raise Arg.Bad ("Unknown preloaded unit set " ^ set) + end + +fun set_msgstyle p = + if exists (fn x => x = p) ["default", "msdev"] then + msgStyle := p + else + raise Arg.Bad ("Unknown message style " ^ p) +; + +fun orthodox () = currentCompliance := Orthodox; +fun conservative () = currentCompliance := Conservative; +fun liberal () = currentCompliance := Liberal; + +fun main () = +( + let in + perv_set "default"; + load_path := []; + toplevel := true; + (* Choose the default (value polymorphism or imperative types) here: *) + value_polymorphism := true; + (* Choose the default SML compliance checks here *) + currentCompliance := Liberal; + Arg.parse [("-stdlib", Arg.String set_stdlib), + ("-I", Arg.String add_include), + ("-include", Arg.String add_include), + ("-P", Arg.String perv_set), + ("-perv", Arg.String perv_set), + ("-imptypes", Arg.Unit (set_value_polymorphism false)), + ("-valuepoly", Arg.Unit (set_value_polymorphism true)), + ("-quietdec", Arg.Unit (set_quietdec true)), + ("-msgstyle", Arg.String set_msgstyle), + ("-m", Arg.String set_msgstyle), + ("-orthodox", Arg.Unit orthodox), + ("-conservative", Arg.Unit conservative), + ("-liberal", Arg.Unit liberal) + ] + anonymous; + if !Exec_phr.quietdec then () + else + (msgIBlock 0; + msgString ("Moscow ML version "^Config.version); + msgEOL(); + msgString "Enter `quit();' to quit."; + msgEOL(); + msgEBlock(); + msgFlush()); + if !path_library <> "" then + load_path := !load_path @ [!path_library] + else (); + resetGlobalDynEnv(); + resetSMLTopDynEnv(); + initPervasiveEnvironments(); + setGlobalVal 16 (Obj.repr true); (* 16: cf ../runtime/globals.h *) + startCompilingUnit "Top" "" TOPDECmode; + app evalLoad (!preloadedUnits); + initInitialEnvironments []; + execToplevelOpen nilLocation "Meta"; + resetTypePrinter(); (* cvr *) + Miscsys.catch_interrupt true; + input_lexbuf := Compiler.createLexerStream std_in; + (initial_loop() handle EndOfFile => ()); + main_loop() + end + handle + Toplevel => + (msgFlush(); BasicIO.exit 2) + | Impossible msg => + (msgIBlock 0; + errPrompt "Internal error: "; msgString msg; + msgEOL(); msgEBlock(); msgFlush(); + BasicIO.exit 4) +); + +val () = Printexc.f main (); + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Makefile mosml-2.10.1/src/compiler.cminusminus/Makefile --- mosml-2.01/src/compiler.cminusminus/Makefile 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Makefile 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,290 @@ +# Unix Makefile for Moscow ML compiler + +COMPFLAGS= +# Option `-g' exports the exception table for mosmltop to read: +LINKFLAGS=-g -noheader + +include ../Makefile.inc + +COMP_OBJS = \ + Miscsys.uo Printexc.uo Filename.uo Fnlib.uo Sort.uo Stack.uo \ + Arg.uo Hasht.uo Memory.uo Config.uo Mixture.uo \ + Const.uo Prim.uo Instruct.uo \ + Lambda.uo Smlprim.uo Globals.uo Location.uo \ + Units.uo Types.uo Smlexc.uo Smlperv.uo Asynt.uo Asyntfn.uo \ + Parser.uo Lexer.uo Primdec.uo Infixst.uo Ovlres.uo \ + Synchk.uo Infixres.uo Elab.uo Tr_env.uo Pr_lam.uo \ + Match.uo Front.uo Back.uo Pr_zam.uo \ + Opcodes.uo Prim_opc.uo Buffcode.uo Labels.uo Code_dec.uo Reloc.uo \ + CmmAST.uo Wpp.uo CmmPrint.uo CmmEmitcode.uo Emit_phr.uo Sigmtch.uo Compiler.uo + +C_LIBOBJS= \ + List.uo Strbase.uo Char.uo String.uo BasicIO.uo TextIO.uo \ + Vector.uo Array.uo Misc.uo \ + StringCvt.uo Word.uo Word8.uo Word8Vector.uo CharVector.uo \ + Word8Array.uo CharArray.uo Obj.uo Nonstdio.uo \ + Lexing.uo Parsing.uo PP.uo + +C_OBJS= \ + Mainc.uo + +L_LIBOBJS= \ + List.uo Strbase.uo Char.uo String.uo BasicIO.uo TextIO.uo \ + Vector.uo Array.uo Misc.uo \ + StringCvt.uo Word.uo Word8.uo Word8Vector.uo CharVector.uo \ + Word8Array.uo CharArray.uo Obj.uo Nonstdio.uo PP.uo + +L_OBJS= \ + Miscsys.uo Printexc.uo Filename.uo \ + Fnlib.uo Arg.uo Hasht.uo Config.uo Mixture.uo Const.uo \ + Opcodes.uo Code_dec.uo \ + Predef.uo Prim_c.uo Symtable.uo Patch.uo Tr_const.uo \ + Link.uo Readword.uo Mainl.uo + +T_LIBOBJS= \ + List.uo Strbase.uo Char.uo String.uo BasicIO.uo TextIO.uo \ + Vector.uo Array.uo Misc.uo \ + StringCvt.uo Word.uo Word8.uo Word8Vector.uo CharVector.uo \ + Word8Array.uo CharArray.uo Obj.uo Nonstdio.uo \ + Substring.uo Path.uo Time.uo OS.uo FileSys.uo \ + Lexing.uo Parsing.uo PP.uo + +T_OBJS= \ + Predef.uo Prim_c.uo Symtable.uo Patch.uo Tr_const.uo \ + Rtvals.uo Load_phr.uo Exec_phr.uo Smltop.uo Maint.uo + +all: mosmlcmmc + +dos: mosmlcmp.dos mosmllnk.dos mosmltop.dos + +w32: mosmlcmp.w32 mosmllnk.w32 mosmltop.w32 + echo 'Remember to set the CPP for win32 in Makefile.inc' + +mosmlcmmc: $(COMP_OBJS) $(C_OBJS) + $(MOSMLL) $(LINKFLAGS) -o mosmlcmmc Mainc.uo + +mosmlcmp.dos: $(COMP_OBJS) $(C_OBJS) + $(MOSMLLDOS) $(LINKFLAGS) -o mosmlcmp Mainc.uo + +mosmlcmp.w32: $(COMP_OBJS) $(C_OBJS) + $(MOSMLL) $(LINKFLAGS) -o mosmlcmp.w32 Mainc.uo + +Opcodes.sml: $(CAMLRT)/instruct.h + $(PERL) $(MOSMLTOOLS)/mksmlopc $(CAMLRT)/instruct.h > Opcodes.sml + +Parser.sml Parser.sig: Parser.grm + $(MOSMLYACC) Parser.grm + +mosmllnk: $(L_OBJS) + $(MOSMLL) $(LINKFLAGS) -o mosmllnk Mainl.uo + +mosmllnk.dos: $(L_OBJS) + $(MOSMLLDOS) $(LINKFLAGS) -o mosmllnk Mainl.uo + +mosmllnk.w32: $(L_OBJS) + $(MOSMLL) $(LINKFLAGS) -o mosmllnk.w32 Mainl.uo + +Predef.sml : $(CAMLRT)/globals.h + $(PERL) $(MOSMLTOOLS)/mksmlpre $(CAMLRT)/globals.h > Predef.sml + +Prim_c.sml : $(CAMLRT)/primitives + $(PERL) $(MOSMLTOOLS)/mksmlprc $(CAMLRT)/primitives > Prim_c.sml + +mosmltop: $(COMP_OBJS) $(T_OBJS) + $(MOSMLL) $(LINKFLAGS) -o mosmltop Maint.uo + +mosmltop.dos: $(COMP_OBJS) $(T_OBJS) + $(MOSMLLDOS) $(LINKFLAGS) -o mosmltop Maint.uo + +mosmltop.w32: $(COMP_OBJS) $(T_OBJS) + $(MOSMLL) $(LINKFLAGS) -o mosmltop.w32 Maint.uo + +clean: + rm -f mosmlcmmc + rm -f mosmllnk + rm -f mosmltop + rm -f *.ui + rm -f *.uo + rm -f Opcodes.sml + rm -f Parser.sml + rm -f Parser.sig + rm -f Parser.output + rm -f Lexer.sml + rm -f Config.sml + rm -f Filename.sml + rm -f Predef.sml + rm -f Prim_c.sml + rm -f Makefile.bak + +install: + ${INSTALL_DATA} mosmlcmmc $(LIBDIR) + ${INSTALL_DATA} mosmlc-- $(BINDIR) + +promote: + test -f ../mosmlcmmc.orig || cp ../mosmlcmmc ../mosmlcmmc.orig + #test -f ../mosmllnk.orig || cp ../mosmllnk ../mosmllnk.orig + #test -f ../mosmllex.orig || cp ../mosmllex ../mosmllex.orig + #$(MOSMLL) $(LINKFLAGS) -o mosmlcmp $(C_LIBOBJS) $(COMP_OBJS) $(C_OBJS) + #$(MOSMLL) $(LINKFLAGS) -o mosmllnk $(L_LIBOBJS) $(L_OBJS) + #$(MOSMLL) $(LINKFLAGS) -o mosmltop $(T_LIBOBJS) $(T_OBJS) + #test -f mosmllnk && cp mosmllnk ../mosmllnk + test -f mosmlcmmc && cp mosmlcmmc ../mosmlcmmc + #test -f ../lex/mosmllex && cp ../lex/mosmllex ../mosmllex + +revert: + test -f ../mosmlcmmc.orig && (rm ../mosmlcmp;mv ../mosmlcmp.orig ../mosmlcmp) + #test -f ../mosmllnk.orig && (rm ../mosmllnk;mv ../mosmllnk.orig ../mosmllnk) + #test -f ../mosmllex.orig && (rm ../mosmllex;mv ../mosmllex.orig ../mosmllex) + #test -f ../mosmllib/Callback.sml.orig && (rm ../mosmllib/Callback.sml;mv ../mosmllib/Callback.sml.orig ../mosmllib/Callback.sml) + +depend: Filename.sml Config.sml Opcodes.sml Parser.sml Parser.sig Lexer.sml \ + Predef.sml Prim_c.sml + rm -f Makefile.bak + mv Makefile Makefile.bak + $(MOSMLCUT) < Makefile.bak > Makefile + $(MOSMLDEP) >> Makefile + +regress: + echo "building current lib" + cd ../mosmllib; make -s current + echo "testing current lib" + cd ../mosmllib/test; make -s current || echo "results differ" + echo "testing current test" + cd ../test; make -s current || echo "results differ" + echo "testing current compiler test" + cd test; make -s current || echo "results differ" + +### DO NOT DELETE THIS LINE +Wpp.uo: Wpp.ui +CmmEmitcode.uo: Mixture.ui Instruct.uo Prim.uo CmmAST.uo Pr_zam.uo Fnlib.ui \ + Const.uo +CmmBack.uo: Sort.ui Pr_lam.ui Stack.ui CmmAST.uo Lambda.uo +CmmPrint.uo: CmmPrint.ui Wpp.ui CmmAST.uo +CmmPrint.ui: Wpp.ui CmmAST.uo +Predef.uo: Const.uo +Lexer.uo: Lexer.ui Parser.ui Const.uo Fnlib.ui Config.uo Stack.ui \ + Mixture.ui Hasht.ui Memory.uo +Parser.ui: Asynt.uo Const.uo +Parser.uo: Parser.ui Asynt.uo Const.uo Fnlib.ui Config.uo Types.ui \ + Asyntfn.ui Globals.uo Location.ui Mixture.ui +Config.uo: Fnlib.ui +Filename.uo: Filename.ui +Units.uo: Units.ui Const.uo Fnlib.ui Config.uo Globals.uo Location.ui \ + Mixture.ui Hasht.ui Filename.ui +Units.ui: Const.uo Fnlib.ui Globals.uo Location.ui Mixture.ui Hasht.ui +Types.uo: Types.ui Const.uo Fnlib.ui Config.uo Globals.uo Smlprim.uo \ + Location.ui Mixture.ui Units.ui Hasht.ui +Types.ui: Const.uo Fnlib.ui Globals.uo Smlprim.uo Location.ui Mixture.ui \ + Units.ui +Tr_env.uo: Tr_env.ui Asynt.uo Const.uo Fnlib.ui Prim.uo Types.ui Asyntfn.ui \ + Globals.uo Mixture.ui Units.ui Hasht.ui Lambda.uo +Tr_env.ui: Asynt.uo Const.uo Mixture.ui Lambda.uo +Tr_const.uo: Const.uo Symtable.ui +Synchk.uo: Synchk.ui Asynt.uo Const.uo Fnlib.ui Asyntfn.ui Globals.uo \ + Location.ui Mixture.ui Units.ui +Synchk.ui: Asynt.uo +Symtable.uo: Symtable.ui Const.uo Fnlib.ui Config.uo Predef.uo Prim_c.uo \ + Mixture.ui Hasht.ui Miscsys.ui +Symtable.ui: Const.uo +Stack.uo: Stack.ui +Sort.uo: Sort.ui +Smltop.uo: Smltop.ui Compiler.ui Const.uo Fnlib.ui Patch.uo Emit_phr.uo \ + Rtvals.ui Config.uo Code_dec.uo Lexer.ui Types.ui Globals.uo Smlprim.uo \ + Smlexc.uo Smlperv.ui Opcodes.uo Location.ui Symtable.ui Emitcode.ui \ + Mixture.ui Units.ui Load_phr.ui Hasht.ui Miscsys.ui Memory.uo \ + Filename.ui Exec_phr.ui +Smlprim.uo: Const.uo Prim.uo +Smlperv.uo: Smlperv.ui Const.uo Fnlib.ui Prim.uo Types.ui Globals.uo \ + Smlprim.uo Smlexc.uo Units.ui Hasht.ui +Smlexc.uo: Const.uo Fnlib.ui Config.uo Types.ui Mixture.ui +Sigmtch.uo: Sigmtch.ui Front.ui Const.uo Back.ui Fnlib.ui Emit_phr.uo \ + Prim.uo Types.ui Globals.uo Mixture.ui Units.ui Hasht.ui Lambda.uo +Sigmtch.ui: Units.ui +Rtvals.uo: Rtvals.ui Const.uo Fnlib.ui Config.uo Types.ui Globals.uo \ + Smlexc.uo Symtable.ui Mixture.ui Units.ui Miscsys.ui Memory.uo +Rtvals.ui: Const.uo Types.ui Globals.uo +Reloc.uo: Const.uo Buffcode.uo Code_dec.uo Hasht.ui +Printexc.uo: Printexc.ui +Primdec.uo: Const.uo Fnlib.ui Prim.uo Smlprim.uo +Prim_opc.uo: Fnlib.ui Prim.uo Opcodes.uo +Prim.uo: Const.uo +Pr_zam.uo: Asynt.uo Const.uo Fnlib.ui Config.uo Pr_lam.ui Instruct.uo \ + Mixture.ui +Pr_lam.uo: Pr_lam.ui Asynt.uo Const.uo Prim.uo Mixture.ui Lambda.uo +Pr_lam.ui: Prim.uo Lambda.uo +Patch.uo: Code_dec.uo Symtable.ui +Ovlres.uo: Ovlres.ui Asynt.uo Const.uo Fnlib.ui Prim.uo Types.ui Globals.uo \ + Smlprim.uo Location.ui Mixture.ui Units.ui +Ovlres.ui: Asynt.uo +Mixture.uo: Mixture.ui Fnlib.ui Config.uo Hasht.ui Miscsys.ui Filename.ui +Mixture.ui: Hasht.ui +Miscsys.uo: Miscsys.ui +Match.uo: Match.ui Asynt.uo Const.uo Fnlib.ui Prim.uo Asyntfn.ui Tr_env.ui \ + Location.ui Mixture.ui Hasht.ui Lambda.uo +Match.ui: Asynt.uo Tr_env.ui Location.ui Lambda.uo +Maint.uo: Maint.ui Compiler.ui Fnlib.ui Rtvals.ui Config.uo Types.ui Arg.ui \ + Printexc.ui Smlperv.ui Location.ui Smltop.ui Mixture.ui Units.ui \ + Miscsys.ui Memory.uo Exec_phr.ui +Mainl.uo: Fnlib.ui Config.uo Arg.ui Printexc.ui Link.ui Symtable.ui \ + Readword.uo Mixture.ui Miscsys.ui Filename.ui +Mainc.uo: Mainc.ui Compiler.ui Fnlib.ui Config.uo Lexer.ui Types.ui Arg.ui \ + Printexc.ui Smlperv.ui Location.ui Mixture.ui Units.ui Miscsys.ui \ + Filename.ui +Location.uo: Location.ui Fnlib.ui Config.uo Mixture.ui +Load_phr.uo: Load_phr.ui Const.uo Reloc.uo Fnlib.ui Buffcode.uo Patch.uo \ + Rtvals.ui Types.ui Opcodes.uo Symtable.ui Labels.uo Emitcode.ui \ + Instruct.uo Tr_const.uo Mixture.ui Memory.uo +Load_phr.ui: Instruct.uo +Link.uo: Link.ui Const.uo Fnlib.ui Patch.uo Config.uo Code_dec.uo \ + Opcodes.uo Symtable.ui Tr_const.uo Mixture.ui Hasht.ui Miscsys.ui \ + Filename.ui +Lexer.ui: Parser.ui +Lambda.uo: Const.uo Prim.uo Instruct.uo +Labels.uo: Fnlib.ui Buffcode.uo Instruct.uo +Instruct.uo: Const.uo Config.uo Prim.uo +Infixst.uo: Infixst.ui Asynt.uo Const.uo Fnlib.ui Globals.uo Location.ui \ + Mixture.ui +Infixst.ui: Asynt.uo Fnlib.ui Globals.uo Location.ui Mixture.ui +Infixres.uo: Infixres.ui Asynt.uo Primdec.uo Const.uo Fnlib.ui Infixst.ui \ + Types.ui Asyntfn.ui Globals.uo Smlprim.uo Smlexc.uo Location.ui \ + Mixture.ui Units.ui +Infixres.ui: Asynt.uo Globals.uo +Hasht.uo: Hasht.ui +Globals.uo: Const.uo Fnlib.ui Smlprim.uo Mixture.ui +Front.uo: Front.ui Asynt.uo Const.uo Fnlib.ui Config.uo Prim.uo Types.ui \ + Asyntfn.ui Globals.uo Smlprim.uo Smlexc.uo Tr_env.ui Location.ui \ + Match.ui Mixture.ui Units.ui Lambda.uo +Front.ui: Asynt.uo Globals.uo Smlprim.uo Tr_env.ui Lambda.uo +Fnlib.uo: Fnlib.ui +Exec_phr.uo: Exec_phr.ui Asynt.uo Front.ui Compiler.ui Const.uo Back.ui \ + Fnlib.ui Pr_zam.uo Infixst.ui Elab.ui Rtvals.ui Types.ui Ovlres.ui \ + Globals.uo Tr_env.ui Symtable.ui Mixture.ui Units.ui Load_phr.ui \ + Infixres.ui Miscsys.ui +Exec_phr.ui: Asynt.uo +Emitcode.uo: Emitcode.ui Const.uo Reloc.uo Fnlib.ui Buffcode.uo Config.uo \ + Prim.uo Opcodes.uo Labels.uo Instruct.uo Mixture.ui Prim_opc.uo +Emitcode.ui: Instruct.uo +Emit_phr.uo: CmmPrint.ui Code_dec.uo Wpp.ui Instruct.uo CmmAST.uo \ + CmmEmitcode.uo +Elab.uo: Elab.ui Asynt.uo Primdec.uo Sort.ui Synchk.ui Const.uo Fnlib.ui \ + Config.uo Types.ui Asyntfn.ui Globals.uo Smlprim.uo Smlexc.uo \ + Location.ui Mixture.ui Units.ui +Elab.ui: Asynt.uo Globals.uo +Const.uo: Fnlib.ui Config.uo Mixture.ui +Compiler.uo: Compiler.ui Asynt.uo Front.ui Parser.ui Const.uo Back.ui \ + Fnlib.ui Pr_zam.uo Elab.ui Emit_phr.uo Lexer.ui Config.uo Sigmtch.ui \ + Types.ui Ovlres.ui Globals.uo Smlperv.ui Tr_env.ui Location.ui \ + Mixture.ui Units.ui Infixres.ui Hasht.ui +Compiler.ui: Asynt.uo Globals.uo Mixture.ui +Code_dec.uo: Const.uo Mixture.ui Hasht.ui +Buffcode.uo: Fnlib.ui Config.uo Opcodes.uo Mixture.ui +Back.uo: Back.ui Sort.ui Const.uo Fnlib.ui Prim.uo Instruct.uo Stack.ui \ + Mixture.ui Lambda.uo +Back.ui: Instruct.uo Lambda.uo +Asyntfn.uo: Asyntfn.ui Asynt.uo Const.uo Fnlib.ui Types.ui Globals.uo \ + Location.ui Mixture.ui +Asyntfn.ui: Asynt.uo Const.uo Fnlib.ui Types.ui Globals.uo Location.ui \ + Mixture.ui +Arg.uo: Arg.ui Fnlib.ui Miscsys.ui +Asynt.uo: Const.uo Fnlib.ui Types.ui Globals.uo Location.ui Mixture.ui \ + Lambda.uo diff -Nru mosml-2.01/src/compiler.cminusminus/makefile.dos mosml-2.10.1/src/compiler.cminusminus/makefile.dos --- mosml-2.01/src/compiler.cminusminus/makefile.dos 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/makefile.dos 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,245 @@ +# DOS Makefile for Moscow ML compiler + +COMPFLAGS= +LINKFLAGS=-g -noheader + +!include "..\makefile.inc" + +COMP_OBJS = \ + miscsys.uo printexc.uo filename.uo fnlib.uo sort.uo stack.uo \ + arg.uo hasht.uo memory.uo config.uo mixture.uo \ + const.uo prim.uo instruct.uo \ + lambda.uo smlprim.uo globals.uo location.uo \ + units.uo types.uo smlexc.uo smlperv.uo asynt.uo asyntfn.uo \ + parser.uo lexer.uo primdec.uo infixst.uo ovlres.uo \ + synchk.uo infixres.uo elab.uo tr_env.uo pr_lam.uo \ + match.uo front.uo back.uo pr_zam.uo \ + opcodes.uo prim_opc.uo buffcode.uo labels.uo code_dec.uo reloc.uo \ + emitcode.uo emit_phr.uo sigmtch.uo compiler.uo + +C_LIBOBJS= \ + list.uo strbase.uo char.uo string.uo basicio.uo textio.uo \ + vector.uo array.uo misc.uo \ + stringcvt.uo word.uo word8.uo word8vec.uo charvect.uo \ + word8arr.uo chararra.uo obj.uo nonstdio.uo \ + lexing.uo parsing.uo pp.uo + +C_OBJS= \ + mainc.uo + +L_LIBOBJS = \ + list.uo strbase.uo char.uo string.uo basicio.uo textio.uo \ + vector.uo array.uo misc.uo \ + stringcvt.uo word.uo word8.uo word8vec.uo charvect.uo \ + word8arr.uo chararra.uo obj.uo nonstdio.uo pp.uo + +L_OBJS= \ + miscsys.uo printexc.uo filename.uo \ + fnlib.uo arg.uo hasht.uo config.uo mixture.uo const.uo \ + opcodes.uo code_dec.uo \ + predef.uo prim_c.uo symtable.uo patch.uo tr_const.uo \ + link.uo readword.uo mainl.uo + +T_LIBOBJS= \ + list.uo strbase.uo char.uo string.uo basicio.uo textio.uo \ + vector.uo array.uo misc.uo \ + stringcvt.uo word.uo word8.uo word8vec.uo charvect.uo \ + word8arr.uo chararra.uo obj.uo nonstdio.uo \ + substrin.uo path.uo time.uo os.uo filesys.uo \ + lexing.uo parsing.uo pp.uo + +T_OBJS= \ + predef.uo prim_c.uo symtable.uo patch.uo tr_const.uo \ + rtvals.uo load_phr.uo exec_phr.uo smltop.uo maint.uo + +all: mosmlcmp mosmllnk mosmltop + +mosmlcmp: $(COMP_OBJS) $(C_OBJS) + $(MOSMLL) $(LINKFLAGS) -o mosmlcmp -files &&| +$(C_LIBOBJS) +$(COMP_OBJS) +$(C_OBJS) +| + +opcodes.sml: $(CAMLRT)\instruct.h + perl $(MOSMLTOOLS)\mksmlopc $(CAMLRT)\instruct.h > opcodes.sml + +parser.sml parser.sig: parser.grm + $(MOSMLYACC) parser.grm + +mosmllnk: $(L_OBJS) + $(MOSMLL) $(LINKFLAGS) -o mosmllnk -files &&| +$(L_LIBOBJS) +$(L_OBJS) +| + +predef.sml : $(CAMLRT)\globals.h $(CAMLRT)\fail.h + perl $(MOSMLTOOLS)\mksmlpre $(CAMLRT)\globals.h $(CAMLRT)\fail.h > predef.sml + +prim_c.sml : $(CAMLRT)\prims + perl $(MOSMLTOOLS)\mksmlprc $(CAMLRT)\prims > prim_c.sml + +mosmltop: $(COMP_OBJS) $(T_OBJS) + $(MOSMLL) $(LINKFLAGS) -o mosmltop -files &&| +$(T_LIBOBJS) +$(COMP_OBJS) +$(T_OBJS) +| + +clean: + del *.exe + del mosmlcmp + del mosmllnk + del mosmltop + del *.ui + del *.uo + del opcodes.sml + del parser.sml + del parser.sig + del lexer.sml + del config.sml + del filename.sml + del predef.sml + del prim_c.sml + del makefile.bak + +install: + copy /b mosmlcmp $(LIBDIR) + copy /b mosmllnk $(LIBDIR) + copy /b mosmltop $(LIBDIR) + +depend: filename.sml config.sml opcodes.sml parser.sml parser.sig lexer.sml \ + predef.sml prim_c.sml + del makefile.bak + ren makefile makefile.bak + $(MOSMLCUT) < makefile.bak > makefile + $(MOSMLDEP) >> makefile + +### DO NOT DELETE THIS LINE +predef.uo: const.uo +lexer.uo: lexer.ui parser.ui const.uo fnlib.ui config.uo stack.ui \ + mixture.ui hasht.ui memory.uo +parser.ui: asynt.uo const.uo +parser.uo: parser.ui asynt.uo const.uo fnlib.ui config.uo types.ui \ + asyntfn.ui globals.uo location.ui mixture.ui +config.uo: fnlib.ui +filename.uo: filename.ui +lexer.ui: parser.ui +units.uo: units.ui const.uo fnlib.ui config.uo globals.uo location.ui \ + mixture.ui hasht.ui +types.uo: types.ui const.uo fnlib.ui globals.uo smlprim.uo location.ui \ + mixture.ui units.ui +tr_env.uo: tr_env.ui asynt.uo const.uo fnlib.ui prim.uo types.ui asyntfn.ui \ + globals.uo mixture.ui units.ui hasht.ui lambda.uo +tr_const.uo: const.uo symtable.ui +synchk.uo: synchk.ui asynt.uo const.uo fnlib.ui asyntfn.ui globals.uo \ + location.ui mixture.ui units.ui +symtable.uo: symtable.ui const.uo fnlib.ui config.uo predef.uo prim_c.uo \ + mixture.ui hasht.ui miscsys.ui +stack.uo: stack.ui +sort.uo: sort.ui +smltop.uo: smltop.ui compiler.ui const.uo fnlib.ui patch.uo emit_phr.uo \ + rtvals.ui config.uo code_dec.uo lexer.ui types.ui globals.uo smlprim.uo \ + smlexc.uo smlperv.ui opcodes.uo location.ui symtable.ui emitcode.ui \ + mixture.ui units.ui load_phr.ui hasht.ui miscsys.ui memory.uo \ + filename.ui exec_phr.ui +smlprim.uo: const.uo prim.uo +smlperv.uo: smlperv.ui const.uo fnlib.ui prim.uo types.ui globals.uo \ + smlprim.uo smlexc.uo units.ui hasht.ui +smlexc.uo: const.uo config.uo types.ui mixture.ui +sigmtch.uo: sigmtch.ui front.ui const.uo back.ui fnlib.ui emit_phr.uo \ + prim.uo types.ui globals.uo mixture.ui units.ui hasht.ui lambda.uo +rtvals.uo: rtvals.ui const.uo fnlib.ui config.uo types.ui globals.uo \ + smlexc.uo symtable.ui location.ui mixture.ui units.ui miscsys.ui \ + memory.uo +reloc.uo: const.uo buffcode.uo code_dec.uo +pr_zam.uo: asynt.uo const.uo fnlib.ui config.uo pr_lam.ui instruct.uo \ + mixture.ui +pr_lam.uo: pr_lam.ui asynt.uo const.uo prim.uo mixture.ui lambda.uo +printexc.uo: printexc.ui miscsys.ui +prim_opc.uo: fnlib.ui prim.uo opcodes.uo +primdec.uo: const.uo fnlib.ui prim.uo smlprim.uo +prim.uo: const.uo +patch.uo: code_dec.uo symtable.ui +ovlres.uo: ovlres.ui asynt.uo const.uo fnlib.ui prim.uo types.ui globals.uo \ + smlprim.uo location.ui mixture.ui units.ui +mixture.uo: mixture.ui fnlib.ui config.uo hasht.ui miscsys.ui filename.ui +miscsys.uo: miscsys.ui +match.uo: match.ui asynt.uo const.uo fnlib.ui prim.uo types.ui asyntfn.ui \ + globals.uo smlexc.uo tr_env.ui location.ui mixture.ui hasht.ui \ + lambda.uo +maint.uo: maint.ui compiler.ui fnlib.ui rtvals.ui config.uo arg.ui \ + printexc.ui smlperv.ui location.ui smltop.ui mixture.ui units.ui \ + miscsys.ui memory.uo +mainl.uo: fnlib.ui config.uo arg.ui printexc.ui link.ui symtable.ui \ + readword.uo mixture.ui miscsys.ui filename.ui +mainc.uo: mainc.ui compiler.ui fnlib.ui config.uo lexer.ui arg.ui \ + printexc.ui smlperv.ui location.ui mixture.ui units.ui miscsys.ui \ + filename.ui +location.uo: location.ui fnlib.ui config.uo mixture.ui +load_phr.uo: load_phr.ui const.uo reloc.uo fnlib.ui buffcode.uo patch.uo \ + rtvals.ui types.ui opcodes.uo symtable.ui labels.uo emitcode.ui \ + instruct.uo tr_const.uo mixture.ui memory.uo +link.uo: link.ui const.uo fnlib.ui patch.uo config.uo code_dec.uo \ + opcodes.uo symtable.ui tr_const.uo mixture.ui hasht.ui miscsys.ui \ + filename.ui +lambda.uo: const.uo prim.uo instruct.uo +labels.uo: fnlib.ui buffcode.uo instruct.uo +instruct.uo: const.uo config.uo prim.uo +infixst.uo: infixst.ui asynt.uo const.uo fnlib.ui globals.uo location.ui \ + mixture.ui +infixres.uo: infixres.ui asynt.uo primdec.uo synchk.ui const.uo fnlib.ui \ + infixst.ui types.ui asyntfn.ui globals.uo smlprim.uo smlexc.uo \ + location.ui mixture.ui units.ui +hasht.uo: hasht.ui +globals.uo: const.uo fnlib.ui smlprim.uo mixture.ui +front.uo: front.ui asynt.uo const.uo fnlib.ui config.uo prim.uo types.ui \ + asyntfn.ui globals.uo smlprim.uo smlexc.uo tr_env.ui location.ui \ + match.ui mixture.ui units.ui lambda.uo +fnlib.uo: fnlib.ui +exec_phr.uo: exec_phr.ui asynt.uo front.ui compiler.ui back.ui fnlib.ui \ + pr_zam.uo infixst.ui elab.ui rtvals.ui types.ui ovlres.ui globals.uo \ + tr_env.ui symtable.ui mixture.ui units.ui load_phr.ui infixres.ui \ + miscsys.ui +emit_phr.uo: const.uo reloc.uo buffcode.uo code_dec.uo labels.uo \ + emitcode.ui instruct.uo mixture.ui +emitcode.uo: emitcode.ui const.uo reloc.uo fnlib.ui buffcode.uo config.uo \ + prim.uo opcodes.uo labels.uo instruct.uo mixture.ui prim_opc.uo +elab.uo: elab.ui asynt.uo const.uo fnlib.ui config.uo types.ui asyntfn.ui \ + globals.uo smlexc.uo location.ui mixture.ui units.ui +const.uo: fnlib.ui config.uo mixture.ui +compiler.uo: compiler.ui asynt.uo front.ui parser.ui const.uo back.ui \ + fnlib.ui pr_zam.uo elab.ui emit_phr.uo lexer.ui sigmtch.ui types.ui \ + ovlres.ui globals.uo smlperv.ui tr_env.ui location.ui mixture.ui \ + units.ui infixres.ui hasht.ui +code_dec.uo: const.uo mixture.ui hasht.ui +buffcode.uo: fnlib.ui config.uo opcodes.uo mixture.ui +back.uo: back.ui sort.ui const.uo fnlib.ui prim.uo instruct.uo stack.ui \ + mixture.ui lambda.uo +asyntfn.uo: asyntfn.ui asynt.uo const.uo fnlib.ui types.ui globals.uo \ + location.ui mixture.ui +asynt.uo: const.uo fnlib.ui types.ui globals.uo location.ui mixture.ui +arg.uo: arg.ui fnlib.ui miscsys.ui +units.ui: const.uo fnlib.ui globals.uo location.ui mixture.ui hasht.ui +types.ui: const.uo fnlib.ui globals.uo smlprim.uo location.ui mixture.ui \ + units.ui +tr_env.ui: asynt.uo const.uo mixture.ui lambda.uo +synchk.ui: asynt.uo +symtable.ui: const.uo +sigmtch.ui: units.ui +rtvals.ui: const.uo types.ui globals.uo +pr_lam.ui: prim.uo lambda.uo +ovlres.ui: asynt.uo +mixture.ui: hasht.ui +match.ui: asynt.uo tr_env.ui location.ui lambda.uo +load_phr.ui: instruct.uo +infixst.ui: asynt.uo fnlib.ui globals.uo location.ui mixture.ui +infixres.ui: asynt.uo globals.uo +front.ui: asynt.uo globals.uo smlprim.uo tr_env.ui lambda.uo +exec_phr.ui: asynt.uo +emitcode.ui: instruct.uo +elab.ui: asynt.uo globals.uo +compiler.ui: asynt.uo globals.uo mixture.ui +back.ui: instruct.uo lambda.uo +asyntfn.ui: asynt.uo const.uo fnlib.ui types.ui globals.uo location.ui \ + mixture.ui diff -Nru mosml-2.01/src/compiler.cminusminus/Makefile.w32 mosml-2.10.1/src/compiler.cminusminus/Makefile.w32 --- mosml-2.01/src/compiler.cminusminus/Makefile.w32 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Makefile.w32 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,257 @@ +# Win32 Makefile for Moscow ML compiler + +COMPFLAGS= +LINKFLAGS=-g -noheader + +!include ..\Makedefs.w32 + +COMP_OBJS = \ + Miscsys.uo Printexc.uo Filename.uo Fnlib.uo Sort.uo Stack.uo \ + Arg.uo Hasht.uo Memory.uo Config.uo Mixture.uo \ + Const.uo Prim.uo Instruct.uo \ + Lambda.uo Smlprim.uo Globals.uo Location.uo \ + Units.uo Types.uo Smlexc.uo Smlperv.uo Asynt.uo Asyntfn.uo \ + Parser.uo Lexer.uo Primdec.uo Infixst.uo Ovlres.uo \ + Synchk.uo Infixres.uo Elab.uo Tr_env.uo Pr_lam.uo \ + Match.uo Front.uo Back.uo Pr_zam.uo \ + Opcodes.uo Prim_opc.uo Buffcode.uo Labels.uo Code_dec.uo Reloc.uo \ + Emitcode.uo Emit_phr.uo Sigmtch.uo Compiler.uo + +C_LIBOBJS= \ + List.uo Strbase.uo Char.uo String.uo BasicIO.uo TextIO.uo \ + Vector.uo Array.uo Misc.uo \ + StringCvt.uo Word.uo Word8.uo Word8Vector.uo CharVector.uo \ + Word8Array.uo CharArray.uo Obj.uo Nonstdio.uo \ + Lexing.uo Parsing.uo PP.uo + +C_OBJS= \ + Mainc.uo + +L_LIBOBJS= \ + List.uo Strbase.uo Char.uo String.uo BasicIO.uo TextIO.uo \ + Vector.uo Array.uo Misc.uo \ + StringCvt.uo Word.uo Word8.uo Word8Vector.uo CharVector.uo \ + Word8Array.uo CharArray.uo Obj.uo Nonstdio.uo PP.uo + +L_OBJS= \ + Miscsys.uo Printexc.uo Filename.uo \ + Fnlib.uo Arg.uo Hasht.uo Config.uo Mixture.uo Const.uo \ + Opcodes.uo Code_dec.uo \ + Predef.uo Prim_c.uo Symtable.uo Patch.uo Tr_const.uo \ + Link.uo Readword.uo Mainl.uo + +T_LIBOBJS= \ + List.uo Strbase.uo Char.uo String.uo BasicIO.uo TextIO.uo \ + Vector.uo Array.uo Misc.uo \ + StringCvt.uo Word.uo Word8.uo Word8Vector.uo CharVector.uo \ + Word8Array.uo CharArray.uo Obj.uo Nonstdio.uo \ + Substring.uo Path.uo Time.uo OS.uo FileSys.uo \ + Lexing.uo Parsing.uo PP.uo + +T_OBJS= \ + Predef.uo Prim_c.uo Symtable.uo Patch.uo Tr_const.uo \ + Rtvals.uo Load_phr.uo Exec_phr.uo Smltop.uo Maint.uo + +all: mosmlcmp mosmllnk mosmltop + +dos: mosmlcmp.dos mosmllnk.dos mosmltop.dos + +mosmlcmp: $(COMP_OBJS) $(C_OBJS) + $(MOSMLL) $(LINKFLAGS) -o mosmlcmp Mainc.uo + +#mosmlcmp.dos: $(COMP_OBJS) $(C_OBJS) +# $(MOSMLLDOS) $(LINKFLAGS) -o mosmlcmp $(C_LIBOBJS) $(COMP_OBJS) $(C_OBJS) + +Opcodes.sml: $(CAMLRT)\instruct.h + perl $(MOSMLTOOLS)\mksmlopc $(CAMLRT)\instruct.h > Opcodes.sml + +Parser.sml Parser.sig: Parser.grm + $(MOSMLYACC) Parser.grm + +mosmllnk: $(L_OBJS) + $(MOSMLL) $(LINKFLAGS) -o mosmllnk Mainl.uo + +#mosmllnk.dos: $(L_OBJS) +# $(MOSMLLDOS) $(LINKFLAGS) -o mosmllnk $(L_LIBOBJS) $(L_OBJS) + +Predef.sml : $(CAMLRT)\globals.h $(CAMLRT)\fail.h + perl $(MOSMLTOOLS)\mksmlpre $(CAMLRT)\globals.h $(CAMLRT)\fail.h > Predef.sml + +Prim_c.sml : $(CAMLRT)\prims + perl $(MOSMLTOOLS)\mksmlprc $(CAMLRT)\prims > Prim_c.sml + +mosmltop: $(COMP_OBJS) $(T_OBJS) + $(MOSMLL) $(LINKFLAGS) -o mosmltop Maint.uo + +#mosmltop.dos: $(COMP_OBJS) $(T_OBJS) +# $(MOSMLLDOS) $(LINKFLAGS) -o mosmltop \ +# $(T_LIBOBJS) $(COMP_OBJS) $(T_OBJS) + +Lexer.sml: Lexer.lex +Config.sml: Config.mlp +Filename.sml: Filename.mlp + +clean: + -del mosmlcmp + -del mosmllnk + -del mosmltop + -del *.ui + -del *.uo + -del Opcodes.sml + -del Parser.sml + -del Parser.sig + -del Lexer.sml + -del Config.sml + -del Filename.sml + -del Predef.sml + -del Prim_c.sml + -del Makefile.bak + +install: + copy /b mosmlcmp $(LIBDIR) + copy /b mosmllnk $(LIBDIR) + copy /b mosmltop $(LIBDIR) + +depend: Filename.sml Config.sml Opcodes.sml Parser.sml Parser.sig Lexer.sml \ + Predef.sml Prim_c.sml + -del Makefile.bak + ren Makefile Makefile.bak + $(MOSMLCUT) < Makefile.bak > Makefile + $(MOSMLDEP) >> Makefile + +### DO NOT DELETE THIS LINE +Predef.uo: Const.uo +Lexer.uo: Lexer.ui Parser.ui Const.uo Fnlib.ui Config.uo Stack.ui \ + Mixture.ui Hasht.ui Memory.uo +Parser.ui: Asynt.uo Const.uo +Parser.uo: Parser.ui Asynt.uo Const.uo Fnlib.ui Config.uo Types.ui \ + Asyntfn.ui Globals.uo Location.ui Mixture.ui +Config.uo: Fnlib.ui +Filename.uo: Filename.ui +Maine.uo: Maine.ui Compiler.ui Fnlib.ui Smltope.ui Rtvals.ui Config.uo \ + Arg.ui Printexc.ui Smlperv.ui Location.ui Mixture.ui Units.ui \ + Miscsys.ui Memory.uo +Smltope.uo: Smltope.ui Rtvals.ui Emitcode.ui Load_phr.ui Mixture.ui \ + Location.ui Lexer.ui Link.ui Smlperv.ui Filename.ui Emit_phr.uo \ + Symtable.ui Globals.uo Compiler.ui Units.ui Smlprim.uo Opcodes.uo \ + Memory.uo Code_dec.uo Fnlib.ui Hasht.ui Const.uo Types.ui Miscsys.ui \ + Config.uo Exec_phr.ui Patch.uo Smlexc.uo +Printexc.uo: Printexc.ui Miscsys.ui +Infixres.ui: Asynt.uo Globals.uo +Units.ui: Const.uo Fnlib.ui Globals.uo Location.ui Mixture.ui Hasht.ui +Tr_env.ui: Asynt.uo Const.uo Mixture.ui Lambda.uo +Tr_const.uo: Const.uo Symtable.ui +Synchk.ui: Asynt.uo +Types.ui: Const.uo Fnlib.ui Globals.uo Smlprim.uo Location.ui Mixture.ui \ + Units.ui +Symtable.ui: Const.uo +Smlprim.uo: Const.uo Prim.uo +Smlexc.uo: Const.uo Config.uo Types.ui Mixture.ui +Sigmtch.ui: Units.ui +Rtvals.ui: Const.uo Types.ui Globals.uo +Primdec.uo: Const.uo Fnlib.ui Prim.uo Smlprim.uo +Prim_opc.uo: Fnlib.ui Prim.uo Opcodes.uo +Pr_zam.uo: Asynt.uo Const.uo Fnlib.ui Config.uo Pr_lam.ui Instruct.uo \ + Mixture.ui +Pr_lam.ui: Prim.uo Lambda.uo +Ovlres.ui: Asynt.uo +Mixture.ui: Hasht.ui +Match.ui: Asynt.uo Tr_env.ui Location.ui Lambda.uo +Mainl.uo: Fnlib.ui Config.uo Arg.ui Printexc.ui Link.ui Symtable.ui \ + Readword.uo Mixture.ui Miscsys.ui Filename.ui +Load_phr.ui: Instruct.uo +Lexer.ui: Parser.ui +Lambda.uo: Const.uo Prim.uo Instruct.uo +Labels.uo: Fnlib.ui Buffcode.uo Instruct.uo +Instruct.uo: Const.uo Config.uo Prim.uo +Infixst.ui: Asynt.uo Fnlib.ui Globals.uo Location.ui Mixture.ui +Globals.uo: Const.uo Fnlib.ui Smlprim.uo Mixture.ui +Front.ui: Asynt.uo Globals.uo Smlprim.uo Tr_env.ui Lambda.uo +Emitcode.ui: Instruct.uo +Exec_phr.ui: Asynt.uo +Emit_phr.uo: Const.uo Reloc.uo Buffcode.uo Code_dec.uo Labels.uo \ + Emitcode.ui Instruct.uo Mixture.ui +Elab.ui: Asynt.uo Globals.uo +Compiler.ui: Asynt.uo Globals.uo Mixture.ui +Code_dec.uo: Const.uo Mixture.ui Hasht.ui +Buffcode.uo: Fnlib.ui Config.uo Opcodes.uo Mixture.ui +Back.ui: Instruct.uo Lambda.uo +Asyntfn.ui: Asynt.uo Const.uo Fnlib.ui Types.ui Globals.uo Location.ui \ + Mixture.ui +Asynt.uo: Const.uo Fnlib.ui Types.ui Globals.uo Location.ui Mixture.ui +Units.uo: Units.ui Const.uo Fnlib.ui Config.uo Globals.uo Location.ui \ + Mixture.ui Hasht.ui +Types.uo: Types.ui Const.uo Fnlib.ui Globals.uo Smlprim.uo Location.ui \ + Mixture.ui Units.ui +Tr_env.uo: Tr_env.ui Asynt.uo Const.uo Fnlib.ui Prim.uo Types.ui Asyntfn.ui \ + Globals.uo Mixture.ui Units.ui Hasht.ui Lambda.uo +Synchk.uo: Synchk.ui Asynt.uo Const.uo Fnlib.ui Asyntfn.ui Globals.uo \ + Location.ui Mixture.ui Units.ui +Symtable.uo: Symtable.ui Const.uo Fnlib.ui Config.uo Predef.uo Prim_c.uo \ + Mixture.ui Hasht.ui Miscsys.ui +Stack.uo: Stack.ui +Sort.uo: Sort.ui +Smltop.uo: Smltop.ui Compiler.ui Const.uo Fnlib.ui Patch.uo Emit_phr.uo \ + Rtvals.ui Config.uo Code_dec.uo Lexer.ui Types.ui Globals.uo Smlprim.uo \ + Smlexc.uo Smlperv.ui Opcodes.uo Location.ui Symtable.ui Emitcode.ui \ + Mixture.ui Units.ui Load_phr.ui Hasht.ui Miscsys.ui Memory.uo \ + Filename.ui Exec_phr.ui +Smlperv.uo: Smlperv.ui Const.uo Fnlib.ui Prim.uo Types.ui Globals.uo \ + Smlprim.uo Smlexc.uo Units.ui Hasht.ui +Sigmtch.uo: Sigmtch.ui Front.ui Const.uo Back.ui Fnlib.ui Emit_phr.uo \ + Prim.uo Types.ui Globals.uo Mixture.ui Units.ui Hasht.ui Lambda.uo +Rtvals.uo: Rtvals.ui Const.uo Fnlib.ui Config.uo Types.ui Globals.uo \ + Smlexc.uo Symtable.ui Location.ui Mixture.ui Units.ui Miscsys.ui \ + Memory.uo +Prim.uo: Const.uo +Pr_lam.uo: Pr_lam.ui Asynt.uo Const.uo Prim.uo Mixture.ui Lambda.uo +Reloc.uo: Const.uo Buffcode.uo Code_dec.uo +Ovlres.uo: Ovlres.ui Asynt.uo Const.uo Fnlib.ui Prim.uo Types.ui Globals.uo \ + Smlprim.uo Location.ui Mixture.ui Units.ui +Mixture.uo: Mixture.ui Fnlib.ui Config.uo Hasht.ui Miscsys.ui Filename.ui +Miscsys.uo: Miscsys.ui +Match.uo: Match.ui Asynt.uo Const.uo Fnlib.ui Prim.uo Types.ui Asyntfn.ui \ + Globals.uo Smlexc.uo Tr_env.ui Location.ui Mixture.ui Hasht.ui \ + Lambda.uo +Maint.uo: Maint.ui Compiler.ui Fnlib.ui Rtvals.ui Config.uo Arg.ui \ + Printexc.ui Smlperv.ui Location.ui Smltop.ui Mixture.ui Units.ui \ + Miscsys.ui Memory.uo Exec_phr.ui +Mainc.uo: Mainc.ui Compiler.ui Fnlib.ui Config.uo Lexer.ui Arg.ui \ + Printexc.ui Smlperv.ui Location.ui Mixture.ui Units.ui Miscsys.ui \ + Filename.ui +Location.uo: Location.ui Fnlib.ui Config.uo Mixture.ui +Load_phr.uo: Load_phr.ui Const.uo Reloc.uo Fnlib.ui Buffcode.uo Patch.uo \ + Rtvals.ui Types.ui Opcodes.uo Symtable.ui Labels.uo Emitcode.ui \ + Instruct.uo Tr_const.uo Mixture.ui Memory.uo +Link.uo: Link.ui Const.uo Fnlib.ui Patch.uo Config.uo Code_dec.uo \ + Opcodes.uo Symtable.ui Tr_const.uo Mixture.ui Hasht.ui Miscsys.ui \ + Filename.ui +Infixst.uo: Infixst.ui Asynt.uo Const.uo Fnlib.ui Globals.uo Location.ui \ + Mixture.ui +Infixres.uo: Infixres.ui Asynt.uo Primdec.uo Synchk.ui Const.uo Fnlib.ui \ + Infixst.ui Types.ui Asyntfn.ui Globals.uo Smlprim.uo Smlexc.uo \ + Location.ui Mixture.ui Units.ui +Hasht.uo: Hasht.ui +Front.uo: Front.ui Asynt.uo Const.uo Fnlib.ui Config.uo Prim.uo Types.ui \ + Asyntfn.ui Globals.uo Smlprim.uo Smlexc.uo Tr_env.ui Location.ui \ + Match.ui Mixture.ui Units.ui Lambda.uo +Fnlib.uo: Fnlib.ui +Exec_phr.uo: Exec_phr.ui Asynt.uo Front.ui Compiler.ui Back.ui Fnlib.ui \ + Pr_zam.uo Infixst.ui Elab.ui Rtvals.ui Types.ui Ovlres.ui Globals.uo \ + Tr_env.ui Symtable.ui Mixture.ui Units.ui Load_phr.ui Infixres.ui \ + Miscsys.ui +Emitcode.uo: Emitcode.ui Const.uo Reloc.uo Fnlib.ui Buffcode.uo Config.uo \ + Prim.uo Opcodes.uo Labels.uo Instruct.uo Mixture.ui Prim_opc.uo +Elab.uo: Elab.ui Asynt.uo Const.uo Fnlib.ui Config.uo Types.ui Asyntfn.ui \ + Globals.uo Smlexc.uo Location.ui Mixture.ui Units.ui +Compiler.uo: Compiler.ui Asynt.uo Front.ui Parser.ui Const.uo Back.ui \ + Fnlib.ui Pr_zam.uo Elab.ui Emit_phr.uo Lexer.ui Sigmtch.ui Types.ui \ + Ovlres.ui Globals.uo Smlperv.ui Tr_env.ui Location.ui Mixture.ui \ + Units.ui Infixres.ui Hasht.ui +Back.uo: Back.ui Sort.ui Const.uo Fnlib.ui Prim.uo Instruct.uo Stack.ui \ + Mixture.ui Lambda.uo +Asyntfn.uo: Asyntfn.ui Asynt.uo Const.uo Fnlib.ui Types.ui Globals.uo \ + Location.ui Mixture.ui +Arg.uo: Arg.ui Fnlib.ui Miscsys.ui +Const.uo: Fnlib.ui Config.uo Mixture.ui +Patch.uo: Code_dec.uo Symtable.ui diff -Nru mosml-2.01/src/compiler.cminusminus/Match.sig mosml-2.10.1/src/compiler.cminusminus/Match.sig --- mosml-2.01/src/compiler.cminusminus/Match.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Match.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,9 @@ +local + open Lambda Location Asynt Tr_env; +in + +val translateMatch : + TranslEnv -> (unit -> Lambda) -> + Location -> (Pat list * Lambda) list -> Lambda + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Match.sml mosml-2.10.1/src/compiler.cminusminus/Match.sml --- mosml-2.01/src/compiler.cminusminus/Match.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Match.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,357 @@ +(* Match.sml : Compile matches to decision trees, then to lambda code + 1996-07-09, 1997-02-03, 2000-02-16 + + See P. Sestoft: ML pattern match compilation and partial + evaluation. In Danvy, Glück, and Thiemann (editors): Dagstuhl + Seminar on Partial Evaluation, February 1996. Lecture Notes in + Computer Science 1110, pages 446-464. Springer-Verlag 1996. + ftp://ftp.dina.kvl.dk/pub/Staff/Peter.Sestoft/papers/match.ps.gz + + Some day the distinction between static and dynamic excons should + be eradicated from mosml; this would lead to some simplification in + the match compiler and the back-end. It finally happened in + January 2000. + *) + +open Asynt Lambda + +fun splitPath n obj = + let fun loop i oargs = + if i < 0 then oargs else + loop (i-1) (Lprim(Prim.Pfield i, [obj]) :: oargs) + in loop (n-1) [] end; + +(* To skip type constraints and aliases, and translate exnname accesses *) + +(* cvr: TODO revise: + translating a long exception name under + the pattern matching function can lead to a space leak --- + do it eagerly! +*) + +fun mkExnPat loc env ii arg = + let val exnname = Tr_env.translateExName env ii + in RECpat(ref (TUPLErp [(loc, EXNAMEpat exnname), arg])) end + +fun simplifyPat env (loc, pat') = + case pat' of + VARpat _ => WILDCARDpat + | REFpat p => RECpat(ref (TUPLErp [p])) + | PARpat p => simplifyPat env p + | TYPEDpat(p,_) => simplifyPat env p + | LAYEREDpat(_, p) => simplifyPat env p + | EXNILpat ii => mkExnPat loc env ii (loc, WILDCARDpat) + | EXCONSpat(ii, p) => mkExnPat loc env ii p + | _ => pat'; + +(* Constructors *) + +datatype con = + SCon of Const.SCon + | Tup of int (* arity *) + | Vec of int (* matching tag = arity *) + | CCon of Const.BlockTag * int (* arity *) + | EExn of Lambda.Lambda (* dynamic excon *) + +fun span (SCon (Const.CHARscon _)) = 256 + | span (SCon _) = 0 (* infinity *) + | span (Tup _) = 1 + | span (Vec _) = 0 (* infinity *) + | span (CCon (Const.CONtag(_, span), _)) = span + | span (EExn _) = 0 (* infinity *) + +fun arity (SCon _) = 0 + | arity (Tup arity) = arity + | arity (Vec arity) = arity + | arity (CCon (_, arity)) = arity + | arity (EExn _) = 0 + +(* Term descriptions *) + +datatype termd = + Pos of con * termd list (* All arguments in proper order *) + | Neg of con list (* No duplicates *) + +val Bot = Neg [] (* The absence of information *) + +fun bots n = List.tabulate(n, fn _ => Bot) + +(* Contexts, or inside-out partial term descriptions: + * Example: The context [(c2, [a2, a1]), (c1, [b2, b1])] represents + * a term description with a hole, of the form + * c1(b1, b2, c1(a1, a2, Bot, ..., Bot), Bot, ..., Bot) + * where the number of Bots is determined by the arity of c1 and c2. + *) + +type context = (con * termd list) list + +(* Static matching *) + +datatype matchresult = Yes | No | Maybe + +fun staticmatch pcon (Pos(scon, _)) = + if pcon = scon then Yes + else (case pcon of + EExn _ => Maybe (* Different excons may have same name *) + | _ => No) + | staticmatch pcon (Neg nonset) = + if Fnlib.member pcon nonset then + No + else if span pcon = 1 + List.length nonset then + Yes + else + Maybe + +(* Managing partial terms and contexts *) + +fun addneg (Neg nonset) con = Neg(con :: nonset) + | addneg dsc _ = dsc + +fun apply [] dsc = [] + | apply ((con, args)::rest) dsc = + if arity con = List.length args + 1 then + apply rest (Pos(con, List.rev(dsc :: args))) + else + (con, dsc :: args) :: rest + +fun revappend [] res = res + | revappend (x::xr) res = revappend xr (x::res) + +fun builddsc [] dsc [] = dsc + | builddsc ((con, args)::rest) dsc ((_, _, sargs) :: work) = + builddsc rest (Pos(con, revappend args (dsc :: sargs))) work + | builddsc _ _ _ = Fnlib.fatalError "Match.builddsc" + +(* Runtime data access and matching actions *) + +type access = Lambda.Lambda + +datatype dec = + Failure + | Success of Lambda (* right-hand side *) + | IfEq of access * con * decision * decision +withtype decision = + {tree : dec, refs : int ref, lamRef : Lambda option ref} ref + +fun shared (ref {refs as ref count, ...} : decision) = count > 1 +fun used (ref {refs as ref count, ...} : decision) = count > 0 +fun incrnode (ref {refs as ref count, ...} : decision) = refs := 1 + count +fun mkDecision t = ref {tree = t, refs = ref 0, lamRef = ref NONE} + + +(* Hash-consing, to get a decision dag rather than a decision tree *) + +val table = Hasht.new 37 : (dec, decision) Hasht.t + +fun unique (node as IfEq(_, _, t1, t2)) = + if t1 = t2 then t1 + else (Hasht.find table node + handle Subscript => + let val rnode = mkDecision node + in + incrnode t1; incrnode t2; + Hasht.insert table node rnode; + rnode + end) + | unique _ = Fnlib.fatalError "Match.unique"; + +fun makedag env failure ([] : (Asynt.Pat list * decision) list) : decision = + Fnlib.fatalError "Match.makedag: no rules" + | makedag env failure (allmrules as (pats1, _) :: _) = +let +val noOfPats = List.length pats1 +val objs1 = List.rev (List.tabulate(noOfPats, Lvar)) + +val topCon = Tup noOfPats (* Hack to handle top-level pat list *) +val topctx = [(topCon, [])] : context + +fun fail _ [] = failure + | fail (Pos(_, dscs)) ((pats1, rhs1) :: rulerest) = + succeed topctx [(pats1, objs1, dscs)] rhs1 rulerest + | fail _ _ = Fnlib.fatalError "Match.fail" + +and succeed ctx [] rhs rules = rhs + | succeed ctx (work1::workrest) rhs rules = + case work1 of + ([], [], []) => succeed ctx workrest rhs rules + | (pat1::patrest, obj1::objrest, dsc1::dscrest) => + match pat1 obj1 dsc1 ctx + ((patrest, objrest, dscrest) :: workrest) rhs rules + | _ => Fnlib.fatalError "Match.succeed" + +and mktest pcon obj dsc ctx work rhs rules conequal = + case staticmatch pcon dsc of + Yes => conequal dsc + | No => fail (builddsc ctx dsc work) rules + | Maybe => + unique(IfEq(obj, pcon, + conequal (Pos(pcon, bots (arity pcon))), + fail (builddsc ctx (addneg dsc pcon) work) rules)) + +and match pat obj dsc ctx work rhs rules = + case simplifyPat env pat of + SCONpat (scon, _) => + let fun conequal newdsc = + succeed (apply ctx newdsc) work rhs rules + in mktest (SCon scon) obj dsc ctx work rhs rules conequal end + + | VECpat pats => + let val arity = List.length pats + val pcon = Vec arity + fun getsargs (Neg _) = bots arity + | getsargs (Pos(con, sargs)) = sargs + fun conequal newdsc = + case pats of + [] => succeed (apply ctx newdsc) work rhs rules + | _ => succeed ((pcon, []) :: ctx) + ((pats, splitPath arity obj, getsargs dsc) + :: work) + rhs rules + in + mktest pcon (Lprim(Prim.Pvectlength, [obj])) dsc ctx work rhs + rules conequal + end + + | WILDCARDpat => + succeed (apply ctx dsc) work rhs rules + + | NILpat ii => + let val ci = !(Asyntfn.getConInfo ii) + val pcon = CCon(Const.CONtag(#conTag ci, #conSpan ci), 0) + fun conequal newdsc = + succeed (apply ctx newdsc) work rhs rules + in mktest pcon obj dsc ctx work rhs rules conequal end + + | CONSpat (ii, pat) => + let val ci = !(Asyntfn.getConInfo ii) + val pcon = CCon(Const.CONtag(#conTag ci, #conSpan ci), 1) + val oarg = if #conIsGreedy ci orelse #conSpan ci = 1 then obj + else Lprim(Prim.Pfield 0, [obj]) + fun getsargs (Neg _) = [ Bot ] + | getsargs (Pos(con, sargs)) = sargs + fun conequal newdsc = + succeed ((pcon, []) :: ctx) + (([pat], [oarg], getsargs dsc) :: work) + rhs rules + in mktest pcon obj dsc ctx work rhs rules conequal end + + | EXNILpat ii => Fnlib.fatalError "match EXNILpat" + | EXCONSpat (ii, pat) => Fnlib.fatalError "match EXCONSpat" + | EXNAMEpat ii => + let fun conequal newdsc = + succeed (apply ctx newdsc) work rhs rules + in mktest (EExn ii) obj dsc ctx work rhs rules conequal end + + | RECpat(ref (TUPLErp [])) => (* The irrefutable pattern () or {} *) + succeed (apply ctx dsc) work rhs rules + + | RECpat(ref (TUPLErp pats)) => + let val arity = List.length pats + val sargs = case dsc of + Neg _ => bots arity + | Pos(_, sargs) => sargs + in + succeed ((Tup arity, []) :: ctx) + ((pats, splitPath arity obj, sargs) :: work) + rhs rules + end + + | RECpat(ref (RECrp _)) => Fnlib.fatalError "match 1" + | _ => Fnlib.fatalError "match 2" +in + fail (Pos(topCon, bots noOfPats)) allmrules +end + +(* Switchify and compile decision nodes to Lambda-code. Each shared + * subdag is compiled once, to a Lambda.Lshared. *) + +fun tolambda (ref {tree, ...} : decision) (failLam : Lambda) : Lambda = + let fun getSCon (SCon scon) = scon + | getSCon _ = Fnlib.fatalError "Match.getSCon" + fun getCCon (CCon (ccon, _)) = ccon + | getCCon _ = Fnlib.fatalError "Match.getCCon" + fun getVec (Vec n) = Const.INTscon n + | getVec _ = Fnlib.fatalError "Match.getVec" + + fun collect getcon last cases + (otherwise as + ref {tree = IfEq(obj, con, thenact, elseact), ...}) = + if obj = last andalso not (shared otherwise) then + collect getcon last ((getcon con, thenact) :: cases) elseact + else + (cases, otherwise) + | collect _ _ cases otherwise = + (cases, otherwise) + + fun revmap f xys = + let fun loop [] res = res + | loop ((x, y)::xyr) res = loop xyr ((x, f y) :: res) + in loop xys [] end + + fun toseq Failure = failLam + | toseq (Success rhs) = rhs + | toseq t = mkSwitch t + + and share (node as ref {tree, lamRef as ref lamOpt, ...}) = + if shared node then + case lamOpt of + NONE => let val lam = shared_lambda (toseq tree) + in lamRef := SOME lam; lam end + | SOME lam => lam + else + toseq tree + + and mkSwitch (IfEq(obj, SCon scon, thenact, elseact)) = + let val (cases, otherwise) = collect getSCon obj [] elseact + in + Lstatichandle(Lcase(obj, (scon, share thenact) + :: revmap share cases), + share otherwise) + end + | mkSwitch (IfEq(obj, con as Vec _, thenact, elseact)) = + let val (cases, otherwise) = collect getVec obj [] elseact + in + Lstatichandle(Lcase(obj, (getVec con, share thenact) + :: revmap share cases), + share otherwise) + end + + | mkSwitch (IfEq(obj, con as CCon _, thenact, elseact)) = + let val (cases, otherwise) = collect getCCon obj [] elseact + in + Lstatichandle(Lswitch(span con, obj, + (getCCon con, share thenact) + ::revmap share cases), + share otherwise) + end + | mkSwitch (IfEq(obj, EExn exnname, thenact, elseact)) = + Lif(Lprim(Prim.Ptest Prim.Peq_test, [obj, exnname]), + share thenact, + share elseact) + | mkSwitch tree = toseq tree + + in toseq tree end + +(* The entry point *) + +fun translateMatch (env : Tr_env.TranslEnv) failure_code loc mrules = + let val failure = mkDecision Failure + val uniqmrules = + List.map (fn (pats, rhs) => (pats, mkDecision (Success rhs))) mrules + val decdag = makedag env failure uniqmrules + val _ = incrnode decdag; + val _ = Hasht.clear table (* Discard memo-table *) + open Mixture + in + if List.exists (fn (_, rhs) => not (used rhs)) uniqmrules then + (msgIBlock 0; + Location.errLocation loc; + errPrompt "Warning: some cases are unused in this match."; + msgEOL(); msgEOL(); + msgEBlock()) + else (); + if used failure then (* Inexhaustive match *) + tolambda decdag (failure_code ()) + else + tolambda decdag Lunspec + end diff -Nru mosml-2.01/src/compiler.cminusminus/Memory.sml mosml-2.10.1/src/compiler.cminusminus/Memory.sml --- mosml-2.01/src/compiler.cminusminus/Memory.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Memory.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,31 @@ +(* To control the runtime system and bytecode interpreter *) + +local + open Obj; +in + +prim_val global_data : obj Vector.vector = 0 "global_data" +prim_val realloc_global_data : int -> unit = 1 "realloc_global"; +prim_val static_alloc : int -> string = 1 "static_alloc"; +prim_val static_free : string -> unit = 1 "static_free"; +prim_val static_resize : string -> int -> string = 2 "static_resize"; +prim_val gc_full_major : unit -> unit = 1 "gc_full_major"; +prim_val interprete : bool -> string -> int -> int -> obj = 4 "start_interp"; +prim_val available_primitives : unit -> string Vector.vector + = 1 "available_primitives"; + +(* The following primitives are not implemented by *) +(* the `standard' Caml Light system. *) + +prim_val sml_int_of_string : string -> int = 1 "sml_int_of_string"; +prim_val sml_hex_of_string : string -> int = 1 "sml_int_of_hex"; +prim_val sml_float_of_string : string -> real = 1 "sml_float_of_string"; +prim_val sml_string_of_int : int -> string = 1 "sml_string_of_int"; +prim_val sml_hexstring_of_word : word -> string = 1 "sml_hexstring_of_word"; +prim_val sml_string_of_float : real -> string = 1 "sml_string_of_float"; +prim_val sml_makestring_of_char : char -> string + = 1 "sml_makestring_of_char"; +prim_val sml_makestring_of_string : string -> string + = 1 "sml_makestring_of_string"; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Miscsys.sig mosml-2.10.1/src/compiler.cminusminus/Miscsys.sig --- mosml-2.01/src/compiler.cminusminus/Miscsys.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Miscsys.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,50 @@ +(* Miscsys.sig -- not part of the new unified basis, 12-27-94 *) + +(* This module provides a simple interface to the operating system. *) + +(* exception SysErr of string * syserror option; *) + (* This exception is identical to sys__Sys_error in the runtime. + Raised by some functions, when the underlying system calls + fail. The argument to SysErr describes the error. + The texts of the error messages are implementation-dependent, + and should not be relied upon to catch specific system errors. *) + +prim_val command_line : string Vector.vector = 0 "command_line"; + (* The command line arguments given to the process. + The first element is the command name used to invoke the + program. *) + +prim_val interactive: bool = 0 "interactive"; + (* True if we're running under the toplevel system. False if + we're running as a standalone program. *) + +prim_val getenv : string -> string = 1 "sys_getenv"; + (* Return the value associated to a variable in the process + environment. Raise [Not_found] if the variable is unbound. *) + +prim_val catch_interrupt : bool -> unit = 1 "sys_catch_break" + (* Currently, this doesn't work properly in the top-level system, + because it calls this primitive itself to prevent the system + from being interrupted while in critical intervals. *) + (* [catch_interrupt] governs whether user interrupt terminates + the program or raises the [Interrupt] exception. Call + [catch_interrupt true] to enable raising [Interrupt], + and [catch_interrupt false] to let the system terminate + the program on user interrupt. *) + +val remove : string -> unit + +val rename : {old: string, new: string} -> unit + +val chdir : string -> unit + + +(* [remove f] deletes the file [f] from the operating system. + + [rename{new, old}] renames file [old] to [new]. + + [chdir dir] changes the current working directory of the process. + Note that there is no easy way of getting the current working + directory from the operating system. +*) + diff -Nru mosml-2.01/src/compiler.cminusminus/Miscsys.sml mosml-2.10.1/src/compiler.cminusminus/Miscsys.sml --- mosml-2.01/src/compiler.cminusminus/Miscsys.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Miscsys.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,15 @@ +(* Miscsys -- not part of the new unified basis, 12-27-94 *) + +(* This module provides a simple interface to the operating system. *) + +prim_val command_line : string Vector.vector = 0 "command_line"; +prim_val interactive: bool = 0 "interactive"; +prim_val getenv : string -> string = 1 "sys_getenv"; + +prim_val catch_interrupt : bool -> unit = 1 "sys_catch_break" + +prim_val rename_ : string -> string -> unit = 2 "sys_rename"; +prim_val remove : string -> unit = 1 "sys_remove"; +prim_val chdir : string -> unit = 1 "sys_chdir"; + +fun rename {old, new} = rename_ old new; diff -Nru mosml-2.01/src/compiler.cminusminus/Mixture.sig mosml-2.10.1/src/compiler.cminusminus/Mixture.sig --- mosml-2.01/src/compiler.cminusminus/Mixture.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Mixture.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,100 @@ +exception Toplevel; +exception EndOfFile; +exception LexicalError of string * int * int; + +val toplevel : bool ref; + +val pp_out : ppstream; +val msgCBlock : int -> unit; (* Begins a CONSISTENT block. *) +val msgIBlock : int -> unit; (* Begins an INCONSISTENT block. *) +val msgEBlock : unit -> unit; +val msgBreak : int * int -> unit; +val msgClear : unit -> unit; +val msgFlush : unit -> unit; + +val msgPrompt : string -> unit; +val msgContPrompt : string -> unit; +val errPrompt : string -> unit; +val msgString : string -> unit; +val msgChar : char -> unit; +val msgInt : int -> unit; +val msgReal : real -> unit; +val msgWord : word -> unit; +val msgEOL : unit -> unit; + +val msgStyle : string ref; + +val path_library : string ref; +val value_polymorphism : bool ref; +val load_path : string list ref; +val file_exists : string -> bool; +val find_in_path : string -> string; +val remove_file : string -> unit; + +datatype Lab = + INTlab of int + | STRINGlab of string +; + +type 'a Row = (Lab * 'a) list; + +val printLab : Lab -> unit; +val isPairRow : 'a Row -> bool; +val isTupleRow : 'a Row -> bool; +val mkPairRow : 'a -> 'a -> 'a Row; +val mkTupleRow : 'a list -> 'a Row; +val lt_lab : Lab -> Lab -> bool; +val insertField : Lab * 'a -> 'a Row -> 'a Row; +val sortRow : 'a Row -> 'a Row; + +datatype ('a, 'b) Env + = NILenv + | BNDenv of 'a * 'b * ('a, 'b) Env + | TOPenv of ('a, 'b) Hasht.t * ('a, 'b) Env + | COMPenv of ('a, 'b) Env * ('a, 'b) Env +; + +val plusEnv : ('a, 'b) Env -> ('a, 'b) Env -> ('a, 'b) Env; +val lookupEnv : (''a, 'b) Env -> ''a -> 'b; +val bindInEnv : ('a, 'b) Env -> 'a -> 'b -> ('a, 'b) Env; +val bindTopInEnv : ('a, 'b) Env -> ('a, 'b) Hasht.t -> ('a, 'b) Env; +val mkHashEnv : int -> (''a, 'b) Env -> (''a, 'b) Env +val mk1Env : 'a -> 'b -> ('a, 'b) Env; +val mk1TopEnv : ('a, 'b) Hasht.t -> ('a, 'b) Env; +val revEnvAcc : ('a, 'b) Env -> ('a, 'b) Env -> ('a, 'b) Env; +val revEnv : ('a, 'b) Env -> ('a, 'b) Env; +val traverseEnv : (''_a -> 'b -> unit) -> (''_a, 'b) Env -> unit; +val mapEnv : (''_a -> 'b -> 'c) -> (''_a, 'b) Env -> (''_a, 'c) Env; +val foldEnv : (''_a -> 'b -> 'c -> 'c) -> 'c -> (''_a, 'b) Env -> 'c; +val cleanEnv : (''_a, 'b) Env -> (''_a, 'b) Env; +val sortEnv : (string, 'b) Env -> (string,'b) Env; +val lookupEnvWithPos : ('b -> int) -> + (''a, 'b) Env -> ''a -> int -> (int * 'b); + +type SigStamp = string; +val dummySigStamp : SigStamp; +val watchDog : (string, SigStamp) Hasht.t ref; + +val preloadedUnits : string list ref; +val preopenedPreloadedUnits : string list ref; + +(* current compilation mode for units + STRmode units are compiled as structures + TOPDECmode if units are compiled as topdecs + should be false for boostrapping! +*) + +datatype Mode = STRmode | TOPDECmode +; +val currentMode : Mode ref +; + +(* vanilla SML compliance levels *) + +datatype Compliance = + Orthodox (* SML only, reject extensions *) + | Conservative (* warn of any extensions *) + | Liberal (* anything goes *); + +val currentCompliance : Compliance ref; + diff -Nru mosml-2.01/src/compiler.cminusminus/Mixture.sml mosml-2.10.1/src/compiler.cminusminus/Mixture.sml --- mosml-2.01/src/compiler.cminusminus/Mixture.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Mixture.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,315 @@ +open BasicIO Nonstdio Fnlib Config PP; + +exception Toplevel; +exception EndOfFile; +exception LexicalError of string * int * int; + +val toplevel = ref false; + +val pp_out = mk_ppstream +{ + linewidth = 79, + flush = fn() => flush_out std_out, + consumer = outputc std_out +}; + +fun msgCBlock offset = begin_block pp_out CONSISTENT offset; +fun msgIBlock offset = begin_block pp_out INCONSISTENT offset; +fun msgEBlock() = end_block pp_out; +fun msgBreak size_offset = add_break pp_out size_offset; +fun msgClear() = clear_ppstream pp_out; +fun msgFlush() = flush_ppstream pp_out; + +val msgString = add_string pp_out; + +fun msgChar (i : char) = msgString (String.str i); +local + prim_val sml_string_of_int : int -> string = 1 "sml_string_of_int"; + prim_val sml_string_of_float : real -> string = 1 "sml_string_of_float"; + prim_val sml_hexstring_of_word : word -> string = 1 "sml_hexstring_of_word"; +in + fun msgInt (i : int) = msgString (sml_string_of_int i); + fun msgReal (r : real) = msgString (sml_string_of_float r); + fun msgWord (w : word) = msgString (sml_hexstring_of_word w); +end + +fun msgEOL() = add_newline pp_out; + +fun msgPrompt s = + (if !toplevel then msgString toplevel_output_prompt + else msgString batch_output_prompt; + msgString s) +; + +fun msgContPrompt s = + (if !toplevel then msgString toplevel_output_cont_prompt + else msgString batch_output_cont_prompt; + msgString s) +; + +fun errPrompt s = + (if !toplevel then msgString toplevel_error_prompt + else msgString batch_error_prompt; + msgString s) +; + +val msgStyle = ref "default"; + +(* Handling files and directories *) + +val path_library = ref ""; +val load_path = ref ([] : string list); + +(* This MUST be ref false; the default (value polymorphism/imperative types) + * is set in files Mainc.sml and Maint.sml instead: + *) +val value_polymorphism = ref false; + +fun cannot_find filename = + raise (Fail ("Cannot find file "^filename)) +; + +fun find_in_path filename = + if file_exists filename then + filename + else if Filename.is_absolute filename then + cannot_find filename + else + let fun h [] = + cannot_find filename + | h (a::rest) = + let val b = Filename.concat a filename in + if file_exists b then b else h rest + end + in h (!load_path) end +; + +fun remove_file f = + Miscsys.remove f + handle SysErr _ => () +; + +(* ---------- *) + +datatype Lab = + INTlab of int + | STRINGlab of string +; + +type 'a Row = (Lab * 'a) list; + +fun printLab (STRINGlab s) = msgString s + | printLab (INTlab i) = msgInt i +; + +val labOne = INTlab 1 +and labTwo = INTlab 2 +; + +fun isPairRow [(INTlab 1, _), (INTlab 2, _)] = true + | isPairRow [(INTlab 2, _), (INTlab 1, _)] = true + | isPairRow _ = false +; + +fun isTupleRow' n [] = true + | isTupleRow' n (((INTlab i), _) :: fs) = + if n = i then isTupleRow' (n+1) fs else false + | isTupleRow' n _ = false + +fun isTupleRow fs = + (List.length fs <> 1) andalso (isTupleRow' 1 fs) +; + +fun mkPairRow x1 x2 = [(labOne, x1), (labTwo, x2)]; + +fun mkTupleRow' n [] = [] + | mkTupleRow' n (x :: xs) = + (INTlab n, x) :: mkTupleRow' (n+1) xs +; + +fun mkTupleRow xs = mkTupleRow' 1 xs; + +fun lt_lab (STRINGlab s1) (STRINGlab s2) = s1 < s2 + | lt_lab (STRINGlab _) (INTlab _) = true + | lt_lab (INTlab _) (STRINGlab _) = false + | lt_lab (INTlab i1) (INTlab i2) = i1 < i2 +; + +fun insertField (lab, x) fields = + case fields of + [] => [(lab, x)] + | (lab', x') :: rest => + if lt_lab lab lab' then + (lab, x) :: fields + else if lt_lab lab' lab then + (lab', x') :: insertField (lab, x) rest + else + fatalError "insertField" +; + +fun sortRow row = foldL insertField [] row; + +(* --- Local environments --- *) + +datatype ('a, 'b) Env + = NILenv + | BNDenv of 'a * 'b * ('a, 'b) Env + | TOPenv of ('a, 'b) Hasht.t * ('a, 'b) Env + | COMPenv of ('a, 'b) Env * ('a, 'b) Env +; + +fun plusEnv NILenv env2 = env2 + | plusEnv env1 NILenv = env1 + | plusEnv env1 (BNDenv(k, v, NILenv)) = BNDenv(k, v, env1) + | plusEnv env1 env2 = COMPenv(env2, env1) +; + +fun lookupEnv env key = + let val rec search = fn + NILenv => raise Subscript + | BNDenv(k, v, env) => + if key = k then v else search env + | TOPenv(x, env) => + (Hasht.find x key handle Subscript => search env) + | COMPenv(env1, env2) => + (search env1 handle Subscript => search env2) + in search env end +; + +fun bindInEnv env k v = BNDenv(k, v, env); +fun bindTopInEnv env x = TOPenv(x, env); + +fun mk1Env k v = BNDenv(k, v, NILenv); +fun mk1TopEnv x = TOPenv(x, NILenv); + +fun revEnvAcc NILenv acc = acc + | revEnvAcc (BNDenv(k, v, env)) acc = + revEnvAcc env (BNDenv(k, v, acc)) + | revEnvAcc (TOPenv(x, env)) acc = + revEnvAcc env (TOPenv(x, acc)) + | revEnvAcc (COMPenv(env1, env2)) acc = + revEnvAcc env2 (revEnvAcc env1 acc) +; + +fun revEnv env = revEnvAcc env NILenv; + +fun traverseEnv action env = + let fun traverse NILenv = () + | traverse (BNDenv(k, v, env)) = + (action k v; traverse env) + | traverse (TOPenv(x, env)) = + (Hasht.apply action x; traverse env) + | traverse (COMPenv(env1, env2)) = + (traverse env1; traverse env2) + in traverse env end +; + +fun mapEnv f env0 = + case env0 of + NILenv => NILenv + | BNDenv(k, v, env) => + BNDenv(k, f k v, mapEnv f env) + | TOPenv(x, env) => + (* This can be improved by simply making a copy of the hash table *) + let val newx = Hasht.new 17 + fun ins k v = Hasht.insert newx k (f k v) + in + Hasht.apply ins x; + TOPenv(newx, mapEnv f env) + end + | COMPenv(env1, env2) => + COMPenv(mapEnv f env1, mapEnv f env2) +; + +fun foldEnv f u env0 = + case env0 of + NILenv => u + | BNDenv(k, v, env) => + f k v (foldEnv f u env) + | TOPenv(x, env) => + Hasht.fold f (foldEnv f u env) x + | COMPenv(env1, env2) => + foldEnv f (foldEnv f u env2) env1 +; + +fun mkHashEnv n env = + if n < 7 then env + else + let val hashenv = Hasht.new n + in + traverseEnv (Hasht.insert hashenv) (revEnv env); + mk1TopEnv hashenv + end + +fun cleanEnv env = + foldEnv (fn k => fn v => fn cont => + fn acc => + if (member k acc) + then cont acc + else bindInEnv (cont (k::acc)) k v) + (fn acc => NILenv) env []; + +local + fun insertInEnv (k:string) v env = + case env of + NILenv => BNDenv(k,v,NILenv) + | BNDenv(k', v', env') => + if k = k' then BNDenv(k,v,env') + else if k < k' then BNDenv(k',v',insertInEnv k v env') + else BNDenv(k,v,env) + | _ => fatalError "insertInEnv" +in + fun sortEnv env = foldEnv insertInEnv NILenv env +end; + +fun lookupEnvWithPos size env key = + (* cvr: assumes env is clean (no shadowed bindings) *) + foldEnv (fn k => fn v => fn cont => + fn pos => if key = k then (pos,v) else cont (pos+size(v))) + (fn pos => raise Subscript) env; + +(* --- Stamps of compiled signatures --- *) + +type SigStamp = string; + +val char_star = Char.chr 42; +val dummySigStamp = CharVector.tabulate(22, fn _ => char_star); + +(* This table is used by `load' to prevent mismatching *) +(* versions of compiled units from being loaded, and also *) +(* to prevent the same unit from being loaded twice. *) + +val watchDog = ref (Hasht.new 17 : (string, SigStamp) Hasht.t); + +(* The list of automatically preloaded units. *) +(* Some of them are also preopened. *) + +val preloadedUnits = ref ([] : string list); +val preopenedPreloadedUnits = ref ([] : string list); + +(* compilation mode *) + +datatype Mode = STRmode | TOPDECmode +; + +val currentMode = ref STRmode +; + +(* vanilla SML compliance levels *) + +datatype Compliance = + Orthodox (* SML only, reject extensions *) + | Conservative (* warn of any extensions *) + | Liberal (* anything goes *); + +val currentCompliance = ref Liberal; + + + + + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/mosmlc-- mosml-2.10.1/src/compiler.cminusminus/mosmlc-- --- mosml-2.01/src/compiler.cminusminus/mosmlc-- 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/mosmlc-- 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,114 @@ +#!/bin/sh + +stdlib=/home/kfl/utils/mosml2.0/lib +mosmlbin=/home/kfl/utils/mosml2.0/bin + +linkalso=false +includes="" +compopt="-conservative" +linkopt="" +custom="" +linkfiles="" +cc=gcc +ccfiles="" +cclib="" +ccopt="" +linkout=a.out +context="-structure" + +while : ; do + case $1 in + "") + break;; + *.sml) + $mosmlbin/camlrunm $stdlib/mosmlcmmc -stdlib $stdlib $includes $compopt $context $1 || exit $? + case $1 in + */*) + context="$context `dirname $1`/`basename $1 .sml`.ui" + ;; + *) context="$context `basename $1 .sml`.ui" + ;; + esac + linkfiles="$linkfiles $1";; + *.sig) + $mosmlbin/camlrunm $stdlib/mosmlcmmc -stdlib $stdlib $includes $compopt $context $1 || exit $? + case $1 in + */*) + context="$context `dirname $1`/`basename $1 .sig`.ui" + ;; + *) context="$context `basename $1 .sig`.ui" + ;; + esac + ;; + *.ui) + context="$context $1" + ;; + *.uo) + linkfiles="$linkfiles $1";; + -structure|-toplevel) + context="$context $1";; + -c) + linkalso=false;; + -I|-include) + includes="$includes -I $2" + shift;; + -P|-perv) + compopt="$compopt -P $2" + linkopt="$linkopt -P $2" + shift;; + -q|-quotation) + compopt="$compopt $1";; + -i) + compopt="$compopt $1" + linkopt="$linkopt $1";; + -g|-debug) + compopt="$compopt $1" + linkopt="$linkopt $1";; + -m|-msgstyle) + compopt="$compopt -msgstyle $2" + shift;; + -noheader) + linkopt="$linkopt $1";; + -noautolink) + linkopt="$linkopt $1";; + -o|-exec) + linkout=$2 + shift;; + -standalone) + linkopt="$linkopt $1";; + -stdlib) + stdlib=$2 + shift;; + -v|-version) + echo "The Moscow ML system (C-- backend), version 2.00 (June 2000)" + echo " (standard library from $stdlib)" + $mosmlbin/camlrunm -V + $mosmlbin/camlrunm $stdlib/mosmlcmmc -version + $mosmlbin/camlrunm $stdlib/mosmllnk -version;; + -imptypes) + compopt="$compopt $1";; + -valuepoly) + compopt="$compopt $1";; + -orthodox|-conservative|-liberal) + compopt="$compopt $1";; + -files) + linkfiles="$linkfiles $1 $2" + shift;; + -dlambda) + compopt="$compopt $1";; + -dzam) + compopt="$compopt $1";; + -*) + echo "Unknown option \"$1\", ignored" >&2;; + *) + echo "I don't know what to do with file \"$1\", ignored" >&2;; + esac + shift +done + +if $linkalso && test -n "$linkfiles"; then + $mosmlbin/camlrunm $stdlib/mosmllnk -stdlib $stdlib $includes $custom $linkopt \ + -exec $linkout $linkfiles || exit $? +fi + +exit 0 diff -Nru mosml-2.01/src/compiler.cminusminus/Ovlres.sig mosml-2.10.1/src/compiler.cminusminus/Ovlres.sig --- mosml-2.01/src/compiler.cminusminus/Ovlres.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Ovlres.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1 @@ +val resolveOvlDec : Asynt.Dec -> unit; diff -Nru mosml-2.01/src/compiler.cminusminus/Ovlres.sml mosml-2.10.1/src/compiler.cminusminus/Ovlres.sml --- mosml-2.01/src/compiler.cminusminus/Ovlres.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Ovlres.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,552 @@ +open List; +open Fnlib Mixture Const Prim Smlprim Globals Location; +open Units Types Asynt; + +fun errorOverloadingType loc id tau = +( + msgIBlock 0; + errLocation loc; + errPrompt "Overloaded "; msgString id; + msgString " cannot be applied to argument(s) of type "; + printType tau; msgEOL(); + msgEBlock(); + raise Toplevel +); + +fun errorOverloadingScon loc msg tau = +( + msgIBlock 0; + errLocation loc; + errPrompt ("Overloaded " ^ msg ^ " constant cannot have type "); + printType tau; msgEOL(); + msgEBlock(); + raise Toplevel +); + +fun errorConstTooLarge loc msg = +( + msgIBlock 0; + errLocation loc; + errPrompt msg; msgString " constant is too large"; msgEOL(); + msgEBlock(); + raise Toplevel +); + +val negInt = mkPrimInfo 1 (MLPprim(1, Psmlnegint)) +and absInt = mkPrimInfo 1 (MLPccall(1, "sml_abs_int")) +and makestringInt = mkPrimInfo 1 (MLPccall(1, "sml_string_of_int")) +and addInt = mkPrimInfo 1 MLPadd_int +and subInt = mkPrimInfo 1 MLPsub_int +and mulInt = mkPrimInfo 1 MLPmul_int +and divInt = mkPrimInfo 1 MLPdiv_int +and modInt = mkPrimInfo 1 MLPmod_int +and ltInt = mkPrimInfo 1 MLPlt_int +and gtInt = mkPrimInfo 1 MLPgt_int +and leInt = mkPrimInfo 1 MLPle_int +and geInt = mkPrimInfo 1 MLPge_int +; + +fun resolveIntOvlId loc "~" OVL1NNo = negInt + | resolveIntOvlId loc "abs" OVL1NNo = absInt + | resolveIntOvlId loc "makestring" OVL1NSo = makestringInt + | resolveIntOvlId loc "+" OVL2NNNo = addInt + | resolveIntOvlId loc "-" OVL2NNNo = subInt + | resolveIntOvlId loc "*" OVL2NNNo = mulInt + | resolveIntOvlId loc "div" OVL2NNNo = divInt + | resolveIntOvlId loc "mod" OVL2NNNo = modInt + | resolveIntOvlId loc "<" OVL2NNBo = ltInt + | resolveIntOvlId loc ">" OVL2NNBo = gtInt + | resolveIntOvlId loc "<=" OVL2NNBo = leInt + | resolveIntOvlId loc ">=" OVL2NNBo = geInt + | resolveIntOvlId _ _ _ = fatalError "resolveIntOvlId" +; + +val addWord = mkPrimInfo 1 MLPadd_word +and subWord = mkPrimInfo 1 MLPsub_word +and mulWord = mkPrimInfo 1 MLPmul_word +and divWord = mkPrimInfo 1 MLPdiv_word +and modWord = mkPrimInfo 1 MLPmod_word +and ltWord = mkPrimInfo 1 MLPlt_word +and gtWord = mkPrimInfo 1 MLPgt_word +and leWord = mkPrimInfo 1 MLPle_word +and geWord = mkPrimInfo 1 MLPge_word +; + +val makestringWord = mkPrimInfo 1 (MLPccall(1, "sml_hexstring_of_word")); + +fun resolveWordOvlId loc "+" OVL2NNNo = addWord + | resolveWordOvlId loc "-" OVL2NNNo = subWord + | resolveWordOvlId loc "*" OVL2NNNo = mulWord + | resolveWordOvlId loc "div" OVL2NNNo = divWord + | resolveWordOvlId loc "mod" OVL2NNNo = modWord + | resolveWordOvlId loc "<" OVL2NNBo = ltWord + | resolveWordOvlId loc ">" OVL2NNBo = gtWord + | resolveWordOvlId loc "<=" OVL2NNBo = leWord + | resolveWordOvlId loc ">=" OVL2NNBo = geWord + | resolveWordOvlId loc "makestring" OVL1NSo = makestringWord + | resolveWordOvlId loc id _ = + errorOverloadingType loc id type_word; + +(* Temporary implementation of Word8.{+,-,*} operations: *) + +val addWord8 = mkPrimInfo 1 (MLPgv {qual="Word8", id=["+"]}) +val subWord8 = mkPrimInfo 1 (MLPgv {qual="Word8", id=["-"]}) +val mulWord8 = mkPrimInfo 1 (MLPgv {qual="Word8", id=["*"]}) + +fun resolveWord8OvlId loc "+" OVL2NNNo = addWord8 + | resolveWord8OvlId loc "-" OVL2NNNo = subWord8 + | resolveWord8OvlId loc "*" OVL2NNNo = mulWord8 + | resolveWord8OvlId loc "div" OVL2NNNo = divWord + | resolveWord8OvlId loc "mod" OVL2NNNo = modWord + | resolveWord8OvlId loc "<" OVL2NNBo = ltWord + | resolveWord8OvlId loc ">" OVL2NNBo = gtWord + | resolveWord8OvlId loc "<=" OVL2NNBo = leWord + | resolveWord8OvlId loc ">=" OVL2NNBo = geWord + | resolveWord8OvlId loc "makestring" OVL1NSo = makestringWord + | resolveWord8OvlId loc id _ = + errorOverloadingType loc id type_word8; + +val makestringChar = mkPrimInfo 1 (MLPccall(1, "sml_makestring_of_char")); + +fun resolveCharOvlId loc "makestring" OVL1NSo = makestringChar + | resolveCharOvlId loc "<" OVL2NNBo = ltInt + | resolveCharOvlId loc ">" OVL2NNBo = gtInt + | resolveCharOvlId loc "<=" OVL2NNBo = leInt + | resolveCharOvlId loc ">=" OVL2NNBo = geInt + | resolveCharOvlId loc id _ = + errorOverloadingType loc id type_char +; + +val negReal = mkPrimInfo 1 (MLPprim(1, Pfloatprim Psmlnegfloat)) +and absReal = mkPrimInfo 1 (MLPccall(1, "sml_abs_real")) +and makestringReal = mkPrimInfo 1 (MLPccall(1, "sml_string_of_float")) +and addReal = mkPrimInfo 1 MLPadd_real +and subReal = mkPrimInfo 1 MLPsub_real +and mulReal = mkPrimInfo 1 MLPmul_real +and ltReal = mkPrimInfo 1 MLPlt_real +and gtReal = mkPrimInfo 1 MLPgt_real +and leReal = mkPrimInfo 1 MLPle_real +and geReal = mkPrimInfo 1 MLPge_real +; + +fun resolveRealOvlId loc "~" OVL1NNo = negReal + | resolveRealOvlId loc "abs" OVL1NNo = absReal + | resolveRealOvlId loc "makestring" OVL1NSo = makestringReal + | resolveRealOvlId loc "+" OVL2NNNo = addReal + | resolveRealOvlId loc "-" OVL2NNNo = subReal + | resolveRealOvlId loc "*" OVL2NNNo = mulReal + | resolveRealOvlId loc "<" OVL2NNBo = ltReal + | resolveRealOvlId loc ">" OVL2NNBo = gtReal + | resolveRealOvlId loc "<=" OVL2NNBo = leReal + | resolveRealOvlId loc ">=" OVL2NNBo = geReal + | resolveRealOvlId loc id _ = + errorOverloadingType loc id type_real +; + +val makestringString = mkPrimInfo 1 (MLPccall(1, "sml_makestring_of_string")) +and ltString = mkPrimInfo 1 MLPlt_string +and gtString = mkPrimInfo 1 MLPgt_string +and leString = mkPrimInfo 1 MLPle_string +and geString = mkPrimInfo 1 MLPge_string +; + +fun resolveStringOvlId loc "makestring" OVL1NSo = makestringString + | resolveStringOvlId loc "<" OVL2NNBo = ltString + | resolveStringOvlId loc ">" OVL2NNBo = gtString + | resolveStringOvlId loc "<=" OVL2NNBo = leString + | resolveStringOvlId loc ">=" OVL2NNBo = geString + | resolveStringOvlId loc id _ = + errorOverloadingType loc id type_string +; + +val eqInt = mkPrimInfo 1 MLPeq_int +and noteqInt = mkPrimInfo 1 MLPnoteq_int; + +val eqWord = mkPrimInfo 1 MLPeq_word +and noteqWord = mkPrimInfo 1 MLPnoteq_word; + +val eqPoly = mkPrimInfo 1 MLPeq +and noteqPoly = mkPrimInfo 1 MLPnoteq; + +fun resolveOvlId loc id ovltype tau = + case (ovltype, id) of + (OVL1TXXo, "printVal") => + let val sc = freshSchemeOfType tau in + mkPrimInfo 1 (MLPgvt({qual="Meta", id=["printVal"]}, ref (Obj.repr sc))) + end + | (OVL1TPUo, "installPP") => + let val sc = freshSchemeOfType tau in + mkPrimInfo 1 (MLPgvt({qual="Meta", id=["installPP"]}, ref (Obj.repr sc))) + end + | (OVL2EEBo, "=") => + (case normType tau of + CONt([], NAMEtyapp tyname) => + if isEqTN tyname tyname_int orelse isEqTN tyname tyname_char then + eqInt + else if (isEqTN tyname tyname_word + orelse isEqTN tyname tyname_word8) then + eqWord + else + eqPoly + | _ => + eqPoly) + | (OVL2EEBo, "<>") => + (case normType tau of + CONt([], NAMEtyapp tyname) => + if isEqTN tyname tyname_int + orelse isEqTN tyname tyname_char then + noteqInt + else if isEqTN tyname tyname_word + orelse isEqTN tyname tyname_word8 then + noteqWord + else + noteqPoly + | _ => + noteqPoly) + | (_,_) => + (case normType tau of + CONt([], NAMEtyapp tyname) => + if (isEqTN tyname tyname_int) then + resolveIntOvlId loc id ovltype + else if (isEqTN tyname tyname_char) then + resolveCharOvlId loc id ovltype + else if (isEqTN tyname tyname_real) then + resolveRealOvlId loc id ovltype + else if (isEqTN tyname tyname_string) then + resolveStringOvlId loc id ovltype + else if (isEqTN tyname tyname_word) then + resolveWordOvlId loc id ovltype + else if (isEqTN tyname tyname_word8) then + resolveWord8OvlId loc id ovltype + else + errorOverloadingType loc id tau + | VARt _ => + (* OK because "/" is not overloaded on `real' types: *) + (unify tau type_int; + resolveIntOvlId loc id ovltype) + | _ => errorOverloadingType loc id tau); + +fun resolveWord8OvlScon loc w = + if w > 0w255 then errorConstTooLarge loc "Word8.word" + else (); + +fun resolveOvlScon loc (scon as WORDscon w, ref (SOME tau)) = + (case normType tau of + CONt([], NAMEtyapp tyname) => + if (isEqTN tyname tyname_word) then + () + else if (isEqTN tyname tyname_word8) then + resolveWord8OvlScon loc w + else + errorOverloadingScon loc "word" tau + | VARt _ => unify tau type_word + | _ => errorOverloadingScon loc "word" tau) + | resolveOvlScon loc (WORDscon w, ref NONE) = + fatalError "resolveOvlScon" + | resolveOvlScon _ _ = (); + +fun resolve3Dot (loc: Location) fs rho = + let val (fields, unresolved) = contentsOfRowType rho + val () = + if unresolved then + errorMsg loc "Unresolved record pattern" + else (); + val fs' = map (fn (lab,_) => (lab, (loc, WILDCARDpat))) fields + in fs @ fs' end +; + +fun resolveOvlPat firstpass (loc, pat') = + case pat' of + SCONpat sconInfo => resolveOvlScon loc sconInfo + | VARpat _ => () + | WILDCARDpat => () + | NILpat _ => () + | CONSpat(_, p) => resolveOvlPat firstpass p + | EXNILpat _ => () + | EXCONSpat(_, p) => resolveOvlPat firstpass p + | EXNAMEpat _ => fatalError "resolveOvlPat:1" + | REFpat p => resolveOvlPat firstpass p + | RECpat rp => + (case !rp of + RECrp(fs, NONE) => + (app_field (resolveOvlPat firstpass) fs; + if firstpass + then rp := TUPLErp(map snd (sortRow fs)) + else ()) + | RECrp(fs, SOME rho) => + (app_field (resolveOvlPat firstpass) fs; + if firstpass + then rp := TUPLErp(map snd (sortRow (resolve3Dot loc fs rho))) + else ()) + | TUPLErp pats => + if firstpass + then fatalError "resolveOvlPat:2" + else app (resolveOvlPat firstpass) pats) + | VECpat ps => app (resolveOvlPat firstpass) ps + | PARpat p => resolveOvlPat firstpass p + | INFIXpat _ => fatalError "resolveOvlPat:3" + | TYPEDpat(p,t) => + (resolveOvlPat firstpass p; + resolveOvlTy firstpass t) + | LAYEREDpat(p1, p2) => + (resolveOvlPat firstpass p1; + resolveOvlPat firstpass p2) +and resolveOvlExp firstpass (loc, exp') = + case exp' of + SCONexp sconInfo => + if firstpass then resolveOvlScon loc sconInfo else () + | VIDPATHexp (ref (RESvidpath vidpath)) => () + | VIDPATHexp (r as ref (OVLvidpath vidpathinfo)) => + (case vidpathinfo of + (ii,ovltype,tau) => + if firstpass then + () + else + let val {qualid, info} = ii + val {qual, id} = qualid + val pi = resolveOvlId loc (hd id) ovltype tau + in + #idKind info := + { qualid={qual="General", id=id}, info=PRIMik pi }; + r := RESvidpath ii + end ) + | FNexp mrules => + app (resolveOvlMRule firstpass) mrules + | APPexp(e1, e2) => + (resolveOvlExp firstpass e1; resolveOvlExp firstpass e2) + | LETexp(dec, body) => + (resolveOvlDec firstpass dec; resolveOvlExp firstpass body) + | RECexp(r as ref (RECre fs)) => (* firstpass only *) + (app_field (resolveOvlExp firstpass) fs; + if isTupleRow fs then + r := TUPLEre(map snd fs) + else ()) + | RECexp(ref (TUPLEre es)) => + if firstpass then fatalError "resolveOvlExp" + else app (resolveOvlExp firstpass) es + | VECexp es => + app (resolveOvlExp firstpass) es + | PARexp e => + resolveOvlExp firstpass e + | INFIXexp (ref(UNRESinfixexp _)) => fatalError "resolveOvlExp" + | INFIXexp (ref(RESinfixexp e)) => resolveOvlExp firstpass e + | TYPEDexp(e,ty) => + (resolveOvlExp firstpass e; + resolveOvlTy firstpass ty) + | ANDALSOexp(e1, e2) => + (resolveOvlExp firstpass e1; resolveOvlExp firstpass e2) + | ORELSEexp(e1, e2) => + (resolveOvlExp firstpass e1; resolveOvlExp firstpass e2) + | HANDLEexp(e, mrules) => + (resolveOvlExp firstpass e; app (resolveOvlMRule firstpass) mrules) + | RAISEexp e => + resolveOvlExp firstpass e + | IFexp(e0, e1, e2) => + (resolveOvlExp firstpass e0; resolveOvlExp firstpass e1; resolveOvlExp firstpass e2) + | WHILEexp(e1, e2) => + (resolveOvlExp firstpass e1; resolveOvlExp firstpass e2) + | SEQexp(e1, e2) => + (resolveOvlExp firstpass e1; resolveOvlExp firstpass e2) + | STRUCTUREexp(modexp,sigexp,_) => + (resolveOvlModExp firstpass modexp;resolveOvlSigExp firstpass sigexp) + | FUNCTORexp(modexp,sigexp,_) => + (resolveOvlModExp firstpass modexp;resolveOvlSigExp firstpass sigexp) +and resolveOvlMRule firstpass (MRule(ref pats, exp)) = + (app (resolveOvlPat firstpass) pats; + resolveOvlExp firstpass exp) +and resolveOvlDec firstpass (_, dec') = + case dec' of + VALdec (_, (pvbs, rvbs)) => + (app (resolveOvlValBind firstpass) pvbs; + app (resolveOvlValBind firstpass) rvbs) + | PRIM_VALdec (_,pbds) => + resolveOvlPrimValBindList firstpass pbds + | FUNdec (ref (UNRESfundec _)) => fatalError "resolveOvlDec" + | FUNdec (ref (RESfundec dec)) => resolveOvlDec firstpass dec + | TYPEdec tbds => resolveOvlTypBindList firstpass tbds + | PRIM_TYPEdec _ => () + | DATATYPEdec (dbds,SOME tbds) => + (resolveOvlDatBindList firstpass dbds; + resolveOvlTypBindList firstpass tbds) + | DATATYPEdec (dbds,NONE) => + (resolveOvlDatBindList firstpass dbds) + | DATATYPErepdec(_,tyconpath) => + resolveOvlTyConPath firstpass tyconpath + | ABSTYPEdec(dbds,NONE, dec2) => + (resolveOvlDatBindList firstpass dbds; + resolveOvlDec firstpass dec2) + | ABSTYPEdec(dbds,SOME tbds , dec2) => + (resolveOvlDatBindList firstpass dbds; + resolveOvlTypBindList firstpass tbds; + resolveOvlDec firstpass dec2) + | EXCEPTIONdec ebs => + resolveOvlExBindList firstpass ebs + | LOCALdec(dec1, dec2) => + (resolveOvlDec firstpass dec1; resolveOvlDec firstpass dec2) + | OPENdec _ => () + | EMPTYdec => () + | SEQdec(dec1, dec2) => + (resolveOvlDec firstpass dec1; resolveOvlDec firstpass dec2) + | FIXITYdec _ => () + | STRUCTUREdec mbs => + resolveOvlModBindList firstpass mbs + | FUNCTORdec fbs => + resolveOvlFunBindList firstpass fbs + | SIGNATUREdec sbs => + resolveOvlSigBindList firstpass sbs +and resolveOvlValBind firstpass (ValBind(ref pat, exp)) = + (resolveOvlPat firstpass pat; + resolveOvlExp firstpass exp) +and resolveOvlExBindList firstpass ebs = + app (fn EXDECexbind(_, SOME ty) => resolveOvlTy firstpass ty + | EXDECexbind(_, NONE) => () + | EXEQUALexbind(_,_) => ()) ebs +and resolveOvlModBindList firstpass mbs = + app (resolveOvlModBind firstpass) mbs +and resolveOvlModBind firstpass (MODBINDmodbind (_,modexp)) = + resolveOvlModExp firstpass modexp + | resolveOvlModBind firstpass (ASmodbind (modid,sigexp,exp)) = + (resolveOvlSigExp firstpass sigexp; + resolveOvlExp firstpass exp) +and resolveOvlFunBindList firstpass fbs = + app (resolveOvlFunBind firstpass) fbs +and resolveOvlFunBind firstpass (FUNBINDfunbind (funid,modexp)) = + resolveOvlModExp firstpass modexp + | resolveOvlFunBind firstpass (ASfunbind (funid,sigexp,exp)) = + (resolveOvlSigExp firstpass sigexp; + resolveOvlExp firstpass exp) +and resolveOvlSigBindList firstpass sbs = + app (resolveOvlSigBind firstpass) sbs +and resolveOvlSigBind firstpass (SIGBINDsigbind (_,sigexp)) = + resolveOvlSigExp firstpass sigexp +and resolveOvlModExp firstpass (loc,(modexp',_)) = + case modexp' of + DECmodexp dec => resolveOvlDec firstpass dec + | LONGmodexp _ => () + | CONmodexp (modexp,sigexp) => + (resolveOvlModExp firstpass modexp;resolveOvlSigExp firstpass sigexp) + | ABSmodexp (modexp,sigexp) => + (resolveOvlModExp firstpass modexp;resolveOvlSigExp firstpass sigexp) + | LETmodexp (dec,modexp) => + (resolveOvlDec firstpass dec;resolveOvlModExp firstpass modexp) + | PARmodexp modexp => + resolveOvlModExp firstpass modexp + | FUNCTORmodexp (_,modid,_,sigexp,modexp) => + (resolveOvlSigExp firstpass sigexp; + resolveOvlModExp firstpass modexp) + | APPmodexp (funmodexp,modexp) => + (resolveOvlModExp firstpass funmodexp; + resolveOvlModExp firstpass modexp) + | RECmodexp (modid,_,sigexp,modexp) => + (resolveOvlSigExp firstpass sigexp; + resolveOvlModExp firstpass modexp) +and resolveOvlTyConPath firstpass (_, LONGtyconpath _) = () + | resolveOvlTyConPath firstpass (_, WHEREtyconpath (_,_,modexp)) = + resolveOvlModExp firstpass modexp +and resolveOvlTy firstpass (_, ty') = + case ty' of + TYVARty ii => () + | RECty fs => + app (fn(_, ty) => resolveOvlTy firstpass ty) fs + | CONty(tys, _) => + app (resolveOvlTy firstpass) tys + | FNty(ty1, ty2) => + (resolveOvlTy firstpass ty1; + resolveOvlTy firstpass ty2) + | PACKty(sigexp) => + resolveOvlSigExp firstpass sigexp + | PARty(ty) => + resolveOvlTy firstpass ty +and resolveOvlSigExp firstpass (_,sigexp) = + case sigexp of + SPECsigexp spec => resolveOvlSpec firstpass spec + | SIGIDsigexp _ => () + | WHEREsigexp (sigexp, tyvarseq, longtycon, ty) => + (resolveOvlSigExp firstpass sigexp; + resolveOvlTy firstpass ty) + | FUNSIGsigexp (_,modid, sigexp,sigexp') => + (resolveOvlSigExp firstpass sigexp; + resolveOvlSigExp firstpass sigexp') + | RECsigexp (modid, sigexp,sigexp') => + (resolveOvlSigExp firstpass sigexp; + resolveOvlSigExp firstpass sigexp') +and resolveOvlSpec firstpass (_, spec') = + case spec' of + VALspec (_,vds) => resolveOvlValDescList firstpass vds + | PRIM_VALspec (_,pbs) => resolveOvlPrimValBindList firstpass pbs + | TYPEDESCspec _ => () + | TYPEspec tbds => resolveOvlTypBindList firstpass tbds + | DATATYPEspec (dbds,SOME tbds) => + (resolveOvlDatBindList firstpass dbds; + resolveOvlTypBindList firstpass tbds) + | DATATYPEspec (dbds,NONE) => + (resolveOvlDatBindList firstpass dbds) + | DATATYPErepspec (_,tyconpath) => + resolveOvlTyConPath firstpass tyconpath + | EXCEPTIONspec eds => + resolveOvlExDescList firstpass eds + | LOCALspec(spec1, spec2) => + (resolveOvlSpec firstpass spec1; + resolveOvlSpec firstpass spec2) + | OPENspec _ => () + | EMPTYspec => () + | SEQspec(spec1, spec2) => + (resolveOvlSpec firstpass spec1; + resolveOvlSpec firstpass spec2) + | INCLUDEspec sigexp => + resolveOvlSigExp firstpass sigexp + | STRUCTUREspec moddescs => + resolveOvlModDescList firstpass moddescs + | FUNCTORspec fundescs => + resolveOvlFunDescList firstpass fundescs + | SHARINGTYPEspec (spec, longtycons) => + resolveOvlSpec firstpass spec + | SHARINGspec (spec, longmodids) => + resolveOvlSpec firstpass spec + | FIXITYspec _ => () + | SIGNATUREspec sigdescs => + resolveOvlSigBindList firstpass sigdescs +and resolveOvlModDescList firstpass mds = + app (fn MODDESCmoddesc(modid,sigexp) => + resolveOvlSigExp firstpass sigexp) + mds +and resolveOvlFunDescList firstpass fds = + app (fn FUNDESCfundesc(modid,sigexp) => + resolveOvlSigExp firstpass sigexp) + fds +and resolveOvlTypBindList firstpass tbds = + app (fn (tyvarseq,tycon,ty) => resolveOvlTy firstpass ty) tbds +and resolveOvlExDescList firstpass eds = + app (fn (_,SOME ty) => resolveOvlTy firstpass ty + | (_,NONE) => ()) + eds +and resolveOvlDatBindList firstpass dbds = + app (fn (tyvarseq, tycon, cbds) => resolveOvlConBindList firstpass cbds) dbds +and resolveOvlConBindList firstpass cbds = + app (fn ConBind (ii, NONE) => () + | ConBind (ii, SOME ty) => resolveOvlTy firstpass ty) + cbds +and resolveOvlPrimValBindList firstpass (pbs) = + (app (fn (ii,ty,arity,n) => resolveOvlTy firstpass ty) pbs) +and resolveOvlValDescList firstpass vds = + app (fn (ii,ty) => resolveOvlTy firstpass ty) vds +; + +(* We perform two passes over the declaration to resolve overloading: + * Pass 1 resolves overloaded constants (and their default types), + * Pass 2 resolves overloaded operators (and their default types). + *) + +val resolveOvlDec = + fn dec => (resolveOvlDec true dec; resolveOvlDec false dec); + + + + + + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Parser.grm mosml-2.10.1/src/compiler.cminusminus/Parser.grm --- mosml-2.01/src/compiler.cminusminus/Parser.grm 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Parser.grm 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,1172 @@ +%{ + +open Fnlib Config Mixture Const Globals Location Types Asynt Asyntfn; + +fun rev acc [] = acc +| rev acc (h::t) = rev (h::acc) t; + +val anonId = "?"; +val anonQualId = {qual = "",id =[anonId]}; + +val mkDerivedfunbind = fn (funid,funsort,modid,sigexp,modexp) => + FUNBINDfunbind(funid,(xxLR modid modexp, + (FUNCTORmodexp(funsort,modid,ref VARik,sigexp,modexp),ref NONE))) + +local + fun flattenDec (dec as (loc,dec')) acc = + case dec' of + SEQdec (dec1,dec2) => flattenDec dec1 (flattenDec dec2 acc) + | _ => dec::acc +in +fun mkDerivedDecs (locmodexp as (loc,(modexp',_))) = + case modexp' of + DECmodexp dec => flattenDec dec [] + | _ => [(loc,LOCALdec ((loc,STRUCTUREdec [MODBINDmodbind((loc,anonId),locmodexp)]), + (loc,OPENdec [(mkIdInfo (loc,anonQualId) false,ref NONE)])))] +end +; + +%} + +%token ABSTYPE +%token AND +%token ANDALSO +%token ARROW +%token AS +%token BAR +%token CASE +%token CHAR +%token COLON +%token COLONGT +%token COMMA +%token DARROW +%token DATATYPE +%token DLBRACE +%token DO +%token DOTDOTDOT +%token DRBRACE +%token ELSE +%token END +%token EOF +%token EQTYPE +%token EQUALS +%token EXCEPTION +%token FN +%token FUN +%token FUNCTOR +%token HANDLE +%token HASH +%token HASHLBRACKET +%token ID +%token IF +%token IN +%token INCLUDE +%token INFIX +%token INFIXR +%token LBRACE +%token LBRACKET +%token LET +%token LOCAL +%token LPAREN +%token NEGINT +%token NONFIX +%token NZDIGIT +%token NZPOSINT2 +%token OF +%token OP +%token OPEN +%token ORELSE +%token PRIM_EQTYPE +%token PRIM_REFTYPE +%token PRIM_TYPE +%token PRIM_VAL +%token QUAL_ID +%token QUAL_STAR +%token QUOTEL +%token QUOTEM +%token QUOTER +%token RAISE +%token RBRACE +%token RBRACKET +%token REAL +%token REC +%token RPAREN +%token SEMICOLON +%token SHARING +%token SIG +%token SIGNATURE +%token STAR +%token STRING +%token STRUCT +%token STRUCTURE +%token THEN +%token TYPE +%token TYVAR +%token UNDERBAR +%token VAL +%token WHERE +%token WHILE +%token WITH +%token WITHTYPE +%token WORD +%token ZDIGIT +%token ZPOSINT2 + +%right AND +%nonassoc DARROW +%nonassoc BAR +%nonassoc ELSE +%nonassoc DO +%nonassoc RAISE +%right HANDLE +%right ORELSE +%right ANDALSO +%right AS + +/* cvr: in Mosml144, COLON was nonassociative but this conflicts + with the modexp COLON SigExp production */ +/* %nonassoc COLON */ + +%right ARROW +%nonassoc ID EQUALS +%right STAR + + + +%start ToplevelPhrase +%type ToplevelPhrase + +%start SigFile +%type SigFile + +%start StructFile +%type StructFile + +%start TopSpecFile +%type TopSpecFile + +%start TopDecFile +%type TopDecFile + + +%type EOPh +%type Ident EqIdent +%type IdentWithLoc +%type OpIdent TypeIdent LongTypeIdent +%type LongIdent LongOpIdent LongOpEqIdent +%type TyVar +%type TyCon +%type ModId +%type SigId + + + +%type EqIdent_seq1 +%type DIGIT_opt Integer NumLabel Arity +%type SemiEof +%type Label +%type SCon +%type Dec KWDec_seq1 KWDec KWCoreDec KWModuleDec +%type KWDec_seq KWCoreDec_seq +%type ValBind AndValBind_opt +%type PrimValBind AndPrimValBind_opt +%type FnValBind AndFnValBind_opt +%type TypBind AndTypBind_opt +%type TypDesc AndTypDesc_opt +%type DatBind AndDatBind_opt DatBind_0 DatBind_n +%type ConBind BarConBind_opt +%type WithType_opt +%type ExBind AndExBind_opt +%type ExDesc AndExDesc_opt +%type OfTy_opt ColonTy_opt +%type FValBind AndFValBind_opt +%type FClauseWithLoc +%type FClause BarFClause_opt +%type VIdPathInfo +%type InfixExp +%type AtExp Exp +%type ExpComma_seq0 ExpComma_seq1 ExpComma_seq2 + QuoteTail ExpQuoteTail +%type ExpSemicolon_seq2 +%type AtExp_seq1 +%type ExpRow_opt ExpRow CommaExpRow_opt +%type Match +%type MatchWithLoc +%type MRule +%type InfixPat +%type Pat AtPat +%type AtPat_seq1 +%type PatComma_seq0 PatComma_seq1 PatComma_seq2 +%type PatRow_opt PatRow CommaPatRow_opt +%type AsPat_opt +%type TyConPath +%type Ty Ty_sans_STAR AtomicTy +%type TupleTy TyComma_seq2 +%type TyRow_opt TyRow CommaTyRow_opt +%type TyVarSeq TyVarSeq1 TyVarComma_seq1 +%type Spec KWSpec KWCoreSpec KWModuleSpec +%type Spec_seq CoreSpec_seq +%type ValDesc AndValDesc_opt +%type LongModId +%type LongModIdInfo_seq1 +%type ModBind_seq1 AndModBind_opt +%type FunBind_seq1 AndFunBind_opt +%type SigBind_seq1 AndSigBind_opt +%type AtModExp ModExp FunBindBody OptConEqualsModExp +%type AtModExp_seq1 +%type ModDesc_seq1 AndModDesc_opt +%type FunDesc_seq1 AndFunDesc_opt +%type SigExp FunDescBody +%type SigId_seq2 +%type LongTyConEqn LongTyConEqnTail +%type LongModIdEqnTail LongModIdEqn +%type LongModIdEqnWithLoc +%type <(Location * (Asynt.TyVarSeq * Asynt.LongTyCon * Asynt.Ty)) list> WhereType AndWhereType_opt +%type <(Asynt.ModId * ModExp) option> WhereModBind_opt +%% + + + +Ident : + ID { $1 } + | STAR { "*" } +; + +IdentWithLoc : + Ident { mkLoc($1) } +; + +OpIdent : + Ident { mkIdInfo (mkLoc { qual="", id=[$1] }) false } + | OP Ident { mkIdInfo (mkLoc { qual="", id=[$2] }) true } +; + +EqIdent : + Ident { $1 } + | EQUALS { "=" } +; + + +ModId : + IdentWithLoc { $1 } +; + +SigId : + IdentWithLoc { $1 } +; + +TypeIdent : + ID { mkIdInfo (mkLoc { qual="", id=[$1] }) false } +; + +LongTypeIdent : + TypeIdent { $1 } + | QUAL_ID { mkIdInfo (mkLoc $1) false } +; + +LongIdent : + Ident { mkIdInfo (mkLoc { qual="", id=[$1] }) false } + | QUAL_ID { mkIdInfo (mkLoc $1) false } + | QUAL_STAR { mkIdInfo (mkLoc $1) false } +; + +LongOpIdent : + LongIdent { $1 } + | OP Ident { mkIdInfo (mkLoc { qual="", id=[$2] }) true } + | OP QUAL_ID { mkIdInfo (mkLoc $2) true } + | OP QUAL_STAR { mkIdInfo (mkLoc $2) true } +; + +LongOpEqIdent : + LongOpIdent { $1 } + | EQUALS { mkIdInfo (mkLoc { qual="", id=["="] }) false } + | OP EQUALS { mkIdInfo (mkLoc { qual="", id=["="] }) true } +; + +TyVar : + TYVAR { mkIdInfo (mkLoc { qual="", id=[$1] }) false } +; + +EqIdent_seq1 : + EqIdent EqIdent_seq1 { $1 :: $2 } + | EqIdent { [$1] } +; + +LongModId : + LongOpIdent {$1} + +LongModIdInfo_seq1 : + LongModId LongModIdInfo_seq1 { (($1,ref NONE)) :: $2 } + | LongModId { [($1, ref NONE)] } +; + +DIGIT_opt : + ZDIGIT { $1 } + | NZDIGIT { $1 } + | /* */ { 0 } +; + +Integer : + ZPOSINT2 { $1 } + | NZPOSINT2 { $1 } + | NEGINT { $1 } + | ZDIGIT { $1 } + | NZDIGIT { $1 } +; + +NumLabel : + NZPOSINT2 { $1 } + | NZDIGIT { $1 } +; + +Label : + Ident { STRINGlab $1 } + | NumLabel { INTlab $1 } +; + +Arity : + ZPOSINT2 { $1 } + | NZPOSINT2 { $1 } + | ZDIGIT { $1 } + | NZDIGIT { $1 } +; + +ToplevelPhrase : + Exp EOPh { (mkValIt $1, $2) } + | KWDec_seq1 EOPh { ($1, $2) } + | EOPh { (mkLoc(EMPTYdec), $1) } +; + +EOPh : + SEMICOLON { false } + | EOF { true } +; + +SemiEof : + SEMICOLON SemiEof { } + | EOF { } +; + +Dec : + KWDec Dec { mkLoc(SEQdec($1, $2)) } + | SEMICOLON Dec { $2 } + | /* */ { mkLoc(EMPTYdec) } +; + +KWDec_seq1 : + KWDec KWDec_seq1 { mkLoc(SEQdec($1,$2)) } + | KWDec { $1 } +; + +TopDecFile : + KWDec_seq EOF { TopDecs $1 } /* cvr: TODO allow expressions? */ +; + +StructFile : + STRUCTURE ModId EQUALS ModExp SemiEof + { NamedStruct{locstrid = $2, locsigid = NONE, decs = mkDerivedDecs $4} } + | STRUCTURE ModId COLONGT SigId EQUALS ModExp SemiEof + { Abstraction{locstrid = $2, locsigid = $4, decs = mkDerivedDecs $6} } + | KWCoreDec_seq EOF { AnonStruct $1 } /* backwards compatability mode * */ +; + +KWDec_seq : + KWDec KWDec_seq { $1 :: $2 } + | SEMICOLON KWDec_seq { $2 } + | /* */ { [] } +; + +KWCoreDec_seq : + KWCoreDec KWCoreDec_seq { $1 :: $2 } + | SEMICOLON KWCoreDec_seq { $2 } + | /* */ { [] } +; + +KWDec : + KWCoreDec {$1} +| KWModuleDec {$1} +; + +KWModuleDec: + STRUCTURE ModBind_seq1 { mkLoc(STRUCTUREdec $2)} + | FUNCTOR FunBind_seq1 { mkLoc(FUNCTORdec $2)} + | SIGNATURE SigBind_seq1 { mkLoc(SIGNATUREdec $2)} +; + + +KWCoreDec : + VAL ValBind { mkLoc(VALdec ([], $2)) } /* cvr: REVIEW */ + | VAL TyVarSeq1 ValBind { mkLoc(VALdec ($2, $3)) } + | PRIM_VAL PrimValBind { mkLoc(PRIM_VALdec ([],$2)) } /* cvr: REVIEW */ + | PRIM_VAL TyVarSeq1 PrimValBind + { mkLoc(PRIM_VALdec ($2,$3)) } + | FUN FValBind { mkLoc(FUNdec (ref (UNRESfundec([], $2)))) } + | FUN TyVarSeq1 FValBind { mkLoc(FUNdec (ref (UNRESfundec($2, $3)))) } + | TYPE TypBind { mkLoc(TYPEdec $2) } + | PRIM_TYPE TypDesc { mkLoc(PRIM_TYPEdec(FALSEequ, $2)) } + | PRIM_EQTYPE TypDesc { mkLoc(PRIM_TYPEdec(TRUEequ, $2)) } + | PRIM_REFTYPE TypDesc { mkLoc(PRIM_TYPEdec(REFequ, $2)) } + | DATATYPE DatBind_0 WithType_opt + { mkLoc(DATATYPEdec($2,$3)) } + | DATATYPE DatBind_n WithType_opt + { mkLoc(DATATYPEdec($2,$3)) } +/* cvr: this simpler production cause a shift/reduce conflict + with datatype replication + | DATATYPE DatBind WithType_opt + { mkLoc(DATATYPEdec($2,$3)) } */ + | DATATYPE TyCon EQUALS DATATYPE TyConPath + { mkLoc(DATATYPErepdec($2,$5))} + | ABSTYPE DatBind WithType_opt WITH Dec END + { mkLoc(ABSTYPEdec($2,$3,$5)) } + | EXCEPTION ExBind { mkLoc(EXCEPTIONdec $2) } + | LOCAL Dec IN Dec END { mkLoc(LOCALdec($2,$4)) } + | OPEN LongModIdInfo_seq1 { mkLoc(OPENdec $2) } + | INFIX DIGIT_opt EqIdent_seq1 + { mkLoc(FIXITYdec(INFIXst $2, $3)) } + | INFIXR DIGIT_opt EqIdent_seq1 + { mkLoc(FIXITYdec(INFIXRst $2, $3)) } + | NONFIX EqIdent_seq1 + { mkLoc(FIXITYdec(NONFIXst, $2)) } +; + +ValBind : + Pat EQUALS Exp AndValBind_opt + { let val (pvbs, rvbs) = $4 + in (ValBind(ref $1, $3)::pvbs, rvbs) end } + | REC FnValBind + { ([], $2) } +; + +AndValBind_opt : + AND ValBind { $2 } + | /* */ { ([], []) } +; + +PrimValBind : + OpIdent COLON Ty EQUALS Arity STRING AndPrimValBind_opt + { ($1, $3, $5, $6) :: $7 } +; + +AndPrimValBind_opt : + AND PrimValBind { $2 } + | /* */ { [] } +; + +FnValBind : + Pat EQUALS Exp AndFnValBind_opt + { ValBind(ref $1, $3) :: $4 } + | REC FnValBind { $2 } +; + +AndFnValBind_opt : + AND FnValBind { $2 } + | /* */ { [] } +; + +TypBind : + TyVarSeq TyCon EQUALS Ty AndTypBind_opt + { ($1, $2, $4) :: $5 } +; + +AndTypBind_opt : + AND TypBind { $2 } + | /* */ { [] } +; + +DatBind : + TyVarSeq TyCon EQUALS ConBind AndDatBind_opt + { ($1, $2, $4) :: $5 } +; + +DatBind_0 : + TyCon EQUALS ConBind AndDatBind_opt + { ([], $1, $3) :: $4 } +; + +DatBind_n : + TyVarSeq1 TyCon EQUALS ConBind AndDatBind_opt + { ($1, $2, $4) :: $5 } +; + +AndDatBind_opt : + AND DatBind { $2 } + | /* */ { [] } +; + +ConBind : + OpIdent OfTy_opt BarConBind_opt { ConBind($1, $2) :: $3 } +; + +BarConBind_opt : + BAR ConBind { $2 } + | /* */ { [] } +; + +WithType_opt : + WITHTYPE TypBind { SOME $2 } + | /* */ { NONE } + +ExBind : + OpIdent OfTy_opt AndExBind_opt { EXDECexbind($1,$2) :: $3 } + | OpIdent EQUALS LongOpEqIdent AndExBind_opt { EXEQUALexbind($1,$3) :: $4 } +; + +AndExBind_opt : + AND ExBind { $2 } + | /* */ { [] } +; + +ExDesc : + OpIdent OfTy_opt AndExDesc_opt { ($1,$2) :: $3 } +; + +AndExDesc_opt : + AND ExDesc { $2 } + | /* */ { [] } +; + +ColonTy_opt : + COLON Ty { SOME $2 } + | /* */ { NONE } + +OfTy_opt : + OF Ty { SOME $2 } + | /* */ { NONE } +; + +FValBind : + FClauseWithLoc AndFValBind_opt { $1 :: $2 } +; + +AndFValBind_opt : + AND FValBind { $2 } + | /* */ { [] } +; + +FClauseWithLoc : + FClause { mkLoc $1 } +; + +FClause : + AtPat_seq1 ColonTy_opt EQUALS Exp BarFClause_opt + { let val rhs = (case $2 of + SOME ty => (xxLR ty $4, TYPEDexp($4,ty)) + | NONE => $4) + in FClause(ref $1, rhs) :: $5 end } +; + +BarFClause_opt : + BAR FClause { $2 } + | /* */ { [] } +; + +SCon : + Integer { INTscon $1 } + | WORD { WORDscon $1 } + | CHAR { CHARscon $1 } + | REAL { REALscon $1 } + | STRING { STRINGscon $1 } +; + +VIdPathInfo : + LongOpEqIdent {RESvidpath $1} +; + +AtExp : + SCon { mkLoc(SCONexp($1, ref NONE)) } + | VIdPathInfo { mkLoc(VIDPATHexp(ref $1)) } + | LET Dec IN Exp END { mkLoc(LETexp($2,$4)) } + | HASH Label { hashLabelExp(mkLoc $2) } + | LPAREN Exp RPAREN { mkLoc(PARexp $2) } + | LPAREN RPAREN { tupleExp(mkLoc []) } + | LPAREN ExpComma_seq2 RPAREN + { tupleExp(mkLoc $2) } + | LPAREN ExpSemicolon_seq2 RPAREN + { seqExp $2 } + | LBRACE ExpRow_opt RBRACE + { mkLoc(RECexp(ref (RECre $2))) } + | LET Dec IN ExpSemicolon_seq2 END + { mkLoc(LETexp($2, seqExp $4)) } + | LBRACKET STRUCTURE ModExp AS SigExp RBRACKET + { mkLoc(STRUCTUREexp($3,$5,ref NONE)) } + | LBRACKET FUNCTOR ModExp AS SigExp RBRACKET + { mkLoc(FUNCTORexp($3,$5,ref NONE)) } + | LBRACKET ExpComma_seq0 RBRACKET + { listExp(mkLoc $2) } + | HASHLBRACKET ExpComma_seq0 RBRACKET + { mkLoc(VECexp $2) } + | QUOTEL QuoteTail + { listExp(mkLoc $2) } +; + +QuoteTail : + QUOTER + { [quoteExp(mkLoc(SCONexp(STRINGscon $1, ref NONE)))] } + | QUOTEM ExpQuoteTail + { quoteExp(mkLoc(SCONexp(STRINGscon $1, ref NONE))) :: $2 } +; + +ExpQuoteTail : + Exp QuoteTail { antiquoteExp($1) :: $2 } +; + +ExpComma_seq0 : + ExpComma_seq1 { $1 } + | /* */ { [] } +; + +ExpComma_seq1 : + Exp COMMA ExpComma_seq1 { $1 :: $3 } + | Exp { [$1] } +; + +ExpComma_seq2 : + Exp COMMA ExpComma_seq1 { $1 :: $3 } +; + +ExpSemicolon_seq2 : + Exp SEMICOLON ExpSemicolon_seq2 { $1 :: $3 } + | Exp SEMICOLON Exp { [$1, $3] } + +AtExp_seq1 : + AtExp AtExp_seq1 { $1 :: $2 } + | AtExp { [$1] } +; + +ExpRow_opt : + ExpRow { $1 } + | /* */ { [] } +; + +ExpRow : + Label EQUALS Exp CommaExpRow_opt { ($1,$3)::$4 } +; + +CommaExpRow_opt : + COMMA ExpRow { $2 } + | /* */ { [] } +; + +InfixExp : + AtExp_seq1 {UNRESinfixexp $1} +Exp : + InfixExp { mkLoc(INFIXexp (ref $1)) } + | Exp COLON Ty { mkLoc(TYPEDexp($1,$3)) } + | Exp ANDALSO Exp { mkLoc(ANDALSOexp($1,$3)) } + | Exp ORELSE Exp { mkLoc(ORELSEexp($1,$3)) } + | Exp HANDLE Match { mkLoc(HANDLEexp($1,$3)) } + | RAISE Exp { mkLoc(RAISEexp $2) } + | IF Exp THEN Exp ELSE Exp { mkLoc(IFexp($2,$4,$6)) } + | WHILE Exp DO Exp { mkLoc(WHILEexp($2,$4)) } + | CASE Exp OF MatchWithLoc + { let val (loc, mrules) = $4 + in mkLoc(APPexp((loc, FNexp mrules), $2)) end } + | FN Match { mkLoc(FNexp $2) } +; + +MatchWithLoc : + Match { mkLoc $1 } +; + +Match : + MRule BAR Match { $1 :: $3 } + | MRule %prec DARROW { [$1] } +; + +MRule : + Pat DARROW Exp { MRule(ref [$1],$3) } +; + +InfixPat : + AtPat_seq1 { UNRESinfixpat $1} +Pat : + InfixPat { mkLoc(INFIXpat (ref $1)) } + | Pat COLON Ty { mkLoc(TYPEDpat($1,$3)) } + | Pat AS Pat { mkLoc(LAYEREDpat($1,$3)) } +; + +AtPat : + UNDERBAR { mkLoc(WILDCARDpat) } + | SCon { mkLoc(SCONpat($1, ref NONE)) } + | LongOpIdent { mkLoc(VARpat $1) } + | LBRACE PatRow_opt RBRACE + { let val (fs, flexible) = $2 in + if flexible then + mkLoc(RECpat(ref (RECrp(fs, SOME (fresh3DotType()))))) + else + mkLoc(RECpat(ref (RECrp(fs, NONE)))) + end } + | LPAREN Pat RPAREN { mkLoc(PARpat $2) } + | LPAREN RPAREN { tuplePat(mkLoc []) } + | LPAREN PatComma_seq2 RPAREN + { tuplePat(mkLoc $2) } + | LBRACKET PatComma_seq0 RBRACKET + { listPat(mkLoc $2) } + | HASHLBRACKET PatComma_seq0 RBRACKET + { mkLoc(VECpat $2) } +; + +PatRow_opt : + PatRow { $1 } + | /* */ { ([], false) } +; + +PatRow : + DOTDOTDOT { ([],true) } + | Label EQUALS Pat CommaPatRow_opt + { let val (fs, flexible) = $4 + in (($1,$3)::fs, flexible) end } + | IdentWithLoc ColonTy_opt AsPat_opt CommaPatRow_opt + { let val (fs, flexible) = $4 + in (mkLabPatOfId $1 $2 $3::fs, flexible) end } +; + +AsPat_opt : + AS Pat { SOME $2 } + | /* */ { NONE } +; + +CommaPatRow_opt : + COMMA PatRow { $2 } + | /* */ { ([], false) } +; + +AtPat_seq1 : + AtPat AtPat_seq1 { $1 :: $2 } + | AtPat { [$1] } +; + +PatComma_seq0 : + PatComma_seq1 { $1 } + | /* */ { [] } +; + +PatComma_seq1 : + Pat COMMA PatComma_seq1 { $1 :: $3 } + | Pat { [$1] } +; + +PatComma_seq2 : + Pat COMMA PatComma_seq1 { $1 :: $3 } +; + +TyCon : + ID {mkLoc $1} +; + +WhereModBind_opt : + WHERE ModId OptConEqualsModExp {SOME($2,$3)} + + | /* */ {NONE} + + +TyConPath : + LongTypeIdent WhereModBind_opt {(case $2 of + NONE => mkLoc(LONGtyconpath $1) + | SOME (modid,modexp) => + mkLoc(WHEREtyconpath($1,modid,modexp))) } +; + +Ty : + TupleTy ARROW Ty { mkLoc(FNty( tupleTy $1, $3)) } + | TupleTy { tupleTy $1 } +; + +TupleTy : + Ty_sans_STAR { [$1] } + | Ty_sans_STAR STAR TupleTy { $1 :: $3 } +; + +Ty_sans_STAR : + LPAREN TyComma_seq2 RPAREN TyConPath { mkLoc(CONty($2, $4)) } + | Ty_sans_STAR TyConPath { mkLoc(CONty([$1], $2)) } + | AtomicTy { $1 } +; + +TyComma_seq2 : + Ty COMMA TyComma_seq2 { $1 :: $3 } + | Ty COMMA Ty { [$1, $3] } +; + +AtomicTy : + TyConPath { mkLoc(CONty([], $1)) } + | TyVar { mkLoc(TYVARty $1) } + | LBRACE TyRow_opt RBRACE { mkLoc(RECty $2) } + | LBRACKET SigExp RBRACKET { mkLoc(PACKty $2) } + | LPAREN Ty RPAREN { mkLoc(PARty($2)) } +; + +TyRow_opt : + TyRow { $1 } + | /* */ { [] } +; + +TyRow : + Label COLON Ty CommaTyRow_opt { ($1,$3)::$4 } +; + +CommaTyRow_opt : + COMMA TyRow { $2 } + | /* */ { [] } +; + +TyVarSeq : + TyVarSeq1 { $1 } + | /* */ { [] } +; + + +TyVarSeq1 : + TyVar { [$1] } + | LPAREN TyVarComma_seq1 RPAREN { $2 } +; + +TyVarComma_seq1 : + TyVar COMMA TyVarComma_seq1 { $1 :: $3 } + | TyVar { [$1] } +; + +LongTyConEqnTail : + LongTypeIdent { [$1]} + | LongTyConEqn { $1 } + +LongTyConEqn : + LongTypeIdent EQUALS LongTyConEqnTail {$1 :: $3} + +LongModIdEqnTail : + LongModId { [$1]} + | LongModIdEqn { $1 } +; +LongModIdEqn: + LongModId EQUALS LongModIdEqnTail {$1 :: $3}; +; +LongModIdEqnWithLoc : + LongModIdEqn {mkLoc($1)} +; + +Spec : + Spec KWSpec { mkLoc(SEQspec($1, $2)) } + | Spec SHARING TYPE LongTyConEqn + {mkLoc(SHARINGTYPEspec($1,$4))} + | Spec SHARING LongModIdEqnWithLoc + {mkLoc(SHARINGspec($1,$3))} + | Spec SEMICOLON { $1 } + | /* */ {mkLoc(EMPTYspec) } +; + + +TopSpecFile : + Spec_seq EOF { TopSpecs (rev [] $1) } +; + +SigFile : + SIGNATURE SigId EQUALS SigExp SemiEof + { NamedSig{locsigid = $2, sigexp = $4 } } + | CoreSpec_seq EOF { AnonSig (rev [] $1) } +; + +Spec_seq : + Spec_seq KWSpec { $2 :: $1 } + | Spec_seq SEMICOLON { $1 } + | /* */ { [] } +; + +CoreSpec_seq : + CoreSpec_seq KWCoreSpec { $2 :: $1 } + | CoreSpec_seq SEMICOLON { $1 } + | /* */ { [] } +; + +KWSpec : + KWCoreSpec {$1} + | KWModuleSpec {$1} +; + +KWCoreSpec : + VAL TyVarSeq ValDesc { mkLoc(VALspec ($2,$3)) } + | PRIM_VAL PrimValBind { mkLoc(PRIM_VALspec ([],$2)) } + | PRIM_VAL TyVarSeq1 PrimValBind + { mkLoc(PRIM_VALspec ($2,$3)) } + | TYPE TypBind { mkLoc(TYPEspec $2) } + | TYPE TypDesc { mkLoc(TYPEDESCspec(FALSEequ, $2)) } + | EQTYPE TypDesc { mkLoc(TYPEDESCspec(TRUEequ, $2)) } + | PRIM_REFTYPE TypDesc { mkLoc(TYPEDESCspec(REFequ, $2)) } + | DATATYPE DatBind_0 WithType_opt + { mkLoc(DATATYPEspec($2,$3)) } + | DATATYPE DatBind_n WithType_opt + { mkLoc(DATATYPEspec($2,$3)) } +/* cvr: this simpler production cause a shift/reduce conflict + with datatype replication + | DATATYPE DatBind WithType_opt + { mkLoc(DATATYPEspec($2,$3)) } */ + | DATATYPE TyCon EQUALS DATATYPE TyConPath + { mkLoc(DATATYPErepspec($2,$5))} + | EXCEPTION ExDesc { mkLoc(EXCEPTIONspec $2) } + | LOCAL Spec IN Spec END { mkLoc(LOCALspec($2,$4)) } + | OPEN LongModIdInfo_seq1 { mkLoc(OPENspec $2) } + | INFIX DIGIT_opt EqIdent_seq1 + { mkLoc(FIXITYspec(INFIXst $2, $3)) } + | INFIXR DIGIT_opt EqIdent_seq1 + { mkLoc(FIXITYspec(INFIXRst $2, $3)) } + | NONFIX EqIdent_seq1 + { mkLoc(FIXITYspec(NONFIXst, $2)) } +; + +SigId_seq2 : + SigId SigId_seq2 {$1::$2} + | SigId SigId {[$1,$2]} +; + +KWModuleSpec : + STRUCTURE ModDesc_seq1 { mkLoc(STRUCTUREspec $2)} + | FUNCTOR FunDesc_seq1 { mkLoc(FUNCTORspec $2)} + | INCLUDE SigExp { mkLoc(INCLUDEspec $2)} + | INCLUDE SigId_seq2 /* derived form */ + { mkLoc(foldR (fn locsigid => fn spec => + (SEQspec(mkLoc(INCLUDEspec (xLR(locsigid), + SIGIDsigexp locsigid)), + mkLoc(spec)))) + (EMPTYspec) + ($2))} + | SIGNATURE SigBind_seq1 { mkLoc(SIGNATUREspec $2)} +; + +ValDesc : + OpIdent COLON Ty AndValDesc_opt + { ($1, $3) :: $4 } +; + +AndValDesc_opt : + AND ValDesc { $2 } + | /* */ { [] } +; + +TypDesc : + TyVarSeq TyCon AndTypDesc_opt + { ($1, $2) :: $3 } +; + +AndTypDesc_opt : + AND TypDesc { $2 } + | /* */ { [] } +; + +ModBind_seq1 : + ModId OptConEqualsModExp AndModBind_opt + { (MODBINDmodbind($1, $2 )) :: $3 } + | ModId AS SigExp EQUALS Exp AndModBind_opt + { (ASmodbind($1,$3,$5)) :: $6 } +; + +AndModBind_opt : + AND ModBind_seq1 { $2 } + | /* */ { [] } +; + +/* cvr: TODO for some reason, this rule introduces loads of shift_reduce conflicts */ +OptConEqualsModExp : + EQUALS ModExp {$2} + | COLON SigExp EQUALS ModExp {mkLoc((CONmodexp($4,$2)),ref NONE)} + | COLONGT SigExp EQUALS ModExp {mkLoc((ABSmodexp($4,$2)),ref NONE)} + +FunBind_seq1 : /* cvr: TODO rationalize */ + ModId AS SigExp EQUALS Exp AndFunBind_opt + { (ASfunbind($1,$3,$5)) :: $6 } +| ModId OptConEqualsModExp AndFunBind_opt + { (FUNBINDfunbind($1, $2 )) :: $3 } +| ModId LPAREN ModId COLON SigExp RPAREN FunBindBody AndFunBind_opt + {(FUNBINDfunbind($1, + mkLoc(FUNCTORmodexp(Generative true,$3,ref VARik,$5,$7), + ref NONE)) + ::$8)} +| ModId LPAREN Spec RPAREN OptConEqualsModExp AndFunBind_opt + {let val modid = (xLR $3,anonId) + val longmodidinfo = (mkIdInfo (xLR $3, anonQualId) false,ref NONE) + in + (mkDerivedfunbind($1, + Generative true, + modid, + (xLR $3,SPECsigexp $3), + (xLR $5,(LETmodexp((xLR $5,OPENdec([longmodidinfo])), + $5), + ref NONE)))) + :: $6 + end} +| ModId ModId COLON SigExp FunBindBody AndFunBind_opt + {(FUNBINDfunbind($1, + mkLoc(FUNCTORmodexp(Applicative,$2,ref VARik,$4,$5), + ref NONE)) + ::$6)} + +| ModId SIG Spec END OptConEqualsModExp AndFunBind_opt + {let val modid = (xLR $3,anonId) + val longmodidinfo = (mkIdInfo (xLR $3, anonQualId) false,ref NONE) + in + (mkDerivedfunbind($1, + Applicative, + modid, + (xLR $3,SPECsigexp $3), + (xLR $5,(LETmodexp((xLR $5,OPENdec([longmodidinfo])), + $5), + ref NONE)))) + :: $6 + end} +/* cvr: the version below causes a shift/reduce conflict when spec is empty +| FunId Spec OptConEqualsModExp AndFunBind_opt + {let val modid = (xLR $3,anonId) + val longmodidinfo = (mkIdInfo (xLR $2, anonQualId) false,ref NONE) + in + (mkDerivedfunbind($1, + Applicative, + modid, + (xLR $2,SPECsigexp $2), + (xLR $3,(LETmodexp((xLR $3,OPENdec([longmodidinfo])), + $3), + ref NONE)))) + :: $4 + end} +*/ +; + +AndFunBind_opt : + AND FunBind_seq1 { $2 } + | /* */ { [] } +; + + +SigBind_seq1 : + SigId EQUALS SigExp AndSigBind_opt + { (SIGBINDsigbind($1, $3)) :: $4} +; + +AndSigBind_opt : + AND SigBind_seq1 { $2 } + | /* */ { [] } +; + + +FunBindBody : + OptConEqualsModExp {$1} + | LPAREN ModId COLON SigExp RPAREN FunBindBody + { mkLoc(FUNCTORmodexp(Generative false,$2,ref VARik,$4,$6),ref NONE) } + | ModId COLON SigExp FunBindBody + { mkLoc(FUNCTORmodexp(Applicative,$1,ref VARik,$3,$4),ref NONE) } +; + + +AtModExp : + STRUCT Dec END {mkLoc((DECmodexp $2,ref NONE))} + | LongModId {mkLoc((LONGmodexp $1,ref NONE))} + | LET Dec IN ModExp END {mkLoc((LETmodexp($2,$4),ref NONE))} + | LPAREN ModExp RPAREN {mkLoc((PARmodexp($2),ref NONE))} + | LPAREN Dec RPAREN {mkLoc((PARmodexp((xLR $2,(DECmodexp $2,ref NONE))),ref NONE))} /* derived form */ + +; + + +ModExp : + AtModExp_seq1 + {(case $1 of + (atmodexp::atmodexps) => + foldL (fn locmodexp => + fn locfunexp => + (xxLR locfunexp locmodexp, + (APPmodexp(locfunexp,locmodexp),ref NONE))) + atmodexp + atmodexps + | [] => fatalError "Parser.ModExp")} + | ModExp COLONGT SigExp {mkLoc((ABSmodexp($1,$3),ref NONE))} + | ModExp COLON SigExp {mkLoc((CONmodexp($1,$3),ref NONE))} + | FUNCTOR ModId COLON SigExp DARROW ModExp + {mkLoc((FUNCTORmodexp(Applicative,$2,ref VARik,$4,$6),ref NONE))} + | FUNCTOR LPAREN ModId COLON SigExp RPAREN DARROW ModExp + {mkLoc((FUNCTORmodexp(Generative false,$3,ref VARik,$5,$8),ref NONE))} + | REC LPAREN ModId COLON SigExp RPAREN ModExp + {mkLoc((RECmodexp($3,ref NONE,$5,$7),ref NONE))} +; + +AtModExp_seq1 : + AtModExp AtModExp_seq1 { $1:: $2 } + | AtModExp { [$1] } +; + +ModDesc_seq1 : + ModId COLON SigExp AndModDesc_opt + { (MODDESCmoddesc($1, $3 )) :: $4 } +; + +AndModDesc_opt : + AND ModDesc_seq1 { $2 } + | /* */ { [] } +; + +FunDescBody : + COLON SigExp {$2} + | LPAREN ModId COLON SigExp RPAREN FunDescBody + {mkLoc(FUNSIGsigexp(Generative false,$2,$4,$6))} + | ModId COLON SigExp FunDescBody + {mkLoc(FUNSIGsigexp(Applicative,$1,$3,$4)) } +; +FunDesc_seq1 : + ModId FunDescBody AndFunDesc_opt + { (FUNDESCfundesc($1, $2)) :: $3 } +; + +AndFunDesc_opt : + AND FunDesc_seq1 { $2 } + | /* */ { [] } +; + +/* + AtSigExp : + SIG Spec END {mkLoc(SPECsigexp $2)} + | SigId {mkLoc(SIGIDsigexp $1)} +*/ + +SigExp : + SIG Spec END {mkLoc(SPECsigexp $2)} + | SigId {mkLoc(SIGIDsigexp $1)} + | SigExp WHERE WhereType + { foldL (fn (loc,(tyvarseq,longtycon,ty)) => fn sigexp => + (loc,WHEREsigexp(sigexp,tyvarseq,longtycon,ty))) + ($1) + ($3)} + | FUNCTOR LPAREN ModId COLON SigExp RPAREN ARROW SigExp + {mkLoc(FUNSIGsigexp(Generative false,$3,$5,$8))} + | FUNCTOR ModId COLON SigExp ARROW SigExp + {mkLoc(FUNSIGsigexp(Applicative,$2,$4,$6))} + | REC LPAREN ModId COLON SigExp RPAREN SigExp + {mkLoc(RECsigexp($3,$5,$7))} +; + + +WhereType : + TYPE TyVarSeq LongTypeIdent EQUALS Ty AndWhereType_opt + { mkLoc(($2,$3,$5)) :: $6 } +; + +AndWhereType_opt : + AND WhereType { $2 } + | { [] } +; + + + + + + + + + + + + + + + + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Patch.sml mosml-2.10.1/src/compiler.cminusminus/Patch.sml --- mosml-2.01/src/compiler.cminusminus/Patch.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Patch.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,40 @@ +local + + open Code_dec Symtable; + + prim_val set_nth_char_ : string -> int -> char -> unit = 3 "set_nth_char"; + prim_val andb_ : int -> int -> int = 2 "and"; + prim_val rshiftsig_ : int -> int -> int = 2 "shift_right_signed"; + prim_val rshiftuns_ : int -> int -> int = 2 "shift_right_unsigned"; + + + fun patch_short buff pos v = + ( + (* `set_nth_char` must not check the length of buff, *) + (* because buff may be allocated outside the heap! *) + set_nth_char_ buff pos (Char.chr (andb_ v 255)); + set_nth_char_ buff (pos+1) (Char.chr (rshiftuns_ v 8)) + ); + +in + +(* To relocate a block of object bytecode *) + +fun patch_object buff offset (stringlist, otherlist) = + let fun relliteral (lit, poss) = + let val slot = get_slot_for_literal lit + fun patchlit pos = patch_short buff (pos + offset) slot + in List.app patchlit poss end + fun relother (Reloc_literal sc, pos) = + patch_short buff (pos + offset) (get_slot_for_literal sc) + | relother (Reloc_getglobal uid, pos) = + patch_short buff (pos + offset) (get_slot_for_variable uid) + | relother (Reloc_setglobal uid, pos) = + patch_short buff (pos + offset) (get_slot_for_defined_variable uid) + | relother (Reloc_primitive name, pos) = + patch_short buff (pos + offset) (get_num_of_prim name) + in + List.app relliteral stringlist; + List.app relother otherlist + end +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Primdec.sml mosml-2.10.1/src/compiler.cminusminus/Primdec.sml --- mosml-2.01/src/compiler.cminusminus/Primdec.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Primdec.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,110 @@ +(* Concrete syntax for primitive declarations *) + +local + open Const Prim Smlprim; + +(* Must be sorted for efficient binary search lookup *) + +val primitive_names = +#[ + ("!=", Ptest Pnoteq_test), + ("*int", Psmlmulint), + ("*intunsig", Pmulint), + ("*real", Pfloatprim Psmlmulfloat), + ("+int", Psmladdint), + ("+intunsig", Paddint), + ("+real", Pfloatprim Psmladdfloat), + ("-int", Psmlsubint), + ("-intunsig", Psubint), + ("-real", Pfloatprim Psmlsubfloat), + ("/", Pfloatprim Psmldivfloat), + ("<=int", Ptest (Pint_test PTle)), + ("<=real", Ptest (Pfloat_test PTle)), + ("<=string", Ptest (Pstring_test PTle)), + ("<>int", Ptest (Pint_test PTnoteq)), + ("<>real", Ptest (Pfloat_test PTnoteq)), + ("<>string", Ptest (Pstring_test PTnoteq)), + ("=int", Ptest (Pint_test PTge)), + (">=real", Ptest (Pfloat_test PTge)), + (">=string", Ptest (Pstring_test PTge)), + (">int", Ptest (Pint_test PTgt)), + (">real", Ptest (Pfloat_test PTgt)), + (">string", Ptest (Pstring_test PTgt)), + ("and", Pandint), + ("div", Psmldivint), + ("divunsig", Pdivint), + ("field0", Pfield 0), + ("field1", Pfield 1), + ("field10", Pfield 10), + ("field11", Pfield 11), + ("field12", Pfield 12), + ("field2", Pfield 2), + ("field3", Pfield 3), + ("field4", Pfield 4), + ("field5", Pfield 5), + ("field6", Pfield 6), + ("field7", Pfield 7), + ("field8", Pfield 8), + ("field9", Pfield 9), + ("get_nth_char", Pgetstringchar), + ("get_vect_item", Pgetvectitem), + ("identity", Pidentity), + ("int_of_float", Pintoffloat), + ("make_ref_vect", Pmakerefvector), + ("make_vect", Pmakevector), + ("mod", Psmlmodint), + ("modunsig", Pmodint), + ("not", Pnot), + ("or", Porint), + ("pred", Psmlpredint), + ("quot", Psmlquotint), + ("raise", Praise), + ("real_of_int", Pfloatprim Pfloatofint), + ("rem", Psmlremint), + ("set_nth_char", Psetstringchar), + ("set_vect_item", Psetvectitem), + ("setfield0", Psetfield 0), + ("setfield1", Psetfield 1), + ("setfield10", Psetfield 10), + ("setfield11", Psetfield 11), + ("setfield12", Psetfield 12), + ("setfield2", Psetfield 2), + ("setfield3", Psetfield 3), + ("setfield4", Psetfield 4), + ("setfield5", Psetfield 5), + ("setfield6", Psetfield 6), + ("setfield7", Psetfield 7), + ("setfield8", Psetfield 8), + ("setfield9", Psetfield 9), + ("shift_left", Pshiftleftint), + ("shift_right_signed", Pshiftrightintsigned), + ("shift_right_unsigned", Pshiftrightintunsigned), + ("string_length", Pstringlength), + ("succ", Psmlsuccint), + ("tag_of", Ptag_of), + ("update", Pupdate), + ("vect_length", Pvectlength), + ("xor", Pxorint), + ("~int", Psmlnegint), + ("~real", Pfloatprim Psmlnegfloat) +]; + +in + +fun findPrimitive arity name = + if arity = 0 then + MLPgv { qual="General", id=[name] } + else + (MLPprim(arity, Fnlib.binlookup name primitive_names) + handle Subscript => + MLPccall(arity, name)) +; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Prim_opc.sml mosml-2.10.1/src/compiler.cminusminus/Prim_opc.sml --- mosml-2.01/src/compiler.cminusminus/Prim_opc.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Prim_opc.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,53 @@ +(* Opcodes for the simple primitives. *) + +local open Fnlib Prim Opcodes in + +val opcode_for_primitive = fn + Pupdate => UPDATE + | Praise => RAISE + | Pnot => BOOLNOT + | Ptag_of => TAGOF + | Paddint => ADDINT + | Psubint => SUBINT + | Pmulint => MULINT + | Pdivint => DIVINT + | Pmodint => MODINT + | Pandint => ANDINT + | Porint => ORINT + | Pxorint => XORINT + | Pshiftleftint => SHIFTLEFTINT + | Pshiftrightintsigned => SHIFTRIGHTINTSIGNED + | Pshiftrightintunsigned => SHIFTRIGHTINTUNSIGNED + | Pintoffloat => INTOFFLOAT + | Pstringlength => STRINGLENGTH + | Pgetstringchar => GETSTRINGCHAR + | Psetstringchar => SETSTRINGCHAR + | Pmakevector => MAKEVECTOR + | Pvectlength => VECTLENGTH + | Pgetvectitem => GETVECTITEM + | Psetvectitem => SETVECTITEM + | Psmlnegint => SMLNEGINT + | Psmlsuccint => SMLSUCCINT + | Psmlpredint => SMLPREDINT + | Psmladdint => SMLADDINT + | Psmlsubint => SMLSUBINT + | Psmlmulint => SMLMULINT + | Psmldivint => SMLDIVINT + | Psmlmodint => SMLMODINT + | Pmakerefvector => MAKEREFVECTOR + | Psmlquotint => SMLQUOTINT + | Psmlremint => SMLREMINT + | Pswap => SWAP + | _ => fatalError "opcode_for_primitive" +; + +val opcode_for_float_primitive = fn + Pfloatofint => FLOATOFINT + | Psmlnegfloat => SMLNEGFLOAT + | Psmladdfloat => SMLADDFLOAT + | Psmlsubfloat => SMLSUBFLOAT + | Psmlmulfloat => SMLMULFLOAT + | Psmldivfloat => SMLDIVFLOAT +; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Prim.sml mosml-2.10.1/src/compiler.cminusminus/Prim.sml --- mosml-2.01/src/compiler.cminusminus/Prim.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Prim.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,60 @@ +(* The type of primitives *) + +local + open Const; +in + +datatype primitive = + Pidentity + | Pget_global of QualifiedIdent * int + | Pset_global of QualifiedIdent * int + | Pdummy of int + | Pupdate + | Ptest of bool_test + | Pmakeblock of BlockTag + | Ptag_of + | Pfield of int + | Psetfield of int + | Pccall of string * int + | Praise + | Pnot + (* The next five are unsigned operations: *) + | Paddint | Psubint | Pmulint | Pdivint | Pmodint + | Pandint | Porint | Pxorint + | Pshiftleftint | Pshiftrightintsigned | Pshiftrightintunsigned + | Pintoffloat + | Pfloatprim of float_primitive + | Pstringlength | Pgetstringchar | Psetstringchar + | Pmakevector | Pvectlength | Pgetvectitem | Psetvectitem + | Psmlnegint | Psmlsuccint | Psmlpredint + | Psmladdint | Psmlsubint | Psmlmulint | Psmldivint | Psmlmodint + | Pmakerefvector + | Patom of int + | Psmlquotint | Psmlremint + | Pclosure of int * int + | Pswap + +and float_primitive = + Pfloatofint + | Psmlnegfloat | Psmladdfloat | Psmlsubfloat | Psmlmulfloat | Psmldivfloat + +and bool_test = + Peq_test + | Pnoteq_test + | Pint_test of int prim_test + | Pfloat_test of real prim_test + | Pstring_test of string prim_test + | Pword_test of word prim_test + | Pnoteqtag_test of BlockTag + +and 'a prim_test = + PTeq + | PTnoteq + | PTnoteqimm of 'a + | PTlt + | PTle + | PTgt + | PTge +; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Printexc.sig mosml-2.10.1/src/compiler.cminusminus/Printexc.sig --- mosml-2.01/src/compiler.cminusminus/Printexc.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Printexc.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,12 @@ +(* A catch-all exception handler *) + +val f: ('a -> 'b) -> 'a -> 'b; + (* [f fn x] applies [fn] to [x] and returns the result. + If the evaluation of [fn x] raises any exception, the + name of the exception is printed on standard error output, + and the programs aborts with exit code 2. + Typical use is [f main ()], where [main], with type + [unit->unit], is the entry point of a standalone program, to catch + and print stray exceptions. + For [f] to work properly, the program must be linked + with the [-g] option. *) diff -Nru mosml-2.01/src/compiler.cminusminus/Printexc.sml mosml-2.10.1/src/compiler.cminusminus/Printexc.sml --- mosml-2.01/src/compiler.cminusminus/Printexc.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Printexc.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,46 @@ +(* A catch-all exception handler *) + +open Obj BasicIO Nonstdio; + +fun errString s = output(std_err, s); + +fun f fct arg = +( + (fct arg) + handle x => + ( + flush_out std_out; + (case x of + Out_of_memory => + errString "Out of memory" + | Fail s => + (errString "Evaluation failed: "; errString s) + | Invalid_argument s => + (errString "Invalid argument: "; errString s) + | SysErr(msg, _) => + (errString "I/O failure: "; errString msg) + | x => + (errString "Uncaught exception: "; + errString (exnMessage x); + flush_out std_err) + ); + errString "\n"; flush_out std_err; + BasicIO.exit 2 + ) +); + + + + + + + + + + + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Pr_lam.sig mosml-2.10.1/src/compiler.cminusminus/Pr_lam.sig --- mosml-2.01/src/compiler.cminusminus/Pr_lam.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Pr_lam.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,3 @@ +val printPrim : Prim.primitive -> unit +val printBoolTest : Prim.bool_test -> unit +val printLam : Lambda.Lambda -> unit; diff -Nru mosml-2.01/src/compiler.cminusminus/Pr_lam.sml mosml-2.10.1/src/compiler.cminusminus/Pr_lam.sml --- mosml-2.01/src/compiler.cminusminus/Pr_lam.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Pr_lam.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,156 @@ +local + open Mixture Const Prim Lambda Asynt; +in + +(* Printing lambda expressions for debugging purposes. *) + +fun printPrimTest printer = fn + PTeq => msgString "eq" + | PTnoteq => msgString "noteq" + | PTnoteqimm a => (msgString "noteqimm "; printer a) + | PTlt => msgString "lt" + | PTle => msgString "le" + | PTgt => msgString "gt" + | PTge => msgString "ge" +; + +val rec printPrim = fn + Pidentity => msgString "identity" + | Pget_global (qualid, stamp) => + (msgString "get_global "; printQualId qualid; + msgString "/"; msgInt stamp) + | Pset_global (qualid, stamp) => + (msgString "set_global "; printQualId qualid; + msgString "/"; msgInt stamp) + | Pdummy n => (msgString "dummy "; msgInt n) + | Pupdate => msgString "update" + | Ptest btest => (msgString "test:"; printBoolTest btest) + | Pmakeblock ctag => (msgString "makeblock "; printCTag ctag) + | Ptag_of => msgString "tag_of" + | Pfield n => (msgString "field "; msgInt n) + | Psetfield n => (msgString "setfield "; msgInt n) + | Pccall(name, arity) => + (msgString "ccall"; msgInt arity; + msgString " "; msgString name) + | Praise => msgString "raise" + | Pnot => msgString "not" + | Paddint => msgString "unsaddint" + | Psubint => msgString "unssubint" + | Pmulint => msgString "unsmulint" + | Pdivint => msgString "unsdivint" + | Pmodint => msgString "unsmodint" + | Pandint => msgString "andint" + | Porint => msgString "orint" + | Pxorint => msgString "xorint" + | Pshiftleftint => msgString "shiftleftint" + | Pshiftrightintsigned => msgString "shiftrightintsigned" + | Pshiftrightintunsigned => msgString "shiftrightintunsigned" + | Pintoffloat => msgString "intoffloat" + | Pfloatprim fprim => (msgString "floatprim "; printFloatPrim fprim) + | Pstringlength => msgString "stringlength" + | Pgetstringchar => msgString "getstringchar" + | Psetstringchar => msgString "setstringchar" + | Pmakevector => msgString "makevector" + | Pvectlength => msgString "vectlength" + | Pgetvectitem => msgString "getvectitem" + | Psetvectitem => msgString "setvectitem" + | Psmlnegint => msgString "smlnegint" + | Psmlsuccint => msgString "smlsuccint" + | Psmlpredint => msgString "smlpredint" + | Psmladdint => msgString "smladdint" + | Psmlsubint => msgString "smlsubint" + | Psmlmulint => msgString "smlmulint" + | Psmldivint => msgString "smldivint" + | Psmlmodint => msgString "smlmodint" + | Pmakerefvector => msgString "makerefvector" + | Patom t => (msgString "atom "; msgInt t) + | Psmlquotint => (msgString "smlquotint") + | Psmlremint => (msgString "smlremint") + | Pclosure (lbl,sz) => + (msgString "closure "; msgInt lbl; msgString " "; msgInt sz) + | Pswap => msgString "swap" + +and printFloatPrim = fn + Pfloatofint => msgString "floatofint" + | Psmlnegfloat => msgString "smlnegfloat" + | Psmladdfloat => msgString "smladdfloat" + | Psmlsubfloat => msgString "smlsubfloat" + | Psmlmulfloat => msgString "smlmulfloat" + | Psmldivfloat => msgString "smldivfloat" + +and printBoolTest = fn + Peq_test => msgString "eq_test" + | Pnoteq_test => msgString "noteq_test" + | Pint_test test => printPrimTest msgInt test + | Pfloat_test test => printPrimTest msgReal test + | Pstring_test test => printPrimTest msgString test + | Pword_test test => printPrimTest msgWord test + | Pnoteqtag_test ct => + (msgString "noteqtag_test "; printCTag ct) +; + +fun printLam lam = + case lam of + Lvar i => (msgString "var:"; msgInt i) + | Lconst cst => printStrConst cst + | Lapply(func, args) => + (msgString "(app "; printLam func; msgString " "; + printSeq printLam " " args; msgString ")") + | Lfn lam => (msgString "(fn "; printLam lam; msgString ")") + | Llet(args, scope) => + (msgString "let "; printSeq printLam " " args; + msgString " in "; printLam scope; msgString " end") + | Lletrec(args, scope) => + (msgString "letrec "; printSeq printLam " " args; + msgString " in "; printLam scope; msgString " end") + | Lprim(prim, args) => + (msgString "(prim ("; printPrim prim; msgString ") "; + printSeq printLam " " args; msgString ")") + | Lcase(arg, clauses) => + (msgString "(case "; printLam arg; msgString " of "; + printSeq printClause " " clauses; msgString ")") + | Lswitch(n, arg, clauses) => + (msgString "(switch:"; msgInt n; msgString " "; + printLam arg; msgString " of "; + printSeq printSwClause " " clauses; msgString ")") + | Lstaticfail => msgString "staticfail" + | Lstatichandle(lam1, lam2) => + (msgString "("; printLam lam1; msgString " statichandle "; + printLam lam2; msgString ")") + | Lhandle(lam1, lam2) => + (msgString "("; printLam lam1; msgString " handle "; + printLam lam2; msgString ")") + | Lif(lam0, lam1, lam2) => + (msgString "if"; printLam lam0; msgString " then ("; + printLam lam1; msgString ") else "; printLam lam2) + | Lseq(lam1, lam2) => + (msgString "("; printLam lam1; msgString "; "; printLam lam2; + msgString ")") + | Lwhile(lam1, lam2) => + (msgString "while "; printLam lam1; msgString " do "; + printLam lam2) + | Landalso(lam1, lam2) => + (msgString "("; printLam lam1; msgString " andalso "; + printLam lam2; msgString ")") + | Lorelse(lam1, lam2) => + (msgString "("; printLam lam1; msgString " orelse "; + printLam lam2; msgString ")") + | Lunspec => + msgString "unspec" + | Lshared(lam_ref, lbl) => + (msgString "(shared:"; msgInt (!lbl); msgString " "; + printLam (!lam_ref); msgString ")") + | Lassign(i,lam) => (msgString "assign:"; msgInt i; + msgString " <- "; printLam lam) + +and printClause (scon, lam) = + (printSCon scon; msgString " : "; printLam lam) + +and printExClause (lam1, lam2) = + (printLam lam1; msgString " : "; printLam lam2) + +and printSwClause (ct, lam) = + (printCTag ct; msgString " : "; printLam lam) +; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Pr_zam.sml mosml-2.10.1/src/compiler.cminusminus/Pr_zam.sml --- mosml-2.01/src/compiler.cminusminus/Pr_zam.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Pr_zam.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,116 @@ +local + open Obj Fnlib Config Mixture Const Instruct Asynt Pr_lam; +in + +(* 1996.07.05 -- e *) + +fun printZamInstr instr = + ((case instr of + Kquote sc => + (msgString "quote "; printStrConst sc) + | Kget_global (qualid, stamp) => + (msgString "get_global "; printQualId qualid; + msgString "/"; msgInt stamp) + | Kset_global (qualid, stamp) => + (msgString "set_global "; printQualId qualid; + msgString "/"; msgInt stamp) + | Kaccess i => + (msgString "access "; msgInt i) + | Kenvacc i => + (msgString "envacc "; msgInt i) + | Kassign i => + (msgString "assign "; msgInt i) + | Kgetfield i => + (msgString "getfield "; msgInt i) + | Ksetfield i => + (msgString "setfield "; msgInt i) + | Kpush => + msgString "push" + | Kpop i => + (msgString "pop "; msgInt i) + | Krestart => + msgString "restart" + | Kgrab i => + (msgString "grab "; msgInt i) + | Kapply n => + (msgString "apply "; msgInt n) + | Kappterm (n,z) => + (msgString "appterm "; msgInt n; msgString " "; msgInt z) + | Kpush_retaddr i => + (msgString "push_retaddr "; msgInt i) + | Kcheck_signals => + msgString "check_signals" + | Kreturn i => + (msgString "return "; msgInt i) + | Kclosure (i,n) => + (msgString "closure "; msgInt i; msgString " "; msgInt n) + | Kclosurerec (i,n) => + (msgString "closurerec "; msgInt i; msgString " "; msgInt n) + | Kraise => + msgString "raise" + | Kmakeblock(ct, i) => + (msgString "makeblock "; printCTag ct; msgString " "; msgInt i) + | Kprim prim => + (msgString "prim "; printPrim prim) + | Kpushtrap i => + (msgString "pushtrap "; msgInt i) + | Kpoptrap => + msgString "poptrap" + | Klabel i => + (msgString "label "; msgInt i) + | Kbranch i => + (msgString "branch "; msgInt i) + | Kbranchif i => + (msgString "branchif "; msgInt i) + | Kbranchifnot i => + (msgString "branchifnot "; msgInt i) + | Kstrictbranchif i => + (msgString "strictbranchif "; msgInt i) + | Kstrictbranchifnot i => + (msgString "strictbranchifnot "; msgInt i) + | Ktest(tst, i) => + (msgString "test:"; printBoolTest tst; + msgString " "; msgInt i) + | Kbranchinterval(i1, i2, i3, i4) => + (msgString "branchinterval "; msgInt i1; + msgString " "; msgInt i2; + msgString " "; msgInt i3; + msgString " "; msgInt i4) + | Kswitch v => + let val () = msgString "switch " + val len = Array.length v + in + for (fn i => + (msgInt (Array.sub(v, i-1)); + if i < len then msgString " " else ())) + 1 len + end + | Kname lbl => + (msgString "name "; msgInt lbl) + | Kcontinuation lbl => + (msgString "continuation "; msgInt lbl) + | Knewgrab(lbl, req) => + (msgString "newgrab "; msgInt lbl; msgString" "; msgInt req) + | Knewrestart lbl => + (msgString "restart "; msgInt lbl) + ); msgString ";"; msgEOL ()) +; + +fun printZamSeq zams = printSeq printZamInstr "; " zams; + +fun printZamPhrase + { kph_is_pure=is_pure, kph_inits=inits, kph_funcs=funcs } = +( + msgIBlock 0; + msgString "***kph_is_pure*** = "; + msgString (if is_pure then "true;" else "false;"); + msgEOL(); + msgString "***kph_inits*** = "; + printSeq printZamInstr "; " inits; + msgEOL(); msgString "***kph_funcs*** = "; + List.app (printSeq printZamInstr "") funcs; + msgEOL(); + msgEBlock() +); + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Readword.sml mosml-2.10.1/src/compiler.cminusminus/Readword.sml --- mosml-2.01/src/compiler.cminusminus/Readword.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Readword.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,46 @@ +(* To read a file word per word, and return the list of the strings read *) + +local + + open BasicIO Nonstdio; + +fun from_stream is = + let val buff = CharArray.array(1024, #" ") + fun readchars i = + case input_char is of + #" " => i + | #"\n" => i + | #"\r" => i (* was #"\^M" *) + | #"\t" => i + | c => + (if i < CharArray.length buff then CharArray.update(buff, i, c) + else (); + readchars (i+1)) + fun readword() = + case input_char is of + #" " => readword() + | #"\n" => readword() + | #"\r" => readword() (* was #"\^M" *) + | #"\t" => readword() + | c => + (CharArray.update(buff, 0, c); + CharArraySlice.vector(CharArraySlice.slice(buff, 0, + SOME (readchars 1)))) + fun readwords l = + (readwords(readword() :: l)) + handle Size => List.rev l + in + readwords [] + end; + +in + +fun from_file filename = + let val is = open_in filename + val res = from_stream is + in + close_in is; + res + end; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Reloc.sml mosml-2.10.1/src/compiler.cminusminus/Reloc.sml --- mosml-2.01/src/compiler.cminusminus/Reloc.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Reloc.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,50 @@ +local + open Const Code_dec Buffcode; +in + +type reloc_table = + { literals : (StructConstant, int list ref) Hasht.t, + reloclist : (reloc_info * int) list ref }; + +val reloc_info : reloc_table = + { literals = Hasht.new 17, reloclist = ref [] } + +fun reloc_reset () = + let val { literals, reloclist } = reloc_info + in Hasht.clear literals; reloclist := [] end + +fun enter info = + let val { reloclist, ... } = reloc_info + in reloclist := (info, !out_position) :: !reloclist end + +fun slot_for_literal sc = + let val { literals, reloclist } = reloc_info + in + (case Hasht.peek literals sc of + SOME addrs => addrs := !out_position :: !addrs + | NONE => Hasht.insert literals sc (ref [!out_position])); + out_short 0 + end + +fun slot_for_get_global uid = + (enter (Reloc_getglobal uid); out_short 0) +; + +fun slot_for_set_global uid = + (enter (Reloc_setglobal uid); out_short 0) +; + +fun slot_for_c_prim name = + (enter (Reloc_primitive name); out_short 0) +; + +fun get_reloc_info () = + let val { literals, reloclist } = reloc_info + fun getlitaddrs sc (ref addrs) acc = (sc, addrs) :: acc + val res = (Hasht.fold getlitaddrs [] literals, + List.rev (!reloclist)) + in + reloc_reset(); + res + end +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Rtvals.sig mosml-2.10.1/src/compiler.cminusminus/Rtvals.sig --- mosml-2.01/src/compiler.cminusminus/Rtvals.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Rtvals.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,18 @@ +(* Rtvals.sig *) + +local + open Obj Const Globals Types; +in + +val getGlobalVal : int -> obj; +val setGlobalVal : int -> obj -> unit; +val printLiteralConst : obj -> unit; +val printDepth : int ref; +val printLength : int ref; +val printVal : TypeScheme -> obj -> unit; +val evalPrint : obj -> obj -> obj; +val evalInstallPP : obj -> (ppstream -> 'a -> unit) -> unit; +val resetGlobalDynEnv : unit -> unit; +val loadGlobalDynEnv : string -> (string * obj) list -> unit; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Rtvals.sml mosml-2.10.1/src/compiler.cminusminus/Rtvals.sml --- mosml-2.01/src/compiler.cminusminus/Rtvals.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Rtvals.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,392 @@ +(* Rtvals.sml *) + +open List Misc Obj BasicIO Nonstdio Miscsys Memory Fnlib Config Mixture; +open Const Smlexc Globals Units Types Symtable; + +(* --- Run-time values --- *) + +(* Encoding and decoding *) + +fun decode_int (v : obj) = (magic_obj v : int); + +fun decode_word (v : obj) = (magic_obj v : word); + +fun decode_char (v : obj) = (magic_obj v : char); + +fun decode_real (v : obj) = (magic_obj v : real); + +fun decode_string (v : obj) = (magic_obj v : string); + +(* Exceptions *) + +fun decode_exn (v : obj) (c0 : QualifiedIdent -> unit) + (c1 : QualifiedIdent -> obj -> Type option -> unit) = + let val strref = getExnStrref v + val arg = obj_field v 1 + fun prExn exnPrName NONE = c0 exnPrName + | prExn exnPrName (SOME argTy) = c1 exnPrName arg (SOME argTy) + in prExn { qual = "", id = [!strref] } (Smlexc.exnArgType strref arg) end + +(* Run-time environments *) + +fun getGlobalVal (slot : int) = + Vector.sub(global_data, slot) +; + +fun setGlobalVal (slot : int) (v : obj) = + let prim_val update_ : 'a Vector.vector -> int -> 'a -> unit + = 3 "set_vect_item" + in update_ global_data slot v end +; + +(* Block values *) + +fun decode_block (v : obj) = + if not(is_block v) then + fatalError "block expected" + else + let val len = obj_size v + fun makeArgs i = + if i>= len then [] else obj_field v i :: makeArgs (i+1) + in (obj_tag v, makeArgs 0) end +; + +fun decode_unit (v : obj) = (); + +fun decode_pair (v : obj) = (magic_obj v : obj * obj); + +fun decode_boolean (v : obj) = (magic_obj v : bool); + +fun decode_list (v : obj) = (magic_obj v : obj list); + +fun decode_vector (v : obj) = (magic_obj v : obj Vector.vector); + +(* --- Value printing --- *) + +fun prSeq lbr rbr printer sep ts vs = + let fun loop [] [] = () + | loop [t] [v] = printer t v + | loop (t :: ts) (v :: vs) = + (printer t v; msgString sep; msgBreak(1, 1); loop ts vs) + | loop _ _ = fatalError "prSeq: length mismatch" + in + msgIBlock 0; msgString lbr; + loop ts vs; + msgString rbr; msgEBlock() + end +; + +fun prInt (v: obj) = + let val n = decode_int v + in msgString (sml_string_of_int n) end +; + +fun prWord (v: obj) = + let val n = decode_word v + in msgString (sml_hexstring_of_word n) end +; + +fun prChar (v : obj) = + let val c = decode_char v + in msgString (sml_makestring_of_char c) end +; + +fun prReal (v : obj) = + let val r = decode_real v + in msgString (sml_string_of_float r) end +; + +fun prString (v : obj) = + let val s = decode_string v + in msgString (sml_makestring_of_string s) end +; + +fun prLiteralConst (depth: int) (v: obj) = + if not(is_block v) then + prInt v + else if depth <= 0 then + msgString "#" + else + let val tag = obj_tag v + val len = obj_size v + in + if tag = realTag then + prReal v + else if tag = stringTag then + prString v + else + (msgString "(BLOCK "; msgInt tag; + for (fn i => (msgString " "; + prLiteralConst (depth-1) (obj_field v i))) + 0 (len-1); + msgString ")") + end +; + +fun printLiteralConst (v: obj) = + prLiteralConst 10 v +; + +fun prGeneric (v : obj) = + if not(is_block v) then + msgString "" + else + let val tag = obj_tag v in + if tag = realTag then prReal v + else if tag = stringTag then prString v + else msgString "" + end +; + +val installedPrinters = ref([] : (TyName * (ppstream -> obj -> unit)) list); + +fun findInstalledPrinter tyname = + let fun loop [] = NONE + | loop ((tyname', p) :: rest) = + if isEqTN tyname tyname' then (SOME p) else (loop rest) + in loop (!installedPrinters) end +; + +val printDepth = ref 20; +val printLength = ref 200; + +fun prVal (depth: int) (prior: int) (tau: Type) (v: obj) = + let fun prP s = if prior > 0 then msgString s else () + fun prD f = if depth <= 0 then msgString "#" else f() + and prExn (e : obj) = (* e : exn *) + decode_exn (repr e) + (fn q => (prP " "; printVQ q)) + (fn q => fn va => fn tyOpt => + (prP "("; + printVQ q; msgString " "; + (case tyOpt of + NONE => prGeneric va + | SOME ty => prVal (depth-1) 1 ty va); + prP ")" )) + fun prettyprint printer pp_out v = + printer pp_out v + handle e => (msgString "") + val tau = normType tau + in + case tau of + VARt _ => (prP " "; prGeneric v) + | ARROWt _ => (prP " "; msgString "fn") + | RECt rt => + let val {fields=fs, ...} = !rt + val (_, vs) = decode_block v + in + if isTupleRow fs then + (prD (fn() => + prSeq "(" ")" (prTupleField (depth-1)) "," fs vs)) + else + (prD (fn() => + prSeq "{" "}" (prField (depth-1)) "," fs vs)) + end + | CONt(ts, tyapp) => + (case conEnvOfTyApp tyapp of + NONE => + (case tyapp of + NAMEtyapp tyname => + (case findInstalledPrinter tyname of + SOME printer => prettyprint printer pp_out v + | NONE => + if (isEqTN tyname tyname_int) then (prP " "; prInt v) + else if (isEqTN tyname tyname_word) + then (prP " "; prWord v) + else if (isEqTN tyname tyname_word8) + then (prP " "; prWord v) + else if (isEqTN tyname tyname_char) + then (prP " "; prChar v) + else if (isEqTN tyname tyname_real) + then (prP " "; prReal v) + else if (isEqTN tyname tyname_string) + then (prP " "; prString v) + else if (isEqTN tyname tyname_exn) then prExn v + else if (isEqTN tyname tyname_ref) then + let val t = hd ts + val x = obj_field v 0 + in + prD (fn() => + (prP "(";printVQ (#qualid tyname); + prVal (depth-1) 1 t x; prP ")")) + end + else if (isEqTN tyname tyname_vector) then + let val vs = decode_vector v in + prD (fn() => + (prP " "; + prVector (depth-1) + (!printLength) + (hd ts) + vs)) + end + else + (msgString "<"; + msgString (hd (#id (#qualid tyname))); + msgString ">")) + | APPtyapp _ =>(msgString "<"; + prTyApp 0 tyapp; + msgString ">")) + | SOME (ConEnv CE) => + ( if (case tyapp of + NAMEtyapp tyname => + (case findInstalledPrinter tyname of + SOME printer => (prettyprint printer pp_out v;true) + | NONE => false) + | _ => false) + then () + else + if null CE then + (msgString "<"; prTyApp 0 tyapp; + msgString ">") + else if #conSpan(! (#info (hd CE))) = 1 andalso + #conArity(! (#info (hd CE))) = 1 + then + let val ci = hd CE + val {qualid, info} = ci + val {conArity, conIsGreedy, conType, ...} = !info + in + case specialization conType of + ARROWt(a_t, r_t) => + (unify tau r_t; + (prD (fn() => + (prP "("; printVQ qualid; + prVal (depth-1) 1 a_t v; + prP ")")))) + | _ => fatalError "prVal" + end + else + let val i = obj_tag v + val ci = nth(CE, i) + val {qualid, info} = ci + val {conArity, conIsGreedy, conType, ...} = !info + in + if case tyapp of + NAMEtyapp tyname => + if (isEqTN tyname tyname_list) then + (prD (fn() => + (prP " "; + prList (depth-1) (!printLength) + (hd ts) (decode_list v))); + true) + else false + | _ => false + then () + else if conArity = 0 then + (prD (fn() => (prP " "; printVQ qualid))) + else + case specialization conType of + ARROWt(a_t, r_t) => + (unify tau r_t; + (prD (fn() => + (prP "("; printVQ qualid; + if conIsGreedy + then prVal (depth-1) 1 a_t v + else prVal (depth-1) 1 a_t (obj_field v 0); + prP ")")))) + | _ => fatalError "prVal" + end) + | _ => fatalError "prVal 1") + | PACKt (EXISTSexmod(T,STRmod S)) => (prP " "; msgString "[structure ...]") + | PACKt (EXISTSexmod(T,FUNmod F)) => (prP " "; msgString "[functor ...]") +end + +and prField (depth: int) (lab, t) v = + (msgIBlock 0; printLab lab; msgString " ="; msgBreak(1, 2); + prVal depth 0 t v; msgEBlock()) + +and prTupleField (depth: int) (lab, t) v = + prVal depth 0 t v + +and prList (depth: int) (len: int) tau v = + case v of + [] => msgString "[]" + | x :: xs => + if len <= 0 then + msgString "[...]" + else + (msgIBlock 0; msgString "["; prVal depth 0 tau x; + prListTail depth (len-1) tau xs) + +and prListTail (depth: int) (len: int) tau = fn + [] => (msgString "]"; msgEBlock()) + | x :: xs => + (msgString ","; msgBreak(1, 1); + if len <= 0 then + (msgString "...]"; msgEBlock()) + else + (prVal depth 0 tau x; prListTail depth (len-1) tau xs)) + +and prVector (depth: int) (maxlen: int) tau v = + let val len = Vector.length v + fun loop count i = + if i = len then msgString "]" + else if count <= 0 then + (msgString ","; msgBreak(1, 2); msgString "...]") + else + (msgString ","; msgBreak(1, 2); + prVal depth 0 tau (Vector.sub(v, i)); + loop (count-1) (i+1)) + in + msgIBlock 0; + if len = 0 then msgString "#[]" + else if maxlen <= 0 then msgString "#[...]" else + (msgString "#["; prVal depth 0 tau (Vector.sub(v, 0)); + loop (maxlen-1) 1); + msgEBlock() + end +; + +fun printVal (scheme: TypeScheme) (v: obj) = + prVal (!printDepth) 0 (specialization scheme) v +; + +fun evalPrint (sc : obj) (v : obj) = + (printVal (magic_obj sc : TypeScheme) v; msgFlush(); v) +; + +fun evalInstallPP (sc : obj) (p : ppstream -> 'a -> unit) = + case normType(specialization (magic_obj sc : TypeScheme)) of + CONt([], NAMEtyapp tyname) => + installedPrinters := + (tyname, magic p : ppstream -> obj -> unit) + :: !installedPrinters +(* + CONt([], NAMEtyapp tyname) => + (case #tnStr(! (#info tyname)) of + DATATYPEts _ => + installedPrinters := + (tyname, magic p : ppstream -> obj -> unit) + :: !installedPrinters + | NILts => + installedPrinters := + (tyname, magic p : ppstream -> obj -> unit) + :: !installedPrinters + | _ => + raise Fail "installPP: pp's argument is not a nullary type constructor") +*) + | CONt(_ :: _, tyname) => + raise Fail "installPP: pp's argument type is not a nullary type constructor" + | _ => + raise Fail "installPP: pp's argument type is not a type constructor" +; + +(* === End of Primitives === *) + +(* --- Handling global dynamic environment --- *) + +fun loadGlobalDynEnv uname env = +( + app (fn(id,_) => + ignore (get_slot_for_defined_variable ({qual=uname, id=[id]}, 0))) + env; + if number_of_globals() >= Vector.length global_data then + realloc_global_data(number_of_globals()) + else (); + app (fn(id,v) => + let val slot = get_slot_for_variable ({qual=uname, id=[id]}, 0) + in setGlobalVal slot v end) + env +); + +fun resetGlobalDynEnv() = init_linker_tables(); diff -Nru mosml-2.01/src/compiler.cminusminus/Sigmtch.sig mosml-2.10.1/src/compiler.cminusminus/Sigmtch.sig --- mosml-2.01/src/compiler.cminusminus/Sigmtch.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Sigmtch.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,4 @@ +(* +val matchSignature : BasicIO.outstream -> (string *int) list -> Units.CSig -> Units.CSig -> unit; +*) +val matchSignature : BasicIO.outstream -> (string * int) list -> Units.CSig -> Units.CSig -> (string * int) list; diff -Nru mosml-2.01/src/compiler.cminusminus/Sigmtch.sml mosml-2.10.1/src/compiler.cminusminus/Sigmtch.sml --- mosml-2.01/src/compiler.cminusminus/Sigmtch.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Sigmtch.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,290 @@ +(* Sigmtch.sml *) + +open List Fnlib Mixture Const Prim Lambda Globals Units Types; +open Front Back Emit_phr; + +(* cvr: TODO these error messages are redundant as they are + now detected and reported in Types.sml *) + +fun errorImplMismatch id = +( + msgIBlock 0; + errPrompt "Mismatch between the specification of the value "; + msgString id; msgEOL(); + errPrompt "in the signature and its implementation in the unit body"; + msgEOL(); + msgEBlock(); + raise Toplevel +); + +fun errorConImplMismatch id = +( + msgIBlock 0; + errPrompt "Mismatch between the specification of the value constructor "; + msgString id; msgEOL(); + errPrompt "in the signature and its implementation in the unit body"; + msgEOL(); + msgEBlock(); + raise Toplevel +); + +fun errorExConImplMismatch id = +( + msgIBlock 0; + errPrompt "Mismatch between the specification of the exception constructor "; + msgString id; msgEOL(); + errPrompt "in the signature and its implementation in the unit body"; + msgEOL(); + msgEBlock(); + raise Toplevel +); + + +fun exportValAsVal os valRenList id (infStatus : ConStatus) (specStatus : ConStatus) = + let val vid = Const.mangle (Const.ValId id) + val lam = Lprim(Pset_global (#qualid specStatus, 0), + [Lprim(Pget_global (#qualid infStatus, 0), [])]) + in emit_phrase os (compileLambda true lam); + drop (fn (name,stamp) => name = vid) valRenList + end +; + +fun exportPrimAsVal os valRenList id (pi : PrimInfo) (specStatus : ConStatus) = + let val vid = Const.mangle (Const.ValId id) + val lam = Lprim(Pset_global (#qualid specStatus, 0), + [trPrimVar (#primOp pi)]) + in emit_phrase os (compileLambda true lam); + drop (fn (name,stamp) => name = vid) valRenList + end +; + +fun exportConAsVal os valRenList id (ci : ConInfo) (specStatus : ConStatus) = + let val vid = Const.mangle (Const.ValId id) + val lam = Lprim(Pset_global (#qualid specStatus, 0), + [trConVar ci]) + in emit_phrase os (compileLambda true lam); + drop (fn (name,stamp) => name = vid) valRenList + end +; + +fun exportExConAsVal os valRenList id (ei : ExConInfo) (infStatus : ConStatus) (specStatus : ConStatus) = + let val vid = Const.mangle (Const.ValId id) + val en = Lprim(Pget_global(#qualid infStatus,lookup vid valRenList),[]) + val lam = Lprim(Pset_global (#qualid specStatus, 0), + [trTopDynExConVar ei en]) + in + emit_phrase os (compileLambda true lam); + drop (fn (name,stamp) => name = vid) valRenList + end; + +(* cvr: TODO simplify to remove error checking (now done during matching in Types.sml) *) + +fun exportVar os valRenList id {info = (_,infInfo),qualid = infQualid} + {info = (_,specInfo),qualid = specQualid} = + let + val {qual=infQual, ...} = infQualid + val {qual=specQual, ...} = specQualid + val infStatus = {qualid = infQualid, info = infInfo} + val specStatus = {qualid = specQualid, info = specInfo} + in + case specInfo of + VARname ovltype => + (case infInfo of + VARname ovltype' => + (if ovltype <> ovltype' then errorImplMismatch id + else (); + if specQual <> infQual then + exportValAsVal os valRenList id infStatus specStatus + else valRenList) + | PRIMname pi' => + exportPrimAsVal os valRenList id pi' specStatus + | CONname ci' => + exportConAsVal os valRenList id ci' specStatus + | EXNname ei' => + exportExConAsVal os valRenList id ei' infStatus specStatus + | REFname => errorImplMismatch id) + | PRIMname pi => + (case infInfo of + VARname ovltype' => errorImplMismatch id + | PRIMname pi'=> + if pi <> pi' then errorImplMismatch id + else valRenList + | CONname ci' => errorImplMismatch id + | EXNname ei' => errorImplMismatch id + | REFname => errorImplMismatch id) + | CONname ci => + (case infInfo of + VARname ovltype' => errorImplMismatch id + | PRIMname pi' => errorImplMismatch id + | CONname ci' => + if #conArity(!ci) <> #conArity(!ci') + orelse #conIsGreedy(!ci) <> #conIsGreedy(!ci') + orelse #conTag(!ci) <> #conTag(!ci') + orelse #conSpan(!ci) <> #conSpan(!ci') + then errorConImplMismatch id + else valRenList + | EXNname ei' => errorImplMismatch id + | REFname => errorImplMismatch id) + | EXNname ei => + (case infInfo of + VARname ovltype' => errorImplMismatch id + | PRIMname pi' => errorImplMismatch id + | CONname ci' => errorImplMismatch id + | EXNname ei' => + if #exconArity(!ei) <> #exconArity(!ei') + then errorExConImplMismatch id + else valRenList + | REFname => errorImplMismatch id) + | REFname => + (case infInfo of + VARname ovltype' => errorImplMismatch id + | PRIMname pi' => errorImplMismatch id + | CONname ci' => errorImplMismatch id + | EXNname ei' => errorImplMismatch id + | REFname => valRenList) + end +; + +fun exportMod os valRenList id + {info = RS,qualid = infQualid} {info = RS',qualid = specQualid} = + let val {qual=infQual, id=_} = infQualid + val {qual=specQual,id=_} = specQualid + in + let val mid = Const.mangle (Const.ModId id) + val strlam = Lprim(Pget_global({qual=infQual,id =[mid]}, + lookup mid valRenList), + []) + val lam = + Lprim(Pset_global ({qual=specQual,id = [mid]}, 0), + [coerceRecStr strlam RS RS']) + in + (* msgIBlock 0; Pr_lam.printLam lam; msgEOL(); msgEBlock(); (* cvr: TODO remove*) *) + emit_phrase os (compileLambda true lam); + drop (fn (name,stamp) => name = mid) valRenList + end + end +; + +fun exportGenFun os valRenList id + {info = F,qualid = infQualid} {info = F',qualid = specQualid} = + let val {qual=infQual, id=_} = infQualid + val {qual=specQual,id=_} = specQualid + in + let val fid = Const.mangle (Const.FunId id) + val funlam = Lprim(Pget_global({qual=infQual, id = [fid]}, + lookup fid valRenList), + []) + val lam = + Lprim(Pset_global ({qual=specQual,id = [fid]}, 0), + [coerceFun funlam F F']) + in emit_phrase os (compileLambda true lam); + drop (fn (name,stamp) => name = fid) valRenList + end + end +; + + +fun matchModes (inferredSig : CSig) (specSig : CSig) = + case (modeOfSig inferredSig,modeOfSig specSig) of + (STRmode,STRmode) => + if !(#uIdent(inferredSig)) = !(#uIdent(specSig)) + then () + else + (msgIBlock 0; + errPrompt "Identifier mismatch: the implementation of "; + msgString (#uName inferredSig);msgEOL(); + errPrompt "was compiled as the declaration of the structure ";msgEOL(); + errPrompt " "; msgString (!(#uIdent inferredSig));msgEOL(); + errPrompt "but its interface was compiled as the declaration of the signature"; msgEOL(); + errPrompt " "; msgString (!(#uIdent specSig));msgEOL(); + errPrompt "The declarations should agree on the identifier"; + msgEOL(); + msgEBlock(); + raise Toplevel) + | (TOPDECmode,TOPDECmode) => () + | (STRmode,TOPDECmode) => + (msgIBlock 0; + errPrompt "Mode mismatch: the implementation of "; + msgString (#uName inferredSig);msgEOL(); + errPrompt "was compiled as a structure declaration"; msgEOL(); + errPrompt "but its interface was compiled as a sequence of top level specifications"; msgEOL(); + errPrompt "The implementation and its interface must be compiled in the same mode"; msgEOL(); + msgEBlock(); + raise Toplevel) + | (TOPDECmode,STRmode) => + (msgIBlock 0; + errPrompt "Mode mismatch: the implementation of "; + msgString (#uName inferredSig);msgEOL(); + errPrompt "was compiled as a sequence of top level declarations";msgEOL(); + errPrompt "but its interface was compiled as a signature declaration"; msgEOL(); + errPrompt "The implementation and its interface must be compiled in the same mode"; msgEOL(); + msgEBlock(); + raise Toplevel) +; + +fun matchStamps (inferredSig : CSig) (specSig : CSig) = + Hasht.apply + (fn uname => fn stamp => + let val stamp' = Hasht.find (#uMentions inferredSig) uname in + if stamp' <> stamp then ( + msgIBlock 0; + errPrompt "The signature of "; msgString uname; + msgString " has changed, while "; msgString (#uName specSig); + msgString ".sig depends on it."; msgEOL(); + errPrompt "Please, recompile "; msgString (#uName specSig); + msgString ".sig, before compiling "; msgString (#uName specSig); + msgString ".sml."; msgEOL(); + msgEBlock(); + raise Toplevel) + else () + end + handle Subscript => ()) + (#uMentions specSig) +; + +fun matchSignature os valRenList (inferredSig : CSig) (specSig : CSig) = + ((* Matching compilation modes *) + matchModes inferredSig specSig; + (* Matching stamps of mentioned signatures *) + matchStamps inferredSig specSig; + (* Matching of components *) + (matchCSig inferredSig specSig + handle MatchError matchReason => + (msgIBlock 0; + errPrompt "Interface mismatch: the implementation of unit ";msgString (#uName inferredSig);msgEOL(); + errPrompt "does not match its interface, because ... "; + msgEOL(); + msgEBlock(); + errMatchReason "implementation" "interface" matchReason; + raise Toplevel)); + (* warn of any un(der)specified (co-variant) declarations in a topdec unit *) + checkCSig inferredSig specSig; + (* coercions *) + let + (* value matching may cause some code to be generated, *) + (* if a primitive function or a value constructor is *) + (* exported as a value. *) + val valRenList = + Hasht.fold (fn id => fn specSc => fn valRenList => + exportVar os valRenList id + (Hasht.find (varEnvOfSig inferredSig) id) specSc) + valRenList (varEnvOfSig specSig); + (* structure matching may cause some coercion code to be generated. *) + val valRenList = + Hasht.fold (fn id => fn specInfo => fn valRenList => + exportMod os valRenList id + (Hasht.find (modEnvOfSig inferredSig) id) specInfo) + valRenList (modEnvOfSig specSig); + (* functor matching may cause some coercion code to be generated. *) + val valRenList = + Hasht.fold (fn id => fn specInfo => fn valRenList => + exportGenFun os valRenList id + (Hasht.find (funEnvOfSig inferredSig) id) specInfo) + valRenList (funEnvOfSig specSig) + in valRenList + end) +; + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Smlexc.sml mosml-2.10.1/src/compiler.cminusminus/Smlexc.sml --- mosml-2.01/src/compiler.cminusminus/Smlexc.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Smlexc.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,46 @@ +(* Predefined SML exceptions *) + +local + open Obj Const Fnlib Config Mixture Types +in + (* The exn names and types of SML Basis Library exceptions *) + + prim_val syserr_ref : string ref = 0 "exn_syserr" + prim_val io_ref : string ref = 0 "exn_io" + +(* ps: temporary fix when bootstrapping: + val syserr_ref = ref "Fix1"; + val io_ref = ref "Fix2"; +*) + val type_of_syserror_exn = (* Must match actual type of OS.SysErr *) + type_pair type_string (type_option type_syserror); + + val type_of_io_exn = (* Must match actual type of IO.Io *) + type_rigid_record + [(STRINGlab "cause", type_exn), + (STRINGlab "function", type_string), + (STRINGlab "name", type_string)]; + + fun decode_string (v : obj) = (magic_obj v : string) + fun decode_real (v : obj) = (magic_obj v : real); + prim_val sml_string_of_float : real -> string = 1 "sml_string_of_float"; + + fun exnArgType (strref : string ref) (arg : obj) = + if strref = syserr_ref then + SOME type_of_syserror_exn + else if strref = io_ref then + SOME type_of_io_exn + else if is_block arg then + if obj_tag arg = stringTag then SOME type_string + else if obj_tag arg = realTag then SOME type_real + else NONE + else (* may be int, char, bool, word8, ... *) + NONE + + fun getExnStrref (v : obj) : string ref = + if is_block v andalso is_block(obj_field v 0) then + magic_obj (obj_field v 0) : string ref + else + fatalError "getExnName" +end + diff -Nru mosml-2.01/src/compiler.cminusminus/Smlperv.sig mosml-2.10.1/src/compiler.cminusminus/Smlperv.sig --- mosml-2.01/src/compiler.cminusminus/Smlperv.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Smlperv.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1 @@ +(* Nothing to export *) diff -Nru mosml-2.01/src/compiler.cminusminus/Smlperv.sml mosml-2.10.1/src/compiler.cminusminus/Smlperv.sml --- mosml-2.01/src/compiler.cminusminus/Smlperv.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Smlperv.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,281 @@ +(* Initialization of built-in units *) + +open List Fnlib Const Smlexc Prim Smlprim Globals Units Types; + +(* --- Global infix basis --- *) + +val std_infix_basis = +[ + ("before", INFIXst 0), + ("o", INFIXst 3), (":=", INFIXst 3), + ("=", INFIXst 4), ("<>", INFIXst 4), + ("<", INFIXst 4), (">", INFIXst 4), + ("<=", INFIXst 4), (">=", INFIXst 4), + ("@", INFIXRst 5), ("::", INFIXRst 5), + ("+", INFIXst 6), ("-", INFIXst 6), + ("^", INFIXst 6), + ("div", INFIXst 7), ("mod", INFIXst 7), + ("*", INFIXst 7), ("/", INFIXst 7) +]; + +val () = + app + (fn(id, status) => + Hasht.insert pervasiveInfixTable id status) + std_infix_basis +; + +(* --- Initial constructor basis --- *) + +val deConEnv = fn (ConEnv CE) => CE | _ => fatalError "deConEnv" + +val infoFalse = hd(deConEnv initial_bool_CE) +and infoTrue = hd(tl (deConEnv initial_bool_CE)) +and infoNil = hd(deConEnv initial_list_CE) +and infoCons = hd(tl(deConEnv initial_list_CE)) +and infoNONE = hd(deConEnv initial_option_CE) +and infoSOME = hd(tl (deConEnv initial_option_CE)) +and infoEQUAL = hd(deConEnv initial_order_CE) +and infoGREATER = hd(tl(deConEnv initial_order_CE)) +and infoLESS = hd(tl(tl(deConEnv initial_order_CE))) +and infoANTIQUOTE = hd(deConEnv initial_frag_CE) +and infoQUOTE = hd(tl (deConEnv initial_frag_CE)) + +(* ps 2000-04-27 +and infoLESS = hd(deConEnv initial_order_CE) +and infoEQUAL = hd(tl(deConEnv initial_order_CE)) +and infoGREATER = hd(tl (tl (deConEnv initial_order_CE))) +and infoQUOTE = hd(deConEnv initial_frag_CE) +and infoANTIQUOTE = hd(tl (deConEnv initial_frag_CE)) *) +; + +(* *** Initial static environments *** *) + +(* Typing variable environment *) + +val sc_bool = + trivial_scheme type_bool +and sc_ii_i = trivial_scheme + (type_arrow (type_pair type_int type_int) type_int) +and sc_r_r = trivial_scheme + (type_arrow type_real type_real) +and sc_s_i = trivial_scheme + (type_arrow type_string type_int) +and sc_ss_s = trivial_scheme + (type_arrow (type_pair type_string type_string) type_string) +and sc_s_exn = trivial_scheme + (type_arrow type_exn type_string) +and sc_exn = + trivial_scheme type_exn +; + +(* cvr: TODO dummy schemes for overloaded val ids *) +(* TODO: perhaps make + these more meaningful than sc_bogus: this is not essential since + they'll never be reported to the user anyway... +*) +val sc_OVL1NNo = sc_bogus; +val sc_OVL1NSo = sc_bogus; +val sc_OVL2NNBo = sc_bogus; +val sc_OVL2NNNo = sc_bogus; + +fun VEofCE (ConEnv CE) = + map (fn ci => + let val coninfo = #info(ci) + in + (hd (#id(#qualid ci)), ((#conType(! coninfo)),CONname coninfo)) + end) + CE + | VEofCE _ = fatalError "VEofCE"; + +(* cvr: added *) +val initial_eq_VE = +[ + ("=", ((scheme_1u_eq (fn a => + type_arrow (type_pair a a) type_bool)), + VARname OVL2EEBo)), + ("<>", ((scheme_1u_eq (fn a => + type_arrow (type_pair a a) type_bool)), + VARname OVL2EEBo)) +]; + + +val initial_OVL1NNo_VE = [ + ("~",(sc_OVL1NNo,VARname OVL1NNo)), + ("abs",(sc_OVL1NNo,VARname OVL1NNo)) +]; + +val initial_OVL2NNNo_VE = [ + ("+",(sc_OVL2NNNo,VARname OVL2NNNo)), + ("-",(sc_OVL2NNNo,VARname OVL2NNNo)), + ("*",(sc_OVL2NNNo,VARname OVL2NNNo)), + ("div",(sc_OVL2NNNo,VARname OVL2NNNo)), + ("mod",(sc_OVL2NNNo,VARname OVL2NNNo)) +]; + +val initial_OVL2NNBo_VE = [ + ("<",(sc_OVL2NNBo,VARname OVL2NNBo)), + (">",(sc_OVL2NNBo,VARname OVL2NNBo)), + ("<=",(sc_OVL2NNBo,VARname OVL2NNBo)), + (">=",(sc_OVL2NNBo,VARname OVL2NNBo)) +]; + +val initial_OVL1NSo_VE = [ + ("makestring",(sc_OVL1NSo,VARname OVL1NSo)) +]; + +val initial_int_VE = +[ +]; + +val initial_real_VE = +[ + ("/", (trivial_scheme + (type_arrow (type_pair type_real type_real) type_real), + PRIMname (mkPrimInfo 1 MLPdiv_real))), + ("floor", (trivial_scheme (type_arrow type_real type_int), + PRIMname (mkPrimInfo 1 (MLPccall(1, "sml_floor"))))), + ("ceil", (trivial_scheme (type_arrow type_real type_int), + PRIMname (mkPrimInfo 1 (MLPccall(1, "sml_ceil"))))), + ("trunc", (trivial_scheme (type_arrow type_real type_int), + PRIMname (mkPrimInfo 1 (MLPccall(1, "sml_trunc"))))), + ("round", (trivial_scheme (type_arrow type_real type_int), + PRIMname (mkPrimInfo 1 (MLPccall(1, "sml_round"))))), + ("real", (trivial_scheme (type_arrow type_int type_real), + PRIMname (mkPrimInfo 1 + (MLPprim(1, Pfloatprim Pfloatofint))))) +]; + +val initial_string_VE = +[ + ("^", (sc_ss_s, + PRIMname (mkPrimInfo 1 (MLPconcat)))), + ("size", (sc_s_i, + PRIMname (mkPrimInfo 1 (MLPprim(1, Pstringlength))))), + ("exnName", (sc_s_exn, + PRIMname (mkPrimInfo 1 (MLPccall(1, "sml_exnname"))))), + ("exnMessage", (sc_s_exn, + PRIMname (mkPrimInfo 1 (MLPccall(1, "sml_exnmessage"))))) +]; + +val initial_ref_VE = +[ + ("ref", (scheme_1u_imp (fn a => + type_arrow a (type_ref a)), + REFname)), + ("!", (scheme_1u (fn a => + type_arrow (type_ref a) a), + PRIMname (mkPrimInfo 1 (MLPprim(1, Pfield 0))))), + (":=", (scheme_1u (fn a => + type_arrow (type_pair (type_ref a) a) type_unit), + PRIMname (mkPrimInfo 1 (MLPsetref)))) +]; + +val sml_initial_VE = concat +[ + VEofCE initial_bool_CE, + initial_eq_VE, (* cvr: cf. the original if this doesn't work *) + initial_int_VE, + initial_real_VE, + initial_string_VE, + VEofCE initial_list_CE, + VEofCE initial_option_CE, + VEofCE initial_order_CE, + VEofCE initial_frag_CE, + initial_ref_VE, + [("not", (trivial_scheme(type_arrow type_bool type_bool), + PRIMname (mkPrimInfo 1 (MLPprim(1, Pnot)))))], + [("ignore", (scheme_1u (fn a => type_arrow a type_unit), + PRIMname (mkPrimInfo 1 (MLPprim(1, Patom 0)))))], + (* cvr: added overloaded bindings to VE *) + initial_OVL1NNo_VE, + initial_OVL2NNNo_VE, + initial_OVL2NNBo_VE, + initial_OVL1NSo_VE +]; + + +val sml_initial_TE = +[ + ("unit", (APPtyfun (NAMEtyapp tyname_unit), ConEnv [])), + ("bool", (APPtyfun (NAMEtyapp tyname_bool), initial_bool_CE)), + ("int", (APPtyfun (NAMEtyapp tyname_int), ConEnv [])), + ("syserror", (APPtyfun (NAMEtyapp tyname_syserror), ConEnv [])), + ("word", (APPtyfun (NAMEtyapp tyname_word), ConEnv [])), + ("word8", (APPtyfun (NAMEtyapp tyname_word8), ConEnv [])), + ("char", (APPtyfun (NAMEtyapp tyname_char), ConEnv [])), + ("real", (APPtyfun (NAMEtyapp tyname_real), ConEnv [])), + ("string", (APPtyfun (NAMEtyapp tyname_string), ConEnv [])), + ("substring", (APPtyfun (NAMEtyapp tyname_substring), ConEnv [])), + ("list", (APPtyfun (NAMEtyapp tyname_list), initial_list_CE)), + ("vector", (APPtyfun (NAMEtyapp tyname_vector), ConEnv [])), + ("option", (APPtyfun (NAMEtyapp tyname_option), initial_option_CE)), + ("order", (APPtyfun (NAMEtyapp tyname_order), initial_order_CE)), + ("frag", (APPtyfun (NAMEtyapp tyname_frag), initial_frag_CE)), + ("ref", (APPtyfun (NAMEtyapp tyname_ref), ConEnv [])), + ("exn", (APPtyfun (NAMEtyapp tyname_exn), ConEnv [])), + ("ppstream", (APPtyfun (NAMEtyapp tyname_ppstream), ConEnv [])) +]; + +val sml_initial_T = + map (fn (_,(APPtyfun (NAMEtyapp tn),_)) => tn + | _ => fatalError "sml_initial_T") + sml_initial_TE; + +val () = + app (fn (id, scis) => + Hasht.insert (#uVarEnv unit_General) id + { qualid={qual="General", id=[id]}, info=scis }) + sml_initial_VE +; + +val () = + app (fn (id, tn) => + Hasht.insert (#uTyEnv unit_General) id tn) + sml_initial_TE +; + +val () = (#uTyNameSet unit_General) := sml_initial_T; + +fun mkEi arity = + let val ei = mkExConInfo() in + setExConArity ei arity; + ei + end; + +val sc_str_exn = trivial_scheme (type_arrow type_string type_exn); + +(* The exn names for these are defined as globals by the runtime system *) + +val predefExceptions = [ + ("Out_of_memory", ("exn_memory", 0, sc_exn)), + ("Invalid_argument", ("exn_argument", 1, sc_str_exn)), + ("Graphic", ("exn_graphic", 1, sc_str_exn)), + ("SysErr", ("exn_syserr", 1, + trivial_scheme (type_arrow type_of_syserror_exn + type_exn))), + ("Io", ("exn_io", 1, + trivial_scheme(type_arrow type_of_io_exn type_exn))), + ("Fail", ("exn_fail", 1, sc_str_exn)), + ("Size", ("exn_size", 0, sc_exn)), + ("Interrupt", ("exn_interrupt", 0, sc_exn)), + ("Subscript", ("exn_subscript", 0, sc_exn)), + ("Chr", ("exn_chr", 0, sc_exn)), + ("Div", ("exn_div", 0, sc_exn)), + ("Domain", ("exn_domain", 0, sc_exn)), + ("Ord", ("exn_ord", 0, sc_exn)), + ("Overflow", ("exn_overflow", 0, sc_exn)), + ("Bind", ("exn_bind", 0, sc_exn)), + ("Match", ("exn_match", 0, sc_exn)), + ("Option", ("exn_option", 0, sc_exn)) +]; + +val () = + app (fn (smlid, (globid, arity, sc)) => + let val sc = { qualid={qual="General", id=[globid]}, + info=(sc, EXNname(mkEi arity)) } + in Hasht.insert (#uVarEnv unit_General) smlid sc end) + predefExceptions + +val () = + Hasht.insert pervSigTable "General" unit_General; diff -Nru mosml-2.01/src/compiler.cminusminus/Smlprim.sml mosml-2.10.1/src/compiler.cminusminus/Smlprim.sml --- mosml-2.01/src/compiler.cminusminus/Smlprim.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Smlprim.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,95 @@ +(* SML primitives *) + +local + open Obj Const Prim; +in + +datatype SMLPrim = + MLPeq + | MLPeq_c + | MLPnoteq + | MLPnoteq_c + | MLPref + | MLPsetref + | MLPsetref_c + | MLPadd_int + | MLPadd_int_c + | MLPsub_int + | MLPsub_int_c + | MLPmul_int + | MLPmul_int_c + | MLPdiv_int + | MLPdiv_int_c + | MLPmod_int + | MLPmod_int_c + | MLPquot_int + | MLPquot_int_c + | MLPrem_int + | MLPrem_int_c + | MLPeq_int + | MLPeq_int_c + | MLPnoteq_int + | MLPnoteq_int_c + | MLPlt_int + | MLPlt_int_c + | MLPgt_int + | MLPgt_int_c + | MLPle_int + | MLPle_int_c + | MLPge_int + | MLPge_int_c + | MLPadd_real + | MLPadd_real_c + | MLPsub_real + | MLPsub_real_c + | MLPmul_real + | MLPmul_real_c + | MLPdiv_real + | MLPdiv_real_c + | MLPlt_real + | MLPlt_real_c + | MLPgt_real + | MLPgt_real_c + | MLPle_real + | MLPle_real_c + | MLPge_real + | MLPge_real_c + | MLPlt_string + | MLPlt_string_c + | MLPgt_string + | MLPgt_string_c + | MLPle_string + | MLPle_string_c + | MLPge_string + | MLPge_string_c + | MLPadd_word + | MLPadd_word_c + | MLPsub_word + | MLPsub_word_c + | MLPmul_word + | MLPmul_word_c + | MLPdiv_word + | MLPdiv_word_c + | MLPmod_word + | MLPmod_word_c + | MLPeq_word + | MLPeq_word_c + | MLPnoteq_word + | MLPnoteq_word_c + | MLPlt_word + | MLPlt_word_c + | MLPgt_word + | MLPgt_word_c + | MLPle_word + | MLPle_word_c + | MLPge_word + | MLPge_word_c + | MLPconcat + | MLPconcat_c + | MLPprim of int * primitive + | MLPccall of int * string + | MLPgv of QualifiedIdent + | MLPgvt of QualifiedIdent * obj ref +; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Smltop.sig mosml-2.10.1/src/compiler.cminusminus/Smltop.sig --- mosml-2.01/src/compiler.cminusminus/Smltop.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Smltop.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,4 @@ +val evalLoad : string -> unit; +val loadToplevelPhrase : Lexing.lexbuf -> bool; +val evalUse : string -> unit; +val resetSMLTopDynEnv : unit -> unit; diff -Nru mosml-2.01/src/compiler.cminusminus/Smltop.sml mosml-2.10.1/src/compiler.cminusminus/Smltop.sml --- mosml-2.01/src/compiler.cminusminus/Smltop.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Smltop.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,346 @@ +(* Smltop.sml *) + +open List Obj BasicIO Nonstdio; +open Miscsys Memory Fnlib Config Mixture Const Smlexc Smlprim; +open Globals Location Units Types Smlperv Code_dec Emitcode Emit_phr Compiler; +open Symtable Patch; +open Rtvals Load_phr Exec_phr; + +exception Already of string +and NotYet of string + +fun add_suffix name suffix = + if Filename.check_suffix name suffix + then (Filename.chop_suffix name suffix, name) + else (name, name ^ suffix) +; + +(* Loading in core a compiled bytecode file *) + +fun tryEvalLoad name = + let + val (simplename, filename) = add_suffix name ".uo" + val uname = normalizedUnitName(Filename.basename simplename) + val () = + if member uname reservedUnitNames then + raise Fail ("load: cannot load built-in unit "^uname) + else () + val () = + (ignore (Hasht.find (!watchDog) uname); + raise Already uname) + handle Subscript => () + val block_len = ref 0 + val code = ref "" + val truename = find_in_path filename + val is = open_in_bin truename + val open_after_loading = ref false + val () = + let + val stop = input_binary_int is + val start = pos_in is + val code_len = stop - start + val () = (block_len := code_len + 1) + (* Now we have to check, whether the unit body is compatible *) + (* with its compiled signature and previously loaded units. *) + val () = seek_in is stop + val tables = (input_value is : compiled_unit_tables) + val () = + Hasht.apply (fn uname' => fn stamp' => + let val stamp'' = Hasht.find (!watchDog) uname' in + if stamp'' <> stamp' then + raise Fail ("load: compiled body of unit "^uname^ + " is incompatible with previously loaded unit "^ + uname') + else () + end + handle Subscript => raise NotYet uname') + (#cu_mentions tables) + (* The following line will put the compiled signature into the *) + (* current table of unit signatures, if not already there: *) + val (sign,already_loaded) = ((Hasht.find (!currentSigTable) uname,true) + handle Subscript => (readSig uname,false)) + prim_val create_string_ : int -> string = 1 "create_string"; + prim_val set_nth_char_ : string -> int -> char -> unit + = 3 "set_nth_char" + in + open_after_loading := + (modeOfSig sign = TOPDECmode andalso (not already_loaded)); + if #cu_sig_stamp tables <> getOption (!(#uStamp sign)) then + raise Fail ("load: compiled body of unit "^uname^ + " is incompatible with its compiled signature") + else (); + seek_in is start; + code := create_string_ (!block_len); + fast_really_input is (!code) 0 code_len; + set_nth_char_ (!code) code_len (Char.chr Opcodes.STOP); + app + (fn phr => + patch_object (!code) ((#cph_pos phr) - start) (#cph_reloc phr)) + (rev (#cu_phrase_index tables)); + exportPublicNames uname + (#cu_exc_ren_list tables) (#cu_val_ren_list tables); + Hasht.insert (!currentSigTable) uname sign; + Hasht.insert (!watchDog) uname (#cu_sig_stamp tables); + close_in is + end + handle x => + (close_in is; raise x) + (* Initialize the unit. *) + (* In case this fails, remove it from the unit and signature tables: *) + val res = + (do_code false (!code) 0 (!block_len); + if !open_after_loading then + execToplevelOpen nilLocation uname + else ()) + handle x => (Hasht.remove (!currentSigTable) uname; + Hasht.remove (!watchDog) uname; + raise x) + in () end; + +fun evalLoad s = + (catch_interrupt false; tryEvalLoad s; catch_interrupt true) + handle + SysErr(s, _) => + (catch_interrupt true; raise Fail ("load: "^s)) + | Already uname => + (catch_interrupt true; + raise Fail ("load: unit "^uname^" has been loaded already")) + | NotYet uname => + (catch_interrupt true; + raise Fail ("load: unit "^uname^" is needed but not yet loaded")) + | Out_of_memory => + (catch_interrupt true; raise Fail "load: out of memory") + | Toplevel => + (catch_interrupt true; + raise Fail "load: unable to load") + | x => (catch_interrupt true; raise x) +; + +(* A more user-friendly load function: + * does not fail when a unit has already been loaded; + * automatically loads any unit that a requested unit depends on. +*) + +fun smartEvalLoad s = + let fun tryload s pending = + (catch_interrupt false; tryEvalLoad s; catch_interrupt true) + handle + SysErr(s, _) => + (catch_interrupt true; raise Fail ("load: "^s)) + | Already _ => + catch_interrupt true + | NotYet missing => + (catch_interrupt true; + if member missing pending then + raise Fail ("load: unit " ^ missing ^ + " indirectly depends on itself") + else + (tryload missing (s :: pending); + tryload s pending)) + | Out_of_memory => + (catch_interrupt true; raise Fail "load: out of memory") + | Toplevel => + (catch_interrupt true; + raise Fail "load: unable to load") + | x => (catch_interrupt true; raise x) + in tryload s [] end +; + +fun evalLoaded () : string list = + Hasht.fold (fn k => fn _ => fn res => k :: res) [] (!watchDog) + +fun protect_current_input fct = + let val saved_input_name = !input_name + and saved_input_stream = !input_stream + and saved_input_lexbuf = !input_lexbuf + in + (fct(); + input_lexbuf := saved_input_lexbuf; + input_stream := saved_input_stream; + input_name := saved_input_name) + handle x => + (input_lexbuf := saved_input_lexbuf; + input_stream := saved_input_stream; + input_name := saved_input_name; + raise x) + end +; + +(* Loading an SML source file *) + +fun loadToplevelPhrase lexbuf = + let val (phrase, isLast) = parseToplevelPhrase lexbuf in + execToplevelPhrase phrase; + isLast + end +; + +fun evalUse filename = + let + val truename = + (find_in_path filename + handle Fail msg => + (msgIBlock 0; errPrompt msg; msgEOL(); msgEBlock(); msgFlush(); + raise Toplevel)) + val () = + if not (!Exec_phr.quietdec) then + (msgIBlock 0; + msgString "[opening file \""; msgString truename; + msgString "\"]"; msgEOL(); msgEBlock(); msgFlush()) + else () + val is = open_in_bin truename + val lexbuf = Compiler.createLexerStream is + fun closeIn() = + (close_in is; + if not (!Exec_phr.quietdec) then + (msgIBlock 0; + msgString "[closing file \""; msgString truename; + msgString "\"]"; msgEOL(); msgEBlock(); msgFlush()) + else ()) + + in + ( protect_current_input (fn () => + (input_name := truename; + input_stream := is; + input_lexbuf := lexbuf; + while true do + let val isLast = loadToplevelPhrase lexbuf + in if isLast then raise EndOfFile else () end))) + handle + EndOfFile => closeIn() + | x => (closeIn(); raise x) + end +; + +(* Compile a file *) + +fun tryEvalCompile mode context s = + protect_current_input (fn () => protectCurrentUnit (fn () => + if Filename.check_suffix s ".sig" then + let val filename = Filename.chop_suffix s ".sig" in + compileSignature context + (normalizedUnitName (Filename.basename filename)) + mode + filename + end + else if Filename.check_suffix s ".sml" then + let val filename = Filename.chop_suffix s ".sml" in + compileUnitBody context + (normalizedUnitName (Filename.basename filename)) + mode + filename + end + else + raise Fail "compile: unknown file name extension")) +; + +fun evalCompile mode context s = + tryEvalCompile mode context s + handle + Interrupt => raise Fail "compile: interrupted by the user" + | Out_of_memory => raise Fail "compile: out of memory" + | Toplevel => raise Fail "compile: error(s) in the source program" + | SysErr _ => raise Fail "compile: file not found" +; + +(* cvr: TODO + it would be better if smltop_con_basis, sml_VE and the global dynamic + env were initialised from a single association list instead of three + possibly inconsistent ones +*) + +val smltop_con_basis = +[ + ("use", { qualid={qual="Meta", id=["use"]}, info=VARname REGULARo}), + ("load", { qualid={qual="Meta", id=["load"]}, info=VARname REGULARo}), + ("loadOne",{ qualid={qual="Meta", id=["loadOne"]}, info=VARname REGULARo}), + ("loaded", { qualid={qual="Meta", id=["loaded"]}, info=VARname REGULARo}), + ("compile",{ qualid={qual="Meta", id=["compile"]}, info=VARname REGULARo}), + ("compileStructure",{ qualid={qual="Meta", id=["compileStructure"]}, info=VARname REGULARo}), + ("compileToplevel",{ qualid={qual="Meta", id=["compileToplevel"]}, info=VARname REGULARo}), + ("verbose",{ qualid={qual="Meta", id=["verbose"]}, info=VARname REGULARo}), + ("quietdec",{ qualid={qual="Meta", id=["quietdec"]}, info=VARname REGULARo}), + ("loadPath",{ qualid={qual="Meta", id=["loadPath"]}, info=VARname REGULARo}), + ("quotation", + { qualid={qual="Meta", id=["quotation"]}, info=VARname REGULARo}), + ("valuepoly", + { qualid={qual="Meta", id=["valuepoly"]}, info=VARname REGULARo}), + ("printVal", { qualid={qual="Meta", id=["printVal"]},info=VARname OVL1TXXo}), + ("printDepth", + { qualid={qual="Meta", id=["printDepth"]},info=VARname REGULARo}), + ("printLength", + { qualid={qual="Meta", id=["printLength"]}, info=VARname REGULARo}), + ("quit", { qualid={qual="Meta", id=["quit"]}, info=VARname REGULARo}), + ("orthodox", { qualid={qual="Meta", id=["orthodox"]}, info=VARname REGULARo}), + ("conservative", { qualid={qual="Meta", id=["conservative"]}, info=VARname REGULARo}), + ("liberal", { qualid={qual="Meta", id=["liberal"]}, info=VARname REGULARo}), + ("installPP", + { qualid={qual="Meta", id=["installPP"]}, info=VARname OVL1TPUo}) +]; + +val smltop_VE = +[ + ("use", trivial_scheme(type_arrow type_string type_unit)), + ("load", trivial_scheme(type_arrow type_string type_unit)), + ("loadOne", trivial_scheme(type_arrow type_string type_unit)), + ("loaded", trivial_scheme(type_arrow type_unit + (type_list type_string))), + ("compile", trivial_scheme(type_arrow type_string type_unit)), + ("compileStructure",trivial_scheme(type_arrow (type_list type_string) + (type_arrow type_string + type_unit))), + ("compileToplevel",trivial_scheme(type_arrow (type_list type_string) + (type_arrow type_string + type_unit))), + ("verbose", trivial_scheme(type_ref type_bool)), + ("quietdec", trivial_scheme(type_ref type_bool)), + ("loadPath", trivial_scheme(type_ref (type_list type_string))), + ("quotation", trivial_scheme(type_ref type_bool)), + ("valuepoly", trivial_scheme(type_ref type_bool)), + ("printVal", sc_bogus), + ("printDepth", trivial_scheme(type_ref type_int)), + ("printLength", trivial_scheme(type_ref type_int)), + ("quit", trivial_scheme(type_arrow type_unit type_unit)), + ("orthodox", trivial_scheme(type_arrow type_unit type_unit)), + ("conservative",trivial_scheme(type_arrow type_unit type_unit)), + ("liberal", trivial_scheme(type_arrow type_unit type_unit)), + ("installPP", sc_bogus) +]; + +val unit_smltop = newSig "Meta" "Meta" STRmode; + +val () = + app + (fn (id, sc) => let val {qualid,info} = lookup id smltop_con_basis + in Hasht.insert (#uVarEnv unit_smltop) id + {qualid = qualid, info = (sc, info)} + end) + smltop_VE +; + +val () = Hasht.insert pervSigTable "Meta" unit_smltop; + +fun resetSMLTopDynEnv() = + loadGlobalDynEnv "Meta" [ + ("use", repr (evalUse: string -> unit)), + ("loadOne", repr evalLoad), + ("loaded", repr evalLoaded), + ("load", repr smartEvalLoad), + ("compile", repr (evalCompile STRmode [])), + ("compileStructure", repr (evalCompile STRmode)), + ("compileToplevel", repr (evalCompile TOPDECmode)), + ("verbose", repr verbose), + ("quietdec", repr Exec_phr.quietdec), + ("loadPath", repr Mixture.load_path), + ("quotation", repr Lexer.quotation), + ("valuepoly", repr Mixture.value_polymorphism), + ("printVal", repr evalPrint), + ("printDepth", repr printDepth), + ("printLength", repr printLength), + ("quit", repr (fn () => (msgFlush(); BasicIO.exit 0))), + ("orthodox", repr (fn () => (currentCompliance := Orthodox))), + ("conservative",repr (fn () => (currentCompliance := Conservative))), + ("liberal", repr (fn () => (currentCompliance := Liberal))), + ("installPP", repr evalInstallPP) +]; + diff -Nru mosml-2.01/src/compiler.cminusminus/Sort.sig mosml-2.10.1/src/compiler.cminusminus/Sort.sig --- mosml-2.01/src/compiler.cminusminus/Sort.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Sort.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,12 @@ +(* Sorting and merging lists *) + +val sort : ('a -> 'a -> bool) -> 'a list -> 'a list; + (* Sort a list in increasing order according to an ordering predicate. + The predicate should return [true] if its first argument is + less than or equal to its second argument. *) +val merge : ('a -> 'a -> bool) -> 'a list -> 'a list -> 'a list; + (* Merge two lists according to the given predicate. + Assuming the two argument lists are sorted according to the + predicate, [merge] returns a sorted list containing the elements + from the two lists. The behavior is undefined if the two + argument lists were not sorted. *) diff -Nru mosml-2.01/src/compiler.cminusminus/Sort.sml mosml-2.10.1/src/compiler.cminusminus/Sort.sml --- mosml-2.01/src/compiler.cminusminus/Sort.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Sort.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,24 @@ +(* Merging and sorting *) + +fun merge order = + let fun loop [] ys = ys + | loop xs [] = xs + | loop (xs as x::xr) (ys as y::yr) = + if order x y then + x :: loop xr ys + else + y :: loop xs yr + in loop end; + +fun sort order l = + let fun initList [] = [] + | initList [e] = [[e]] + | initList (x1::x2::xs) = + (if order x1 x2 then [x1, x2] else [x2, x1]) :: initList xs + fun merge2 (xs1::xs2::xss) = merge order xs1 xs2 :: merge2 xss + | merge2 x = x + fun mergeAll [] = [] + | mergeAll [xs] = xs + | mergeAll xss = mergeAll (merge2 xss) + in mergeAll(initList l) end +; diff -Nru mosml-2.01/src/compiler.cminusminus/Stack.sig mosml-2.10.1/src/compiler.cminusminus/Stack.sig --- mosml-2.01/src/compiler.cminusminus/Stack.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Stack.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,26 @@ +(* Stack.sig *) + +(* This module implements stacks (LIFOs), with in-place modification. *) + +type 'a t; + (* The type of stacks containing elements of type ['a]. *) + +exception Empty; + (* Raised when [pop] is applied to an empty stack. *) + +val new: unit -> '_a t; + (* Return a new stack, initially empty. *) +val push: 'a -> 'a t -> unit; + (* [push x s] adds the element [x] at the top of stack [s]. *) +val pop: 'a t -> 'a; + (* [pop s] removes and returns the topmost element in stack [s], + or raises [Empty] if the stack is empty. *) +val peek: 'a t -> 'a; + (* [pop s] returns the topmost element in stack [s], + without removing it, or raises [Empty] if the stack is empty. *) +val update: 'a -> 'a t -> unit; + (* [update x s] replaces the top element of stack [s] with [x]. *) +val null: 'a t -> bool; + (* [null s] returns true iff stack [s] is empty. *) +val clear : 'a t -> unit; + (* Discard all elements from a stack. *) diff -Nru mosml-2.01/src/compiler.cminusminus/Stack.sml mosml-2.10.1/src/compiler.cminusminus/Stack.sml --- mosml-2.01/src/compiler.cminusminus/Stack.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Stack.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,33 @@ +(* Stack.sml *) + +open List; + +type 'a t = 'a list ref; + +exception Empty; + +fun new() = ref []; + +fun push x s = (s := x :: !s); + +fun pop s = + case !s of + [] => raise Empty + | x :: xs => (s := xs; x) +; + +fun peek s = + case !s of + [] => raise Empty + | x :: xs => x +; + +fun update x s = + case !s of + [] => raise Empty + | _ :: xs => (s := x :: xs) +; + +fun null s = List.null (!s); + +fun clear s = (s := []); diff -Nru mosml-2.01/src/compiler.cminusminus/Symtable.sig mosml-2.10.1/src/compiler.cminusminus/Symtable.sig --- mosml-2.01/src/compiler.cminusminus/Symtable.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Symtable.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,20 @@ +local + open BasicIO Const; +in + +val literal_table : (int * StructConstant) list ref; +val get_slot_for_variable : QualifiedIdent * int -> int; +val get_slot_for_defined_variable : QualifiedIdent * int -> int; +val get_slot_for_literal : StructConstant -> int; +val number_of_globals : unit -> int; +val get_num_of_prim : string -> int; +val intOfTag : BlockTag -> int; +val exportPublicNames : + string -> (QualifiedIdent * (QualifiedIdent * int)) list -> + (string * int) list -> unit; +val reset_linker_tables : unit -> unit; +val save_linker_tables : outstream -> unit; +val init_linker_tables : unit -> unit; +val protect_linker_tables : (unit -> 'a) -> unit; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Symtable.sml mosml-2.10.1/src/compiler.cminusminus/Symtable.sml --- mosml-2.01/src/compiler.cminusminus/Symtable.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Symtable.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,291 @@ +(* Symtable.sml : to assign numbers to global variables and so on *) + +local + open Misc Nonstdio Obj Fnlib Config Mixture Const; +in + +(* Hashtables for numbering objects *) + +type 'a numtable = +{ + num_cnt: int ref, (* The current number *) + num_tbl: ('a, int) Hasht.t (* The table *) +}; + +fun new_numtable size = + { num_cnt = ref 0, num_tbl = Hasht.new size } +; + +fun find_in_numtable (nt : ''a numtable) = + Hasht.find (#num_tbl nt) +; + +fun enter_in_numtable (nt : ''_a numtable) key = + let val c = !(#num_cnt nt) in + #num_cnt nt := !(#num_cnt nt) + 1; + Hasht.insert (#num_tbl nt) key c; + c + end; + +fun remove_from_numtable (nt : ''a numtable) key = + Hasht.remove (#num_tbl nt) key +; + +(* Global variables *) + +val global_table = + ref (new_numtable 1 : (QualifiedIdent * int) numtable) + +and literal_table = + ref ([] : (int * StructConstant) list) +; + +fun get_slot_for_variable (uid as (qualid, stamp)) = + find_in_numtable (!global_table) uid + handle Subscript => + (let val {qual,id} = qualid + val mid = longIdentAsIdent id "get_slot_for_variable" + val (desc,s) = + case unmangle mid of + ValId s => + ("Value ",s) + | ModId s => + ("Structure ",s) + | FunId s => + ("Functor ",s) + in + msgIBlock 0; + msgEOL(); + errPrompt desc; + msgString qual; msgString "."; msgString s; + if stamp <> 0 then (msgString "/"; msgInt stamp) else (); + msgString " hasn't been defined yet"; msgEOL(); + msgEBlock(); + raise Toplevel + end) +; + +fun get_slot_for_defined_variable (uid as (qualid, stamp)) = + enter_in_numtable (!global_table) uid +; + +fun get_slot_for_literal cst = + let val c = !(#num_cnt (!global_table)) in + #num_cnt(!global_table) := !(#num_cnt (!global_table)) + 1; + literal_table := (c, cst) :: !literal_table; + c + end; + +fun number_of_globals () = + !(#num_cnt (!global_table)) +; + +fun defineGlobalValueAlias uid uid' = + let val slot = get_slot_for_variable uid' in + Hasht.insert (#num_tbl (!global_table)) uid slot + end; + +(* The exception tags *) + +(* ps: val unknown_exn_name = ({qual="?", id=["?"]}, 0); +val exn_tag_table = ref(new_numtable 1 : (QualifiedIdent * int) numtable); +val tag_exn_table = ref(Array.fromList [] : (QualifiedIdent * int) Array.array ); + +*) + +(* cvr: +fun fromShortTagExnTable a = Array.tabulate + ((Array.length a), + (fn i => case Array.sub (a, i) of + ({qual=qual,id = id},i) => ({qual=qual,id = [id]},i))); + +fun toShortTagExnTable a = Array.tabulate + ((Array.length a), + (fn i => case Array.sub (a, i) of + ({qual=qual,id = [id]},i) => ({qual=qual,id = id},i))); + +fun get_num_of_exn (name, stamp) = + Hasht.find (#num_tbl (!exn_tag_table)) (name, stamp) + handle Subscript => + let val c = enter_in_numtable (!exn_tag_table) (name, stamp) + val len = Array.length (!tag_exn_table) + in + if c < len then () else + let val new_len = 2 * len + val new_tag_exn_table = Array.array(new_len, unknown_exn_name) + in + Array.copy {src = !tag_exn_table, si = 0, len = NONE, + dst = new_tag_exn_table, di = 0}; + tag_exn_table := new_tag_exn_table + end; + Array.update(!tag_exn_table, c, (name, stamp)); + c + end; + +fun get_exn_of_num tag = + if tag >= Array.length (!tag_exn_table) + then unknown_exn_name + else Array.sub(!tag_exn_table, tag) +; + +fun defineGlobalExceptionAlias (q, (q', stamp')) = + let val tag = get_num_of_exn (q', stamp') in + Hasht.insert (#num_tbl (!exn_tag_table)) (q, 0) tag + end; +*) + +fun intOfTag (CONtag(n,_)) = n +(* | intOfTag (EXNtag(id, stamp)) = fatalError "intOfTag" (* ps: get_num_of_exn(id, stamp) *) *) +; + +(* The C primitives *) + +val c_prim_table = ref (new_numtable 0 : string numtable); + +(* cvr: 144 merge +fun set_c_primitives prim_vect = + (c_prim_table := new_numtable 31; + for (fn i => ignore + (enter_in_numtable (!c_prim_table) (Vector.sub(prim_vect, i)))) + 0 (Vector.length prim_vect - 1)) +; +*) +fun set_c_primitives prim_vect = + (c_prim_table := new_numtable 67; + Vector.app (ignore o enter_in_numtable (!c_prim_table)) prim_vect) +; + +fun get_num_of_prim name = + find_in_numtable (!c_prim_table) name + handle Subscript => + (msgIBlock 0; + errPrompt "Unavailable C primitive: "; + msgString name; msgEOL(); + msgEBlock(); + raise Toplevel) +; + +fun exportPublicNames uname excRenList valRenList = + ((* ps: List.app defineGlobalExceptionAlias excRenList; *) + List.app + (fn (id, stamp) => + defineGlobalValueAlias + ({ qual=uname, id=[id] }, 0) + ({ qual=uname, id=[id] }, stamp)) + valRenList) +; + +(* Initialization *) + +(* ps: + +val normalizeExnName = fn + {qual="sys", id=["Break"]} => {qual="General", id=["Interrupt"]} + | {qual="sys", id=["Sys_error"]} => {qual="General", id=["SysErr"]} + | {qual="exc", id=["Not_found"]} => {qual="General", id=["Subscript"]} + | {qual="io", id=["End_of_file"]} => {qual="General", id=["Size"]} + | {qual="exc", id=["Out_of_memory"]} => {qual="General", id=["Out_of_memory"]} + | {qual="exc", id=["Invalid_argument"]} => + {qual="General", id=["Invalid_argument"]} + | {qual="exc", id=["Failure"]} => {qual="General", id=["Fail"]} + | {qual="graphics", id=["Graphic_failure"]} => + {qual="General", id=["Graphic_failure"]} + | {qual="general", id=["Exception"]} => {qual="General", id=["(Exception)"]} + | {qual="general", id=[id]} => {qual="General", id=[id]} + | qualid => qualid +; + +*) + +fun reset_linker_tables () = +( + global_table := new_numtable 263; + literal_table := []; + List.app + (fn {qual, id} => + ignore( get_slot_for_defined_variable + (* ps: ({qual="(global)", id=[id]}, 0) *) + ({qual=qual, id=[id]}, 0) )) + Predef.predef_variables; +(* ps: exn_tag_table := new_numtable 31; + tag_exn_table := Array.array(50, unknown_exn_name); + List.app + (fn ({qual,id}, stamp) => + ignore(get_num_of_exn (normalizeExnName {qual=qual,id = [id]}, 0))) + Predef.predef_exn; +*) + set_c_primitives Prim_c.primitives_table +); + +fun save_linker_tables outstream = +( + output_binary_int outstream (! (#num_cnt(!global_table))) +(* cvr: removed + output_value outstream (!exn_tag_table); + output_value outstream (!tag_exn_table) +*) +(* cvr: added: *) +(* ps: ; output_value outstream (toShortExnTagTable(!exn_tag_table)); + output_value outstream (toShortTagExnTable(!tag_exn_table)) +(* cvr: *) *) +); + +(* To read linker tables from the executable file *) + +fun load_linker_tables () = + ( let + val is = open_in_bin (Vector.sub(Miscsys.command_line, 0)) + (* The code, data, symb, and debug indexes are located 20 bytes + before the end of the bytecode file. *) + val () = seek_in is (in_stream_length is - 20) + val size_code = input_binary_int is + val size_data = input_binary_int is + val size_symb = input_binary_int is + val size_debug = input_binary_int is + in + seek_in is (in_stream_length is - 20 - size_debug - size_symb); + (* We don't need information about the internals *) + (* of Moscow ML system! *) + global_table := new_numtable 263; + #num_cnt (!global_table) := input_binary_int is + end + ) handle _ => fatalError "Unable to read linker tables from bytecode" +; + +(* Initialization *) + +prim_val available_primitives : unit -> string Vector.vector + = 1 "available_primitives"; + +fun init_linker_tables () = +( + load_linker_tables(); + (* Hasht.clear (#num_tbl (!global_table)); *) + appFrom + (fn slot => fn {qual,id} => + Hasht.insert (#num_tbl (!global_table)) ({qual=qual,id=[id]}, 0) slot) + 0 Predef.predef_variables; + literal_table := []; + set_c_primitives (available_primitives()) +); + +(* added -- 07Sep95 e *) + +fun protect_linker_tables fct = + let val saved_global_table = !global_table + and saved_literal_table = !literal_table + and saved_c_prim_table = !c_prim_table + in + (fct(); + global_table := saved_global_table; + literal_table := saved_literal_table; + c_prim_table := saved_c_prim_table + ) + handle x => + (global_table := saved_global_table; + literal_table := saved_literal_table; + c_prim_table := saved_c_prim_table; + raise x) + end + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Synchk.sig mosml-2.10.1/src/compiler.cminusminus/Synchk.sig --- mosml-2.01/src/compiler.cminusminus/Synchk.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Synchk.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,7 @@ +val compliantStrDec: Asynt.Dec -> unit; +val compliantTopDec: Asynt.Dec -> unit; +val compliantSigExp: Asynt.SigExp -> unit; +val compliantSpec: Asynt.Spec -> unit; +val compliantTopSpec: Asynt.Spec -> unit; + + diff -Nru mosml-2.01/src/compiler.cminusminus/Synchk.sml mosml-2.10.1/src/compiler.cminusminus/Synchk.sml --- mosml-2.01/src/compiler.cminusminus/Synchk.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Synchk.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,430 @@ +open List Fnlib Mixture Const Globals Location Units Asynt Asyntfn + +fun complianceMsg loc msg = + case (!currentCompliance) of + Orthodox => + (msgIBlock 0; + errLocation loc; + errPrompt "Compliance Error: ";msgEOL(); + errPrompt "The phrase is an instance of the Moscow ML extension:";msgEOL(); + errPrompt " ";msgString msg; msgEOL(); + errPrompt "which is not supported by the Definition of Standard ML."; msgEOL(); + msgEBlock(); + raise Toplevel) + | Conservative => + (msgIBlock 0; + errLocation loc; + errPrompt "Compliance Warning: ";msgEOL(); + errPrompt "The phrase is an instance of the Moscow ML extension:";msgEOL(); + errPrompt " ";msgString msg; msgEOL(); + errPrompt "which is not supported by the Definition of Standard ML."; msgEOL(); + msgEBlock()) + | Liberal =>() +; + +fun atmodexps args (loc,(APPmodexp(func,arg),_)) = + atmodexps (arg::args) func + | atmodexps args head = (head,args) + +fun compliantExp (loc, exp') = + case exp' of + SCONexp _ => () + | VIDPATHexp _ => () + | RECexp(ref (RECre fields)) => + app (fn(_, e) => compliantExp e) fields + | RECexp(ref (TUPLEre es)) => + app compliantExp es + | VECexp es => + app compliantExp es + | LETexp(dec, exp) => + (compliantDec dec;compliantExp exp) + | PARexp exp => compliantExp exp + | APPexp(exp1, exp2) => + (compliantExp exp1;compliantExp exp2) + | INFIXexp (ref (UNRESinfixexp es)) => + app compliantExp es + | INFIXexp (ref (RESinfixexp e)) => compliantExp e + | TYPEDexp(exp, ty) => + (compliantExp exp;compliantTy ty) + | ANDALSOexp(exp1, exp2) => + (compliantExp exp1;compliantExp exp2) + | ORELSEexp(exp1, exp2) => + (compliantExp exp1;compliantExp exp2) + | HANDLEexp(exp, mrules) => + (compliantExp exp;app compliantMRule mrules) + | RAISEexp exp => + compliantExp exp + | IFexp(e0, e1, e2) => + (compliantExp e0;compliantExp e1;compliantExp e2) + | FNexp mrules => + app compliantMRule mrules + | WHILEexp(exp1, exp2) => + (compliantExp exp1;compliantExp exp2) + | SEQexp(exp1, exp2) => + (compliantExp exp1;compliantExp exp2) + | STRUCTUREexp(modexp,sigexp,_) => + (complianceMsg loc " ::= [structure as ]"; + compliantModExp modexp; + compliantSigExp sigexp) + | FUNCTORexp(modexp,sigexp,_) => + (complianceMsg loc " ::= [functor as ]"; + compliantModExp modexp; + compliantSigExp sigexp) +and compliantMRule (MRule(ref pats, exp)) = + (app compliantPat pats;compliantExp exp) +and compliantPat (_, pat') = + case pat' of + SCONpat _ => () + | VARpat _ => () + | WILDCARDpat => () + | NILpat _ => () + | CONSpat(_, p) => compliantPat p + | EXNILpat _ => () + | EXCONSpat(_,p) => compliantPat p + | EXNAMEpat _ => fatalError "compliantPat" +(* cvr: TODO review *) + | REFpat p => compliantPat p + | RECpat(ref (RECrp(fs, _))) => + app (fn(_, p) => compliantPat p) fs + | RECpat(ref (TUPLErp _)) => fatalError "compliantPat" +(* cvr: TODO review *) + | VECpat ps => + app compliantPat ps + | INFIXpat (ref (RESinfixpat p)) => compliantPat p + | INFIXpat (ref (UNRESinfixpat _)) => fatalError "compliantPat" +(* cvr: TODO review *) + | PARpat pat => compliantPat pat + | TYPEDpat(pat, ty) => + (compliantPat pat;compliantTy ty) + | LAYEREDpat(pat1, pat2) => + (compliantPat pat1;compliantPat pat2) +and compliantDec (loc,dec') = + case dec' of + VALdec (tyvarseq,(valbind,valbind')) => + (app compliantValBind valbind; + app compliantValBind valbind') + | PRIM_VALdec _ => () + | FUNdec (ref (UNRESfundec (tyvarseq, fvbds))) => fatalError "compliantDec" +(* cvr: TODO review *) + | FUNdec (ref (RESfundec dec)) => compliantDec dec + | TYPEdec tbds => + app compliantTypBind tbds + | PRIM_TYPEdec _ => () + | DATATYPEdec (dbds,SOME tbds) => + ((app compliantDatBind dbds) ; + (app compliantTypBind tbds)) + | DATATYPEdec (dbds,NONE) => + app compliantDatBind dbds + | DATATYPErepdec (_,tyconpath) => + compliantTyConPath tyconpath + | ABSTYPEdec(dbds,SOME tbds,dec) => + ((app compliantDatBind dbds); + (app compliantTypBind tbds); + compliantDec dec) + | ABSTYPEdec(dbds,NONE,dec) => + ((app compliantDatBind dbds); + compliantDec dec) + | EXCEPTIONdec ebs => + app compliantExBind ebs + | LOCALdec (dec1, dec2) => + (compliantDec dec1;compliantDec dec2) + | OPENdec longmodidinfos => + compliantLongModIdInfoList longmodidinfos + | EMPTYdec => () + | SEQdec (dec1, dec2) => + (compliantDec dec1;compliantDec dec2) + | FIXITYdec _ => () + | STRUCTUREdec mbds => + (complianceMsg loc " ::= structure "; + app compliantModBind mbds) + | FUNCTORdec fbds => + (complianceMsg loc " ::= functor "; + app compliantFunBind fbds) + | SIGNATUREdec sbds => + (complianceMsg loc " ::= signature "; + app compliantSigBind sbds) +and compliantStrDec (loc,dec') = + case dec' of + VALdec (tyvarseq,(valbind,valbind')) => + (app compliantValBind valbind; + app compliantValBind valbind') + | PRIM_VALdec _ => () + | FUNdec (ref (UNRESfundec (tyvarseq, fvbds))) => fatalError "compliantStrDec" +(* cvr: TODO review *) + | FUNdec (ref (RESfundec dec)) => compliantStrDec dec + | TYPEdec tbds => + app compliantTypBind tbds + | PRIM_TYPEdec _ => () + | DATATYPEdec (dbds,SOME tbds) => + ((app compliantDatBind dbds) ; + (app compliantTypBind tbds)) + | DATATYPEdec (dbds,NONE) => + app compliantDatBind dbds + | DATATYPErepdec (_,tyconpath) => + compliantTyConPath tyconpath + | ABSTYPEdec(dbds,SOME tbds,dec) => + ((app compliantDatBind dbds); + (app compliantTypBind tbds); + compliantDec dec) + | ABSTYPEdec(dbds,NONE,dec) => + ((app compliantDatBind dbds); + compliantDec dec) + | EXCEPTIONdec ebs => + app compliantExBind ebs + | LOCALdec (dec1, dec2) => + (compliantStrDec dec1;compliantStrDec dec2) + | OPENdec longmodidinfos => + compliantLongModIdInfoList longmodidinfos + | EMPTYdec => () + | SEQdec (dec1, dec2) => + (compliantStrDec dec1;compliantStrDec dec2) + | FIXITYdec _ => () + | STRUCTUREdec mbds => + (app compliantModBind mbds) + | FUNCTORdec fbds => + (complianceMsg loc " ::= functor "; + app compliantFunBind fbds) + | SIGNATUREdec sbds => + (complianceMsg loc " ::= signature "; + app compliantSigBind sbds) +and compliantTopDec (loc,dec') = + case dec' of + VALdec (tyvarseq,(valbind,valbind')) => + (app compliantValBind valbind; + app compliantValBind valbind') + | PRIM_VALdec _ => () + | FUNdec (ref (UNRESfundec (tyvarseq, fvbds))) => fatalError "compliantTopDec" +(* cvr: TODO review *) + | FUNdec (ref (RESfundec dec)) => compliantTopDec dec + | TYPEdec tbds => + app compliantTypBind tbds + | PRIM_TYPEdec _ => () + | DATATYPEdec (dbds,SOME tbds) => + ((app compliantDatBind dbds) ; + (app compliantTypBind tbds)) + | DATATYPEdec (dbds,NONE) => + app compliantDatBind dbds + | DATATYPErepdec (_,tyconpath) => + compliantTyConPath tyconpath + | ABSTYPEdec(dbds,SOME tbds,dec) => + ((app compliantDatBind dbds); + (app compliantTypBind tbds); + compliantDec dec) + | ABSTYPEdec(dbds,NONE,dec) => + ((app compliantDatBind dbds); + compliantDec dec) + | EXCEPTIONdec ebs => + app compliantExBind ebs + | LOCALdec (dec1, dec2) => + (compliantStrDec dec1;compliantStrDec dec2) + | OPENdec longmodidinfos => + compliantLongModIdInfoList longmodidinfos + | EMPTYdec => () + | SEQdec (dec1, dec2) => + (compliantTopDec dec1;compliantTopDec dec2) + | FIXITYdec _ => () + | STRUCTUREdec mbds => + (app compliantModBind mbds) + | FUNCTORdec fbds => + (app compliantFunBind fbds) + | SIGNATUREdec sbds => + (app compliantSigBind sbds) +and compliantExBind (EXDECexbind(_, SOME ty)) = compliantTy ty + | compliantExBind (EXDECexbind(_, NONE)) = () + | compliantExBind (EXEQUALexbind(_,_)) = () +and compliantValBind (ValBind(ref pat, exp)) = + (compliantPat pat;compliantExp exp) +and compliantPrimValBindList (pbs) = + (app (fn (ii,ty,arity,n) => compliantTy ty) pbs) +and compliantValDec (pvbs, rvbs) = + ((app compliantValBind pvbs) ; + (app compliantValBind rvbs)) +and compliantTy (loc, ty') = + case ty' of + TYVARty ii => () + | RECty fs => + app (fn(_, ty) => compliantTy ty) fs + | CONty(tys, tyconpath) => + ((app compliantTy tys);compliantTyConPath tyconpath) + | FNty(ty1, ty2) => + (compliantTy ty1;compliantTy ty2) + | PACKty(sigexp) => + (complianceMsg loc " ::= []"; + compliantSigExp sigexp) + | PARty(ty) => + compliantTy ty +and compliantModBind (MODBINDmodbind(modid,modexp)) = + compliantModExp modexp + | compliantModBind (ASmodbind(modid,sigexp,exp)) = + (complianceMsg (xxLR modid exp) " ::= as = "; + compliantSigExp sigexp; + compliantExp exp) +and compliantSigBind (SIGBINDsigbind(sigid,sigexp)) = + compliantSigExp sigexp +and compliantFunBind (FUNBINDfunbind(funid, + modexp as (loc,(FUNCTORmodexp _,_)))) = + compliantModExp modexp + | compliantFunBind (FUNBINDfunbind(funid,modexp)) = + (complianceMsg (xxLR funid modexp) " ::= = "; + compliantModExp modexp) + | compliantFunBind (ASfunbind(funid,sigexp,exp)) = + (complianceMsg (xxLR funid exp) " ::= as = "; + compliantSigExp sigexp; + compliantExp exp) +and compliantLongModIdInfoList longmodidinfos = + app (fn ({info = {withOp,idLoc,...},...},_) => + if withOp then + complianceMsg idLoc + " ::= op . ... .." + else ()) + longmodidinfos +and compliantModExp (loc,(modexp,_)) = + case modexp of + DECmodexp dec => + compliantStrDec dec + | LONGmodexp {info = {idKind = ref {info = FUNik,...}, + withOp = true, + ...}, + ...} => + complianceMsg loc " ::= op . ... .." + | LONGmodexp {info = {idKind = ref {info = STRik,...}, + withOp = true, + ...}, + ...} => + complianceMsg loc " ::= op . ... .." + | LONGmodexp {info = {idKind = ref {info = FUNik,...}, + withOp = false, + ...}, + qualid = {id = (funid::strid::_),...}} => + complianceMsg loc " ::= . ... .." | LONGmodexp _ => () + | LETmodexp (dec,modexp) => + (compliantStrDec dec;compliantModExp modexp) + | PARmodexp modexp => + (complianceMsg loc + " ::= ( )"; + compliantModExp modexp) + | CONmodexp (modexp,sigexp) => + (compliantModExp modexp;compliantSigExp sigexp) + | ABSmodexp (modexp,sigexp) => + (compliantModExp modexp;compliantSigExp sigexp) + | FUNCTORmodexp (Generative isDerived,modid,_, sigexp, modexp) => + (if isDerived then () + else complianceMsg loc + " ::= functor ( : ) => "; + compliantSigExp sigexp;compliantModExp modexp) + | FUNCTORmodexp (Applicative,modid,_, sigexp, modexp) => + (complianceMsg loc + " ::= functor : => "; + compliantSigExp sigexp;compliantModExp modexp) + | APPmodexp (func,arg) => + (case (atmodexps [arg] func) of + (head as (_,(LONGmodexp _,_)), + [arg as (_,(PARmodexp modexp,_))]) => + (compliantModExp head; + compliantModExp modexp) + | (head,args) => + (complianceMsg loc + " ::= ... "; + compliantModExp head; + app compliantModExp args)) + + | RECmodexp (modid,_,sigexp, modexp) => + (complianceMsg loc + " ::= rec ( : ) "; + compliantSigExp sigexp;compliantModExp modexp) +and compliantSigExp (loc,sigexp) = + case sigexp of + SPECsigexp spec => compliantSpec spec + | SIGIDsigexp _ => () + | WHEREsigexp (sigexp, tyvarseq, longtycon, ty) => + (compliantSigExp sigexp;compliantTy ty) + | FUNSIGsigexp (Generative _,modid,sigexp,sigexp') => + (complianceMsg loc + " ::= functor ( : ) -> "; + compliantSigExp sigexp; + compliantSigExp sigexp') + | FUNSIGsigexp (Applicative,modid,sigexp,sigexp') => + (complianceMsg loc + " ::= functor : -> "; + compliantSigExp sigexp; + compliantSigExp sigexp') + | RECsigexp (modid, sigexp,sigexp') => + (complianceMsg loc + " ::= rec ( : ) "; + compliantSigExp sigexp; + compliantSigExp sigexp') +and compliantSpec (loc, spec') = + case spec' of + VALspec ([],vds) => + compliantValDescList vds + | VALspec ((tyvar::_), vds)=> + (complianceMsg loc " ::= val "; + compliantValDescList vds) + | PRIM_VALspec _ => () + | TYPEDESCspec _ => () + | TYPEspec tbds => app compliantTypBind tbds + | DATATYPEspec (dbds,SOME tbds) => + (complianceMsg loc " ::= datatype withtype "; + (app compliantDatBind dbds); + (app compliantTypBind tbds)) + | DATATYPEspec (dbds,NONE) => + app compliantDatBind dbds + | DATATYPErepspec (_,tyconpath) => + compliantTyConPath tyconpath + | EXCEPTIONspec eds => app compliantExDesc eds + | LOCALspec(spec1, spec2) => + (complianceMsg loc " ::= local in end"; + compliantSpec spec1;compliantSpec spec2) + | OPENspec longmodidinfos => + (complianceMsg loc " ::= open ... "; + compliantLongModIdInfoList longmodidinfos) + | EMPTYspec => () + | SEQspec(spec1, spec2) => + (compliantSpec spec1;compliantSpec spec2) + | INCLUDEspec sigexp => + compliantSigExp sigexp + | STRUCTUREspec moddescs => + app compliantModDesc moddescs + | FUNCTORspec fundescs => + (complianceMsg loc " ::= functor "; + app compliantFunDesc fundescs) + | SHARINGTYPEspec (spec, longtycons) => + compliantSpec spec + | SHARINGspec (spec, longmodids) => + compliantSpec spec + | FIXITYspec (NONFIXst,_) => + complianceMsg loc " ::= nonfix ... " + | FIXITYspec (INFIXst _,_) => + complianceMsg loc " ::= infix ... " + | FIXITYspec (INFIXRst _,_) => + complianceMsg loc " ::= infixr ... " + | SIGNATUREspec sigdescs => + (complianceMsg loc " ::= signature "; + app compliantSigBind sigdescs) +and compliantTopSpec spec = compliantSpec spec +and compliantModDesc (MODDESCmoddesc(modid,sigexp)) = + compliantSigExp sigexp +and compliantFunDesc (FUNDESCfundesc(funid,sigexp)) = + compliantSigExp sigexp +and compliantTyConPath (_,LONGtyconpath _) = () + | compliantTyConPath (loc,WHEREtyconpath (_,_,modexp)) = + (complianceMsg loc " ::= where = "; + compliantModExp modexp) +and compliantTypBind (tyvarseq,tycon,ty) = + compliantTy ty +and compliantExDesc (_,SOME ty) = + compliantTy ty + | compliantExDesc (_,NONE) = () +and compliantDatBind (tyvarseq, tycon, cbds) = + app compliantConBind cbds +and compliantConBind (ConBind (ii, NONE)) = () + | compliantConBind (ConBind (ii, SOME ty)) = compliantTy ty +and compliantValDescList (vds) = + (app (fn (ii,ty) => compliantTy ty) vds) +; + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Tr_const.sml mosml-2.10.1/src/compiler.cminusminus/Tr_const.sml --- mosml-2.01/src/compiler.cminusminus/Tr_const.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Tr_const.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,26 @@ +local + open Obj Const Symtable; +in + +(* To translate a structured constant into an object. *) + +fun translStructuredConst (ATOMsc(INTscon i)) = repr i + | translStructuredConst (ATOMsc(WORDscon w)) = repr w + | translStructuredConst (ATOMsc(CHARscon c)) = repr c + | translStructuredConst (ATOMsc(REALscon f)) = repr f + | translStructuredConst (ATOMsc(STRINGscon s)) = repr s + | translStructuredConst (BLOCKsc(tag, comps)) = + let val res = obj_block (intOfTag tag) (List.length comps) in + fillStructuredConst 0 res comps; + res + end + | translStructuredConst (QUOTEsc (ref v)) = v + +and fillStructuredConst n obj = fn + [] => () + | cst::rest => + (set_obj_field obj n (translStructuredConst cst); + fillStructuredConst (n+1) obj rest) +; + +end; diff -Nru mosml-2.01/src/compiler.cminusminus/Tr_env.sig mosml-2.10.1/src/compiler.cminusminus/Tr_env.sig --- mosml-2.01/src/compiler.cminusminus/Tr_env.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Tr_env.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,34 @@ +local + open Mixture Const Lambda Asynt; +in + + +type RenEnv = (string * int) list; + +val lookupRenEnv : (string -> Const.Id) -> QualifiedIdent -> (QualifiedIdent * int); +val updateCurrentRenEnv: RenEnv -> unit; + +val renameId : string -> string * int; + +datatype AccessPath = + Path_rec of int + | Path_local of int + | Path_global of (QualifiedIdent * int) + | Path_son of int * AccessPath + | Path_virtual_son of int * AccessPath +; + +type TranslEnv = (Const.Id, AccessPath) Env * int; +val translateLocalAccess : (string -> Const.Id) -> TranslEnv -> string -> Lambda; +val translateAccess : (string -> Const.Id) -> TranslEnv -> QualifiedIdent -> Lambda; +val translateLongAccess : (string -> Const.Id) -> TranslEnv -> IdInfo -> Lambda; + +val translateExName : TranslEnv -> IdInfo -> Lambda; +val mkEnvOfRecPats : int -> Pat list -> TranslEnv; +val mkEnvOfPats : int -> Pat list -> TranslEnv * (Lambda -> Lambda); + +end; + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Tr_env.sml mosml-2.10.1/src/compiler.cminusminus/Tr_env.sml --- mosml-2.01/src/compiler.cminusminus/Tr_env.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Tr_env.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,233 @@ +(* tr_env.ml: handling of the translation environment. *) + +open List Fnlib Mixture Const Prim Lambda Globals Units Types Asynt Asyntfn; + +type RenEnv = (string * int) list; + +datatype AccessPath = + Path_rec of int + | Path_local of int + | Path_global of (QualifiedIdent * int) + | Path_son of int * AccessPath + | Path_virtual_son of int * AccessPath +; + +type TranslEnv = (Const.Id, AccessPath) Env * int; + + +fun lookupRenEnv asId q = + let val {qual, id = lid} = q + val id = (longIdentAsIdent lid "lookupRenEnv") + val mangled_id = mangle (asId id) + in (* cvr: TODO treat lond ids *) + if qual = "" then fatalError ("lookupRenEnv: empty qualifier for "^id) + else (); + if qual = currentUnitName() then + (mkUniqueGlobalName (mangled_id, Hasht.find (!currentRenEnv) (mangled_id)) + handle Subscript => fatalError + ("lookupRenEnv: unknown variable: " ^ showQualId q)) + else + ({qual=qual,id = [mangled_id]}, 0) + end +; + +fun updateCurrentRenEnv RE = + app (fn (x,y) => Hasht.insert (!currentRenEnv) x y) + (rev RE) +; + +fun renameId id = (id, newValStamp()); + +(* Generating lambda expressions from access pahts *) +local (* cvr: TODO copied from Front.sml ---- code should be shared *) + fun mkDynexn exnname = + Lprim(Pmakeblock (CONtag(0,1)), + [exnname, Lconst constUnit]) + val bindExn = + mkDynexn (Lprim(Pget_global ({qual="General", id=["exn_bind"]}, 0), [])); + val bindRaiser = Lprim(Praise, [bindExn]) +in +fun translatePath depth = fn + Path_rec i => + Llet([Lprim(Pfield 0,[Lvar (depth-(i+1))])], + Lswitch(2,Lvar 0, + [(CONtag(0,2),bindRaiser), + (CONtag(1,2),Lprim(Pfield 0,[Lvar 0]))])) + | Path_local i => Lvar (depth-(i+1)) + | Path_global uid => Lprim(Pget_global uid, []) + | Path_virtual_son(arity, p) => + translatePath depth p + | Path_son(n, p) + => Lprim(Pfield n, [translatePath depth p]) +end + +fun translateTopOfPath depth = fn + Path_virtual_son(arity, Path_local i) => + let val lvar = Lvar (depth-(i+1)) in + Lprim(Pmakeblock(CONtag(0,1)), + tabulate(arity, (fn n => Lprim(Pfield n, [lvar])))) + end + | Path_virtual_son(arity, p) => + Llet([translatePath depth p], + Lprim(Pmakeblock(CONtag(0,1)), + tabulate(arity, (fn n => Lprim(Pfield n, [Lvar 0]))))) + | p => translatePath depth p +; + +fun translateLocalAccess asId (rho, depth) id = + translateTopOfPath depth (lookupEnv rho (asId id)) + handle Subscript => + fatalError ("translateLocalAccess"^id) +; + +fun lookupInLocalEnv asId env q = + let val {qual,id} = q in (* cvr: TODO handle long ids *) + if qual = "" orelse qual = currentUnitName() then + lookupEnv env (asId (longIdentAsIdent id "lookupInLocalEnv")) + else + raise Subscript + end +; + +fun translateAccess asId (rho, depth) q = + translateTopOfPath depth (lookupInLocalEnv asId rho q) + handle Subscript => + Lprim(Pget_global (lookupRenEnv asId q), []) +; + +(* cvr: added *) + +fun translateLongAccess asId env (ii:IdInfo) = + let val {info={idKind,idFields,...}, ...} = ii + val {qualid, ...} = !idKind + in + case qualid of + {qual,id=[]} => Lstruct [] + | {qual,id=[_]} => translateAccess asId env qualid + | {qual,id} => + let fun trLongAccess [id] _ = + translateAccess ModId env {qual = qual,id = [id]} + | trLongAccess (id::ids) (field::fields) = + Lprim(Pfield field, [trLongAccess ids fields]) + | trLongAccess _ _ = fatalError "trLongAccess" + in trLongAccess id (!idFields) + end + end; + + +fun translateExName env (ii : IdInfo) = + let val {qualid, info} = ii in + case #info(!(#idKind info)) of + EXCONik _ => + translateLongAccess ValId env ii + | _ => fatalError "translateExName" + end; + +fun pair x y = (x, y); + +fun pathsOfPatAcc path ((loc, pat') : Pat) acc = + case pat' of + SCONpat _ => acc + | VARpat ii => + bindInEnv acc (ValId (hd(#id(#qualid ii)))) path + | WILDCARDpat => acc + | NILpat _ => acc + | CONSpat(ii, p) => + let val ci = getConInfo ii in + if #conSpan(!ci) = 1 then + pathsOfPatAcc path p acc + else if #conIsGreedy(!ci) then + (if #conTag(!ci) = 0 then + pathsOfPatAcc path p acc + else + pathsOfPatAcc (Path_virtual_son(#conArity(!ci), path)) p acc) + else + pathsOfPatAcc (Path_son(0, path)) p acc + end + | EXNILpat _ => acc + | EXCONSpat(ii, p) => pathsOfPatAcc (Path_son(1, path)) p acc + | EXNAMEpat _ => fatalError "pathsOfPatAcc" + | REFpat p => pathsOfPatAcc (Path_son(0, path)) p acc + | RECpat(ref (TUPLErp ps)) => + foldR (fn(i,p) => fn acc => pathsOfPatAcc (Path_son(i,path)) p acc) + acc (mapFrom pair 0 ps) + | RECpat(ref (RECrp _)) => + fatalError "pathsOfPatAcc: unresolved record pattern" + | VECpat ps => + foldR (fn(i,p) => fn acc => pathsOfPatAcc (Path_son(i,path)) p acc) + acc (mapFrom pair 0 ps) + | INFIXpat _ => fatalError "pathsOfPatAcc" + | PARpat p => pathsOfPatAcc path p acc + | TYPEDpat(p, _) => pathsOfPatAcc path p acc + | LAYEREDpat(p1, p2) => + pathsOfPatAcc path p1 (pathsOfPatAcc path p2 acc) +; + +fun pathsOfPat path pat = pathsOfPatAcc path pat NILenv; + +fun mutableVarsOfPatAcc ((loc, pat') : Pat) acc = + case pat' of + SCONpat _ => acc + | VARpat _ => acc + | WILDCARDpat => acc + | NILpat _ => acc + | CONSpat(_, p) => + mutableVarsOfPatAcc p acc + | EXNILpat _ => acc + | EXCONSpat(ii, p) => + mutableVarsOfPatAcc p acc + | EXNAMEpat _ => fatalError "mutableVarsOfPatAcc" + | REFpat p => + domPatAcc p acc + | RECpat(ref (TUPLErp ps)) => + foldR mutableVarsOfPatAcc acc ps + | RECpat(ref (RECrp _)) => + fatalError "mutableVarsOfPatAcc: unresolved record pattern" + | VECpat ps => + foldR mutableVarsOfPatAcc acc ps + | INFIXpat _ => fatalError "mutableVarsOfPatAcc" + | PARpat p => + mutableVarsOfPatAcc p acc + | TYPEDpat(p, _) => + mutableVarsOfPatAcc p acc + | LAYEREDpat(p1, p2) => + mutableVarsOfPatAcc p1 (mutableVarsOfPatAcc p2 acc) +; + +(* Since the program is supposed to be well-typed, *) +(* the patterns in a `val rec' can't contain mutable variables. *) +(* Thus there's no danger in accessing variable values via *) +(* their access paths... *) + +fun mkEnvOfRecPats depth pats = + foldL (fn pat => fn (rho, depth) => + (pathsOfPatAcc (Path_local depth) pat rho, depth+1)) + (NILenv, depth) pats +; + +(* If a `val' declaration isn't recursive, the mutable variables *) +(* appearing in its patterns must be taken special care of... *) + +fun mutableVarsOfPat pat = mutableVarsOfPatAcc pat []; + +fun addLetsToEnv varlist (env as (rho, depth)) = + case varlist of + [] => env + | var::rest => + addLetsToEnv rest (bindInEnv rho (ValId var) (Path_local depth), depth+1) +; + +fun addLetsToExp varlist (rho, depth) exp = + case varlist of + [] => exp + | _ => + Llet(mapFrom (fn i => fn var => translateLocalAccess ValId (rho, i) var) + depth varlist, + exp) +; + +fun mkEnvOfPats depth pats = + let val env' = mkEnvOfRecPats depth pats + val mut_vars = foldR mutableVarsOfPatAcc [] pats + in (addLetsToEnv mut_vars env', addLetsToExp mut_vars env') end +; diff -Nru mosml-2.01/src/compiler.cminusminus/Types.sig mosml-2.10.1/src/compiler.cminusminus/Types.sig --- mosml-2.01/src/compiler.cminusminus/Types.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Types.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,239 @@ +local + open Fnlib Mixture Const Smlprim Globals Location Units; +in + +(* cvr: operations on structures *) +val SofRecStr : RecStr -> Str; +val MEofStr : Str -> ModEnv; +val FEofStr : Str -> FunEnv; +val GEofStr : Str -> SigEnv; +val VEofStr : Str -> VarEnv; +val TEofStr : Str -> TyEnv; + +val removeGEofStr : Str -> Str; +val removeGEofRecStr : RecStr -> RecStr; + +val VEofCE : ConEnv -> VarEnv; + +datatype ScopeViolation = + TYNAMEsv of TyName + | TYPEVARsv of TypeVar; + +type matchReason; + +datatype reason = + UnifyCircular | UnifyEquality | UnifyExplicit + | UnifyTup | UnifyRec of Lab | UnifyOther + | UnifyMod of matchReason option * matchReason option + | UnifyScope of TypeVar * ScopeViolation +; + +exception MatchError of matchReason; + +exception Unify of reason; + +val tyname_unit : TyName; +val tyname_bool : TyName; +val tyname_int : TyName; +val tyname_word : TyName; +val tyname_word8 : TyName; +val tyname_char : TyName; +val tyname_real : TyName; +val tyname_string : TyName; +val tyname_substring: TyName; +val tyname_syserror : TyName; +val tyname_list : TyName; +val tyname_vector : TyName; +val tyname_ref : TyName; +val tyname_exn : TyName; +val tyname_option : TyName; +val tyname_order : TyName; +val tyname_frag : TyName; +val tyname_ppstream : TyName; + +val mkConInfo : unit -> ConInfo; +val mkExConInfo : unit -> ExConInfo; +val mkPrimInfo : int -> SMLPrim -> PrimInfo; + +val normType: Type -> Type; +val normTyApp: TyApp -> TyFun; +val normTyFun: TyFun -> TyFun; + +val normRecStr : RecStr -> RecStr; +val normStr : Str -> Str; +val normMod : Mod -> Mod; +val normExMod : ExMod -> ExMod; + +val savePrState : unit -> (unit -> unit); +val under_binder : ('a -> 'b) -> 'a -> 'b; + +val checkpoint_free_typevar_names: unit -> unit; +val rollback_free_typevar_names: unit -> unit; +val commit_free_typevar_names: unit -> unit; +val prTypeVar: TypeVar -> unit; +val prTyName : bool -> TyName -> unit; +val prTyNameSet : TyNameSet -> string -> unit; +val prTyApp : int -> TyApp -> unit; +val prType : Type -> unit; +val prTypeScheme : TypeScheme -> unit +val prMod : Mod -> unit; +val prSig : Sig -> unit; +val prModInfo : string -> RecStr global -> unit; +val prFunInfo : string -> GenFun global -> unit; +val prSigInfo : string -> Sig global -> unit; +val prInfixStatus : string -> InfixStatus -> unit; +val prVarInfo : ((TypeScheme * ConStatusDesc) global -> unit) -> + string -> (TypeScheme * ConStatusDesc) global -> unit +val prTyInfo : string -> (TyFun * ConEnv) -> unit; +(* val prGenFun : GenFun -> unit; *) +val prTyFun : TyFun -> unit; + +val resetTypePrinter: unit -> unit; +val collectExplicitVars: Type -> unit; +val collectTopVars: ExEnvironment -> unit; +val printNextType: Type -> unit; +val printType: Type -> unit; +val printScheme: TypeScheme -> unit; +val collectSchemeExplicitVars: TypeScheme -> unit; +val printNextScheme: TypeScheme -> unit; + + + +val newExplicitTypeVar: string -> TypeVar; +val mkTypeVar : bool -> bool -> bool -> int -> TypeVar; +val newTypeVar : bool -> bool -> bool -> TypeVar; +val newTypeVars : int -> TypeVar list; +val newUnknown : unit -> Type; +val isExplicit : TypeVar -> bool; + +val TypeOfTypeVar : TypeVar -> Type; +val fresh3DotType : unit -> RowType; +val contentsOfRowType : RowType -> Type Row * bool; +val isTupleType : Type -> bool; + +val kindTyName : TyName -> Kind; +val kindTyApp : TyApp -> Kind; +val kindTyFun : TyFun -> Kind; + +val etaExpandTyApp : TyApp -> TyFun; +val freeVarsTyStr : + TyName list -> TypeVar list -> + (TyName list * TypeVar list * RowVar list) -> + TyStr -> + (TyName list * TypeVar list * RowVar list) +val unify: Type -> Type -> unit; +val unifyTyApp: TyApp -> TyApp -> unit; +val unifyTyFun: TyFun -> TyFun -> unit; +val equalsTyFunTyName: TyFun -> TyName -> bool; + +val generalization: bool -> Type -> TypeScheme; + +val specialization: TypeScheme -> Type; +val TypeOfScheme : TypeScheme -> Type; +val type_subst: (TypeVar * Type) list -> Type -> Type; +val freshSchemeOfType: Type -> TypeScheme; +val mkScheme: TypeVar list -> Type -> TypeScheme; +val trivial_scheme: Type -> TypeScheme; +val scheme_1u: (Type -> Type) -> TypeScheme; +val scheme_1u_eq: (Type -> Type) -> TypeScheme; +val scheme_1u_imp: (Type -> Type) -> TypeScheme; +val scheme_2u: (Type -> Type -> Type) -> TypeScheme; +val scheme_3u: (Type -> Type -> Type -> Type) -> TypeScheme; + +val resetBindingLevel: unit -> unit; +val incrBindingLevel: unit -> unit; +val decrBindingLevel: unit -> unit; +val currentBindingLevel: unit -> int; +val setCurrentBindingLevel: bool -> Type -> unit; + +val EqualityOfTyFun : TyFun -> TyNameEqu; + +val makeEquality : Type -> unit +val schemeViolatesEquality : TypeScheme -> bool; +val typeIsImperative : Type -> bool; + +val sc_bool : TypeScheme; +val sc_bogus : TypeScheme; +val initial_bool_CE : ConEnv; +val initial_list_CE : ConEnv; +val initial_option_CE : ConEnv; +val initial_order_CE : ConEnv; +val initial_frag_CE : ConEnv; + +val type_con : Type list -> TyName -> Type; +val type_arrow: Type -> Type -> Type; +val type_rigid_record : Type Row -> Type; +val type_flexible_record: Type Row -> RowType -> Type; +val type_ref: Type -> Type; +val type_pair: Type -> Type -> Type; +val type_product: Type list -> Type; + +val type_unit : Type; +val type_bool : Type; +val type_int : Type; +val type_word : Type; +val type_word8 : Type; +val type_char : Type; +val type_real : Type; +val type_string : Type; +val type_substring : Type; +val type_syserror : Type; +val type_list : Type -> Type; +val type_vector : Type -> Type; +val type_exn : Type; +val type_option : Type -> Type; +val type_order : Type; +val type_frag : Type -> Type; +val type_ppstream : Type; + +val unit_General : CSig; + +val checkClosedCSig : CSig -> unit; +val checkClosedExEnvironment : ExEnvironment -> unit; + +val copySig : (TyName * TyApp) list -> (TypeVar * Type) list -> Sig -> Sig; +val copyMod : (TyName * TyApp) list -> (TypeVar * Type) list -> Mod -> Mod; +val copyRecStr : (TyName * TyApp) list -> (TypeVar * Type) list -> RecStr -> RecStr; +val copyStr : (TyName * TyApp) list -> (TypeVar * Type) list -> Str -> Str; +val copyGenFun : (TyName * TyApp) list -> (TypeVar * Type) list -> GenFun -> GenFun; + +val parameteriseTyNameSet: TyNameSet -> TyNameSet -> (TyNameSet * (TyName * TyApp) list); + +val conEnvOfTyApp: TyApp -> ConEnv option; + + +(* destructively change the kind and update the binding level of type names +*) +val refreshTyName: TnSort -> TyName -> unit; +val refreshTyNameSet: TnSort -> TyNameSet -> unit; + +val realizeLongTyCon : QualifiedIdent -> TyStr -> TyStr -> unit; +val matchMod : Mod -> Mod -> unit; +val matchCSig : CSig -> CSig -> unit; +val errMatchReason : string -> string -> matchReason -> unit; +val checkCSig : CSig -> CSig -> unit; + +(* cvr: operations on normed structures and environments to return + runtime field and static info *) + +val sizeOfStr: Str -> int; + +val lookupMEofStr : Str -> string -> (int * (RecStr global)) +val lookupFEofStr : Str -> string -> (int * (GenFun global)) +val lookupVEofStr : Str -> string -> (int*(TypeScheme * ConStatusDesc) global); + +val lookupMEofEnv : Environment -> string -> (int * (RecStr global)) +val lookupFEofEnv : Environment -> string -> (int * (GenFun global)) +val lookupVEofEnv : Environment -> string -> (int* (TypeScheme * + ConStatusDesc) global); + +end; + + + + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Types.sml mosml-2.10.1/src/compiler.cminusminus/Types.sml --- mosml-2.01/src/compiler.cminusminus/Types.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Types.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,3742 @@ +open Misc List Fnlib Mixture + Config + Const Smlprim Globals Location Units; + +(* cvr: operations on semantic structures *) + +fun SofRecStr RS = + case RS of + RECrec(RS,RS') => SofRecStr RS' + | NONrec S => S +; + +fun MEofStr (STRstr (ME,_,_,_,_)) = ME + | MEofStr (SEQstr (Str1,Str2)) = plusEnv (MEofStr Str1) (MEofStr Str2) + +fun FEofStr (STRstr (_,FE,_,_,_)) = FE + | FEofStr (SEQstr (Str1,Str2)) = plusEnv (FEofStr Str1) (FEofStr Str2) + +fun GEofStr (STRstr (_,_,GE,_,_)) = GE + | GEofStr (SEQstr (Str1,Str2)) = plusEnv (GEofStr Str1) (GEofStr Str2) + +fun TEofStr (STRstr (_,_,_,TE,_)) = TE + | TEofStr (SEQstr (Str1,Str2)) = plusEnv (TEofStr Str1) (TEofStr Str2) + +fun VEofStr (STRstr (_,_,_,_,VE)) = VE + | VEofStr (SEQstr (Str1,Str2)) = plusEnv (VEofStr Str1) (VEofStr Str2) + +fun removeGEofStr S = + case S of + STRstr (ME,FE,NILenv,TE,VE) => S (* share if possible *) + | STRstr (ME,FE,GE,TE,VE) => STRstr (ME,FE,NILenv,TE,VE) + | SEQstr (S1,S2) => SEQstr (removeGEofStr S1,removeGEofStr S2) (* cvr: TODO improve sharing? *) +; + +fun removeGEofRecStr RS = + case RS of + RECrec(_,_) => RS + | NONrec S => NONrec (removeGEofStr S) +; + +fun VEofCE (ConEnv CE : ConEnv) = + foldL (fn cs => fn env => + let val {qualid, info} = cs + in bindInEnv env (hd(#id qualid)) + {qualid = qualid, + info = (#conType (!info),CONname info)} end) + NILenv + CE + | VEofCE _ = fatalError "VEofCE" +; + + +(* cvr: paths locate errors that occur during signature matching *) +datatype path = NILpath + | IDpath of string + | DOTpath of path * string + | DOMpath of path + | RNGpath of path + | UNITpath +; + +datatype ScopeViolation = + TYNAMEsv of TyName + | TYPEVARsv of TypeVar; +(* unification *) +datatype reason = + UnifyCircular | UnifyEquality | UnifyExplicit + | UnifyTup | UnifyRec of Lab | UnifyOther + | UnifyMod of matchReason option * matchReason option + | UnifyScope of TypeVar * ScopeViolation +and matchReason = + MissingValue of path * string * VarInfo +| MissingStructure of path * string * ModInfo +| MissingFunctor of path * string * FunInfo +| MissingSignature of path * string * SigInfo +| MissingType of path * string * TyInfo +| MissingInfixStatus of path * string * InfixStatus +| InfixStatusMismatch of path * string * InfixStatus * InfixStatus +| SignatureMismatch of path * string * SigInfo * SigInfo * matchReason option * matchReason option +| SchemeMismatch of path * string * VarInfo * VarInfo +| StatusMismatch of path * string * VarInfo * VarInfo +| ConEnvMismatch of path * string * TyInfo * TyInfo +| ArityMismatch of path * string * TyInfo * TyInfo * int * int +| RefEqualityMismatch of path * string * TyInfo * TyInfo +| EqualityMismatch of path * string * TyInfo * TyInfo +| TransparentMismatch of path * string * TyInfo * TyInfo +| PatternMismatch of path * string * TyStr * TyStr * TyName * ScopeViolation +| CircularMismatch of path * string * TyStr * TyStr * TyName +| DatatypeMismatch of path * string * TyInfo * TyInfo +| ModuleMismatch of path * string * string + (* path * infDesc * specDesc *) +; + +exception Unify of reason; + +exception MatchError of matchReason; + +local + (* cvr: REVISE?*) + (* fun mktyname qual name info = + {qualid={qual=qual, id=[name]}, info=ref info} : TyName; *) + fun mktyname qual name info = + {qualid={qual="General", id=[name]}, info=ref info} : TyName; + fun mkSML name info = + mktyname "General" name info; + val mkSMLStamp = + let val next_stamp = ref 0 + in fn () => (incr (next_stamp); + ("General",!next_stamp)) + end +in +(* Some predefined type names *) +val tyname_unit = mkSML "unit" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 0, tnEqu=TRUEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +and tyname_bool = mkSML "bool" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 0, tnEqu=TRUEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +and tyname_char = mktyname "Char" "char" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 0, tnEqu=TRUEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +and tyname_exn = mkSML "exn" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 0, tnEqu=FALSEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +and tyname_frag = mkSML "frag" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 1, tnEqu=TRUEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +and tyname_int = mktyname "Int" "int" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 0, tnEqu=TRUEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +and tyname_list = mkSML "list" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 1, tnEqu=TRUEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +and tyname_option = mkSML "option" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 1, tnEqu=TRUEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +and tyname_order = mkSML "order" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 0, tnEqu=TRUEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +and tyname_ppstream = mkSML "ppstream" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 0, tnEqu=FALSEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +and tyname_real = mktyname "Real" "real" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 0, tnEqu=TRUEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +and tyname_ref = mkSML "ref" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 1, tnEqu=REFequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +and tyname_string = mktyname "String" "string" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 0, tnEqu=TRUEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +(* cvr: REVISE hardwiring Substring.substring and the other type names seems + a horrible hack - can't + we simplify this? *) +and tyname_substring = mktyname "Substring" "substring" + {tnStamp=("Substring",1), tnKind=ARITYkind 0, tnEqu=FALSEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +and tyname_syserror = mktyname "OS" "syserror" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 0, tnEqu=FALSEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +and tyname_vector = mkSML "vector" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 1, tnEqu=TRUEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +and tyname_word = mktyname "Word" "word" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 0, tnEqu=TRUEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +and tyname_word8 = mktyname "Word8" "word8" + {tnStamp=mkSMLStamp(), tnKind=ARITYkind 0, tnEqu=TRUEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE} +val tyname_bogus = + mkSML "bogus" {tnStamp=mkSMLStamp(), tnKind=ARITYkind 0, tnEqu=TRUEequ, tnSort=PARAMETERts, tnLevel=0, tnConEnv=ref NONE}; +end; + +val type_bogus = CONt([], NAMEtyapp tyname_bogus); +val sc_bogus = TypeScheme{ tscParameters=[], tscBody=type_bogus }; + + +fun mkConInfo () = + ref{ conArity=(~1), conSpan=(~1), + conIsGreedy=false, + conTag=(~1), conType=sc_bogus } +; + +fun mkExConInfo () = ref{ exconArity=(~1) }; + +fun mkPrimInfo arity prim = + { primArity=arity, primOp=prim } +; + +(* ps: fun isExConStatic (ei : ExConInfo) = + case #exconTag(!ei) of + SOME _ => true + | NONE => false +; +*) + +fun isNilRowType rho = + case !rho of + NILrow => true + | VARrow _ => false + | _ => fatalError "isNilRowType" +; + +fun normalizeRecType (r: RecType) = + case !(#rho(!r)) of + NILrow => () + | VARrow _ => () + | LINKrow rho' => + (setRtRho r rho'; normalizeRecType r) + | FIELDrow(lab, tau, rho') => + (setRtFields r (insertField (lab, tau) (#fields(!r))); + setRtRho r rho'; normalizeRecType r) +; + +(* Binding levels *) + +val binding_level = ref 0; + +fun resetBindingLevel() = binding_level := 0; +fun incrBindingLevel() = incr binding_level; +fun decrBindingLevel() = decr binding_level; +fun currentBindingLevel() = !binding_level; (* cvr: added *) + +fun setCurrentBindingLevel isOverloaded = fn + VARt var => + (setTvOvl var isOverloaded; + setTvLevel var (!binding_level)) + | _ => fatalError "setCurrentBindingLevel" +; + +fun newExplicitTypeVar syntaxTypeVar = + let val tv = ref + { + tvKind = Explicit syntaxTypeVar, + tvLevel = !binding_level, + tvImp = !value_polymorphism, + tvEqu = false, + tvOvl = false + } + in + (case explode syntaxTypeVar of + #"'" :: #"'" :: #"_" :: _ => + (setTvEqu tv true; setTvImp tv true) + | #"'" :: #"'" :: _ => + setTvEqu tv true + | #"'" :: #"_" :: _ => + setTvImp tv true + | _ => ()); + tv + end; + +fun mkTypeVar equ imp ovl level = ref +{ + tvKind = NoLink, + tvEqu = equ, + tvImp = !value_polymorphism orelse imp, + tvOvl = ovl, + tvLevel = level +}; + +fun newTypeVar equ imp ovl = + mkTypeVar equ imp ovl (!binding_level) +; + +fun newTypeVars 0 = [] + | newTypeVars n = newTypeVar false false false :: newTypeVars (n-1) +; + +fun refreshTypeVar (tv : TypeVar) = + let val {tvEqu, tvImp, tvOvl, ...} = !tv + in newTypeVar tvEqu tvImp tvOvl end +; + + +fun isExplicit (tv : TypeVar) = + let val {tvKind, ...} = !tv in + case tvKind of + Explicit _ => true + | _ => false + end; + +fun newUnknown() = + VARt (newTypeVar false false false) +; + +(* cvr: added *) + +(* type parameters *) +fun mkTypeParameter name equ imp ovl level = ref +{ + tvKind = Explicit name, + tvEqu = equ, + tvImp = !value_polymorphism orelse imp, + tvOvl = ovl, + tvLevel = level +}; + +fun newTypeParameter equ imp ovl = + mkTypeParameter "" equ imp ovl (!binding_level) +; + +fun newTypeParameters [] = [] + | newTypeParameters (h::t) = + ((VARt (newTypeParameter false (* cvr: should this be true? *) false false) + :: + newTypeParameters t)) +; + +fun refreshTypeParameter (tv : TypeVar) = + let val {tvKind, tvEqu, tvImp, tvOvl, ...} = !tv + val tvName = case tvKind of Explicit name => name | _ => "" + in mkTypeParameter tvName tvEqu tvImp tvOvl (!binding_level) end +; + +(* *) + +fun TypeOfTypeVar tv = VARt tv; + +fun freshNilRowType() = ref NILrow; + +fun mkVarRowType equ imp level = + ref (VARrow (ref {rvEqu=equ, rvImp=imp, rvLevel=level})) +; + + +fun kindTyName (tn:TyName) = #tnKind (!(#info tn)); + +fun kindTyApp tyapp = + case tyapp of + NAMEtyapp tn => kindTyName tn + | APPtyapp (tyapp,app) => + (case kindTyApp tyapp of + ARROWkind(k,k') => k' + | _ => fatalError "kindTyApp") +and kindTyFun tyfun = + case tyfun of + APPtyfun tyapp => kindTyApp tyapp + | LAMtyfun (tn,tyfun) => + ARROWkind(kindTyName tn,kindTyFun tyfun) + | TYPEtyfun (vs,tau) => ARITYkind (List.length vs) +; + +fun equTyName (tn:TyName) = #tnEqu (!(#info tn)); + +fun etaExpandTyApp tyapp = + case kindTyApp tyapp of + ARITYkind n => + let val _ = incrBindingLevel(); + val vs = foldInt + (fn n => fn vs => + newTypeParameter false false false::vs) + [] + n + in decrBindingLevel(); + TYPEtyfun(vs,CONt(map TypeOfTypeVar vs,tyapp)) + end + | _ => fatalError "etaExpandTyApp"; +fun etaExpandTyFun tyfun = + case tyfun of + APPtyfun tyapp => etaExpandTyApp tyapp + | TYPEtyfun _ => tyfun + | LAMtyfun _ => fatalError "etaExpandTyFun"; + +(* cvr: new, optimized and highly dodgy copying *) + +local +fun restrictBns bns1 bns2 = + drop (fn (tn1,NAMEtyapp tn1') => + exists (fn (tn2,NAMEtyapp tn2') => + tn1 = tn2 andalso tn1' = tn2' + | _ => false) bns2 + | _ => false) bns1; +fun restrictBvs bvs1 bvs2 = + drop (fn (tv1,VARt tv1') => + exists (fn (tv2,VARt tv2') => + tv1 = tv2 andalso tv1' = tv2' + | _ => false) bvs2 + | _ => false) bvs1; +fun copyAndRealiseTyName (tn:TyName) tyfun = + case tn of + {qualid,info = ref { tnKind,tnEqu,tnStamp,tnSort = _, tnLevel,tnConEnv}} => + {qualid = qualid, + info = ref {tnKind = tnKind, + tnEqu = tnEqu, + tnSort = REAts tyfun, + tnStamp = newTyNameStamp(), + tnLevel = tnLevel, + tnConEnv = ref NONE}} +; + +fun copyEnv copyInfo bns bvs env = + case env of + NILenv => (bns,bvs,true,env) + | BNDenv(k, info, env') => + let val (bns,bvs,sinfo,cinfo) = copyInfo bns bvs info + val (bns,bvs,senv',cenv') = copyEnv copyInfo bns bvs env' + in + if sinfo andalso senv' + then (bns,bvs,true,env) + else (bns,bvs,false,BNDenv(k,cinfo,cenv')) + end + | COMPenv(env1, env2) => + let val (bns,bvs,senv1,cenv1) = copyEnv copyInfo bns bvs env1 + val (bns,bvs,senv2,cenv2) = copyEnv copyInfo bns bvs env2 + in + if senv1 andalso senv2 + then (bns,bvs,true,env) + else (bns,bvs,false,COMPenv(cenv1,cenv2)) + end + | TOPenv(t, env') => + let val ct = Hasht.new 17 + val (bns,bvs,st) = + Hasht.fold + (fn k => fn info => fn (bns,bvs,st) => + let val (bns,bvs,sinfo,cinfo) = copyInfo bns bvs info + in + if sinfo + then (Hasht.insert ct k cinfo; + (bns,bvs,st)) + else (Hasht.insert ct k cinfo; + (bns,bvs,false)) + end) + (bns,bvs,true) t + val ct = if st then t else ct + val (bns,bvs,senv',cenv') = copyEnv copyInfo bns bvs env' + in + if st andalso senv' + then (bns,bvs,true,env) + else (bns,bvs,false,TOPenv(ct,cenv')) + end +; + +fun copyGlobal copyInfo bns bvs (global as {qualid,info}) = + let val (bns,bvs,sinfo,cinfo) = copyInfo bns bvs info + in + if sinfo + then (bns,bvs,true,global) + else (bns,bvs,false,{qualid = qualid,info = cinfo}) + end +; + +fun copyTyNameSet tnSort bns bvs T = + let val bns' = + map (fn tn => + case tn of + {qualid,info = ref {tnKind,tnEqu,tnStamp,tnSort = _,tnLevel,tnConEnv}} => + let val tn' = {qualid = qualid, + info = ref {tnKind = tnKind, + tnEqu = tnEqu, + tnSort = tnSort, + tnStamp = newTyNameStamp(), + tnLevel= !binding_level, + tnConEnv = ref NONE}} + in (tn, NAMEtyapp tn') + end) + T + val bns'' = bns'@bns + fun copyConEnvs bns bvs [] = (bns,bvs,[]) + | copyConEnvs bns bvs ((tn,NAMEtyapp tn')::bns') = + (case !(#tnConEnv (!(#info tn))) of + NONE => + let + val (bns,bvs,T') = copyConEnvs bns bvs bns' + in + (bns,bvs,tn'::T') + end + | SOME conenv => + let val (bns,bvs,sconenv,cconenv) = + copyConEnv bns bvs conenv + val (bns,bvs,T') = copyConEnvs bns bvs bns' + in + if sconenv + then setTnConEnv (#info tn') (#tnConEnv(!(#info tn))) + else setTnConEnv (#info tn') (ref (SOME cconenv)); + (bns,bvs,tn'::T') + end) + | copyConEnvs _ _ _ = fatalError "copyConEnvs" + val (bns,bvs,T') = copyConEnvs bns'' bvs bns' + in + (restrictBns bns bns',bvs,T',bns') + end +and copyTyName tnSort bns bvs tn = + case copyTyNameSet tnSort bns bvs [tn] of + (bns,bvs,[tn'],[tn2tn']) => + (bns,bvs,tn',tn2tn') + | _ => fatalError "copyTyName" +and copyType bns bvs tau = + case tau of + VARt var => + (let val ctau = lookup var bvs + val stau = case ctau of + VARt var' => var = var' + | _ => false + in + (bns,bvs,stau,ctau) + end + handle Subscript => + (case #tvKind(!var) of + NoLink => (bns,bvs,true,tau) + | Explicit s => (bns,bvs,true,tau) + | LinkTo tau' => + let val (bns,bvs,shared,tau'') = + copyType bns bvs tau' + in + if shared then (bns,(var,tau)::bvs,true,tau) + else (bns,(var,tau'')::bvs,false,tau'') + end)) + | ARROWt(t,u) => + let val (bns,bvs,st,ct) = copyType bns bvs t + val (bns,bvs,su,cu) = copyType bns bvs u + in + if st andalso su + then (bns,bvs,true,tau) + else (bns,bvs,false,ARROWt(ct,cu)) + end + | CONt(ts, tyapp) => + let val (bns,bvs,sts,cts) = copyTypeList bns bvs ts + val (bns,bvs,styapp,ctyapp) = copyTyApp bns bvs tyapp + in + if sts andalso styapp + then (bns,bvs,true,tau) + else (bns,bvs,false,CONt(cts,ctyapp)) + end + | RECt (ref {fields, rho = rowtype}) => + let val (bns,bvs,sfields,cfields) = copyFields bns bvs fields + in + if sfields then (bns,bvs,true,tau) + else (bns,bvs,false,RECt (ref {fields = cfields,rho = rowtype})) + end + | PACKt X => + let val (bns,bvs,sX,cX) = copyExMod bns bvs X + in + if sX then (bns,bvs,true,tau) + else (bns,bvs,false,PACKt cX) + end +and copyTypeList bns bvs (ts as []) = (bns,bvs,true,ts) +| copyTypeList bns bvs (tts as (t::ts)) = + let val (bns,bvs,st,ct)= copyType bns bvs t + val (bns,bvs,sts,cts) = copyTypeList bns bvs ts + in + if st andalso sts + then (bns,bvs,true,tts) + else (bns,bvs,false,ct::cts) + end +and copyFields bns bvs (fields as []) = (bns,bvs,true,fields) +| copyFields bns bvs (fields as ((field as (lab,t))::fields')) = + let val (bns,bvs,st,ct)= copyType bns bvs t + val (bns,bvs,sfields',cfields') = copyFields bns bvs fields' + in + if st andalso sfields' + then (bns,bvs,true,fields) + else (bns,bvs,false,(lab,ct)::cfields') + + end +and copyTypeScheme bns bvs (scheme as TypeScheme {tscParameters=vs,tscBody=ty}) = + let val _ = incrBindingLevel() + val vs' = map refreshTypeParameter vs + val bvs' = zip2 vs (map VARt vs') + val (bns,bvs,sty,cty) = copyType bns (bvs'@bvs) ty + val bvs = restrictBvs bvs bvs' + in + decrBindingLevel(); + if sty + then (bns,bvs,true,scheme) + else (bns,bvs,false,TypeScheme{tscParameters = vs',tscBody = cty}) + end +and copyTyApp bns bvs tyapp = + case tyapp of + NAMEtyapp tyname => + (let val ctyapp = lookup tyname bns + in + (bns,bvs,false,ctyapp) + end + handle Subscript => + (case #tnSort(!(#info(tyname))) of + VARIABLEts => (bns,bvs,true,tyapp) + | PARAMETERts => (bns,bvs,true,tyapp) + | REAts tyfun => + let + val (bns,bvs,styfun,ctyfun) = + copyTyFun bns bvs tyfun + in + if styfun then + let val ctyname = + copyAndRealiseTyName tyname tyfun + val ctyapp = NAMEtyapp ctyname + in ((tyname,ctyapp)::bns,bvs,false,ctyapp) + end + else + let val ctyname = + copyAndRealiseTyName tyname ctyfun + val ctyapp = NAMEtyapp ctyname + in ((tyname,ctyapp)::bns,bvs,false,ctyapp) + end + end)) + | APPtyapp (tyapp',tyfun) => + let val (bns,bvs,styapp',ctyapp') = copyTyApp bns bvs tyapp' + val (bns,bvs,styfun,ctyfun) = copyTyFun bns bvs tyfun + in + if styapp' andalso styfun + then (bns,bvs,true,tyapp) + else (bns,bvs,false,APPtyapp(ctyapp',ctyfun)) + end +and copyTyFun bns bvs tyfun = + case tyfun of + TYPEtyfun (vs,ty) => + let val _ = incrBindingLevel() + val vs' = map refreshTypeParameter vs + val bvs' = zip2 vs (map VARt vs') + val (bns,bvs,sty,cty) = copyType bns (bvs'@bvs) ty + val bvs = restrictBvs bvs bvs' + in + decrBindingLevel(); + if sty + then (bns,bvs,true,tyfun) + else (bns,bvs,false,TYPEtyfun(vs',cty)) + end + | LAMtyfun (tn,tyfun') => + let val () = incrBindingLevel (); + val (bns,bvs,tn',tn2tn') = copyTyName PARAMETERts bns bvs tn + val (bns,bvs,styfun',ctyfun') = + copyTyFun (tn2tn'::bns) bvs tyfun' + val bns = restrictBns bns [tn2tn'] + in + decrBindingLevel(); + if styfun' + then (bns,bvs,true,tyfun) + else (bns,bvs,false,LAMtyfun(tn',ctyfun')) + end + | APPtyfun tyapp => + let val (bns,bvs,styapp,ctyapp) = copyTyApp bns bvs tyapp + in + if styapp + then (bns,bvs,true,tyfun) + else (bns,bvs,false,APPtyfun ctyapp) + end +and copyConInfo bns bvs (coninfo as ref { conArity, conIsGreedy, conSpan, conTag, conType}) = + let val (bns,bvs,sconType,cconType) = copyTypeScheme bns bvs conType + in + if sconType + then (bns,bvs,true,coninfo) + else (bns, + bvs, + false, + ref {conArity = conArity, + conIsGreedy = conIsGreedy, + conSpan = conSpan, + conTag = conTag, + conType = cconType}) + end +and copyConStatusDesc bns bvs csd = + (case csd of + CONname coninfo => + let val (bns,bvs,sconinfo,cconinfo) = copyConInfo bns bvs coninfo + in + if sconinfo + then (bns,bvs,true,csd) + else (bns,bvs,false,CONname cconinfo) + end + | _ => (bns,bvs,true,csd)) +and copyVarEnv bns bvs env = + copyEnv (copyGlobal + (fn bns => fn bvs => + fn (info as (scheme,status)) => + let val (bns,bvs,sscheme,cscheme) = copyTypeScheme bns bvs scheme + val (bns,bvs,sstatus,cstatus) = copyConStatusDesc bns bvs status + in + if sscheme andalso sstatus + then (bns,bvs,true,info) + else (bns,bvs,false,(cscheme,cstatus)) + end)) + bns bvs env +and copyConBindList bns bvs (coninfos as []) = + (bns,bvs,true,coninfos) +| copyConBindList bns bvs (coninfos as (coninfo :: coninfos')) = + let val (bns,bvs,sconinfo,cconinfo)= copyGlobal copyConInfo bns bvs coninfo + val (bns,bvs,sconinfos',cconinfos') = copyConBindList bns bvs coninfos' + in + if sconinfo andalso sconinfos' + then (bns,bvs,true,coninfos) + else (bns,bvs,false,cconinfo::cconinfos') + end +and copyConEnv bns bvs conenv = + case conenv of + ConEnv CE => + let val (bns,bvs,sCE,cCE) = copyConBindList bns bvs CE + in + if sCE + then (bns,bvs,true,conenv) + else (bns,bvs,false,ConEnv cCE) + end + | LAMconenv(tn,conenv') => + let val () = incrBindingLevel (); + val (bns,bvs,tn',tn2tn') = copyTyName PARAMETERts bns bvs tn; + val (bns,bvs,sconenv',cconenv') = + copyConEnv (tn2tn'::bns) bvs conenv' + val bns = restrictBns bns [tn2tn'] + in + decrBindingLevel(); + if sconenv' + then (bns,bvs,true,conenv) + else (bns,bvs,false,LAMconenv(tn',cconenv')) + end +and copyTyEnv bns bvs TE = + copyEnv (fn bns => fn bvs => + fn (info as (tyfun,CE)) => + let val (bns,bvs,styfun,ctyfun) = copyTyFun bns bvs tyfun + val (bns,bvs,sCE,cCE) = copyConEnv bns bvs CE + in + if styfun andalso sCE + then (bns,bvs,true,info) + else (bns,bvs,false,(ctyfun,cCE)) + end) + bns bvs TE +and copyStr bns bvs S = + case S of + STRstr (ME,FE,GE,TE,VE) => + let val (bns,bvs,sME,cME) = copyModEnv bns bvs ME + val (bns,bvs,sFE,cFE) = copyFunEnv bns bvs FE + val (bns,bvs,sGE,cGE) = copySigEnv bns bvs GE + val (bns,bvs,sTE,cTE) = copyTyEnv bns bvs TE + val (bns,bvs,sVE,cVE) = copyVarEnv bns bvs VE + in + if sME andalso sFE andalso sGE andalso sTE andalso sVE + then (bns,bvs,true,S) + else (bns,bvs,false,STRstr (cME,cFE,cGE,cTE,cVE)) + end + | SEQstr (S1,S2) => + let val (bns,bvs,sS1,cS1) = copyStr bns bvs S1 + val (bns,bvs,sS2,cS2) = copyStr bns bvs S2 + in + if sS1 andalso sS2 + then (bns,bvs,true,S) + else (bns,bvs,false,SEQstr(cS1,cS2)) + end +and copyRecStr bns bvs RS = + case RS of + RECrec (RS1,RS2) => + let val (bns,bvs,sRS1,cRS1) = copyRecStr bns bvs RS1 + val (bns,bvs,sRS2,cRS2) = copyRecStr bns bvs RS2 + in + if sRS1 andalso sRS2 + then (bns,bvs,true,RS) + else (bns,bvs,false,RECrec(cRS1,cRS2)) + end + | NONrec S => + let val (bns,bvs,sS,cS) = copyStr bns bvs S + in + if sS + then (bns,bvs,true,RS) + else (bns,bvs,false,NONrec(cS)) + end +and copyMod bns bvs M = + case M of + STRmod RS => + let val (bns,bvs,sRS,cRS) = copyRecStr bns bvs RS + in + if sRS + then (bns,bvs,true,M) + else (bns,bvs,false,STRmod cRS) + end + | FUNmod F => + let val (bns,bvs,sF,cF) = copyFun bns bvs F + in + if sF + then (bns,bvs,true,M) + else (bns,bvs,false,FUNmod cF) + end +and copyModEnv bns bvs ME = + copyEnv (copyGlobal copyRecStr) bns bvs ME +and copyFunEnv bns bvs FE = + copyEnv (copyGlobal copyFun) bns bvs FE +and copySigEnv bns bvs GE = + copyEnv (copyGlobal copySig) bns bvs GE +and copyFun bns bvs (F as (T,M,X)) = + let val () = incrBindingLevel (); + val (bns,bvs,T',T2T') = copyTyNameSet PARAMETERts bns bvs T + val (bns,bvs,sM,cM) = copyMod ((T2T')@bns) bvs M + val (bns,bvs,sX,cX) = copyExMod bns bvs X + val bns = restrictBns bns T2T' + in + decrBindingLevel(); + if sM andalso sX + then (bns,bvs,true,F) + else (bns,bvs,false,(T',cM,cX)) + end +and copyExMod bns bvs (X as EXISTSexmod(T,M)) = + let val () = incrBindingLevel (); + val (bns,bvs,T',T2T') = copyTyNameSet PARAMETERts bns bvs T + val (bns,bvs,sM,cM) = copyMod ((T2T')@bns) bvs M + val bns = restrictBns bns T2T' + in + decrBindingLevel(); + if sM + then (bns,bvs,true,X) + else (bns,bvs,false,EXISTSexmod(T',cM)) + end +and copySig bns bvs (G as LAMBDAsig(T,M)) = + let val () = incrBindingLevel (); + val (bns,bvs,T',T2T') = copyTyNameSet PARAMETERts bns bvs T + val (bns,bvs,sM,cM) = copyMod ((T2T')@bns) bvs M + val bns = restrictBns bns T2T' + in + decrBindingLevel(); + if sM + then (bns,bvs,true,G) + else (bns,bvs,false,LAMBDAsig(T',cM)) + end; +in + val copyTyName = fn tnSort => fn bns => fn bvs => fn tn => + let val (_,_,tn',tn2tn') = copyTyName tnSort bns bvs tn + in + (tn',tn2tn') + end + val copyTyNameSet = fn tnSort => fn bns => fn bvs => fn T => + let val (_,_,T',T2T') = copyTyNameSet tnSort bns bvs T + in + (T',T2T') + end + val copyType = fn bns => fn bvs => fn t => + #4 (copyType bns bvs t) + val copyTyFun = fn bns => fn bvs => fn tyfun => + #4 (copyTyFun bns bvs tyfun) + val copyTyApp = fn bns => fn bvs => fn tyapp => + #4 (copyTyApp bns bvs tyapp) + val copyConEnv = fn bns => fn bvs => fn conenv => + #4 (copyConEnv bns bvs conenv) + val copyStr = fn bns => fn bvs => fn S => + #4 (copyStr bns bvs S) + val copyRecStr = fn bns => fn bvs => fn S => + #4 (copyRecStr bns bvs S) + val copyGenFun = fn bns => fn bvs => fn F => + #4 (copyFun bns bvs F) + val copyMod = fn bns => fn bvs => fn M => + #4 (copyMod bns bvs M) + val copyExMod = fn bns => fn bvs => fn X => + #4 (copyExMod bns bvs X) + val copySig = fn bns => fn bvs => fn G => + #4 (copySig bns bvs G) +end; + +(* free variables (type names, type vars and rho vars) *) +(* cvr: TODO freevars currently done in reverse order for envs --- change this as it affects + pretty printing*) +fun freeVarsType bns bvs (fnvs as (fns, fvs, frvs)) tau = + case normType tau of + VARt var => + if member var fvs orelse member var bvs + then fnvs + else (fns, var::fvs,frvs) + | ARROWt(t,t') => + (freeVarsType bns bvs (freeVarsType bns bvs fnvs t) t') + | CONt(ts, tyapp) => + freeVarsTyApp bns bvs (foldL (fn t => fn fnvs => freeVarsType bns bvs fnvs t) fnvs ts) tyapp + | RECt (ref{fields, rho = rowtype}) => + freeVarsRowType bns bvs + (foldL (fn (lab,ty) => fn fnvs => freeVarsType bns bvs fnvs ty) fnvs fields) + rowtype + | PACKt X => freeVarsExMod bns bvs fnvs X +and freeVarsRowType bns bvs (fnvs as (fns,fvs,frvs)) rowtype = + case !rowtype of + NILrow => fnvs + | VARrow rowvar => + if member rowvar frvs + then fnvs + else (fns,fvs,rowvar::frvs) + | FIELDrow (lab,ty,rowtype) => + freeVarsRowType bns bvs + (freeVarsType bns bvs fnvs ty) + rowtype + | LINKrow rowtype => fatalError "freeVarRowType" +and freeVarsTypeScheme bns bvs fnvs (TypeScheme {tscParameters,tscBody}) = + freeVarsType bns (tscParameters@bvs) fnvs tscBody +and freeVarsTyApp bns bvs (fnvs as (fns, fvs,frvs)) tyapp = + case tyapp of + NAMEtyapp tyname => +(* if member tyname fns orelse member tyname bns *) + if exists (isEqTN tyname) fns + orelse exists (isEqTN tyname) bns + then fnvs + else (tyname::fns,fvs,frvs) + | APPtyapp (tyapp,tyfun) => + freeVarsTyFun bns bvs (freeVarsTyApp bns bvs fnvs tyapp) tyfun +and freeVarsTyFun bns bvs fnvs tyfun = + case normTyFun tyfun of + TYPEtyfun (vs,ty) => freeVarsType bns (vs@bvs) fnvs ty + | LAMtyfun (v,tyfun) => freeVarsTyFun (v::bns) bvs fnvs tyfun + | APPtyfun tyapp => freeVarsTyApp bns bvs fnvs tyapp +and freeVarsVarInfo bns bvs fnvs {qualid=_,info = (sc,_)} = freeVarsTypeScheme bns bvs fnvs sc +and freeVarsVarEnv bns bvs fnvs VE = + foldEnv (fn _ => fn info => fn fnvs => freeVarsVarInfo bns bvs fnvs info) fnvs VE +and freeVarsTyEnv bns bvs fnvs VE = + foldEnv (fn _ => fn tystr => fn fnvs => freeVarsTyStr bns bvs fnvs tystr) fnvs VE +and freeVarsTyStr bns bvs fnvs (tyfun,conenv) = + freeVarsConEnv bns bvs (freeVarsTyFun bns bvs fnvs tyfun) conenv +and freeVarsConEnv bns bvs fnvs conenv = + case conenv of + ConEnv CE => + foldL (fn {info=ref {conType,...},...} => + fn fnvs => freeVarsTypeScheme bns bvs fnvs conType) + fnvs CE + | LAMconenv(tn,conenv) => + freeVarsConEnv (tn::bns) bvs fnvs conenv +and freeVarsStr bns bvs fnvs S = + case S of + STRstr (ME,FE,GE,TE,VE) => + freeVarsModEnv bns bvs (freeVarsFunEnv bns bvs (freeVarsSigEnv bns bvs (freeVarsTyEnv bns bvs (freeVarsVarEnv bns bvs fnvs VE) TE) GE) FE) ME + | SEQstr (S,S') => + (freeVarsStr bns bvs (freeVarsStr bns bvs fnvs S) S') +and freeVarsRecStr bns bvs fnvs RS = + case RS of + RECrec (RS,RS') => + (freeVarsRecStr bns bvs (freeVarsRecStr bns bvs fnvs RS) RS') + | NONrec S => + (freeVarsStr bns bvs fnvs S) +and freeVarsMod bns bvs fnvs M = + case M of + STRmod S => freeVarsRecStr bns bvs fnvs S + | FUNmod F => freeVarsGenFun bns bvs fnvs F +and freeVarsModInfo bns bvs fnvs {qualid=_,info = RS} = freeVarsRecStr bns bvs fnvs RS +and freeVarsModEnv bns bvs fnvs ME = + foldEnv (fn id => fn info => fn fnvs => freeVarsModInfo bns bvs fnvs info) fnvs ME +and freeVarsGenFun bns bvs fnvs (T,M,X) = + let val bns' = T @ bns in + (freeVarsExMod (bns') bvs (freeVarsMod bns' bvs fnvs M) X) + end +and freeVarsFunInfo bns bvs fnvs {qualid=_,info = F} = freeVarsGenFun bns bvs fnvs F +and freeVarsSigInfo bns bvs fnvs {qualid=_,info = G} = freeVarsSig bns bvs fnvs G +and freeVarsFunEnv bns bvs fnvs FE = + foldEnv (fn id => fn info => fn fnvs => freeVarsFunInfo bns bvs fnvs info) fnvs FE +and freeVarsExMod bns bvs fnvs (EXISTSexmod(T,M)) = freeVarsMod (T@bns) bvs fnvs M +and freeVarsSig bns bvs fnvs (LAMBDAsig(T,M)) = freeVarsMod (T@bns) bvs fnvs M +and freeVarsSigEnv bns bvs fnvs GE = + foldEnv (fn id => fn {qualid, info = G} => fn fnvs => freeVarsSig bns bvs fnvs G) fnvs GE +and freeVarsExEnv bns bvs fnvs (EXISTS(T,(ME,FE,GE,VE,TE))) = + freeVarsModEnv bns bvs (freeVarsFunEnv bns bvs (freeVarsSigEnv bns bvs (freeVarsTyEnv bns bvs (freeVarsVarEnv bns bvs fnvs VE) TE) GE) FE) ME + +and apptycon tys tyfun = + case tyfun of + (* TYPEtyfun([],tau) => tau *) + TYPEtyfun(tvs,tau) => copyType [] (zip2 tvs tys) tau + | APPtyfun tyapp => CONt (tys,tyapp) + | _ => fatalError "apptycon" +and apptyfun tyfun tyfun' = + case tyfun of + +(* LAMtyfun(tn,tyfun) => + let val () = incrBindingLevel (); + val (tn',tn2tn') = copyTyName (REAts tyfun') [] [] tn; + (* cvr: rewrite using proper substitution? *) + val tyfun'' = LAMtyfun(tn', copyTyFun [tn2tn'] [] tyfun) + in + decrBindingLevel(); + tyfun' + end +*) + LAMtyfun(tn,tyfun) => + let val () = incrBindingLevel (); + val (tn',tn2tn') = copyTyName (REAts tyfun') [] [] tn; + (* cvr: rewrite using proper substitution? *) + val tyfun'' = copyTyFun [tn2tn'] [] tyfun + in + decrBindingLevel(); + tyfun'' + end + | APPtyfun tyapp => APPtyfun(APPtyapp(tyapp,tyfun')) + | _ => fatalError "apptyfun" +and type_subst UE tau = copyType [] UE tau +(* + case normType tau of + VARt var => + (lookup var UE + handle Subscript => tau ) (* cvr: surely this is the correct behaviour? *) + (* fatalError "type_subst: Unknown variable") *) + | ARROWt(t,t') => + ARROWt(type_subst UE t, type_subst UE t') + | CONt(ts, tn) => + CONt(map (type_subst UE) ts, tn) (* cvr: TODO *) + | RECt (ref{fields, rho}) => + RECt (ref{fields=map_fields (type_subst UE) fields, rho=rho})*) +and normType tau = + case tau of + VARt var => + (case #tvKind(!var) of + LinkTo tau' => + let val tau'' = normType tau' in + setTvKind var (LinkTo tau''); + tau'' + end + | _ => tau) + | RECt r => + (normalizeRecType r; tau) + | CONt (tys,tyapp) => + (* apptycon tys (normTyApp tyapp) not good enough *) + (case normTyApp tyapp of + APPtyfun tyapp =>CONt(tys,tyapp) + | tyfun => normType (apptycon tys tyfun)) + | _ => tau +and normTyApp tyapp = + case tyapp of + NAMEtyapp tn => + (case #tnSort (!(#info tn)) of +(* cvr: TODO Review path compression invalidates the hack of forgetting realisations... because we identify shared type names by swinging pointers, +instead of copying. Which do we want? + REAts tyfun => + let val tyfun' = normTyFun tyfun in + setTnSort (#info tn) (REAts tyfun'); + tyfun' + end +*) + REAts tyfun => + normTyFun tyfun + | _ => APPtyfun tyapp + ) + | APPtyapp (tyapp,tyfun) => + (case normTyApp tyapp of + APPtyfun tyapp => APPtyfun (APPtyapp (tyapp,tyfun)) + | tyfun' => normTyFun (apptyfun tyfun' tyfun)) + (* (* normTyFun *) (apptyfun (normTyApp tyapp) tyfun) + (* cvr: TODO does the outer norm cause looping? *) *) +and normTyFun tyfun = + case tyfun of + LAMtyfun _ => tyfun + | APPtyfun tyapp => normTyApp tyapp + | TYPEtyfun _ => tyfun; + +(* cvr: normalizing a module type sorts the entries of its term components + so their field positions can be calculated correctly *) + +fun normStr S = + STRstr (sortEnv (mapEnv normModBind (MEofStr S)), + sortEnv (FEofStr S), + GEofStr S, + TEofStr S, + sortEnv (VEofStr S)) +and normRecStr RS = + case RS of + NONrec S => NONrec (normStr S) + | RECrec (RS,RS') => normRecStr RS' +and normMod M = + case M of + STRmod S => STRmod (normRecStr S) + | M => M +and normModBind id {qualid, info = RS} = + {qualid = qualid,info = normRecStr RS} +and normExMod (EXISTSexmod(T,M)) = EXISTSexmod(T,normMod M); + +(* cvr: parameterization of T over P *) +fun parameteriseTyNameSet T P = + let val (T',T2T') = + foldR (fn tn as {qualid,info = ref {tnKind,tnEqu,tnStamp,tnSort = _,tnLevel,tnConEnv}}:TyName => + fn (T',T2T') => + let val tnKind' = foldR (fn p => fn k' => ARROWkind (kindTyName p,k')) tnKind P + val tnEqu' = foldR (fn p => fn k' => ARROWequ (equTyName p,k')) tnEqu P + val tn' = {qualid = {qual = "", id = #id qualid}, + info = ref {tnKind = tnKind', + tnEqu = tnEqu', + tnSort = PARAMETERts, + tnStamp = newTyNameStamp(), + tnLevel= currentBindingLevel(), + tnConEnv = ref NONE}} + val tyapp = foldL (fn tn => fn tyapp => APPtyapp (tyapp,APPtyfun (NAMEtyapp tn))) (NAMEtyapp tn') P + in (tn'::T',(tn,tyapp)::T2T') + end) + ([],[]) T + val _ = app2 (fn tn => fn tn' => + case !(#tnConEnv (!(#info tn))) of + NONE => () + | SOME conenv => + let val (P',P2P') = + copyTyNameSet PARAMETERts [] [] P + val T2P2P'T'= + map (fn (tn,tyapp)=> + (tn,copyTyApp P2P' [] tyapp)) + T2T' + val conenv' = + copyConEnv (P2P'@T2P2P'T') [] conenv + in + (#tnConEnv (!(#info tn'))) := + SOME (foldR (fn p => fn conenv => LAMconenv(p,conenv)) + conenv' + P') + end) + T + T' + in + (T',T2T') + end +; + + +fun stripTyApp tyfuns tyapp = + case tyapp of + NAMEtyapp tn => (tn,tyfuns) + | APPtyapp (tyapp,tyfun) =>stripTyApp (tyfun::tyfuns) tyapp + +local + fun stripConEnv conenv = + case conenv of + ConEnv CE => ([],conenv) + | LAMconenv (tn,conenv) => + let val (tns,conenv) = stripConEnv conenv + in (tn::tns,conenv) + end +in + + fun conEnvOfTyApp tyapp = + let val (tn,tyfuns) = stripTyApp [] tyapp + in + case !(#tnConEnv (!(#info tn))) of + NONE => NONE + | conenvopt as (SOME (ConEnv _)) => conenvopt (* cvr: needn't copy *) + | SOME conenv => + let val conenv = copyConEnv [] [] conenv + val (tns,conenv) = stripConEnv conenv + in + app2 (fn tn => fn tyfun => + setTnSort (#info tn) (REAts tyfun)) + tns + tyfuns; + SOME conenv + end + end + +end +; + + +fun isTupleType tau = + case normType tau of + RECt rt => let val {fields, rho} = !rt + in isNilRowType rho andalso isTupleRow fields end + | _ => false; + + +(* Correct binding level will be set later, *) +(* during type-checking *) + +fun fresh3DotType() = mkVarRowType false false ~1; + +fun contentsOfRowTypeAcc acc rho = + case !rho of + NILrow => (acc, false) + | VARrow _ => (acc, true) + | LINKrow rho' => + contentsOfRowTypeAcc acc rho' + | FIELDrow(lab, tau, rho') => + contentsOfRowTypeAcc ((lab,tau)::acc) rho' +; + +fun contentsOfRowType rho = + contentsOfRowTypeAcc [] rho +; + +fun extractLab r r' (lab: Lab) (rho: RowType) = + case !rho of + NILrow => + if isTupleType (RECt r) andalso isTupleType (RECt r') then + raise Unify UnifyTup + else + raise Unify (UnifyRec lab) + | VARrow rv => + let val {rvEqu=equ, rvImp=imp, rvLevel=level, ...} = !rv + val rho' = mkVarRowType equ imp level + val tau' = VARt (mkTypeVar equ imp false level) + in + rho := (FIELDrow(lab, tau', rho')); + (tau', rho') + end + | LINKrow _ => fatalError "extractLab" + | FIELDrow _ => fatalError "extractLab" +; + +fun occur_check var fvs = + (* cvr: TODO it might be more efficient to proceed as above and only caculate free vars for PACKt *) + app (fn var' => + if var = var' then + raise Unify UnifyCircular + else ()) + fvs; + +exception ScopeViolation of ScopeViolation; + +fun prune_level max_level (fns,fvs,frvs) = + (app (fn (tn:TyName) => + if #tnLevel(!(#info tn)) > max_level then + raise ScopeViolation (TYNAMEsv tn) + else ()) fns; + app (fn (tv:TypeVar) => + if #tvLevel(!tv) > max_level then + (if isExplicit tv then + raise ScopeViolation (TYPEVARsv tv) + else + setTvLevel tv max_level) + else ()) fvs; + app (fn (rv:RowVar) => + if #rvLevel(!rv) > max_level then + setRvLevel rv max_level + else ()) frvs) +; + + +fun assumingEqualityTypeVars tvs f a = + let val tvRecords = + map (fn tv as (ref tvRecord) => (setTvEqu tv true;tvRecord)) tvs + val res = f a + in + map2 (fn tv => fn tvRecord => tv := tvRecord) tvs tvRecords; + res + end +; + +fun typeViolatesEquality tau = + case normType tau of + VARt tv => + if isExplicit tv + then not(#tvEqu(!tv)) + else false + | ARROWt _ => true + | CONt(ts, tyapp) => + (case EqualityOfTyApp tyapp of + FALSEequ => true + | TRUEequ => exists typeViolatesEquality ts + | REFequ => false + | _ => fatalError "typeViolatesEquality") + | RECt (ref{fields, ...}) => + exists_field typeViolatesEquality fields + | PACKt _ => true +and EqualityOfTyName tn = equTyName tn +and EqualityOfTyApp tyapp = + case tyapp of + NAMEtyapp tn => EqualityOfTyName tn + | APPtyapp (tyapp,tyfun) => + (case EqualityOfTyApp tyapp of + ARROWequ(equ,equ') => equ' + | _ => fatalError "EqualityOfTyApp") +and EqualityOfTyFun tyfun = + case normTyFun tyfun of + APPtyfun tyapp => EqualityOfTyApp tyapp + | TYPEtyfun(tvs, ty)=> + (case (tvs,normType ty) of + ([tv],CONt([VARt tv'],NAMEtyapp tn)) => + if tv = tv' andalso isEqTN tyname_ref tn + (* tyfun is an eta-expansion of ref *) + then REFequ + else + assumingEqualityTypeVars tvs + (fn ty => + if typeViolatesEquality ty + then FALSEequ + else TRUEequ) + ty + | (tvs,ty) => assumingEqualityTypeVars tvs + (fn ty => + if typeViolatesEquality ty + then FALSEequ + else TRUEequ) + ty) + | LAMtyfun (tn,tyfun) => + ARROWequ(EqualityOfTyName tn,EqualityOfTyFun tyfun) +; + + +fun makeEqualityRho (rho: RowType) = + case !rho of + VARrow rv => + setRvEqu rv true + | _ => () +; + +fun makeEquality t = (* cvr: TODO review for tyapp *) + case normType t of + VARt var => + if #tvEqu(!var) then () + else if isExplicit var then + raise Unify UnifyEquality + else + setTvEqu var true + | ARROWt(t1,t2) => + raise Unify UnifyEquality + | CONt(ts, tyapp) => + (case EqualityOfTyApp tyapp of + FALSEequ => raise Unify UnifyEquality + | TRUEequ => + (app makeEquality ts + (* cvr: TODO remove ;makeEqualityTyApp tyapp *) + ) + | REFequ => () + | _ => fatalError "makeEquality") + | RECt (ref {fields, rho}) => + (app_field makeEquality fields; + makeEqualityRho rho) + | PACKt _ => raise Unify UnifyEquality +; + + +fun makeImperativeRho rho = + case !rho of + VARrow rv => + setRvImp rv true + | _ => () +; + +fun makeImperative (fnvs as (fns,fvs,frvs)) = + (app (fn var => + if #tvImp(!var) then () + else if isExplicit var + then raise Unify UnifyExplicit + else + setTvImp var true + ) fvs; + app (fn rowvar => + setRvImp rowvar true + ) frvs); + +fun makeOverloaded t = + case normType t of + VARt var => + if #tvOvl(!var) then () + else if isExplicit var then + raise Unify UnifyExplicit + else + setTvOvl var true + | ARROWt _ => () + | CONt _ => () + | RECt _ => () + | PACKt _ => () +; + +fun updateAttributes (var : TypeVar) t fnvsOft = + let val {tvEqu, tvImp, tvOvl, ...} = !var in + if tvEqu then makeEquality t else (); + if tvImp andalso not (!value_polymorphism) then makeImperative fnvsOft else (); + if tvOvl then makeOverloaded t else () + end; + +fun unifyRho rho1 rho2 = + if rho1 = rho2 then () else + case (!rho1, !rho2) of + (NILrow, NILrow) => () + | (NILrow, VARrow _) => + rho2 := LINKrow rho1 + | (VARrow _, NILrow) => + rho1 := LINKrow rho2 + | (VARrow rv1, VARrow rv2) => + let val {rvEqu=rvEqu1, rvImp=rvImp1, rvLevel=rvLevel1, ...} = !rv1 + and {rvEqu=rvEqu2, rvImp=rvImp2, rvLevel=rvLevel2, ...} = !rv2 + in + if rvLevel2 > rvLevel1 then + setRvLevel rv2 rvLevel1 + else (); + setRvEqu rv2 (rvEqu1 orelse rvEqu2); + setRvImp rv2 (rvImp1 orelse rvImp2); + rho1 := LINKrow rho2 + end + | (_, _) => fatalError "unifyRow" +; + + + +fun makeTyNameParameter kind = + { qualid= {qual=[],id=""}, + info=ref { tnStamp=newTyNameStamp(), tnKind=kind, tnLevel = !binding_level, + tnEqu=TRUEequ, tnSort = PARAMETERts, tnConEnv = ref NONE }} + ; + +val matchExModRef = + let fun dummyMatchExMod (_:ExMod) (_:ExMod) : unit = fatalError "dummyMatchExMod" + in ref dummyMatchExMod + end; + + +fun unify (tau1: Type) (tau2: Type) = + let val tau1' = normType tau1 + and tau2' = normType tau2 + in + case (tau1', tau2') of + (VARt var1, VARt var2) => + (if var1 = var2 then () else + (case (#tvKind(!var1), #tvKind(!var2)) of + (Explicit _, Explicit _) => + raise Unify UnifyOther + | (Explicit _,_) => + linkVarToType var2 tau1' + | (_, Explicit _) => + linkVarToType var1 tau2' + | (_,_) => + if #tvLevel(!var1) <= #tvLevel(!var2) then + linkVarToType var1 tau2' + else + linkVarToType var2 tau1')) + | (VARt var, _) => + if isExplicit var then raise Unify UnifyOther + else linkVarToType var tau2' + | (_, VARt var) => + if isExplicit var then raise Unify UnifyOther + else linkVarToType var tau1' + | (ARROWt(a,b), ARROWt(a',b')) => + (unify a a'; unify b b') + | (CONt(ts, tyapp), CONt(ts', tyapp')) => + if not ((kindTyApp tyapp) = (kindTyApp tyapp')) then raise Unify UnifyOther + else (unifyTyApp tyapp tyapp';unifySeq ts ts') + | (RECt r, RECt r') => + if r = r' then () else + (unifyRec r r' : unit) + | (PACKt exmod, PACKt exmod') => + let val exmod = copyExMod [] [] exmod; + val exmod' = copyExMod [] [] exmod'; + in + (((!matchExModRef) exmod exmod') + handle MatchError reason => raise (Unify (UnifyMod(SOME reason,NONE))); + ((!matchExModRef) exmod' exmod) + handle MatchError reason => raise (Unify ((UnifyMod(NONE,SOME reason))))) + end + | (_, _) => + raise Unify UnifyOther + end +and unifyTyApp tyapp tyapp' = + if not ((kindTyApp tyapp) = (kindTyApp tyapp')) (* cvr: TODO remove this test *) + then fatalError "unifyTyApp" + else + case (tyapp,tyapp') of + (NAMEtyapp tn, NAMEtyapp tn') => + if isEqTN tn tn' then () else raise Unify UnifyOther + | (APPtyapp (tyapp,tyfun), APPtyapp(tyapp',tyfun')) => + (unifyTyApp tyapp tyapp'; + unifyTyFun (normTyFun tyfun) (normTyFun tyfun')) + | (_,_) => raise Unify UnifyOther +and unifyTyFun tyfun tyfun' = + case (tyfun,tyfun') of + (APPtyfun tyapp, APPtyfun tyapp') => + unifyTyApp tyapp tyapp' + | (LAMtyfun (tn,tyfun), LAMtyfun (tn',tyfun')) => + let val () = incrBindingLevel (); + val (tn'',tn2tn'') = copyTyName PARAMETERts [] [] tn; + in + unifyTyFun (copyTyFun [tn2tn''] [] tyfun) + (copyTyFun [(tn',NAMEtyapp tn'')] [] tyfun'); + decrBindingLevel() + end + | (LAMtyfun (tn,tyfun), APPtyfun tyapp) => + let val () = incrBindingLevel (); + val (tn',tn2tn') = copyTyName PARAMETERts [] [] tn; + in + unifyTyFun (copyTyFun [tn2tn'] [] tyfun) + (APPtyfun (APPtyapp (tyapp,APPtyfun (NAMEtyapp tn')))); + decrBindingLevel() + end + | (TYPEtyfun (vs,ty), TYPEtyfun (vs',ty')) => + let val () = incrBindingLevel (); + val tys = newTypeParameters vs; + val UE = zip2 vs tys; + val UE' = zip2 vs' tys; + in + unify (copyType [] UE ty) (copyType [] UE' ty'); + decrBindingLevel() + end + | (TYPEtyfun (vs,ty), APPtyfun tyapp) => + let val () = incrBindingLevel (); + val tys = newTypeParameters vs; + val UE = zip2 vs tys; + in + unify (copyType [] UE ty) (CONt(tys,tyapp)); + decrBindingLevel() + end + | (APPtyfun tyapp, TYPEtyfun (vs,ty)) => + let val () = incrBindingLevel (); + val tys = newTypeParameters vs; + val UE = zip2 vs tys; + in + unify (CONt(tys,tyapp)) (copyType [] UE ty); + decrBindingLevel() + end + | (_,_) => fatalError "unifyTyFun" +(* +and linkVarToType var tau = +( + occur_check var tau; + prune_level (#tvLevel(!var)) tau; + updateAttributes var tau; + setTvKind var (LinkTo tau) +) +*) +and linkVarToType var tau = + let val fnvs as (fns,fvs,frvs) = freeVarsType [] [] ([],[],[]) tau + in + occur_check var fvs; + (prune_level (#tvLevel(!var)) fnvs + handle ScopeViolation sv => raise (Unify (UnifyScope (var,sv)))); + updateAttributes var tau fnvs; + setTvKind var (LinkTo tau) + end + +and unifySeq (ts: Type list) (ts': Type list) = app2 unify ts ts' + +and unifyRec (r : RecType) (r' : RecType) = + let val {fields=fs, rho=rho} = !r + val {fields=fs', rho=rho'} = !r' + fun unifyRecAcc fs1 rho1 fs2 rho2 acc = + ((case (fs1, fs2) of + ([], []) => (unifyRho rho1 rho2; (rev acc, rho1)) + | ((lab1,t1)::fs1', []) => + let val (t2, rho2') = extractLab r r' lab1 rho2 in + unify t1 t2; + unifyRecAcc fs1' rho1 [] rho2' ((lab1,t1)::acc) + end + | ([], (lab2,t2)::fs2') => + let val (t1, rho1') = extractLab r r' lab2 rho1 in + unify t1 t2; + unifyRecAcc [] rho1' fs2' rho2 ((lab2,t2)::acc) + end + | ((lab1,t1)::fs1', (lab2,t2)::fs2') => + (if lt_lab lab1 lab2 then + let val (t2, rho2') = extractLab r r' lab1 rho2 in + unify t1 t2; + unifyRecAcc fs1' rho1 fs2 rho2' ((lab1,t1)::acc) + end + else if lt_lab lab2 lab1 then + let val (t1, rho1') = extractLab r r' lab2 rho1 in + unify t1 t2; + unifyRecAcc fs1 rho1' fs2' rho2 ((lab2,t2)::acc) + end + else (* lab1 = lab2 *) + (unify t1 t2; + unifyRecAcc fs1' rho1 fs2' rho2 ((lab1,t1)::acc)))) + : (Lab * Type) list * RowType) + val (fs'', rho'') = unifyRecAcc fs rho fs' rho' [] + in + setRtFields r fs''; setRtRho r rho''; + setRtFields r' fs''; setRtRho r' rho'' + end +; + +val equalsTyFunTyName = fn tyfun => fn tn => + if kindTyName tn = kindTyFun tyfun + then + (unifyTyFun (normTyFun tyfun) (APPtyfun(NAMEtyapp tn)); + true) + handle Unify _ => false + else false; + + + +fun generalization isExpansive tau = + let val (_,fvs,_)= freeVarsType [] [] ([],[],[]) tau + val parameters = + foldL (fn var => fn parameters => + let val {tvImp, tvOvl, tvLevel, ...} = !var in + if member var parameters then parameters + else if tvLevel <= !binding_level then + parameters + else if tvOvl then + (setTvLevel var (!binding_level); + parameters) + else if tvImp andalso isExpansive then + (setTvLevel var (!binding_level); + parameters) + else + var :: parameters + end) + [] + fvs + + in + TypeScheme {tscParameters = parameters, tscBody = tau} + end; + +(* cvr: TODO simplify by call to freeVars?*) +fun checkClosedType parameters tau = + case normType tau of + VARt var => + if member var (parameters) + then () + else raise Subscript + | ARROWt(t,t') => + (checkClosedType parameters t; checkClosedType parameters t') + | CONt(ts, tyapp) => + (app (checkClosedType parameters) ts; checkClosedTyApp parameters tyapp) + | RECt (ref{fields, ...}) => + app_field (checkClosedType parameters) fields + | PACKt X => checkClosedExMod parameters X +and checkClosedTypeScheme parameters (TypeScheme {tscParameters,tscBody}) = + checkClosedType (tscParameters@parameters) tscBody +and checkClosedTyApp parameters tyapp = + case (* normTyApp *) tyapp of + NAMEtyapp _ => () + | APPtyapp (tyapp,tyfun) => (checkClosedTyApp parameters tyapp; checkClosedTyFun parameters tyfun) +and checkClosedTyFun parameters tyfun = + case normTyFun tyfun of + TYPEtyfun (vs,ty) => checkClosedType (vs@parameters) ty + | LAMtyfun (v,tyfun) => checkClosedTyFun parameters tyfun + | APPtyfun tyapp => checkClosedTyApp parameters tyapp +and checkClosedVarEnv parameters VE = + traverseEnv (fn id => fn {qualid, info = (sc,_)} => checkClosedTypeScheme parameters sc) VE +and checkClosedTyEnv parameters VE = + traverseEnv (fn id => fn (tyfun,_) => checkClosedTyFun parameters tyfun) VE +and checkClosedStr parameters str = + case str of + STRstr (ME,FE,GE,TE,VE) => + (checkClosedModEnv parameters ME; + checkClosedFunEnv parameters FE; + checkClosedSigEnv parameters GE; + checkClosedTyEnv parameters TE; + checkClosedVarEnv parameters VE) + | SEQstr (str,str') => + (checkClosedStr parameters str;checkClosedStr parameters str') +and checkClosedRecStr parameters RS = + case RS of + RECrec (RS,RS') => + (checkClosedRecStr parameters RS;checkClosedRecStr parameters RS') + | NONrec S => (checkClosedStr parameters S) +and checkClosedMod parameters M = + case M of + STRmod RS => checkClosedRecStr parameters RS + | FUNmod (T,M,X) => (checkClosedMod parameters M;checkClosedExMod parameters X) +and checkClosedModEnv parameters ME = + traverseEnv (fn id => fn {qualid, info = RS} => checkClosedRecStr parameters RS) ME +and checkClosedGenFun parameters (T,M,X) = (checkClosedMod parameters M; checkClosedExMod parameters X) +and checkClosedFunEnv parameters FE = + traverseEnv (fn id => fn {qualid, info = F} => checkClosedGenFun parameters F) FE +and checkClosedExMod parameters (EXISTSexmod(T,M)) = (checkClosedMod parameters M) +and checkClosedSig parameters (LAMBDAsig(T,M)) = (checkClosedMod parameters M) +and checkClosedSigEnv parameters GE = + traverseEnv (fn id => fn {qualid, info = G} => checkClosedSig parameters G) GE; + + + + +local fun errorToplevelImperativeVar desc id = +( + msgIBlock 0; + if !value_polymorphism then + errPrompt ("Value polymorphism: Free type variable at top level in "^desc^" identifier "^id) + else + errPrompt ("Free imperative type variable at top level in "^desc^" identifier "^id); + msgEOL(); + msgEBlock(); + raise Toplevel +) +in +fun checkClosedCSig (csig:CSig) = + ( Hasht.apply (fn id => fn {qualid, info = (sc,_)} => + (checkClosedTypeScheme [] sc) + handle Subscript => errorToplevelImperativeVar "value" id) + (varEnvOfSig csig); + Hasht.apply (fn id => fn (tyfun,_) => + (checkClosedTyFun [] tyfun) + handle Subscript => errorToplevelImperativeVar "type" id) + (tyEnvOfSig csig); + Hasht.apply (fn id => fn {qualid, info = RS} => + (checkClosedRecStr [] RS) + handle Subscript => errorToplevelImperativeVar "structure" id) + (modEnvOfSig csig); + Hasht.apply (fn id => fn {qualid, info = F} => + (checkClosedGenFun [] F) + handle Subscript => errorToplevelImperativeVar "functor" id) + (funEnvOfSig csig); + Hasht.apply (fn id => fn {qualid, info = G} => + (checkClosedSig [] G) + handle Subscript => errorToplevelImperativeVar "signature" id) + (sigEnvOfSig csig)) +end; + + + + + + + + +fun mkScheme pars tau = + TypeScheme{ tscParameters=pars, tscBody=tau } +; + +fun trivial_scheme tau = TypeScheme{tscParameters = [], tscBody = tau}; + +fun scheme_1u_attr equ imp builder = + let val () = incrBindingLevel() + val v = VARt (newTypeVar equ imp false) + val tau = builder v + in + decrBindingLevel(); + generalization false tau + end; + +fun scheme_1u builder = scheme_1u_attr false false builder; +fun scheme_1u_eq builder = scheme_1u_attr true false builder; +fun scheme_1u_imp builder = scheme_1u_attr false true builder; + +fun scheme_2u builder = + let val () = incrBindingLevel() + val a1 = newUnknown() + val a2 = newUnknown() + val tau = builder a1 a2 + in + decrBindingLevel(); + generalization false tau + end; + +fun scheme_3u builder = + let val () = incrBindingLevel() + val a1 = newUnknown() + val a2 = newUnknown() + val a3 = newUnknown() + val tau = builder a1 a2 a3 + in + decrBindingLevel(); + generalization false tau + end; + +(* +fun specialization scheme = + let val TypeScheme{ tscParameters, tscBody } = scheme in + case tscParameters of + [] => tscBody + | _ => + let val newUnknowns = + map (fn var => (var, VARt(refreshTypeVar var))) tscParameters + fun copy tau = + case normType tau of + t as (VARt var) => + (lookup var newUnknowns + handle Subscript => t) + | ARROWt(t,t') => + ARROWt(copy t, copy t') + | CONt(ts, tn) => + CONt(map copy ts, tn) + | RECt (ref{fields, rho}) => + RECt (ref{fields=map_fields copy fields, rho=rho}) + in copy tscBody end + end; +*) + +fun specialization scheme = + let val TypeScheme{ tscParameters, tscBody } = scheme in + case tscParameters of + [] => tscBody + | _ => + let + val UE = + map (fn var => (var, VARt(refreshTypeVar var))) tscParameters; + in copyType [] UE tscBody end + end; + +fun TypeOfScheme (TypeScheme {tscBody, ...}) = tscBody; + +fun freshSchemeOfType tau = + let + val (_,parameters,_) = freeVarsType [] [] ([],[],[]) tau + val vs = map (fn _ => newTypeParameter false false false) parameters + val UE = Fnlib.map2 (fn var => fn var' => (var, VARt var')) + parameters vs + in + TypeScheme{tscParameters = vs, tscBody = copyType [] UE tau} + end; + +fun schemeViolatesEquality sch = + let val TypeScheme {tscBody, tscParameters} = sch in + case normType tscBody of + ARROWt(t,t') => + assumingEqualityTypeVars tscParameters typeViolatesEquality t + | _ => false + end; + +fun rhoIsImperative rho = + case !rho of + NILrow => true + | VARrow (ref{rvImp, ...}) => rvImp + | _ => fatalError "rhoIsImperative" +; + +fun typeIsImperative tau = + case normType tau of + VARt (ref{tvImp, ...}) => tvImp + | ARROWt(t,t') => + (typeIsImperative t andalso typeIsImperative t') + | CONt(ts, _) => + all typeIsImperative ts + | RECt (ref{fields, rho}) => + (all_fields typeIsImperative fields andalso rhoIsImperative rho) + | PACKt _ => false + +; + + +fun setRho_level (rho: RowType) = + case !rho of + VARrow rv => + setRvLevel rv (!binding_level) + | _ => fatalError "setRho_level" +; + +(* Some predefined types *) + +fun type_con ts tyname = CONt(ts, NAMEtyapp tyname) +and type_arrow t1 t2 = ARROWt(t1, t2) +and type_rigid_record fs = + RECt (ref{fields=sortRow fs, rho=freshNilRowType()}) +and type_flexible_record fs rho = +( + setRho_level rho; + RECt (ref{fields=sortRow fs, rho=rho}) +); + +fun type_pair t t' = type_rigid_record (mkPairRow t t'); +fun type_product ts = type_rigid_record (mkTupleRow ts); + +val type_bool = type_con [] tyname_bool; +val type_char = type_con [] tyname_char; +val type_exn = type_con [] tyname_exn; +fun type_frag t = type_con [t] tyname_frag; +val type_int = type_con [] tyname_int; +fun type_list t = type_con [t] tyname_list; +fun type_option t = type_con [t] tyname_option; +val type_order = type_con [] tyname_order; +val type_ppstream = type_con [] tyname_ppstream; +val type_real = type_con [] tyname_real; +fun type_ref t = type_con [t] tyname_ref; +val type_string = type_con [] tyname_string; +val type_substring = type_con [] tyname_substring; +val type_syserror = type_con [] tyname_syserror; +val type_word = type_con [] tyname_word; +val type_word8 = type_con [] tyname_word8; +val type_unit = type_product []; +fun type_vector t = type_con [t] tyname_vector; + +val sc_bool = trivial_scheme type_bool; +val sc_order = trivial_scheme type_order; + +local + fun mktyname qual name info = + {qualid={qual=qual, id=[name]}, info=ref info} : ConInfo global; + fun mkSML name info = + mktyname "General" name info; +in +val infoFalse = mkSML "false" + { conArity=0, conIsGreedy=false, conTag=0, conSpan=2, + conType=sc_bool } +and infoTrue = mkSML "true" + { conArity=0, conIsGreedy=false, conTag=1, conSpan=2, + conType=sc_bool } +and infoNil = mkSML "nil" + { conArity=0, conIsGreedy=false, conTag=0, conSpan=2, + conType= scheme_1u (fn a => type_list a) } +and infoCons = mkSML "::" + { conArity=2, conIsGreedy=true, conTag=1, conSpan=2, + conType= scheme_1u (fn a => + type_arrow (type_pair a (type_list a)) (type_list a)) } +and infoNONE = mkSML "NONE" + { conArity=0, conIsGreedy=false, conTag=0, conSpan=2, + conType= scheme_1u (fn a => type_option a) } +and infoSOME = mkSML "SOME" + { conArity=1, conIsGreedy=false, conTag=1, conSpan=2, + conType= scheme_1u (fn a => + type_arrow a (type_option a)) } +and infoEQUAL = mkSML "EQUAL" + { conArity=0, conIsGreedy=false, conTag=0, conSpan=3, + conType=sc_order } +and infoGREATER = mkSML "GREATER" + { conArity=0, conIsGreedy=false, conTag=1, conSpan=3, + conType=sc_order } +and infoLESS = mkSML "LESS" + { conArity=0, conIsGreedy=false, conTag=2, conSpan=3, + conType=sc_order } +and infoANTIQUOTE = mkSML "ANTIQUOTE" + { conArity=1, conIsGreedy=false, conTag=0, conSpan=2, + conType= scheme_1u (fn a => + type_arrow a (type_frag a)) } +and infoQUOTE = mkSML "QUOTE" + { conArity=1, conIsGreedy=false, conTag=1, conSpan=2, + conType= scheme_1u (fn a => + type_arrow type_string (type_frag a)) } +; +end; + +val initial_bool_CE = ConEnv [infoFalse, infoTrue]; +val initial_list_CE = ConEnv [infoNil, infoCons]; +val initial_option_CE = ConEnv [infoNONE, infoSOME]; +val initial_order_CE = ConEnv [infoEQUAL, infoGREATER, infoLESS]; +val initial_frag_CE = ConEnv [infoANTIQUOTE, infoQUOTE]; + +val unit_General = newSig "General" "General" STRmode; + +val () = setTnSort (#info tyname_unit) (REAts (TYPEtyfun([], type_unit))); +val () = (#tnConEnv (!(#info tyname_bool))) := SOME (initial_bool_CE); +val () = (#tnConEnv (!(#info tyname_list))) := SOME (initial_list_CE); +val () = (#tnConEnv (!(#info tyname_option))) := SOME (initial_option_CE); +val () = (#tnConEnv (!(#info tyname_order))) := SOME (initial_order_CE); +val () = (#tnConEnv (!(#info tyname_frag))) := SOME (initial_frag_CE); + +local fun lookupStr envOfStr (STRstr S) id = lookupEnv (envOfStr S) id + | lookupStr envOfStr (SEQstr (S,S')) id = + (lookupStr envOfStr S' id) + handle Subscript => lookupStr envOfStr S id +in +fun lookupStr_ModEnv S path id info = + (lookupStr #1 S id) + handle Subscript => + raise MatchError (MissingStructure (path, id, info)) +fun lookupStr_FunEnv S path id info = + (lookupStr #2 S id) + handle Subscript => + raise MatchError (MissingFunctor (path, id, info)) +fun lookupStr_SigEnv S path id info = + (lookupStr #3 S id) + handle Subscript => + raise MatchError (MissingSignature (path, id, info)) +fun lookupStr_TyEnv S path id info = + (lookupStr #4 S id) + handle Subscript => + raise MatchError (MissingType (path, id, info)) +fun lookupStr_VarEnv S path id info = + (lookupStr #5 S id) + handle Subscript => + raise MatchError (MissingValue (path, id, info)) +end; + + +(* cvr: since substitution now expands realisations automatically by normalisation we can simplify expandRea to: *) + +fun expandRea UE tau = + type_subst UE tau; + +fun newParTypeVar () = + mkTypeVar false false false 0 +; + +fun newHardTypeVar () = + let val tv = mkTypeVar false false false 0 in + setTvKind tv (Explicit ""); + tv + end; + +fun isTypeFcnEqu vs' tau' vs tau = + let val ts = map (fn _ => TypeOfTypeVar(newHardTypeVar())) vs + val UE = zip2 vs ts + val tau0 = expandRea UE tau + val UE' = zip2 vs' ts + val tau'0 = type_subst UE' tau' + in + (unify tau'0 tau0; true) + handle Unify _ => false + end +; + +fun matchDatatype path (id : string) (infTyStr as (_,ConEnv infCE : ConEnv)) + (specTyStr as (_,ConEnv specCE : ConEnv)) = + (*cvr: changed ^^^^^^^^^^^^, ^^^^^^ and ^^^^^^ *) + let val domCE = map (fn gci => hd(#id(#qualid gci))) ( infCE) + val domCE' = map (fn gci => hd(#id(#qualid gci))) ( specCE) + in + (* domCE' is non-empty, because `abstype' is not allowed *) + (* in signatures, and "primitive" types are represented *) + (* as NILts. *) + if domCE <> domCE' + then raise MatchError (ConEnvMismatch (path, id, infTyStr, specTyStr)) + else () + (* We don't have to compare the types of constructors here, *) + (* because they will be compared as values. Note that all *) + (* constructors are visible, for redefining values in signatures *) + (* is not allowed. *) + end + | matchDatatype _ _ _ _ = fatalError "matchDatatype" +; + +fun refreshHardTypeVar (var : TypeVar) = + let val {tvEqu, tvImp, ...} = !var + val tv = mkTypeVar tvEqu tvImp false (!binding_level) + in + setTvKind tv (Explicit ""); + tv + end; + +fun refreshFlexibleTypeVar (var : TypeVar) = (* cvr: TODO is it ok to ignore overloading? *) + let val {tvEqu, tvImp, ...} = !var + in + mkTypeVar tvEqu tvImp false (!binding_level) + end; + +(* cvr: refreshing type names to change their status *) +fun refreshTyName tnSort ({qualid,info}:TyName) = + let val { tnStamp=stamp, + tnKind=kind, + tnEqu=equ, + tnSort=sort, + tnLevel=_, + tnConEnv=tnConEnv} = !info in + info := {tnStamp=stamp, + tnKind=kind, (* change the status *) + tnEqu=equ, + tnSort=tnSort, + tnLevel= !binding_level, (* update the level *) + tnConEnv = tnConEnv} + end; + +fun refreshTyNameSet tnSort (T:TyNameSet) = + app (refreshTyName tnSort) T; + +(* cvr: matching type schemes *) + +fun matchTypeSchemes path id (infInfo as {info = (infSc,_),qualid = _}) + (specInfo as {info = (specSc,_),qualid = _}) = + let + val TypeScheme{tscParameters=vs, tscBody=tau} = specSc + val ts = map (fn v => TypeOfTypeVar(refreshHardTypeVar v)) vs + val UE = zip2 vs ts + val tau0 = expandRea UE tau + val TypeScheme{tscParameters=vs', tscBody=tau'} = infSc + val ts' = map (fn v => TypeOfTypeVar(refreshFlexibleTypeVar v)) vs' + val UE' = zip2 vs' ts' + val tau'0 = type_subst UE' tau' + in + unify tau'0 tau0 + handle Unify _ => + (let val ts = map TypeOfTypeVar vs + val UE = zip2 vs ts + val tau0 = expandRea UE tau + in + raise MatchError (SchemeMismatch (path, id,infInfo,specInfo)) + end) + end; + +exception NotAPattern; +fun patternOfTyFun (APPtyfun tyapp) = patternOfTyApp (tyapp,[]) + | patternOfTyFun tyfun = raise NotAPattern +and patternOfTyApp (NAMEtyapp (tn as {info = ref {tnSort = VARIABLEts,...},...}),tns) = (tn,tns) + | patternOfTyApp (APPtyapp (tyapp, + APPtyfun (NAMEtyapp (tn as {info = ref {tnSort = PARAMETERts,...},...}))),tns) = + patternOfTyApp (tyapp,tn::tns) + | patternOfTyApp _ = raise NotAPattern; + +fun realizeTyStr path id (infTyStr : TyFun * ConEnv) (specTyStr : TyFun * ConEnv) = +(*cvr: modified case (#1 infTyStr, #1 specTyStr) of *) + case (normTyFun (#1 infTyStr), normTyFun (#1 specTyStr)) of (* cvr: inserted call to normTyFun *) + (infTyFun, specTyFun) => + (let + in + (case (kindTyFun infTyFun, kindTyFun specTyFun) of + (ARITYkind infArity, ARITYkind specArity) => + if specArity <> infArity then + raise MatchError (ArityMismatch (path,id,infTyStr,specTyStr,infArity,specArity)) + else () + | (_,_) => fatalError "realizeTyStr:1" (* cvr: TODO *)); + (case EqualityOfTyFun specTyFun of + (* cvr: TODO revise - it should be sufficient + (and more efficient) to do this + check only once we've determined that specTyFun + is a pattern *) + REFequ => + if (EqualityOfTyFun infTyFun) <> REFequ then + raise MatchError (RefEqualityMismatch (path,id,infTyStr,specTyStr)) + else () + | TRUEequ => + if (EqualityOfTyFun infTyFun) = FALSEequ then + raise MatchError (EqualityMismatch (path,id,infTyStr,specTyStr)) + else () + | FALSEequ => + () + | _ => fatalError "realizeTyStr:2"); + ((case patternOfTyFun specTyFun of + (tn,tns) => + let val tnLevel = #tnLevel(!(#info tn)) + val (fns,fvs,frvs) = freeVarsTyFun tns [] ([],[],[]) infTyFun + val _ = (* occur check *) + app (fn tn' => + if tn = tn' + then raise MatchError (CircularMismatch(path, + id, + infTyStr, + specTyStr, + tn')) + else ()) + fns + val _ = (prune_level (tnLevel) (fns,fvs,frvs)) + handle ScopeViolation sv => + raise MatchError (PatternMismatch (path, + id, + infTyStr, + specTyStr, + tn, + sv)) + in + setTnSort (#info tn) (REAts (foldR (fn tn => fn tyfun => LAMtyfun(tn,tyfun)) (normTyFun infTyFun) tns)) + end) + handle NotAPattern => ()) + (* cvr: *) + end) + +fun checkRealization (* (inferredSig : CSig) (specSig : CSig)*) + path id (infTyStr : TyFun * ConEnv) (specTyStr : TyFun * ConEnv) = + case (normTyFun (#1 specTyStr),(#2 specTyStr)) of + (specTyFun, ConEnv []) => + let val infTyFun = normTyFun (#1 infTyStr) + in + unifyTyFun infTyFun specTyFun (* cvr: CHECK THIS *) + handle Unify _ => + raise MatchError (TransparentMismatch (path,id,infTyStr,specTyStr)) + end + | (specTyFun, specCE) => + case (normTyFun (#1 infTyStr),(#2 infTyStr)) of + (infTyfun, ConEnv []) => + raise MatchError (DatatypeMismatch (path,id,infTyStr,specTyStr)) + | (infTyfun, infCE) => + matchDatatype path id infTyStr specTyStr + +; + +fun matchIdStatus (* os *) path id + (infInfo as {info = (_,infStatus),qualid = infQualid}) + (specInfo as {info = (_,specStatus),qualid = specQualid}) = + let + val {qual=infQual, ...} = infQualid + val {qual=specQual,...} = specQualid + in + case specStatus of + VARname ovltype => + (case infStatus of + VARname ovltype' => + (if ovltype <> ovltype' then + raise MatchError (StatusMismatch (path,id,infInfo,specInfo)) + else ()) + | REFname => raise MatchError (StatusMismatch (path,id,infInfo,specInfo)) + | _ => ()) + | PRIMname pi => + (case infStatus of + PRIMname pi'=> + if pi <> pi' + then + raise MatchError (StatusMismatch (path,id,infInfo,specInfo)) + else () + | _ => + raise MatchError (StatusMismatch (path,id,infInfo,specInfo))) + | CONname ci => + (case infStatus of + CONname ci' => + if #conArity(!ci) <> #conArity(!ci') + orelse #conIsGreedy(!ci) <> #conIsGreedy(!ci') + orelse #conTag(!ci) <> #conTag(!ci') + orelse #conSpan(!ci) <> #conSpan(!ci') + then raise MatchError (StatusMismatch (path,id,infInfo,specInfo)) + else () + | _ => raise MatchError (StatusMismatch (path,id,infInfo,specInfo))) + | EXNname ei => + (case infStatus of + EXNname ei' => + (if #exconArity(!ei) <> #exconArity(!ei') + then raise MatchError (StatusMismatch (path,id,infInfo,specInfo)) + else ()) + | _ => raise MatchError (StatusMismatch (path,id,infInfo,specInfo))) + | REFname => + (case infStatus of + REFname => () + | _ => raise MatchError (StatusMismatch (path,id,infInfo,specInfo))) + end +and matchStr path S S' = + case S' of + STRstr (ME,FE,GE,TE,VE) => + (traverseEnv (fn id => fn specInfo => + realizeTyStr path id + (lookupStr_TyEnv S path id specInfo) specInfo) + TE; + traverseEnv (fn id => fn specInfo => + checkRealization path id + (lookupStr_TyEnv S path id specInfo) specInfo) + TE; + traverseEnv (fn id => fn specInfo => + let val infInfo = lookupStr_VarEnv S path id specInfo + in + (matchTypeSchemes path id infInfo specInfo; + matchIdStatus path id infInfo specInfo) + end) + VE; + traverseEnv (fn id => fn specInfo => + matchModBind path id + (lookupStr_ModEnv S path id specInfo) specInfo) + ME; + traverseEnv (fn id => fn specInfo => + matchFunBind path id + (lookupStr_FunEnv S path id specInfo) specInfo) + FE; + traverseEnv (fn id => fn specInfo => + matchSigBind path id + (lookupStr_SigEnv S path id specInfo) specInfo) + GE) + | SEQstr (S1',S2') => (matchStr path S S1'; matchStr path S S2') +and matchRecStr path RS (RECrec (RS1',RS2')) = + (matchRecStr path RS RS1'; matchRecStr path RS RS2') +| matchRecStr path (NONrec S) (NONrec S') = + (matchStr path S S') +| matchRecStr path (RECrec(RS1,RS2)) RS' = + (matchRecStr path RS2 RS') +and matchFun path (T,M,X) (T',M',X') = + (incrBindingLevel(); + refreshTyNameSet PARAMETERts T'; + refreshTyNameSet VARIABLEts T; + matchMod (DOMpath(path)) M' M; + matchExMod (RNGpath(path)) X X'; + decrBindingLevel()) +and matchModBind path id {qualid = _,info = RS} {qualid = _,info = RS'} = + matchRecStr (DOTpath(path,id)) RS RS' +and matchFunBind path id {qualid = _,info = F} {qualid = _,info = F'} = + matchFun (DOTpath(path,id)) F F' +and matchSigBind path id (infInfo as {qualid = _,info = G}) (specInfo as {qualid = _,info = G'}) = + ((matchSig (NILpath) G G') + handle MatchError reason => + raise MatchError (SignatureMismatch(path,id,infInfo,specInfo,SOME reason,NONE)); + (matchSig (NILpath) G' G) + handle MatchError reason => + raise MatchError (SignatureMismatch(path,id,infInfo,specInfo,NONE,SOME reason))) +and matchMod path M M' = + case (M,M') of + (STRmod RS,STRmod RS') => matchRecStr path RS RS' + | (FUNmod F, FUNmod F') => matchFun path F F' + | (_,STRmod _) => + raise MatchError (ModuleMismatch(path,"functor","structure")) + | (_,FUNmod _) => + raise MatchError (ModuleMismatch(path,"structure","functor")) + +and matchExMod path (EXISTSexmod(T,M)) (EXISTSexmod(T',M')) = + (incrBindingLevel(); + refreshTyNameSet PARAMETERts T; + refreshTyNameSet VARIABLEts T'; + matchMod path M M'; + refreshTyNameSet PARAMETERts T'; (* forget the realisation *) + decrBindingLevel()) +and matchSig path (LAMBDAsig(T,M)) (LAMBDAsig(T',M')) = + (incrBindingLevel(); + refreshTyNameSet PARAMETERts T; + refreshTyNameSet VARIABLEts T'; + matchMod path M M'; + refreshTyNameSet PARAMETERts T'; (* forget the realisation *) + decrBindingLevel()); + +fun matchInfixStatus path id infFixity specFixity = + if specFixity = infFixity then () + else raise MatchError(InfixStatusMismatch(path,id,infFixity,specFixity)) +; + +fun matchInfixBasis path infIBas specIBas = + (Hasht.apply + (fn id => fn specFixity => + matchInfixStatus path id + ((Hasht.find infIBas id) + handle Subscript => + raise MatchError (MissingInfixStatus (path,id,specFixity))) + specFixity) + specIBas) +; + +fun matchCSig (inferredSig:CSig) (specSig:CSig) = + case !(strOptOfSig specSig) of + NONE => fatalError "matchSignature" + | SOME RS => + (* NB: the infix bases and sigenv's will be empty in STRmode *) + let val (T,RS) = + case copySig [] [] (LAMBDAsig(!(tyNameSetOfSig specSig),STRmod RS)) of + LAMBDAsig(T,STRmod RS) => (T,RS) + | _ => fatalError "matchCSig" + val RS' = NONrec (STRstr (mk1TopEnv (#uModEnv inferredSig), + mk1TopEnv (#uFunEnv inferredSig), + mk1TopEnv (#uSigEnv inferredSig), + mk1TopEnv (#uTyEnv inferredSig), + mk1TopEnv (#uVarEnv inferredSig))) + + in + refreshTyNameSet VARIABLEts T; + matchRecStr UNITpath RS' RS; + matchInfixBasis UNITpath (iBasOfSig inferredSig) (iBasOfSig specSig) + end +; + +(* define the exported variants *) + +local + fun pathOfLongStrId [id] = IDpath id + | pathOfLongStrId (id::ids) = DOTpath(pathOfLongStrId ids,id) + | pathOfLongStrId [] = NILpath +in +fun realizeLongTyCon (qualid as {qual,id = tycon::longstrid}) infTyStr specTyStr = + let val path = pathOfLongStrId longstrid + in realizeTyStr path tycon infTyStr specTyStr + end + | realizeLongTyCon _ _ _ = fatalError "realizeLongTyCon" +end; + + +val matchMod = matchMod NILpath; +val matchSig = matchSig NILpath; + +(* tie the knot *) + +val () = matchExModRef := matchExMod NILpath; + +(* cvr: printing semantic objects *) + +val free_tyname_names = ref ([] : (TyName * (string * int)) list); +val free_tyname_counter = ref 0; + +val free_variable_names = ref ([] : (TypeVar * string) list); +val free_variable_counter = ref 0; + +val savePrState = fn () => + (let val temp_freetyname_names = !free_tyname_names + val temp_freetyname_counter = !free_tyname_counter + val temp_free_variable_names = !free_variable_names + val temp_free_variable_counter = !free_variable_counter + in fn () => (free_tyname_names := temp_freetyname_names; + free_tyname_counter := temp_freetyname_counter; + free_variable_names := temp_free_variable_names; + free_variable_counter := temp_free_variable_counter) + end); + +fun under_binder f a = + (let val temp_freetyname_names = !free_tyname_names + val temp_freetyname_counter = !free_tyname_counter + val temp_free_variable_names = !free_variable_names + val temp_free_variable_counter = !free_variable_counter + val r = f a + in free_tyname_names := temp_freetyname_names; + free_tyname_counter := temp_freetyname_counter; + free_variable_names := temp_free_variable_names; + free_variable_counter := temp_free_variable_counter; + r + end); + +fun alphaOfInt i = + if i < 26 then + CharVector.fromList [Char.chr (i + 97)] + else + alphaOfInt(i div 26) ^ alphaOfInt(i mod 26) +; + +fun choose_arbitrary_tyname () = + let fun choose_arbitrary_tyname name = + if exists (fn (_,(name',_)) => name' = name) (!free_tyname_names) + then (incr free_tyname_counter; + choose_arbitrary_tyname (alphaOfInt( !free_tyname_counter))) + else (incr free_tyname_counter; + (name,0)) + in + choose_arbitrary_tyname (alphaOfInt( !free_tyname_counter)) + end; + +(* +fun choose_derived_tyname name = + if exists (fn (_,name') => name' = name) (!free_tyname_names) + then choose_derived_tyname (name ^ "'") + else name; +*) + +fun choose_derived_tyname name = + let val (_,(_,lastsuffix)) = + choose (fn (_,(name',_)) => name' = name) (!free_tyname_names) + in + (name,lastsuffix + 1) + end + handle Subscript => (name,0) +; + + + +fun choose_arbitrary_variable () = + let fun choose_arbitrary_variable name = + if exists (fn (_,name') => name' = name) (!free_variable_names) + then (incr free_variable_counter; + choose_arbitrary_variable (alphaOfInt( !free_variable_counter))) + else (incr free_variable_counter; + name) + in + choose_arbitrary_variable (alphaOfInt( !free_variable_counter)) + end; + +local + fun choose_derived_variable name = + if exists (fn (_,name') => name' = name) (!free_variable_names) + then choose_derived_variable (name ^ "'") + else name; +in + val choose_derived_variable = + fn "" => choose_arbitrary_variable () + | name => choose_derived_variable (implode (case explode name of + #"'" :: #"_" :: rest => + rest + | #"'" :: #"'" :: #"_" :: rest => + rest + | #"'" :: #"'" :: rest => + rest + | #"'" :: rest => + rest + | rest => rest)) +end + +(* cvr: TODO rationalise *) +fun collectExplicitVarsInObj freeVarsObj obj = + let val (fns,fvs,_) = + freeVarsObj (map #1 (!free_tyname_names)) + (map #1 (!free_variable_names)) + ([],[],[]) + obj + in revApp (fn var => + let val newname = + case #tvKind(!var) of + Explicit name => choose_derived_variable name + | _ => choose_arbitrary_variable () + in + free_variable_names := ((var, newname) :: !free_variable_names) + end) + fvs; + revApp (fn tn as {qualid={id = id,...},...} => + (case id of + [""] => free_tyname_names := ((tn,choose_arbitrary_tyname()) :: !free_tyname_names) + | [name] => + let val newname = choose_derived_tyname name + in + free_tyname_names := ((tn, newname) :: !free_tyname_names) + end + | _ => free_tyname_names := ((tn,choose_arbitrary_tyname()) :: !free_tyname_names))) + fns + end +; + + +fun collectExplicitVars tau = collectExplicitVarsInObj freeVarsType tau; + +fun collectTopVars ExEnv = + let val (fns,fvs,_) = + freeVarsExEnv (map #1 (!free_tyname_names)) + (map #1 (!free_variable_names)) + ([],[],[]) + ExEnv + in revApp (fn var => + let val newname = + case #tvKind(!var) of + Explicit name => choose_derived_variable name + | _ => choose_arbitrary_variable () + in + free_variable_names := ((var, newname) :: !free_variable_names) + end) + fvs + end +; + + + +fun prTypeVar var = + let val {tvEqu, tvImp, tvKind,...} = !var + val name = lookup var (!free_variable_names) + handle Subscript => + let val newname = + (case tvKind of + Explicit name => + choose_derived_variable name + | _ => choose_arbitrary_variable ()) + in + free_variable_names := (var, newname) :: !free_variable_names; + newname + end + in + msgString ("'"^ + (if tvEqu then "'" else "") ^ + (if tvImp andalso not (!value_polymorphism) then "_" else "") ^ + name) + end; + + +local fun prNameSuffix (name,0) = msgString name + | prNameSuffix (name,suffix) = (msgString name;msgString "/";msgInt suffix) + fun prEqu equ = + case equ of + FALSEequ => msgString "" + | TRUEequ => msgString "=" + | REFequ => msgString "=" + | ARROWequ(_,equ) => prEqu equ +in +fun prTyName showTnEqu tn = + (let val namesuffix = find (isEqTN tn) (!free_tyname_names) + (* we use find instead of lookup because tynames in different + units may be equivalent according to isEqTn without being + equivalent references *) + in + prNameSuffix namesuffix + end + handle Subscript => + let val namesuffix as (name,suffix) = + case (#id(#qualid(tn))) of + [""] => choose_arbitrary_tyname () + | [name] => choose_derived_tyname name + | _ => choose_arbitrary_tyname () + in + free_tyname_names := (tn, namesuffix) :: !free_tyname_names; + if showTnEqu + then prEqu (EqualityOfTyName tn) + else (); + prNameSuffix namesuffix + end) +end +; + +fun arrowsToList tau = + case normType tau of + ARROWt(t, t') => t :: arrowsToList t' + | t => [t] +; + +fun prEnv prInfo env initial = + foldEnv (fn k => fn v => fn initial => + (if initial + then () + else (msgString ","; + msgBreak(1, 0)); + msgIBlock 0; + prInfo k v; + msgEBlock(); + false)) initial env; + +fun prType prior tau = + let + fun prParen prior' s = if prior >= prior' then msgString s else () + in + case normType tau of + VARt var => + prTypeVar var + | ARROWt(t,t') => + let val ts = t :: arrowsToList t' in + prParen 1 "("; msgIBlock 0; + prTypeSeq 1 " ->" 0 ts; + prParen 1 ")"; msgEBlock() + end + | CONt(ts, NAMEtyapp tn) => + (case ts of + [] => () + | [t] => (prType 2 t; msgString " ") + | _ => + (msgIBlock 0; msgString "("; + prTypeSeq 0 "," 1 ts; + msgString ") "; msgEBlock()); + prTyName false tn) + | CONt(ts, tyapp) => (* cvr: TODO revise *) + (case ts of + [] => () + | [t] => (prType 2 t; msgString " ") + | _ => + (msgIBlock 0; msgString "("; + prTypeSeq 0 "," 1 ts; + msgString ") "; msgEBlock()); + prTyApp 1 tyapp) + | RECt rt => + let val {fields=fs, rho=rho} = !rt in + if isNilRowType rho then + (if null fs then + prTyName false tyname_unit + else if isTupleRow fs then + (prParen 2 "("; + msgIBlock 0; + prTypeSeq 2 " *" 0 (map snd fs); + prParen 2 ")"; msgEBlock()) + else + (msgString "{"; msgIBlock 0; + prTypeRow fs; msgString "}"; msgEBlock())) + else if null fs then + msgString "{...}" + else + (msgString "{"; msgIBlock 0; + prTypeRow fs; msgString ","; msgBreak(1, 0); + msgString "...}"; msgEBlock()) + end + | PACKt X => + (msgString "["; msgIBlock 0; + prExMod 0 X; + msgString "]"; msgEBlock()) + end +and prTypeSeq prior sep offset ts = + case ts of + [] => () + | [t] => + prType prior t + | t :: rest => + (prType prior t; msgString sep; msgBreak(1, offset); + prTypeSeq prior sep offset rest) +and prTypeVarSeq vs sep = (* cvr:TODO *) + case vs of + [] => () + | [v] => + prTypeVar v + | v :: vs => + (prTypeVar v; msgString sep; msgBreak(1, 1); + prTypeVarSeq vs sep) +and prTyNameSet T sep = (* cvr:TODO *) + case T of + [] => () + | [tn] => + prTyName true tn + | tn :: T' => + (prTyName true tn; msgString sep; msgBreak(1, 1); + prTyNameSet T' sep) +and prTypeRow fs = + case fs of + [] => () + | [(lab,t)] => + (msgIBlock 0; printLab lab; msgString " :"; + msgBreak(1, 2); prType 0 t; msgEBlock()) + | (lab,t) :: rest => + (msgIBlock 0; printLab lab; msgString " :"; msgBreak(1, 2); + prType 0 t; + msgString ","; msgEBlock(); msgBreak(1, 0); prTypeRow rest) +and prTypeScheme sch = under_binder + (fn (TypeScheme {tscParameters,tscBody}) => + (case tscParameters of + [] => () + | _ => (msgString "!"; + prTypeVarSeq tscParameters ""; + msgString "."); + prType 0 tscBody)) sch +and prTyApp prior tyapp = + let + fun prParen prior' s = if prior >= prior' then msgString s else () + in + case stripTyApp [] tyapp of + (tyname,[]) => + prTyName false tyname + | (tyname,tyfuns) => + ( prParen 1 "("; (* cvr: TODO revise *) + msgIBlock 0; + prTyName false tyname; + app (fn tyfun => + (msgBreak(1,2); + prTyFun 1 tyfun)) + tyfuns; + prParen 1 ")"; + msgEBlock()) + end +and prTyFun prior tyfun = + let + fun prParen prior' s = if prior >= prior' then msgString s else () + in + case normTyFun tyfun of + TYPEtyfun ([],ty) => + prType prior ty + | TYPEtyfun vsty => + (prParen 1 "("; + under_binder + (fn (vs,ty) => + ((case vs of + [] => () + | _ => + (msgIBlock 0; + msgString "/\\"; + prTypeVarSeq vs ","; + msgString "."; + msgEBlock())); + prType prior ty)) + vsty; + prParen 1 ")") + | LAMtyfun (tn,tyfun) => + (prParen 1 "("; + prBoundTyNameSet "/\\" 2 [tn] (fn () => prTyFun 0 tyfun); + prParen 1 ")") + | APPtyfun tyapp => + prTyApp prior tyapp + end +and prInfixStatus id status = +( + (case status of + NONFIXst => + msgString "nonfix " + | INFIXst i => + (msgString "infix "; + msgInt i; msgString " ") + | INFIXRst i => + (msgString "infixr "; + msgInt i; msgString " ")); + msgString id +) +and prVarInfo prVal id info = + under_binder (fn {qualid,info = (TypeScheme {tscParameters,tscBody},status)} => + (msgString + (case status of + VARname _ => "val " + | PRIMname _ => "val " + | CONname _ => "con " + | EXNname _ => "exn " + | REFname => "con "); + (case tscParameters of + [] => () + | [v] => (prTypeVar v; + msgBreak (1,1)) + | _ => (msgString "("; + prTypeVarSeq tscParameters ","; + msgString ")"; + msgBreak (1,1))); + msgString id; + prVal info; + msgString " :"; + msgBreak(1, 2); + (case status of (* cvr: REVISE *) + VARname ovltype => + (case ovltype of + REGULARo => prType 0 tscBody + | OVL1NNo => msgString "num -> num " + | OVL1NSo => msgString "numtext -> string " + | OVL2NNBo => msgString "numtext * numtext -> bool " + | OVL2NNNo => msgString "num * num -> num " + | OVL1TXXo => msgString "'a -> 'a " + | OVL1TPUo => msgString "(ppstream -> 'a -> unit) -> unit " + | OVL2EEBo => msgString "''a * ''a -> bool ") + | CONname ci => + (if (#conIsGreedy(!ci)) orelse (#conSpan(!ci) = 1) + then prType 0 tscBody + else case tscBody of + ARROWt(t,t') => + (case normType t of + RECt (ref {fields=(_::_),...}) => + (msgString "("; msgIBlock 0; + prType 0 t; + msgEBlock (); + msgString ")"; + msgString " -> "; + prType 0 t') + | _ => prType 0 tscBody) + | _ => prType 0 tscBody) + | _ => prType 0 tscBody))) + info +and prTyInfo id (tyfun,conenv) = + let fun prTypeArgs vs = + case vs of + [] => () + | [v] => (prTypeVar v; + msgBreak (1,1)) + | _ => (msgString "("; + prTypeVarSeq vs ","; + msgString ")"; + msgBreak (1,1)) + in + case (etaExpandTyFun (normTyFun tyfun),conenv) of + (TYPEtyfun(vs,ty),ConEnv []) => + (msgString "type "; + under_binder (fn () => + (prTypeArgs vs; + msgString id; + msgString " ="; + msgBreak(1, 2); + prType 0 ty)) + ()) + | (TYPEtyfun(vs,ty),ConEnv _) => + (msgString "datatype "; + under_binder (fn () => + (prTypeArgs vs; + msgString id; + msgString " ="; + msgBreak(1, 2); + msgCBlock 1; + msgString "("; + prType 0 ty; + msgString ","; + msgBreak(0,0) + )) + (); + prConEnv conenv; + msgString ")"; + msgEBlock()) + | (_,_) => fatalError "prTyInfo" + end +and prConEnv CE = + (msgString "{"; + msgCBlock 0; + prEnv (prVarInfo (fn info => ())) + (VEofCE CE) + true; + msgString "}"; + msgEBlock()) +and prStrBody S initial = + case S of + STRstr (ME,FE,GE,TE,VE) => + let val initial = prEnv prModInfo ME initial + val initial = prEnv prFunInfo FE initial + val initial = prEnv prSigInfo GE initial + val initial = prEnv prTyInfo TE initial + in prEnv (prVarInfo (fn info => ())) VE initial + end + | SEQstr (S,S') => + let val initial = prStrBody S initial + in prStrBody S' initial + end +and prRecStr RS = + case RS of + NONrec S => + (msgString "{"; + msgCBlock 0; + prStrBody S true ; + msgString "}"; + msgEBlock()) + | RECrec (RS,RS') => + (msgString "rec ("; + msgIBlock 0; + prRecStr RS; + msgString ","; + msgBreak (0,3); + prRecStr RS'; + msgEBlock(); + msgString ")") +and prModInfo id {qualid,info = RS} = + (msgString "structure "; + msgString id; + msgString " :"; + msgBreak(1, 2); + prRecStr RS) +and prBoundTyNameSet binder offset T = + under_binder (fn prBody => + (msgCBlock 0; + (case T of + [] => () + | _ => (msgString binder; + msgIBlock 0; + prTyNameSet T ""; + msgString "."; + msgEBlock(); + msgBreak(0,offset)) + ); +(* msgEBlock())); + msgBreak(0,offset); *) + prBody (); + msgEBlock())) +and prMod prior M = + let + fun prParen prior' s = if prior >= prior' then msgString s else () + in + case M of + STRmod S => prRecStr S + | FUNmod F => prGenFun prior F (* cvr: REVISE *) + end +and prGenFun prior (T,M,X) = + let + fun prParen prior' s = if prior >= prior' then msgString s else () + in + (prParen 1 "("; + prBoundTyNameSet "!" 1 T + (fn () => + (msgIBlock 0; + prMod 1 M; + msgString "->"; + msgBreak (0,4); + prExMod 0 X; + msgEBlock())); + prParen 1 ")") + end +and prFunInfo id {qualid,info = F} = + (msgString "functor "; + msgString id; + msgString " :"; + msgBreak(1, 2); + prGenFun 0 F) +and prExMod prior (EXISTSexmod(T,M)) = + let + fun prParen prior' s = if prior >= prior' then msgString s else () + in + (prParen 1 "("; + prBoundTyNameSet "?" 1 T (fn () => prMod 0 M); (* cvr: REVISE*) + prParen 1 ")") + end +and prSig (LAMBDAsig(T,M)) = + prBoundTyNameSet "/\\" 2 T (fn () => prMod 0 M) +and prSigInfo id {qualid,info = G} = + (msgString "signature "; + msgString id; + msgString " ="; + msgBreak(1, 2); + prSig G) +; + +val prMod = prMod 0; +val prTyFun = prTyFun 0; +val prType = prType 0; + +fun resetTypePrinter () = +( free_tyname_names := []; + free_tyname_counter := 0; + free_variable_names := []; + free_variable_counter := 0; + app (fn tn as {qualid,...} => + if isGlobalName qualid andalso + not (member (#qual qualid) (!preopenedPreloadedUnits)) andalso + not (member (#qual qualid) (pervasiveOpenedUnits)) + then +(* free_tyname_names := (tn,showQualId qualid) :: !free_tyname_names *) + free_tyname_names := (tn,(showQualId qualid,0)) :: !free_tyname_names (* cvr: TODO revise *) + else + (case #id(qualid) of + [""] => free_tyname_names := ((tn,choose_arbitrary_tyname()) + :: !free_tyname_names) + | [name] => + let val newname = choose_derived_tyname name + in + free_tyname_names := ((tn, newname) + :: !free_tyname_names) + end + | _ => free_tyname_names := ((tn,choose_arbitrary_tyname()) :: !free_tyname_names))) + (mkGlobalT ()) +); + +local val checkpointed_free_variable_names = ref [] +in +val checkpoint_free_typevar_names = fn () => + (checkpointed_free_variable_names := map (fn (tv,string) => ((tv,!tv))) (!free_variable_names)) +val rollback_free_typevar_names = fn () => + app (fn (tv,string) => + tv := ((lookup tv (!checkpointed_free_variable_names)) + handle Subscript => !tv)) + (!free_variable_names) +val commit_free_typevar_names = fn () => + free_variable_names := drop (fn (tv,name) => + let val {tvEqu,tvImp,tvKind,...} = + (lookup tv (!checkpointed_free_variable_names)) + handle Subscript => !tv + in if (#tvEqu(!tv)) <> tvEqu + orelse (#tvImp(!tv)) <> tvImp + orelse case ((#tvKind(!tv)),tvKind) of + (LinkTo _, NoLink) => true | _ => false + then + let val tau = normType(VARt tv) + in + collectExplicitVars tau; + msgIBlock 0; + errPrompt "Warning: the free type variable "; + let val {tvEqu,tvImp,...} = + (lookup tv (!checkpointed_free_variable_names)) + handle Subscript => !tv + in + msgString ("'"^ + (if tvEqu then "'" else "") ^ + (if tvImp andalso not (!value_polymorphism) + then "_" else "") ^ + name) + end; + msgString " has been instantiated to "; + prType tau; + msgEOL(); + msgEBlock(); + case ((#tvKind(!tv)),tvKind) of + (LinkTo _, NoLink) => true (* drop only linked vars *) + | _ => false + end + else false + end) + (!free_variable_names); +end; + + +(* cvr: REVISE *) +fun printType tau = + under_binder + (fn tau => + (collectExplicitVars tau; + prType tau)) + tau +; + +fun printNextType tau = + prType tau +; + +fun printNextType tau = + prType tau +; + +fun collectSchemeExplicitVars scheme = + let val TypeScheme {tscBody, ...} = scheme + in collectExplicitVars tscBody end +; + +fun printScheme scheme = prTypeScheme scheme; +(* + let val TypeScheme {tscBody, ...} = scheme + in printType tscBody end +;*) + +fun printNextScheme scheme = prTypeScheme scheme; +(* + let val TypeScheme {tscBody, ...} = scheme + in prType tscBody end +; +*) + +(* error reporting *) +local + fun prPath path = + case path of + NILpath => + (fn () => ()) + | IDpath id => + (msgString " ";msgString id; + fn () => ()) + | DOTpath (NILpath,id) => + (msgString " ";msgString id; + fn () => ()) + | DOTpath (path as DOMpath _,id) => + (msgString " ";msgString id; + fn () => (msgString " of"; + prPath path())) + | DOTpath (path as RNGpath _,id) => + (msgString " ";msgString id; + fn () => (msgString " of"; + prPath path())) + | DOTpath (UNITpath,id) => + (case (modeOfSig (!currentSig)) of + STRmode => (msgString " ";msgString (!(#uIdent(!currentSig))); + msgString ".";msgString id; + fn () => + (msgString " in the unit "; + msgString (currentUnitName()))) + | TOPDECmode => (msgString " ";msgString id; + fn () => + (msgString " in the toplevel unit "; + msgString (currentUnitName())))) + | DOTpath (path,id) => + (let val cont = prPath path + in + msgString "."; + msgString id; + cont + end) + | DOMpath(NILpath) => + (fn () => msgString " the domain") + | DOMpath(path) => + (fn () =>(msgString " the domain of"; + prPath path())) + | RNGpath(NILpath) => + (fn () => msgString " the range") + | RNGpath(path) => + (fn () => (msgString " the range of"; + prPath path ())) + | UNITpath => + (fn () => (case (modeOfSig (!currentSig)) of + STRmode => + (msgString " the structure unit "; + msgString (currentUnitName())) + | TOPDECmode => + (msgString " the toplevel unit "; + msgString (currentUnitName())))) +in + val prPath = fn path => prPath path () +end +; + +(* cvr: it may be worth restructuring this code to print out the actual info for each field *) + + +fun errMatchReason infDesc specDesc matchreason = +let fun prInf path = + case path of + NILpath => msgString infDesc + | UNITpath => msgString infDesc + | IDpath _ => msgString infDesc + | DOTpath (path,_) => prInf path + | DOMpath path => prSpec path + | RNGpath path => prInf path + and prSpec path = + case path of + NILpath => msgString specDesc + | UNITpath => msgString specDesc + | IDpath _ => msgString specDesc + | DOTpath (path,_) => prSpec path + | DOMpath path => prInf path + | RNGpath path => prSpec path + + fun errMissingDeclaration (path,id,info) s freeVarsInfo prInfo = + under_binder (fn info => + (collectExplicitVarsInObj freeVarsInfo info; + msgIBlock 0; + errPrompt "Missing declaration: ";msgString s; + prPath (DOTpath(path,id));msgEOL(); + errPrompt "is specified in the "; + prSpec path;msgString " as "; + msgEOL(); + errPrompt " ";prInfo id info;msgEOL(); + errPrompt "but not declared in the "; + prInf path; + msgEOL(); + msgEBlock())) + info +in + case matchreason of + MissingValue pathidinfo => + errMissingDeclaration pathidinfo + "value" + freeVarsVarInfo + (prVarInfo (fn info => ())) + | MissingType pathidinfo => + errMissingDeclaration pathidinfo + "type constructor" + freeVarsTyStr + prTyInfo + | MissingStructure pathidinfo => + errMissingDeclaration pathidinfo + "structure" + freeVarsModInfo + prModInfo + | MissingFunctor pathidinfo => + errMissingDeclaration pathidinfo + "functor" + freeVarsFunInfo + prFunInfo + | MissingSignature pathidinfo => + errMissingDeclaration pathidinfo + "signature" + freeVarsSigInfo + prSigInfo + | MissingInfixStatus pathidinfo => + errMissingDeclaration pathidinfo + "the infix status of" + (fn _ => fn _ => fn _ => fn _ => ([],[],[])) + prInfixStatus + | InfixStatusMismatch (path,id,infInfo,specInfo) => + (msgIBlock 0; + errPrompt "Infix status mismatch: value identifier"; + prPath(DOTpath(path,id));msgEOL(); + errPrompt "is specified with fixity status ";msgEOL(); + errPrompt " ";prInfixStatus id specInfo;msgEOL(); + errPrompt "in the ";prSpec path;msgEOL(); + errPrompt "but declared with status ";msgEOL(); + errPrompt " ";prInfixStatus id infInfo;msgEOL(); + errPrompt "in the ";prInf path;msgEOL(); + msgEBlock()) + | SignatureMismatch (path,id,infInfo,specInfo,reasonopt,reasonopt') => + under_binder + (fn () => + (collectExplicitVarsInObj freeVarsSigInfo specInfo; + collectExplicitVarsInObj freeVarsSigInfo infInfo; + msgIBlock 0; + errPrompt "Signature mismatch: signature identifier"; + prPath(DOTpath(path,id));msgEOL(); + errPrompt "is specified as ";msgEOL(); + errPrompt " ";prSigInfo id specInfo;msgEOL(); + errPrompt "in the ";prSpec path;msgEOL(); + errPrompt "but is declared as"; + msgEOL(); + errPrompt " ";prSigInfo id infInfo;msgEOL(); + errPrompt "in the ";prInf path;msgEOL(); + (case reasonopt of + NONE => () + | SOME reason => + (errPrompt "The declaration does \ + \not match the specification because ..."; + msgEOL(); + errMatchReason "declared signature" "specified signature" reason); + case reasonopt' of + NONE => () + | SOME reason => + (errPrompt "The specification does \ + \not match the declaration because"; + msgEOL(); + errMatchReason "specified signature" "declared signature" reason)); + errPrompt "The signatures should be equivalent."; + msgEOL(); + msgEBlock())) + () + (* cvr: we trap this StatusMismatch for two constructors + to report representation mismatches better *) + | StatusMismatch (path,id,infInfo as {info=(_,CONname infConInfo),...}, + specInfo as {info=(_,CONname specConInfo),...})=> + let val (argdesc,fs) = + (case specInfo of + {info = (TypeScheme {tscBody = ARROWt(t,t'),...},_),...} => + (case normType t of + RECt (ref {fields = fs,...}) => + (if isTupleRow fs then ("tuple",fs) else ("record",fs)) + | _ => ("record",[])) + | _ => ("record",[])) + fun describeConInfo (ref {conArity=thisArity, + conIsGreedy=thisIsGreedy, + conTag=thisTag, + conSpan=thisSpan, + ...}) + (ref {conArity=otherArity, + conIsGreedy=otherIsGreedy, + conTag=otherTag, + conSpan=otherSpan, + ...}) = + (if otherArity <> thisArity andalso thisIsGreedy + then (msgString "a constructor carrying ";msgInt thisArity; + msgString " fields of a "; msgString argdesc) + else if otherArity <> thisArity andalso not(thisIsGreedy) + then (msgString "a constructor carrying a ";msgString argdesc;msgString " with ";msgInt otherArity; + msgString " fields") + else if not(otherIsGreedy) andalso thisIsGreedy + then (msgString "a constructor carrying one field of a ";msgString argdesc) + else if otherIsGreedy andalso not(thisIsGreedy) + then msgString "a constructor carrying a record with one field" + else if otherTag <> thisTag + then (msgString "constructor ";msgInt thisTag; msgString " of "; + msgInt thisSpan; msgString " constructor(s)") + else (* otherSpan <> thisSpan *) + (msgString "one constructor out of "; + msgInt thisSpan; msgString " constructor(s)")) + fun prFields fs = + let fun prTy_ n = (msgString "") + fun prRow fs n = + case fs of + [] => () + | [(lab,t)] => + (msgIBlock 0; printLab lab; msgString " :"; + msgBreak(1, 2); + prTy_ n; + msgEBlock()) + | (lab,t) :: rest => + (msgIBlock 0; printLab lab; msgString " :"; msgBreak(1, 2); + prTy_ n; + msgString ","; msgEBlock(); msgBreak(1, 0); + prRow rest (n+1)) + fun prTuple fs n = + case fs of + [] => () + | [(lab,t)] => + (msgIBlock 0; + prTy_ n; msgEBlock()) + | (lab,t) :: rest => + (msgIBlock 0; + prTy_ n; + msgString " *"; msgEBlock(); msgBreak(1,0); + prTuple rest (n+1)) + in + if isTupleRow fs + then prTuple fs 1 + else (msgString "{";prRow fs 1;msgString "}") + end + fun rectifyConInfo msg prDesc (ref {conArity=thisArity, + conIsGreedy=thisIsGreedy, + conTag=thisTag, + conSpan=thisSpan, + ...}) + (ref {conArity=otherArity, + conIsGreedy=otherIsGreedy, + conTag=otherTag, + conSpan=otherSpan, + ...}) = + (if otherArity <> thisArity orelse otherIsGreedy <> thisIsGreedy + then if thisIsGreedy + then (errPrompt msg;msgEOL(); + errPrompt "- in the ";prDesc path; + msgString ", enclose the argument type of the constructor in parentheses:";msgEOL(); + errPrompt " change \"";msgString id;msgString " of "; + prFields fs; msgString "\""; msgEOL(); + errPrompt " to \"";msgString id;msgString " of ("; + prFields fs; msgString ")\""; + msgEOL()) + else (errPrompt msg;msgEOL(); + errPrompt "- in the ";prDesc path; + msgString", re-express the argument type of the constructor as a syntactic "; + msgString argdesc;msgString ":";msgEOL(); + errPrompt " change \"";msgString id;msgString " of "; + msgString ""; msgString "\""; msgEOL(); + errPrompt " to \"";msgString id;msgString " of "; + prFields fs; msgString "\"";msgEOL()) + else ()) + in + under_binder (fn () => + (collectExplicitVarsInObj freeVarsVarInfo specInfo; + collectExplicitVarsInObj freeVarsVarInfo infInfo; + msgIBlock 0; + errPrompt "Status mismatch: constructor "; + prPath(DOTpath(path,id));msgEOL(); + errPrompt "is specified as "; + describeConInfo specConInfo infConInfo; + msgString " in the ";prSpec path;msgEOL(); + errPrompt " ";prVarInfo (fn info => ()) id specInfo;msgEOL(); + errPrompt "but declared as "; + describeConInfo infConInfo specConInfo; + msgString " in the ";prInf path;msgEOL(); + errPrompt " ";prVarInfo (fn info => ()) id infInfo;msgEOL(); + rectifyConInfo "EITHER: edit the specification to match the declaration: " prSpec specConInfo infConInfo; + rectifyConInfo "OR: edit the declaration to match the specification: " prInf infConInfo specConInfo; + msgEBlock())) + () + end + | StatusMismatch (path,id,infInfo as {info=(_,infStatus),...}, + specInfo as {info=(_,specStatus),...})=> + under_binder (fn () => + (collectExplicitVarsInObj freeVarsVarInfo specInfo; + collectExplicitVarsInObj freeVarsVarInfo infInfo; + msgIBlock 0; + errPrompt "Status mismatch: identifier"; + prPath(DOTpath(path,id));msgEOL(); + errPrompt "is specified as "; + msgString (case (infStatus,specStatus) of + (VARname _ ,VARname _) => "an ordinary value" + | (_ ,VARname _)=> "a value" + | (PRIMname _,PRIMname _) => "one primitive" + | (_ ,PRIMname _) => "a primitive" + | ( CONname _,CONname _) => "a constructor" + | (_ ,CONname _) => "a constructor" + | (EXNname infei,EXNname specei) => + fatalError "errMatchReason 1" +(* ps: (case(#exconTag(!infei),#exconTag(!specei)) of + (NONE,SOME _) => "a static exception" + | (SOME _,NONE) => "a dynamic exception" + | (_,_) => "an exception") *) + | (_ ,EXNname _) => "an exception" + | (_ ,REFname) => "the `ref' constructor"); + msgString " in the ";prSpec path;msgEOL(); + errPrompt " ";prVarInfo (fn info => ()) id specInfo;msgEOL(); + errPrompt "but declared as "; + msgString (case (infStatus,specStatus) of + (VARname _,VARname _) => "an overloaded value" + | (VARname _,_)=> "an ordinary value" + | (PRIMname _,PRIMname _) => "a different primitive" + | (PRIMname _,_) => "a primitive" + | (CONname _,CONname _) => "a constructor with a different representation" + | (CONname _,_) => "a constructor" + | (EXNname infei,EXNname specei) => + fatalError "errMatchReason 2" + (* ps: + (case(#exconTag(!infei),#exconTag(!specei)) of + (NONE,SOME _) => "a dynamic exception" + | (SOME _,NONE) => "a static exception" + | (_,_) => "an exception with a different representation") *) + | (EXNname _,_) => "an exception" + | (REFname,_) => "the `ref' constructor"); + msgString " in the ";prInf path;msgEOL(); + errPrompt " ";prVarInfo (fn info => ()) id infInfo;msgEOL(); + msgEBlock())) + () + | ConEnvMismatch (path,id,infTyStr,specTyStr) => + under_binder (fn () => + (collectExplicitVarsInObj freeVarsTyStr specTyStr; + collectExplicitVarsInObj freeVarsTyStr infTyStr; + msgIBlock 0; + errPrompt "Datatype mismatch: type constructor"; + prPath(DOTpath(path,id));msgEOL(); + errPrompt "is specified as the datatype";msgEOL(); + errPrompt " ";prTyInfo id specTyStr;msgEOL(); + errPrompt "in the ";prSpec path;msgEOL(); + errPrompt "but declared as the different datatype";msgEOL(); + errPrompt " ";prTyInfo id infTyStr;msgEOL(); + errPrompt "in the ";prInf path;msgEOL(); + errPrompt "The datatypes should agree on the names \ + \and the order of value constructors"; + msgEOL(); + msgEBlock())) + () + | SchemeMismatch (path,id,infInfo,specInfo) => + under_binder + (fn () => + (collectExplicitVarsInObj freeVarsVarInfo specInfo; + collectExplicitVarsInObj freeVarsVarInfo infInfo; + msgIBlock 0; + errPrompt "Scheme mismatch: value identifier"; + prPath(DOTpath(path,id));msgEOL(); + errPrompt "is specified with type scheme ";msgEOL(); + errPrompt " ";prVarInfo (fn info => ()) id specInfo;msgEOL(); + errPrompt "in the ";prSpec path;msgEOL(); + errPrompt "but its declaration has the unrelated type scheme "; + msgEOL(); + errPrompt " ";prVarInfo (fn info => ()) id infInfo;msgEOL(); + errPrompt "in the ";prInf path;msgEOL(); + errPrompt "The declared type scheme should be at least as general as the specified type scheme"; + msgEOL(); + msgEBlock())) + () + | ArityMismatch (path,id,infTyStr,specTyStr,infArity,specArity) => + under_binder (fn () => + (collectExplicitVarsInObj freeVarsTyStr specTyStr; + collectExplicitVarsInObj freeVarsTyStr infTyStr; + msgIBlock 0; + errPrompt "Arity mismatch: type constructor"; + prPath(DOTpath(path,id));msgEOL(); + errPrompt "is specified with arity "; + msgInt (specArity);msgString " in the ";prSpec path;msgEOL(); + errPrompt " ";prTyInfo id specTyStr;msgEOL(); + errPrompt "but declared with arity ";msgInt (infArity); + msgString " in the ";prInf path;msgEOL(); + errPrompt " ";prTyInfo id infTyStr;msgEOL(); + errPrompt "The arities should agree";msgEOL(); + msgEBlock())) + () + | RefEqualityMismatch (path,id,infTyStr,specTyStr) => + under_binder (fn () => + (collectExplicitVarsInObj freeVarsTyStr specTyStr; + collectExplicitVarsInObj freeVarsTyStr infTyStr; + msgIBlock 0; + errPrompt "Equality type mismatch: type constructor"; + prPath(DOTpath(path,id));msgEOL(); + errPrompt "is specified as a `prim_EQtype' in the "; + prSpec path;msgEOL(); + errPrompt " ";prTyInfo id specTyStr;msgEOL(); + errPrompt "but is not declared as a `prim_EQtype' in the "; + prInf path;msgEOL(); + errPrompt " ";prTyInfo id infTyStr;msgEOL(); + msgEBlock())) + () + | EqualityMismatch (path,id,infTyStr,specTyStr) => + under_binder (fn () => + (collectExplicitVarsInObj freeVarsTyStr specTyStr; + collectExplicitVarsInObj freeVarsTyStr infTyStr; + msgIBlock 0; + errPrompt "Equality type mismatch: type constructor"; + prPath(DOTpath(path,id));msgEOL(); + errPrompt "is specified as admitting equality in the "; + prSpec path;msgEOL(); + errPrompt " ";prTyInfo id specTyStr;msgEOL(); + errPrompt "but its declaration does not admit equality in the "; + prInf path;msgEOL(); + errPrompt " ";prTyInfo id infTyStr;msgEOL(); + msgEBlock())) + () + | TransparentMismatch (path,id,infTyStr,specTyStr) => + under_binder (fn () => + (collectExplicitVarsInObj freeVarsTyStr specTyStr; + collectExplicitVarsInObj freeVarsTyStr infTyStr; + msgIBlock 0; + errPrompt "Type mismatch: type constructor"; + prPath(DOTpath(path,id));msgEOL(); + errPrompt "is specified as one abbreviation in the "; + prSpec path;msgEOL(); + errPrompt " ";prTyInfo id specTyStr;msgEOL(); + errPrompt "but declared as a different abbreviation in the "; + prInf path;msgEOL(); + errPrompt " ";prTyInfo id infTyStr;msgEOL(); + errPrompt "The abbreviations should be equivalent";msgEOL(); + msgEBlock())) + () + | PatternMismatch (path,id,infTyStr, specTyStr, tn,sv) => + under_binder + (fn () => + (collectExplicitVarsInObj freeVarsTyStr specTyStr; + collectExplicitVarsInObj freeVarsTyStr infTyStr; + msgIBlock 0; + errPrompt "Scope Violation: type constructor"; + prPath (DOTpath(path,id)); + msgString " has specification:";msgEOL(); + errPrompt " ";prTyInfo id specTyStr;msgEOL(); + errPrompt "in the ";prSpec path;msgEOL(); + errPrompt "but is implemented by the declaration: ";msgEOL(); + errPrompt " ";prTyInfo id infTyStr;msgEOL(); + errPrompt "in the ";prInf path;msgEOL(); + errPrompt "The declaration violates the specification because "; + msgEOL(); + (case sv of + TYNAMEsv tn' => + (errPrompt "the type constructor "; + prTyName false tn'; + msgString " is a parameter " ; + msgEOL(); + errPrompt "that is declared within \ + \the scope of "; + prTyName false tn; + msgString "."; + msgEOL()) + | TYPEVARsv tv => + (errPrompt "the type variable "; + prTypeVar tv; + msgString " is a parameter " ; + msgEOL(); + errPrompt "that is declared within \ + \the scope of "; + prTyName false tn; + msgString "."; + msgEOL())); + msgEBlock())) + () + | CircularMismatch (path,id,infTyStr,specTyStr,tn) => + under_binder + (fn () => + (collectExplicitVarsInObj freeVarsTyStr specTyStr; + collectExplicitVarsInObj freeVarsTyStr infTyStr; + msgIBlock 0; + errPrompt "Circularity: type constructor"; + prPath (DOTpath(path,id)); + msgString " has specification:";msgEOL(); + errPrompt " ";prTyInfo id specTyStr;msgEOL(); + errPrompt "in the ";prSpec path;msgEOL(); + errPrompt "but is implemented by the declaration: ";msgEOL(); + errPrompt " ";prTyInfo id infTyStr;msgEOL(); + errPrompt "in the ";prInf path;msgEOL(); + errPrompt "The declaration violates the specification because ";msgEOL(); + errPrompt "of the circular occurrence of "; prTyName false tn; + msgEOL(); + msgEBlock())) + () + | DatatypeMismatch (path,id,infTyStr,specTyStr) => + under_binder (fn () => + (collectExplicitVarsInObj freeVarsTyStr specTyStr; + collectExplicitVarsInObj freeVarsTyStr infTyStr; + msgIBlock 0; + errPrompt "Datatype mismatch: type constructor"; + prPath(DOTpath(path,id));msgEOL(); + errPrompt "is specified as a datatype in the "; + prSpec path;msgEOL(); + errPrompt " ";prTyInfo id specTyStr;msgEOL(); + errPrompt "but not declared as a datatype in the ";prInf path;msgEOL(); + errPrompt " ";prTyInfo id infTyStr;msgEOL(); + errPrompt "The declaration should also be a datatype";msgEOL(); + msgEBlock())) + () + | ModuleMismatch (path as NILpath,infDesc,specDesc) => + (msgIBlock 0; + errPrompt "Module mismatch: The "; + prSpec path;msgString " specifies a ";msgString specDesc; + msgEOL(); + errPrompt "but the ";prInf path;msgString " is a " ;msgString infDesc; + msgEOL(); + msgEBlock()) + | ModuleMismatch (path,infDesc,specDesc) => + (msgIBlock 0; + errPrompt "Module mismatch:"; + prPath path;msgEOL(); + errPrompt "is specified as a ";msgString specDesc; + msgString " in the ";prSpec path;msgEOL(); + errPrompt "but declared as a " ;msgString infDesc; + msgString " in the ";prInf path;msgEOL(); + msgEBlock()) +end +; + +local + fun warnAdditional path desc = + (msgIBlock 0; + errPrompt "Warning: "; msgString desc; + prPath path;msgEOL(); + errPrompt "is declared by the implementation"; msgEOL (); + errPrompt "but not specified in the interface"; + msgEOL(); + msgEBlock()); + fun checkTyInfo path id (infTyStr : TyFun * ConEnv) (specTyStr : TyFun * ConEnv) = + case (#2 infTyStr,#2 specTyStr) of + (ConEnv [], ConEnv []) => () + | (ConEnv (_::_), ConEnv []) => + (msgIBlock 0; + errPrompt "Warning: type constructor"; + prPath (DOTpath(path,id));msgEOL(); + errPrompt "is declared by the implementation as a datatype"; + msgEOL(); + errPrompt "but specified as an ordinary type in the interface"; + msgEOL(); + msgEBlock()) + | (ConEnv _, ConEnv _) => () + | (_,_) => fatalError "checkTyInfo" + + fun checkVarInfo path id + (infInfo as {info = (_,infStatus),qualid = infQualid}) + (specInfo as {info = (_,specStatus),qualid = specQualid}) = + let + val {qual=infQual, ...} = infQualid + val {qual=specQual,...} = specQualid + in + case specStatus of + VARname ovltype => + (case infStatus of + CONname _ => + (msgIBlock 0; + errPrompt "Warning: value"; + prPath (DOTpath(path,id));msgEOL(); + errPrompt "is declared by the implementation as a constructor"; + msgEOL(); + errPrompt "but specified as an ordinary value in the interface"; + msgEOL(); + msgEBlock()) + | EXNname _ => + (msgIBlock 0; + errPrompt "Warning: value"; + prPath (DOTpath(path,id));msgEOL(); + errPrompt "is declared by the implementation as an \ + \exception constructor"; + msgEOL(); + errPrompt "but specified as an ordinary value in the interface"; + msgEOL(); + msgEBlock()) + | _ => ()) + | _ => () + end + and checkStr path S S' = + case S of + STRstr (ME,FE,GE,TE,VE) => + (traverseEnv (fn id => fn infInfo => + checkTyInfo path id infInfo (lookupEnv (TEofStr S') id) + handle Subscript => + warnAdditional (DOTpath(path,id)) "type constructor") + TE; + traverseEnv (fn id => fn infInfo => + checkVarInfo path id infInfo (lookupEnv (VEofStr S') id) + handle Subscript => + warnAdditional (DOTpath(path,id)) "value") + VE; + traverseEnv (fn id => fn infInfo => + checkModInfo path id infInfo (lookupEnv (MEofStr S') id) + handle Subscript => + warnAdditional (DOTpath(path,id)) "structure") + ME; + traverseEnv (fn id => fn infInfo => + checkFunInfo path id infInfo (lookupEnv (FEofStr S') id) + handle Subscript => + warnAdditional (DOTpath(path,id)) "functor") + FE; + traverseEnv (fn id => fn infInfo => + checkSigInfo path id infInfo (lookupEnv (GEofStr S') id) + handle Subscript => + warnAdditional (DOTpath(path,id)) "signature") + GE) + | SEQstr (S1,S2) => (checkStr path S1 S'; checkStr path S2 S') + and checkRecStr path RS (RECrec (RS1',RS2')) = + checkRecStr path RS RS2' + | checkRecStr path (NONrec S) (NONrec S') = + checkStr path S S' + | checkRecStr path (RECrec(RS1,RS2)) RS' = + checkRecStr path RS2 RS' + and checkFun path (T,M,X) (T',M',X') = + checkExMod (RNGpath(path)) X X' + and checkModInfo path id {qualid = _,info = RS} {qualid = _,info = RS'} = + checkRecStr (DOTpath(path,id)) RS RS' + and checkFunInfo path id {qualid = _,info = F} {qualid = _,info = F'} = + checkFun (DOTpath(path,id)) F F' + and checkSigInfo path id {qualid = _,info = G} {qualid = _,info = G'} = + () + and checkMod path M M' = + case (M,M') of + (STRmod RS,STRmod RS') => checkRecStr path RS RS' + | (FUNmod F, FUNmod F') => checkFun path F F' + | (_,_) => fatalError "checkMod" + and checkExMod path (EXISTSexmod(T,M)) (EXISTSexmod(T',M')) = + checkMod path M M' + and checkInfixBasis path infIBas specIBas = + Hasht.apply + (fn id => fn infInfo => + ((ignore (Hasht.find specIBas id)) + handle Subscript => + warnAdditional (DOTpath(path,id)) "the infix status of")) + infIBas +in + +fun checkCSig infCSig specCSig = + if modeOfSig(specCSig) = STRmode then () + else + case !(strOptOfSig specCSig) of + NONE => fatalError "checkCSig" + | SOME RS => + let val RS' = NONrec (STRstr (mk1TopEnv (#uModEnv infCSig), + mk1TopEnv (#uFunEnv infCSig), + mk1TopEnv (#uSigEnv infCSig), + mk1TopEnv (#uTyEnv infCSig), + mk1TopEnv (#uVarEnv infCSig))) + in + checkRecStr UNITpath RS' RS; + checkInfixBasis UNITpath (iBasOfSig (infCSig)) + (iBasOfSig (specCSig)) + end +end; + + + +(* lookup with calculated position in + normed (sorted) structures and environments *) + +fun sizeModInfo {qualid,info} = if isGlobalName qualid then 0 else 1 +fun sizeFunInfo {qualid,info} = if isGlobalName qualid then 0 else 1 +fun sizeVarInfo {qualid,info = (_,cs)} = + if isGlobalName qualid + then 0 + else + (case cs of + VARname _ => 1 + | EXNname ei => + (* ps: if isExConStatic ei then 0 else *) 1 + | _ (* PRIMname _ | CONname _ | REFname *) => 0) + + +fun sizeOfModEnv env = + foldEnv (fn _ => fn info => fn size => size + sizeModInfo info) 0 env +fun sizeOfFunEnv env = + foldEnv (fn _ => fn info => fn size => size + sizeFunInfo info) 0 env +fun sizeOfVarEnv env = + foldEnv (fn _ => fn info => fn size => size + sizeVarInfo info) 0 env + +fun sizeOfStr (STRstr(ME,FE,GE,TE,VE)) = sizeOfModEnv ME + sizeOfFunEnv FE + sizeOfVarEnv VE + | sizeOfStr (SEQstr (S,S')) = sizeOfStr S + sizeOfStr S' + + +(* cvr: the position calculated by lookupMEofStr and lookupVEofStr will *only* be + meaningfull if str is normed, but we return a result if it is not + to support lookup in context where positions are irrelevant (ie, within signatures and + and type expressions) *) + +fun lookupMEofStr str = + case str of + STRstr(ME,FE,GE,TE,VE) => + (fn mid => lookupEnvWithPos sizeModInfo ME mid 0) + | _ => fn mid => (0, lookupEnv (MEofStr str) mid) + +fun lookupFEofStr str = + case str of + STRstr(ME,FE,GE,TE,VE) => + let val sizeOfME = sizeOfModEnv ME in + fn fid => lookupEnvWithPos sizeFunInfo FE fid sizeOfME + end + | _ => fn fid => (0, lookupEnv (FEofStr str) fid) + +fun lookupVEofStr str = + case str of + STRstr(ME,FE,GE,TE,VE) => + let val sizeOfMEFE = (sizeOfModEnv ME) + (sizeOfFunEnv FE) in + fn vid => lookupEnvWithPos sizeVarInfo VE vid sizeOfMEFE + end + | _ => fn vid => (0, lookupEnv (VEofStr str) vid) + +fun lookupMEofEnv ((ME,_,_,_,_):Environment) = + fn mid => lookupEnvWithPos sizeModInfo ME mid 0; + + +fun lookupFEofEnv ((ME,FE,_,_,_):Environment) = + let val sizeOfME = sizeOfModEnv ME + in + fn fid => lookupEnvWithPos sizeFunInfo FE fid sizeOfME + end; + +fun lookupVEofEnv ((ME,FE,_,VE,_):Environment) = + let + val sizeOfMEFE = sizeOfModEnv ME + sizeOfFunEnv FE + in + fn vid => lookupEnvWithPos sizeVarInfo VE vid (sizeOfMEFE) + end; + + +local fun warnToplevelImperativeVar desc id = +( + msgIBlock 0; + if !value_polymorphism then + (errPrompt "Warning: Value polymorphism:"; + msgEOL(); + errPrompt ("Free type variable(s) at top level in " + ^desc^" identifier "^id)) + else + errPrompt ("Warning: Free imperative type variable(s) at top level in "^desc^" identifier "^id); + msgEOL(); + msgEBlock() +) +in +fun checkClosedExEnvironment (EXISTS(T,(ME,FE,GE,VE,TE))) = + let val fvs = (map #1 (!free_variable_names)) + in + ( foldEnv (fn id => fn {qualid, info = (sc,_)} => fn _ => + (checkClosedTypeScheme fvs sc) + handle Subscript => warnToplevelImperativeVar "value" id) + () VE; + foldEnv (fn id => fn (tyfun,_) => fn _ => + (checkClosedTyFun fvs tyfun) + handle Subscript => warnToplevelImperativeVar "type" id) + () TE; + foldEnv (fn id => fn {qualid, info = RS} => fn _ => + (checkClosedRecStr fvs RS) + handle Subscript => warnToplevelImperativeVar "structure" id) + () ME; + foldEnv (fn id => fn {qualid, info = F} => fn _ => + (checkClosedGenFun fvs F) + handle Subscript => warnToplevelImperativeVar "functor" id) + () FE; + foldEnv (fn id => fn {qualid, info = G} => fn _ => + (checkClosedSig fvs G) + handle Subscript => warnToplevelImperativeVar "signature" id) + () GE) + end +end; + + diff -Nru mosml-2.01/src/compiler.cminusminus/Units.sig mosml-2.10.1/src/compiler.cminusminus/Units.sig --- mosml-2.01/src/compiler.cminusminus/Units.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Units.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,122 @@ +local + open Fnlib Mixture Const Globals Location; +in + +type CSig = +{ + uMode: Mode, (* true if compiled as a structure, false if compiled as + top dec *) + uName: string, (* the normalized basename of the filename *) + uIdent: string ref, (* the (non-normalized) + ML structure and signature identifier + for the unit if uMode = STRmode *) + uIBas: (string,InfixStatus) Hasht.t, + uVarEnv: (string, VarInfo) Hasht.t, + uTyEnv: (string, TyInfo) Hasht.t, + uModEnv: (string, ModInfo) Hasht.t, + uFunEnv: (string, FunInfo) Hasht.t, + uSigEnv: (string, SigInfo) Hasht.t, + (* uTyNameSet is the set of names introduced in the unit's implementation, + or the set of names bound in the unit's interface (if any). + *) + uTyNameSet: TyNameSet ref, + (* The optional Str uStrOpt comes from the unit's optional interface. + It is the body of the signature to be matched against. + *) + uStrOpt: RecStr option ref, + uStamp: SigStamp option ref, + (* present, if this signature comes from a .ui file *) + uMentions: (string, SigStamp) Hasht.t +}; + +val modeOfSig : CSig -> Mode; +val iBasOfSig : CSig -> (string, InfixStatus) Hasht.t; +val varEnvOfSig : CSig -> (string, (TypeScheme * ConStatusDesc)global) Hasht.t; +val tyEnvOfSig : CSig -> (string, (TyFun * ConEnv)) Hasht.t; +val modEnvOfSig : CSig -> (string, RecStr global) Hasht.t; +val funEnvOfSig : CSig -> (string, GenFun global) Hasht.t; +val sigEnvOfSig : CSig -> (string, Sig global) Hasht.t; +val tyNameSetOfSig : CSig -> TyNameSet ref; +val strOptOfSig : CSig -> RecStr option ref; + + +type SigTable = (string, CSig) Hasht.t; + +val pervSigTable : SigTable; +val currentSigTable : SigTable ref; +val newSig : (* uName *) string -> (* uIdent *) string -> Mode -> CSig; +val currentSig : CSig ref; +val currentRenEnv : (string, int) Hasht.t ref; +val readSig : string -> CSig; +val readAndMentionSig : string -> CSig; +val findSig : Location -> string -> CSig; +val pervasiveInfixTable : (string, InfixStatus) Hasht.t; +val initPervasiveEnvironments : unit -> unit; +val findAndMentionSig : Location -> string -> CSig; +val initInitialEnvironments : (string list) -> unit; +val extendInitialSigEnv : CSig option -> unit; +val protectCurrentUnit : (unit -> 'a) -> unit; +val currentUnitName : unit -> string; +val mkGlobalName : string -> QualifiedIdent; +val isUnitName : QualifiedIdent -> bool; +val isGlobalName : QualifiedIdent -> bool; +val mkLocalName : string -> QualifiedIdent; +val mkName : bool -> string -> QualifiedIdent; + +val mkGlobalInfo : string -> 'a -> 'a global; +val mkUniqueGlobalName : string * 'a -> QualifiedIdent * 'a; +val newTypeStamp : unit -> int; + +val newTyNameStamp : unit -> (string*int); +val newExcStamp : unit -> int; +val newValStamp : unit -> int; + + +val isEqTN : TyName -> TyName -> bool; + +val updateCurrentStaticT : TyNameSet -> unit; +val updateCurrentInfixBasis : InfixBasis -> unit; +val extendCurrentStaticIBas : InfixBasis -> unit; +val updateCurrentStaticVE : VarEnv -> unit; +val extendCurrentStaticVE : VarEnv -> unit; +val updateCurrentStaticTE : TyEnv -> unit; +val extendCurrentStaticTE : TyEnv -> unit; +val updateCurrentStaticME : ModEnv -> unit; +val extendCurrentStaticME : ModEnv -> unit; +val updateCurrentStaticFE : FunEnv -> unit; +val extendCurrentStaticFE : FunEnv -> unit; +val updateCurrentStaticGE : SigEnv -> unit; +val extendCurrentStaticGE : SigEnv -> unit; + +val extendCurrentStaticS : Str -> unit; + + +val mkGlobalInfixBasis : unit -> (string, InfixStatus) Env; + +val mkGlobalT : unit -> TyNameSet; +val mkGlobalVE : unit -> VarEnv; +val mkGlobalTE : unit -> TyEnv; +val mkGlobalME : unit -> ModEnv; +val mkGlobalFE : unit -> FunEnv; +val mkGlobalGE : unit -> SigEnv; + +val execToplevelOpen : Location -> string -> unit; +val printVQ : QualifiedIdent -> unit; + +val startCompilingUnit : (* uName *) string -> (*uIdent *) string -> Mode -> unit; +val rectifySignature : unit -> + (QualifiedIdent * (QualifiedIdent * int)) list * (string * int) list; + + +end; + + + + + + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Units.sml mosml-2.10.1/src/compiler.cminusminus/Units.sml --- mosml-2.01/src/compiler.cminusminus/Units.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Units.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,792 @@ + +open Misc BasicIO Nonstdio Fnlib Config Mixture Const Globals Location; + +(* Compiled signatures *) + +type CSig = +{ + uMode: Mode, (* whether to interpret the unit as a structure or topdec *) + uName: string, (* the normalized basename of the filename *) + uIdent: string ref, (* the (non-normalized) + ML structure and signature identifier + for the unit if uMode = STRmode *) + uIBas: (string,InfixStatus) Hasht.t, + uVarEnv: (string, VarInfo) Hasht.t, + uTyEnv: (string, TyInfo) Hasht.t, + uModEnv: (string, ModInfo) Hasht.t, + uFunEnv: (string, FunInfo) Hasht.t, + uSigEnv: (string, SigInfo) Hasht.t, + (* uTyNameSet is the set of names introduced in the unit's implementation, + or the set of names bound in the unit's interface (if any). + *) + uTyNameSet: TyNameSet ref, + (* The optional Str uStrOpt comes from the unit's optional interface. + It is the body of the signature to be matched against. + *) + uStrOpt: RecStr option ref, + uStamp: SigStamp option ref, + (* present, if this signature comes from a .ui file *) + uMentions: (string, SigStamp) Hasht.t +}; + + + +fun iBasOfSig (cu : CSig) = #uIBas cu +and varEnvOfSig (cu : CSig) = #uVarEnv cu +and tyEnvOfSig (cu : CSig) = #uTyEnv cu +and modEnvOfSig (cu : CSig) = #uModEnv cu +and funEnvOfSig (cu : CSig) = #uFunEnv cu +and sigEnvOfSig (cu : CSig) = #uSigEnv cu +and tyNameSetOfSig (cu : CSig) = #uTyNameSet cu +and strOptOfSig (cu : CSig) = #uStrOpt cu +and modeOfSig (cu : CSig) = #uMode cu +; + +(* The table of unit signatures already loaded in memory *) + +type SigTable = (string, CSig) Hasht.t; + +fun mkSigTable() = (Hasht.new 37 : SigTable); +val dummySigTable = (Hasht.new 0 : SigTable); + +val pervSigTable = (Hasht.new 7 : SigTable); + +val currentSigTable = ref dummySigTable; + +fun newSig nm id mode : CSig = +{ + uName = nm, + uMode = mode, + uIdent = ref id, + uIBas = Hasht.new 7, + uVarEnv = Hasht.new 17, + uTyEnv = Hasht.new 7, + uModEnv = Hasht.new 7, + uFunEnv = Hasht.new 7, + uSigEnv = Hasht.new 7, + uTyNameSet = ref [], + uStrOpt = ref NONE, + uMentions = Hasht.new 13, + uStamp = ref NONE +}; + +(* the current order of unit signatures *) + + +(* Current signature *) + +val dummySig = newSig "" "" STRmode; + +val currentSig = ref dummySig; + +val dummyInfixBasis = (Hasht.new 0 : (string, InfixStatus) Hasht.t); + +val currentInfixBasis = ref dummyInfixBasis; + +val currentTypeStamp = ref 0; +val currentExcStamp = ref 0; +val currentValStamp = ref 0; + +val dummyRenEnv = (Hasht.new 0 : (string, int) Hasht.t); + +val currentRenEnv = ref dummyRenEnv; + +(* To load a signature from a file *) + +(* +fun readSig name = + let val filename = find_in_path (name ^ ".ui") + val is = open_in_bin filename + in + let + val sigStamp = input(is, 22) + val () = if size sigStamp < 22 then raise Fail "sigStamp" else () + val cu = (input_value is : CSig) + val {uStamp, uName, ...} = cu + in + close_in is; + uStamp := SOME sigStamp; + if name <> uName then ( + msgIBlock 0; + errPrompt "File "; msgString filename; + msgString " contains the signature of unit "; + msgString uName; msgEOL(); + errPrompt "instead of the signature of unit "; + msgString name; msgEOL(); + msgEBlock(); + raise Toplevel) + else (); + cu + end + handle Fail _ => + (close_in is; + msgIBlock 0; + errPrompt "Corrupted compiled signature file: "; + msgString filename; msgEOL(); + msgEBlock(); + raise Toplevel) + end; +*) +fun readSig filename = + let + val name = normalizedUnitName(Filename.basename filename) + val filename = find_in_path (filename ^ ".ui") + val is = open_in_bin filename + in + let + val sigStamp = input(is, 22) + val () = if size sigStamp < 22 then raise Fail "sigStamp" else () + val cu = (input_value is : CSig) + val {uStamp, uName, ...} = cu + in + close_in is; + uStamp := SOME sigStamp; + if name <> uName then ( + msgIBlock 0; + errPrompt "File "; msgString filename; + msgString " contains the signature of unit "; + msgString uName; msgEOL(); + errPrompt "instead of the signature of unit "; + msgString name; msgEOL(); + msgEBlock(); + raise Toplevel) + else (); + cu + end + handle Fail _ => + (close_in is; + msgIBlock 0; + errPrompt "Corrupted compiled signature file: "; + msgString filename; msgEOL(); + msgEBlock(); + raise Toplevel) + end; + +fun readAndMentionSig filename = + let val cu = readSig filename in + (case !(#uStamp cu) of + NONE => () + | SOME stamp => + let val mentions = #uMentions (!currentSig) in + ignore(Hasht.find mentions (#uName(cu))) + handle Subscript => Hasht.insert mentions (#uName(cu)) stamp + end); + cu + end; + +(* To find a pervasive signature by its name *) + +fun findPervSig uname = + Hasht.find pervSigTable uname + handle Subscript => + fatalError "findPervSig" +; + +(* To find a signature by its name *) + +fun findSig loc uname = + Hasht.find pervSigTable uname + handle Subscript => + (Hasht.find (!currentSigTable) uname + handle Subscript => + (if #uName(!currentSig) = "Top" then + (ignore(Hasht.find (!watchDog) uname) + handle Subscript => + errorMsg loc ("Cannot access unit " ^ uname ^ + " before it has been loaded.")) + else (); + let val cu = + readSig uname + handle Fail msg => errorMsg loc msg + in + Hasht.insert (!currentSigTable) uname cu; cu + end)) +; + +(* --- The current state of the compiler --- *) + +val pervasiveInfixTable = + (Hasht.new 7 : (string, InfixStatus) Hasht.t); + +val pervasiveInfixBasis = ref (NILenv : InfixBasis); +val pervasiveStaticT = ref ([]:TyNameSet); +val pervasiveStaticVE = ref (NILenv : VarEnv); +val pervasiveStaticTE = ref (NILenv : TyEnv); +val pervasiveStaticME = ref (NILenv : ModEnv); +val pervasiveStaticFE = ref (NILenv : FunEnv); +val pervasiveStaticGE = ref (NILenv : SigEnv); + +(* cvr: TODO at the moment there are no pervasive modules functors + or signatures but there probably should be *) +fun initPervasiveEnvironments() = +( pervasiveInfixBasis := mk1TopEnv pervasiveInfixTable; + pervasiveStaticT := []; + pervasiveStaticVE := NILenv; + pervasiveStaticTE := NILenv; + pervasiveStaticME := NILenv; + pervasiveStaticFE := NILenv; + pervasiveStaticGE := NILenv; + List.app + (fn uname => + let val cu = findPervSig uname in + pervasiveInfixBasis := bindTopInEnv (!pervasiveInfixBasis) (#uIBas cu); + pervasiveStaticT := + (!pervasiveStaticT) @ (!(#uTyNameSet cu)); + pervasiveStaticVE := + bindTopInEnv (!pervasiveStaticVE) (#uVarEnv cu); + pervasiveStaticTE := + bindTopInEnv (!pervasiveStaticTE) (#uTyEnv cu); + pervasiveStaticME := + bindTopInEnv (!pervasiveStaticME) (#uModEnv cu); + pervasiveStaticFE := + bindTopInEnv (!pervasiveStaticFE) (#uFunEnv cu); + pervasiveStaticGE := + bindTopInEnv (!pervasiveStaticGE) (#uSigEnv cu) + end) + pervasiveOpenedUnits +); + +(* Find and mention a signature *) + +fun findAndMentionSig loc uname = + let val cu = findSig loc uname in + (case !(#uStamp cu) of + NONE => () + | SOME stamp => + let val mentions = #uMentions (!currentSig) in + ignore(Hasht.find mentions uname) + handle Subscript => Hasht.insert mentions uname stamp + end); + cu + end; + +val initialInfixBasis = ref (NILenv : InfixBasis); +val initialStaticT = ref ([]:TyNameSet); +val initialStaticVE = ref (NILenv : VarEnv); +val initialStaticTE = ref (NILenv : TyEnv); +val initialStaticME = ref (NILenv : ModEnv); +val initialStaticFE = ref (NILenv : FunEnv); +val initialStaticGE = ref (NILenv : SigEnv); + +fun initInitialEnvironments context = +( initialInfixBasis := !pervasiveInfixBasis; + initialStaticT := !pervasiveStaticT; + initialStaticVE := !pervasiveStaticVE; + initialStaticTE := !pervasiveStaticTE; + initialStaticME := !pervasiveStaticME; + initialStaticFE := !pervasiveStaticFE; + initialStaticGE := !pervasiveStaticGE; + List.app + (fn uname => + let val cu = findAndMentionSig nilLocation uname in + initialInfixBasis := bindTopInEnv (!initialInfixBasis) (#uIBas cu); + initialStaticT := (!initialStaticT) @ (!(#uTyNameSet cu)); + initialStaticTE := bindTopInEnv (!initialStaticTE) (#uTyEnv cu); + initialStaticVE := bindTopInEnv (!initialStaticVE) (#uVarEnv cu); + initialStaticME := bindTopInEnv (!initialStaticME) (#uModEnv cu); + initialStaticFE := bindTopInEnv (!initialStaticFE) (#uFunEnv cu); + initialStaticGE := bindTopInEnv (!initialStaticGE) (#uSigEnv cu) + end) + (!preopenedPreloadedUnits); + List.app + (fn filename => + let val cu = readAndMentionSig filename in + case #uMode cu of + STRmode => + let val id = !(#uIdent cu) + val T = !(tyNameSetOfSig cu) + in + (case !(strOptOfSig cu) of + NONE => () + | SOME RS => + (initialStaticGE := + bindInEnv (!initialStaticGE) + id + {qualid = {qual = "",id=[id]}, + info = (LAMBDAsig (T, + STRmod RS))})); + initialStaticT := (!initialStaticT) @ T; + initialStaticME := + bindInEnv (!initialStaticME) + id + {qualid = {qual = #uName cu,id=[]}, + info = NONrec (STRstr(mk1TopEnv (modEnvOfSig cu), + mk1TopEnv(funEnvOfSig cu), + mk1TopEnv(sigEnvOfSig cu), (* should be NILenv *) + mk1TopEnv(tyEnvOfSig cu), + mk1TopEnv(varEnvOfSig cu)))} + end + | TOPDECmode => + (initialInfixBasis := bindTopInEnv (!initialInfixBasis) (#uIBas cu); + initialStaticT := (!initialStaticT) @ (!(#uTyNameSet cu)); + initialStaticTE := bindTopInEnv (!initialStaticTE) (#uTyEnv cu); + initialStaticVE := bindTopInEnv (!initialStaticVE) (#uVarEnv cu); + initialStaticME := bindTopInEnv (!initialStaticME) (#uModEnv cu); + initialStaticFE := bindTopInEnv (!initialStaticFE) (#uFunEnv cu); + initialStaticGE := bindTopInEnv (!initialStaticGE) (#uSigEnv cu)) + end) + context +); + +fun extendInitialSigEnv (SOME ({uMode = STRmode, + uIdent = ref id, + uTyNameSet = ref T, + uStrOpt = ref (SOME RS), + ...}:CSig)) = + (initialStaticGE := bindInEnv (!initialStaticGE) + id + {qualid = {qual = "",id=[id]}, + info = (LAMBDAsig (T,STRmod RS))}) +| extendInitialSigEnv _ = (); + + + +(* To put aside the current toplevel unit while compiling another unit. *) + +fun protectCurrentUnit fct = + let + val saved_currentSigTable = !currentSigTable + val saved_currentSig = !currentSig + val saved_currentTypeStamp = !currentTypeStamp + val saved_currentExcStamp = !currentExcStamp + val saved_currentValStamp = !currentValStamp + val saved_currentRenEnv = !currentRenEnv + val saved_InfixBasis = !initialInfixBasis + val saved_initialStaticT = !initialStaticT + val saved_initialStaticVE = !initialStaticVE + val saved_initialStaticTE = !initialStaticTE + val saved_initialStaticME = !initialStaticME + val saved_initialStaticFE = !initialStaticFE + val saved_initialStaticGE = !initialStaticGE + in + ( + fct(); + currentSigTable := saved_currentSigTable; + currentSig := saved_currentSig; + currentTypeStamp := saved_currentTypeStamp; + currentExcStamp := saved_currentExcStamp; + currentValStamp := saved_currentValStamp; + currentRenEnv := saved_currentRenEnv; + initialInfixBasis := saved_InfixBasis; + initialStaticT := saved_initialStaticT; + initialStaticVE := saved_initialStaticVE; + initialStaticTE := saved_initialStaticTE; + initialStaticME := saved_initialStaticME; + initialStaticFE := saved_initialStaticFE; + initialStaticGE := saved_initialStaticGE + ) + handle x => + ( + currentSigTable := saved_currentSigTable; + currentSig := saved_currentSig; + currentTypeStamp := saved_currentTypeStamp; + currentExcStamp := saved_currentExcStamp; + currentValStamp := saved_currentValStamp; + currentRenEnv := saved_currentRenEnv; + initialInfixBasis := saved_InfixBasis; + initialStaticT := saved_initialStaticT; + initialStaticVE := saved_initialStaticVE; + initialStaticTE := saved_initialStaticTE; + initialStaticME := saved_initialStaticME; + initialStaticFE := saved_initialStaticFE; + initialStaticGE := saved_initialStaticGE; + raise x + ) + end; + +fun currentUnitName() = + #uName(!currentSig) +; + + +fun mkGlobalName id = + { qual = #uName(!currentSig), id = [id] } +; + +fun isUnitName {qual, id} = id = []; + +fun isGlobalName {qual, id} = not(qual = currentUnitName() orelse qual = ""); + +fun mkLocalName id = + { qual = "", id = [id]} +; +fun mkName onTop = + if onTop then mkGlobalName else mkLocalName; +; +fun mkGlobalInfo id info = + { qualid = mkGlobalName id, info = info } +; + +fun mkUniqueGlobalName (id, stamp) = + ({ qual = #uName(!currentSig), id = [id] }, stamp) +; + +fun newTypeStamp() = +( + incr currentTypeStamp; + !currentTypeStamp +); + +fun newTyNameStamp() = +( + incr currentTypeStamp; + (currentUnitName (),!currentTypeStamp) +); + +fun newExcStamp() = +( + incr currentExcStamp; + !currentExcStamp +); + +fun newValStamp() = +( + incr currentValStamp; + !currentValStamp +); + +(* Additions to the unit being compiled *) + +fun add_global_info sel_fct id info = + let val tbl = sel_fct (!currentSig) in + Hasht.insert tbl id info + end +; + +(* cvr: modified to set local to global qualifiers *) +fun add_qualified_info sel_fct i (info as {qualid = {qual,id},info = info'}) = + let val tbl = sel_fct (!currentSig) in + if qual = "" orelse qual = currentUnitName() + then Hasht.insert tbl i {qualid={qual = currentUnitName(), id = id}, info = info'} + else Hasht.insert tbl i info + end +; + + +val add_InfixBasis = add_global_info iBasOfSig +and add_VarEnv = add_qualified_info varEnvOfSig +and add_TyEnv = add_global_info tyEnvOfSig +and add_ModEnv = add_qualified_info modEnvOfSig +and add_FunEnv = add_qualified_info funEnvOfSig +and add_SigEnv = add_qualified_info sigEnvOfSig +; + +(* Additions to the unit being compiled *) +(* without redefining names that are already bound! *) + +(* cvr: these functions should all be redundant now that + signature elaboration is done properly *) + +fun extend_InfixBasis id info = + let val tbl = iBasOfSig (!currentSig) in + (ignore (Hasht.find tbl id); + msgIBlock 0; + errPrompt "The fixity status of "; + msgString id; msgString " cannot be redefined in a signature."; + msgEOL(); + msgEBlock(); + raise Toplevel) + handle Subscript => + (* Hasht.insert tbl id info *) + add_InfixBasis id info + end; + +fun extend_VarEnv id info = + let val tbl = varEnvOfSig (!currentSig) in + (ignore (Hasht.find tbl id); + msgIBlock 0; + errPrompt "Value identifier "; + msgString id; msgString " cannot be redefined in a signature."; + msgEOL(); + msgEBlock(); + raise Toplevel) + handle Subscript => + (* Hasht.insert tbl id info *) + add_VarEnv id info + end; + +fun extend_TyEnv id info = + let val tbl = tyEnvOfSig (!currentSig) in + (ignore (Hasht.find tbl id); + msgIBlock 0; + errPrompt "Type constructor "; + msgString id; msgString " cannot be redefined in a signature."; + msgEOL(); + msgEBlock(); + raise Toplevel) + handle Subscript => + Hasht.insert tbl id info + end; + +fun extend_ModEnv id info = + let val tbl = modEnvOfSig (!currentSig) in + (ignore (Hasht.find tbl id); + msgIBlock 0; + errPrompt "Module identifier "; + msgString id; msgString " cannot be redefined in a signature."; + msgEOL(); + msgEBlock(); + raise Toplevel) + handle Subscript => + (* Hasht.insert tbl id info *) + add_ModEnv id info + end; + +fun extend_FunEnv id info = + let val tbl = funEnvOfSig (!currentSig) in + (ignore (Hasht.find tbl id); + msgIBlock 0; + errPrompt "Functor identifier "; + msgString id; msgString " cannot be redefined in a signature."; + msgEOL(); + msgEBlock(); + raise Toplevel) + handle Subscript => + (* Hasht.insert tbl id info *) + add_FunEnv id info + end; + +fun extend_SigEnv id info = + let val tbl = sigEnvOfSig (!currentSig) in + (ignore (Hasht.find tbl id); + msgIBlock 0; + errPrompt "Signature identifier"; + msgString id; msgString " cannot be redefined in a signature."; + msgEOL(); + msgEBlock(); + raise Toplevel) + handle Subscript => + (* Hasht.insert tbl id info *) + add_SigEnv id info + end; + + +(* We have to compare the whole qualids, because in exported *) +(* TyNames all stamps are reset to 0. Therefore, different *) +(* exported TyNames may have equal stamps. *) + +fun isEqTN (tn1 : TyName) (tn2 : TyName) = + (* #qualid tn1 = #qualid tn2 andalso*) + #tnStamp (!(#info tn1)) = #tnStamp (!(#info tn2)) +; + +fun updateCurrentInfixBasis iBas = + traverseEnv add_InfixBasis (revEnv iBas) +; + + +(* cvr: added *) +local +fun updateTyName ({qualid,info}:TyName) = + let val { tnStamp, + tnKind, + tnEqu, + tnSort, + tnLevel, + tnConEnv} = !info in + info := {tnStamp=tnStamp, + tnKind=tnKind, + tnEqu=tnEqu, + tnSort=tnSort, + tnLevel=0, (* update the level *) + tnConEnv = tnConEnv} + end; +in +fun updateCurrentStaticT T = + (app updateTyName T; + tyNameSetOfSig (!currentSig) := (!(tyNameSetOfSig (!currentSig))) @ T) +end; + +fun extendCurrentStaticS S = + let val strOpt = strOptOfSig (!currentSig) + in (* cvr: TODO check for duplicate specs? *) + strOpt := (case !strOpt of + NONE => SOME (NONrec S) + | SOME (NONrec S') => SOME (NONrec (SEQstr (S',S))) + | SOME (RECrec _) => fatalError "extendCurrentStaticS") + end; + +fun extendCurrentStaticIBas iBas = + traverseEnv extend_InfixBasis (revEnv iBas) +; + +fun extendCurrentStaticVE VE = + traverseEnv extend_VarEnv (revEnv VE) +; + +fun updateCurrentStaticVE VE = + traverseEnv add_VarEnv (revEnv VE) +; + +fun updateCurrentStaticTE TE = + traverseEnv add_TyEnv (revEnv TE) +; + +fun extendCurrentStaticTE TE = + traverseEnv extend_TyEnv (revEnv TE) +; + +fun extendCurrentStaticME ME = + traverseEnv extend_ModEnv (revEnv ME) +; + +fun updateCurrentStaticME ME = + traverseEnv add_ModEnv (revEnv ME) +; + +fun extendCurrentStaticFE FE = + traverseEnv extend_FunEnv (revEnv FE) +; + +fun updateCurrentStaticFE FE = + traverseEnv add_FunEnv (revEnv FE) +; + +fun extendCurrentStaticGE GE = + traverseEnv extend_SigEnv (revEnv GE) +; + +fun updateCurrentStaticGE GE = + traverseEnv add_SigEnv (revEnv GE) +; + +(* +fun mkGlobalInfixBasis() = + bindTopInEnv pervasiveInfixBasis (!currentInfixBasis) +; +*) + +fun mkGlobalInfixBasis() = + bindTopInEnv (!initialInfixBasis) (#uIBas (!currentSig)); +; + +fun mkGlobalT() = (!initialStaticT) @ (!(#uTyNameSet (!currentSig))) + +fun mkGlobalVE() = + bindTopInEnv (!initialStaticVE) (#uVarEnv (!currentSig)) +; + +fun mkGlobalTE() = + bindTopInEnv (!initialStaticTE) (#uTyEnv (!currentSig)) +; + + +fun mkGlobalME() = + bindTopInEnv (!initialStaticME) (#uModEnv (!currentSig)) +; +fun mkGlobalFE() = + bindTopInEnv (!initialStaticFE) (#uFunEnv (!currentSig)) +; +fun mkGlobalGE() = + bindTopInEnv (!initialStaticGE) (#uSigEnv (!currentSig)) +; + +fun execToplevelOpen loc uname = + let val cu = findAndMentionSig loc uname in + updateCurrentInfixBasis (mk1TopEnv (#uIBas cu)); + updateCurrentStaticT (!(#uTyNameSet cu)); + updateCurrentStaticVE (mk1TopEnv (#uVarEnv cu)); + updateCurrentStaticTE (mk1TopEnv (#uTyEnv cu)); + updateCurrentStaticME (mk1TopEnv (#uModEnv cu)); + updateCurrentStaticFE (mk1TopEnv (#uFunEnv cu)); + updateCurrentStaticGE (mk1TopEnv (#uSigEnv cu)) + end; + +fun print_qual "" = () + | print_qual qual = (msgString qual; msgString "."); + +fun print_id [] = () + | print_id [i] = msgString i + | print_id (i::id) = + (print_id id; msgString "." ; msgString i); + +fun printHiddenId id = + (msgString "?{"; print_id id; msgString "}") +; +(* cvr: revise printVQ to deal with real long ids*) + +fun printVQ q = + let val {qual, id} = q + fun printHidden() = + if qual <> #uName(!currentSig) then + (print_qual qual; + print_id id) + else + printHiddenId id + in + (if #qual(#qualid (lookupEnv (mkGlobalVE()) (hd id))) = qual then + print_id id + else + printHidden()) + handle Subscript => + printHidden() + end; + + +(* cvr: TODO see above *) + +fun mkInfixBasis() = (Hasht.new 13 : (string, InfixStatus) Hasht.t); +fun mkRenEnv() = (Hasht.new 113 : (string, int) Hasht.t); + +fun startCompilingUnit uname uident umode = +( + currentSigTable := mkSigTable(); + currentSig := newSig uname uident umode; + currentInfixBasis := mkInfixBasis(); + currentTypeStamp := 0; + currentExcStamp := 0; + currentValStamp := 0; + currentRenEnv := mkRenEnv() +); + +fun rectifyVarEnv VE = + let + val excRen = ref( [] : (QualifiedIdent * (QualifiedIdent * int)) list ) + in + (* Hasht.apply (fn id => fn {qualid, info = (sc,status)} => + case status of + EXNname ei => + (case #exconTag(!ei) of + NONE => () + | SOME (name, stamp) => + if #qual(qualid) = #uName(!currentSig) then + excRen := (qualid, (name, stamp)) :: !excRen + else () + ) + | _ => ()) + VE; *) + (!excRen) + end; + + +fun rectifySignature() = + let + val excRenList = rectifyVarEnv (#uVarEnv(!currentSig)) + val valRenList = + foldEnv (fn id => fn stamp => fn acc => (id,stamp)::acc) + [] (mk1TopEnv (!currentRenEnv)) + in + currentRenEnv := dummyRenEnv; + (excRenList, valRenList) + end; + + + + + + + + + + + + + + + + + + + + + diff -Nru mosml-2.01/src/compiler.cminusminus/Wpp.sig mosml-2.10.1/src/compiler.cminusminus/Wpp.sig --- mosml-2.01/src/compiler.cminusminus/Wpp.sig 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Wpp.sig 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,43 @@ +(* A Pretty Printer, based on Philip Wadler's "A prettier printer". + But heavily modified to be efficient in a strict language. + http://cm.bell-labs.com/cm/cs/who/wadler/topics/recent.html + + Copyright 1997, 1998, 1999, 2000, 2001 Ken Friis Larsen + + This code is released under GNU LGPL version 2 or any later after + your choice, the licence can be obtained at + http://www.gnu.org/copyleft/lgpl.html +*) +signature Wpp = + sig + type doc + val empty : doc + val break : int -> int -> doc + val line : doc + val newline : doc (* force a new line *) + + val group : doc -> doc + val nest : int -> doc -> doc + val text : string -> doc + val ^^ : doc * doc -> doc + + (* derived functions *) + val concat : doc list -> doc + val seq : doc -> ('a -> doc) -> 'a list -> doc + + (* Simple converters*) + val fromConv : ('a -> string) -> 'a -> doc + val int : int -> doc (* an integer *) + val char : char -> doc (* an ML character *) + val word : word -> doc (* an ML word constant *) + val word8 : word8 -> doc (* an ML word constant *) + val real : real -> doc (* an ML real constant *) + val bool : bool -> doc (* a boolean *) + + + val toString : int -> doc -> string + val toOutStream : int -> TextIO.outstream -> doc -> unit + val toFile : int -> string -> doc -> unit + val toConsumer : int -> ('a -> string -> 'a) -> 'a -> doc -> 'a + end + diff -Nru mosml-2.01/src/compiler.cminusminus/Wpp.sml mosml-2.10.1/src/compiler.cminusminus/Wpp.sml --- mosml-2.01/src/compiler.cminusminus/Wpp.sml 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/compiler.cminusminus/Wpp.sml 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,137 @@ +(* A Pretty Printer, based on Philip Wadler's "A prettier printer". + But heavily modified to be efficient in a strict language. + http://cm.bell-labs.com/cm/cs/who/wadler/topics/recent.html + + Copyright 1997, 1998, 1999, 2000, 2001 Ken Friis Larsen + + This code is released under GNU LGPL version 2 or any later after + your choice, the licence can be obtained at + http://www.gnu.org/copyleft/lgpl.html +*) +structure Wpp :> Wpp = +struct + infixr 6 ^^ + + datatype doc = + NIL + | APPEND of doc * doc + | NEST of int * doc + | TEXT of string + | BREAK of int * int + | NEWLINE + | GROUP of doc + + fun op^^ p = case p of + (NIL,NIL) => NIL + | (NIL, y) => y + | (x, NIL) => x + | _ => APPEND p + + val empty = NIL + fun nest i x = NEST(i,x) + val text = TEXT + fun break sp off = BREAK(sp, off) + val line = BREAK (1,0) + val newline = NEWLINE + fun group x = GROUP x + + (*** Derived functions ***) + val concat = List.foldr op^^ empty + fun seq sep ppr xs = + let fun iter nil acc = acc + | iter [x] acc = acc ^^ ppr x + | iter (x::xs) acc = iter xs (acc ^^ ppr x ^^ sep) + in iter xs empty + end + + fun fromConv conv x = text(conv x) + val int = fromConv Int.toString + val char = fromConv Char.toString + val word = fromConv Word.toString + val word8 = fromConv Word8.toString + val real = fromConv Real.toString + fun bool b = if b then text "true" else text "false" + + + + (*** Formating of docs ***) + + val nlsize = String.size "\n" + fun spaces outs s i = outs s (StringCvt.padLeft #" " i "") + fun nlspace outs s i = outs s (StringCvt.padRight #" " (i+nlsize) "\n") + + local + datatype mode = Flat | Break + + fun fitting [] left = true + | fitting ((i, mode, doc) :: rest) left = + if left >= 0 + then case doc of + NIL => fitting rest left + | APPEND(x,y) => fitting ((i,mode,x)::(i,mode,y)::rest) left + | NEST(j,x) => fitting ((i+j, mode, x) :: rest) left + | TEXT s => fitting rest (left - String.size s) + | BREAK(sp,_) => (case mode of + Flat => fitting rest (left - sp) + | Break => true) + | NEWLINE => true + | GROUP x => fitting ((i,mode,x) :: rest) left + else false + in + (* w : linewidth + outs : function to output a string + s : state for outs + k : number of chars already used on current line + i : indent after linebreaks + *) + fun best w outs s x = + let fun be s k [] = s + | be s k ((i, mode, doc) :: rest) = + case doc of + NIL => be s k rest + | APPEND(x,y) => be s k ((i,mode,x)::(i,mode,y)::rest) + | NEST(j,x) => be s k ((i+j, mode, x):: rest) + | TEXT str => let val s = outs s str + in be s (k+String.size str) rest end + | NEWLINE => let val s = nlspace outs s i + in be s i rest end + | BREAK(sp,off) => + (case mode of + Flat => let val s = spaces outs s sp + in be s (k+sp) rest end + | Break => let val s = nlspace outs s (i+off) + in be s (i+off) rest end) + | GROUP x => + (case mode of + Flat => be s k ((i,Flat,x) :: rest) + | Break => + if fitting ((i,Flat,x)::rest) (w - k) + then be s k ((i,Flat,x)::rest) + else be s k ((i,Break,x)::rest)) + in be s 0 [(0,Break,x)] + end + end + + fun toOutStream w outstream doc = + let fun outs () s = TextIO.output(outstream, s) + in best w outs () doc + ; outs () "\n" + ; TextIO.flushOut outstream + end + + fun toFile w filename doc = + let val dev = TextIO.openOut filename + in (toOutStream w dev doc) handle ? => (TextIO.closeOut dev; raise ?) + ; TextIO.closeOut dev + end + + fun toString w doc = + let fun outs strs s = s :: strs + val strs = best w outs [] doc + in String.concat (List.rev ("\n" :: strs)) + end + + val toConsumer = best +end + + diff -Nru mosml-2.01/src/config/autoconf mosml-2.10.1/src/config/autoconf --- mosml-2.01/src/config/autoconf 2000-01-26 16:35:17.000000000 +0000 +++ mosml-2.10.1/src/config/autoconf 2014-08-28 08:47:22.000000000 +0000 @@ -2,7 +2,7 @@ case $1 in "") cc=cc;; - *) cc=$1;; + *) cc="$@";; esac export cc diff -Nru mosml-2.01/src/config/.gitignore mosml-2.10.1/src/config/.gitignore --- mosml-2.01/src/config/.gitignore 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/config/.gitignore 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1 @@ +/defs.h diff -Nru mosml-2.01/src/config/Makefile mosml-2.10.1/src/config/Makefile --- mosml-2.01/src/config/Makefile 2000-02-16 15:36:57.000000000 +0000 +++ mosml-2.10.1/src/config/Makefile 2014-08-28 08:47:22.000000000 +0000 @@ -1,11 +1,22 @@ include ../Makefile.inc -all: - @echo "Run 'sh autoconf' or 'sh autoconf gcc' or ..." +all: defs.h runtime + +defs.h: + @echo "#define VERSION $(VERSION)" > defs.h + @echo "#define VERSION_S \"$(VERSION)\"" >> defs.h + @echo "#define DYNLIBSUPPORT $(DYNLIBSUPPORT)" >> defs.h + @echo "#define DYNLIBSUPPORT_S \"$(DYNLIBSUPPORT)\"" >> defs.h + +.PHONY: runtime w32 +runtime: + sh autoconf $(CC) + $(INSTALL_DATA) m.h s.h ../runtime +w32: + $(INSTALL_DATA) ../config.w32/m.h ../runtime + $(INSTALL_DATA) ../config.w32/s.h ../runtime -install: - $(INSTALL_PROGRAM) m.h s.h $(INCDIR) clean scratch: - rm -f m.h s.h + rm -f m.h s.h defs.h cd auto-aux; rm -f *.o a.out diff -Nru mosml-2.01/src/config.w32/s.h mosml-2.10.1/src/config.w32/s.h --- mosml-2.01/src/config.w32/s.h 2000-01-21 10:07:13.000000000 +0000 +++ mosml-2.10.1/src/config.w32/s.h 2014-08-28 08:47:22.000000000 +0000 @@ -1,11 +1,23 @@ #define HAS_MEMMOVE #define HAS_BCOPY +#define HAS__SETJMP #define sighandler_return_type void /* #define BSD_SIGNALS */ #define HAS_RENAME -/* #define HAS_UTIMES */ +#define HAS_STRERROR +#define HAS_SOCKETS +#define HAS_UNISTD +#define HAS_DIRENT +#define HAS_LOCKF +#define HAS_MKFIFO +#define HAS_GETPRIORITY +#define HAS_UTIME +#define HAS_UTIMES #define HAS_DUP2 +#define HAS_FCHMOD +#define HAS_TRUNCATE #define HAS_SELECT /* #define HAS_SYMLINK */ +/* #define HAS_WAIT3 */ /* #define HAS_WAITPID */ -#define HAS__SETJMP +/* #define HAS_TERMIOS */ diff -Nru mosml-2.01/src/convert/GenPm.sml mosml-2.10.1/src/convert/GenPm.sml --- mosml-2.01/src/convert/GenPm.sml 2000-07-19 15:54:48.000000000 +0000 +++ mosml-2.10.1/src/convert/GenPm.sml 2014-08-28 08:47:22.000000000 +0000 @@ -4,7 +4,7 @@ Based on Peter Sestoft's mosmldep tool, first modified for Holmake, then for moscm, and finally(?) for this purpose. - Last modified: $Date: 2000/07/19 15:54:48 $ by $Author: kla $ + Last modified: $Date: 2000-07-19 15:54:48 $ by $Author: kla $ DOES NOT normalizes file names under DOS. (yet) Binary files /tmp/HAzJFmIrvn/mosml-2.01/src/cutdeps and /tmp/A1vl5z0ZBv/mosml-2.10.1/src/cutdeps differ Binary files /tmp/HAzJFmIrvn/mosml-2.01/src/cutdeps.w32 and /tmp/A1vl5z0ZBv/mosml-2.10.1/src/cutdeps.w32 differ diff -Nru mosml-2.01/src/doc/.gitignore mosml-2.10.1/src/doc/.gitignore --- mosml-2.01/src/doc/.gitignore 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/doc/.gitignore 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,16 @@ +*.bbl +*.blg +*.dvi +*.log +*.aux +*.toc +*.idx +*.ilg +*.ind +*.out +index.tex +manual.ps +mosmllib.ps +mosmllib2up.ps +mosmlref.ps +texsigsigs.tex diff -Nru mosml-2.01/src/doc/helpsigs/Asynt.sml mosml-2.10.1/src/doc/helpsigs/Asynt.sml --- mosml-2.01/src/doc/helpsigs/Asynt.sml 2000-05-17 10:21:35.000000000 +0000 +++ mosml-2.10.1/src/doc/helpsigs/Asynt.sml 2014-08-28 08:47:22.000000000 +0000 @@ -11,7 +11,7 @@ type QualifiedIdent = { - id: string, + id: string list, qual: string }; diff -Nru mosml-2.01/src/doc/helpsigs/.gitignore mosml-2.10.1/src/doc/helpsigs/.gitignore --- mosml-2.01/src/doc/helpsigs/.gitignore 1970-01-01 00:00:00.000000000 +0000 +++ mosml-2.10.1/src/doc/helpsigs/.gitignore 2014-08-28 08:47:22.000000000 +0000 @@ -0,0 +1,8 @@ +# Files derived from .lex and .grm files +*.ui +*.uo +Lexer.sml +Parser.sig +Parser.sml +index.txt +makebase Binary files /tmp/HAzJFmIrvn/mosml-2.01/src/doc/helpsigs/helpsigs.val and /tmp/A1vl5z0ZBv/mosml-2.10.1/src/doc/helpsigs/helpsigs.val differ diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/AppleScript.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/AppleScript.html --- mosml-2.01/src/doc/helpsigs/htmlsigs/AppleScript.html 2000-08-02 13:05:32.000000000 +0000 +++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/AppleScript.html 2014-08-28 08:47:22.000000000 +0000 @@ -6,24 +6,24 @@ Structure index 

-(* AppleScript -- Apple MacOS scripting *)
-
-type OSAID
-type OSAerr = int
-
-exception AppleScriptErr of OSAerr * string
-
-val as_compile    : string -> OSAID
-val as_dispose    : OSAID -> unit
-val as_run_script : OSAID -> string
-val as_run_text   : string -> string
-
-(*
-   These Mac specific functions provide the capability to compile 
-   and run AppleScript programs.
-
-   The exception AppleScriptErr is raised in the event of an error.
-
+(* AppleScript -- Apple MacOS scripting *)
+
+type OSAID
+type OSAerr = int
+
+exception AppleScriptErr of OSAerr * string
+
+val as_compile    : string -> OSAID
+val as_dispose    : OSAID -> unit
+val as_run_script : OSAID -> string
+val as_run_text   : string -> string
+
+(*
+   These Mac specific functions provide the capability to compile 
+   and run AppleScript programs.
+
+   The exception AppleScriptErr is raised in the event of an error.
+
    [as_compile str] compiles AppleScript source code text, returning
    an abstract token of type OSAID. This token may be used to run
    the script. The token may be used repeatedly until it is returned
@@ -54,4 +54,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Array2.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Array2.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Array2.html	2000-08-02 13:05:32.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Array2.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,42 +6,42 @@
 Structure index
 

 
-(* Array2 -- SML Basis Library *)
-
-eqtype 'a array
-
-datatype traversal = RowMajor | ColMajor
-
-val array      : int * int * '_a -> '_a array
-val fromList   : '_a list list -> '_a array
-val tabulate   : traversal -> int * int * (int * int -> '_a) -> '_a array
-
-val dimensions : 'a array -> int * int
-val nCols      : 'a array -> int
-val nRows      : 'a array -> int
-
-val sub        : 'a array * int * int -> 'a
-val update     : 'a array * int * int * 'a -> unit
-
-val row        : 'a array * int -> 'a Vector.vector
-val column     : 'a array * int -> 'a Vector.vector
-
-type 'a region = { base : 'a array, row : int, col : int, 
-                   nrows : int option, ncols : int option}
-
-val copy       : { src : 'a region, dst : 'a array, 
-                   dst_row : int, dst_col : int } -> unit
-
-val app        : traversal -> ('a -> unit) -> 'a array -> unit
-val modify     : traversal -> ('a -> 'a) -> 'a array -> unit
-val fold       : traversal -> ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
-
-val appi       : traversal -> (int * int * 'a -> unit) -> 'a region -> unit
-val modifyi    : traversal -> (int * int * 'a -> 'a) -> 'a region -> unit
-val foldi      : traversal -> (int * int * 'a * 'b -> 'b) -> 'b 
-                 -> 'a region -> 'b
-
-(* 
+(* Array2 -- SML Basis Library *)
+
+eqtype 'a array
+
+datatype traversal = RowMajor | ColMajor
+
+val array      : int * int * '_a -> '_a array
+val fromList   : '_a list list -> '_a array
+val tabulate   : traversal -> int * int * (int * int -> '_a) -> '_a array
+
+val dimensions : 'a array -> int * int
+val nCols      : 'a array -> int
+val nRows      : 'a array -> int
+
+val sub        : 'a array * int * int -> 'a
+val update     : 'a array * int * int * 'a -> unit
+
+val row        : 'a array * int -> 'a Vector.vector
+val column     : 'a array * int -> 'a Vector.vector
+
+type 'a region = { base : 'a array, row : int, col : int, 
+                   nrows : int option, ncols : int option}
+
+val copy       : { src : 'a region, dst : 'a array, 
+                   dst_row : int, dst_col : int } -> unit
+
+val app        : traversal -> ('a -> unit) -> 'a array -> unit
+val modify     : traversal -> ('a -> 'a) -> 'a array -> unit
+val fold       : traversal -> ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
+
+val appi       : traversal -> (int * int * 'a -> unit) -> 'a region -> unit
+val modifyi    : traversal -> (int * int * 'a -> 'a) -> 'a region -> unit
+val foldi      : traversal -> (int * int * 'a * 'b -> 'b) -> 'b 
+                 -> 'a region -> 'b
+
+(* 
    ['ty array] is the type of two-dimensional, mutable, zero-based
    constant-time-access arrays with elements of type 'ty.  
    Type 'ty array admits equality even if 'ty does not.  Arrays a1 and a2 
@@ -198,4 +198,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Array.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Array.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Array.html	2000-08-02 13:05:32.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Array.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,9 +6,10 @@
 Structure index
 

 
-(* Array -- SML Basis Library *)
-
-prim_EQtype 'a array
+(* Array -- SML Basis Library *)
+
+prim_EQtype 'a array
+type 'a vector = 'a Vector.vector
 
 val maxLen   : int
 
@@ -19,46 +20,37 @@
 val length   : 'a array -> int
 val sub      : 'a array * int -> 'a
 val update   : 'a array * int * 'a  -> unit
-val extract  : 'a array * int * int option -> 'a Vector.vector
+val vector   : 'a array -> 'a vector
 
-val copy     : {src: 'a array,  si: int, len: int option,
-                dst: 'a array, di: int} -> unit
-val copyVec  : {src: 'a vector, si: int, len: int option, 
-                dst: 'a array, di: int} -> unit
-
-val app      : ('a -> unit) -> 'a array -> unit
-val foldl    : ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
-val foldr    : ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
-val modify   : ('a -> 'a) -> 'a array -> unit
-
-val appi     : (int * 'a -> unit) -> 'a array * int * int option -> unit
-val foldli   : (int * 'a * 'b -> 'b) -> 'b -> 'a array * int * int option -> 'b
-val foldri   : (int * 'a * 'b -> 'b) -> 'b -> 'a array * int * int option -> 'b
-val modifyi  : (int * 'a -> 'a) -> 'a array * int * int option -> unit
-
-(* 
+val copy     : {src: 'a array,  dst: 'a array, di: int} -> unit
+val copyVec  : {src: 'a vector, dst: 'a array, di: int} -> unit
+
+val find     : ('a -> bool) -> 'a array -> 'a option
+val exists   : ('a -> bool) -> 'a array -> bool
+val all      : ('a -> bool) -> 'a array -> bool
+
+val app      : ('a -> unit) -> 'a array -> unit
+val foldl    : ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
+val foldr    : ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
+val modify   : ('a -> 'a) -> 'a array -> unit
+
+val findi    : (int * 'a -> bool) -> 'a array -> (int * 'a) option
+val appi     : (int * 'a -> unit) -> 'a array -> unit
+val foldli   : (int * 'a * 'b -> 'b) -> 'b -> 'a array -> 'b
+val foldri   : (int * 'a * 'b -> 'b) -> 'b -> 'a array -> 'b
+val modifyi  : (int * 'a -> 'a) -> 'a array -> unit
+
+val collate  : ('a * 'a -> order) -> 'a array * 'a array -> order
+
+(* 
    ['ty array] is the type of one-dimensional, mutable, zero-based
    constant-time-access arrays with elements of type 'ty.  Type 
    'ty array admits equality even if 'ty does not.  Arrays a1 and a2 
    are equal if both were created by the same call to a primitive
    (array, tabulate, fromList).
 
-   Some functions work on a *slice* of an array:
-
-   The slice (a, i, SOME n) denotes the subarray a[i..i+n-1].  That is,
-   a[i] is the first element of the slice, and n is the length of the
-   slice.  Valid only if 0 <= i <= i+n <= length a.
-
-   The slice (a, i, NONE) denotes the subarray a[i..length a-1].  That
-   is, the slice denotes the suffix of the array starting at i.  Valid
-   only if 0 <= i <= length a.  Equivalent to (a, i, SOME(length a - i)).
-
-       slice             meaning 
-       ----------------------------------------------------------
-       (a, 0, NONE)      the whole array              a[0..len-1]   
-       (a, 0, SOME n)    a left subarray (prefix)     a[0..n-1]
-       (a, i, NONE)      a right subarray (suffix)    a[i..len-1]
-       (a, i, SOME n)    a general slice              a[i..i+n-1] 
+   Functions working on a slices (contiguous subsequence) of an array
+   are found in the ArraySlice structure.
 
    [maxLen] is the maximal number of elements in an array.
 
@@ -82,30 +74,25 @@
    [update(a, i, x)] destructively replaces the i'th element of a by x.
    Raises Subscript if i<0 or i>=length a.
 
-   [extract(a, i, NONE)] returns a vector of the elements a[i..length a-1] 
-   of a.  Raises Subscript if i<0 or i>length a.
-
-   [extract(a, i, SOME len)] returns a vector of the elements a[i..i+len-1] 
-   of a.  Raises Subscript if i<0 or len<0 or i+len>length a or
-   len>Vector.maxLen.
-
-   [copy{src, si, len, dst, di}] destructively copies the slice
-   (src, si, len) to dst, starting at index di.  More precisely:
-   If len=NONE and n=length src, it copies src[si..n-1] to dst[di..di+n-si].
-   If len=SOME k, it copies src[si..si+k-1] to dst[di..di+k-1].  
-   Works also if src and dst are the same and the segments overlap.
-   Raises Subscript if si < 0 or di < 0, 
-   or if len=NONE and di + length src - si > length dst,
-   or if len=SOME k and k < 0 or si + k > length src or di + k > length dst.
-
-   [copyVec{src, si, len, dst, di}] destructively copies the slice
-   (src, si, len) to dst, starting at index di.  More precisely:
-   If len=NONE and n=length src, it copies src[si..n-1] to dst[di..di+n-si].
-   If len=SOME k, it copies src[si..si+k-1] to dst[di..di+k-1].  
-   Works also if src and dst are the same and the segments overlap.
-   Raises Subscript if si < 0 or di < 0, 
-   or if len=NONE and di + length src - si > length dst,
-   or if len=SOME k and k < 0 or si + k > length src or di + k > length dst.
+   [copy{src, dst, di}] destructively copies the array src to dst,
+   starting at index di.  
+   Raises Subscript if di<0, or if di + length src > length dst.
+
+   [copyVec{src, dst, di}] destructively copies the vector to dst,
+   starting at index di.  
+   Raises Subscript if di<0, or if di + Vector.length src > length dst.
+
+   [find p a] applies p to each element x of a, from left to right,
+   until p(x) evaluates to true; returns SOME x if such an x exists,
+   otherwise NONE.
+
+   [exists p a] applies p to each element x of a, from left to right,
+   until p(x) evaluates to true; returns true if such an x exists,
+   otherwise false.
+
+   [all p a] applies p to each element x of a, from left to right,
+   until p(x) evaluates to false; returns false if such an x exists,
+   otherwise true.
 
    [foldl f e a] folds function f over a from left to right.  That is,
    computes f(a[len-1], f(a[len-2], ..., f(a[1], f(a[0], e)) ...)),
@@ -120,49 +107,31 @@
    [modify f a] applies f to a[j] and updates a[j] with the result
    f(a[j]) for j=0,1,...,length a-1. 
 
-   The following iterators generalize the above ones in two ways:
+   The following iterators generalize the above ones by passing also
+   the index j to the function being iterated.
+
+   [findi p a] applies f to successive pairs (j, a[j]) for j=0,1,...,n-1, 
+   until p(j, a[j]) evaluates to true; returns SOME (j, a[j]) if such
+   a pair exists, otherwise NONE.
+
+   [foldli f e a] folds function f over the array from left to right.
+   That is, computes f(n-1, a[n-1], f(..., f(1, a[1], f(0, a[0], e)) ...)).  
+
+   [foldri f e a] folds function f over the array from right to left.  
+   That is, computes f(0, a[0], f(1, a[1], ..., f(n-1, a[n-1], e) ...)).
+
+   [appi f a] applies f to successive pairs (j, a[j]) for j=0,1,...,n-1.  
 
-    . the index j is also being passed to the function being iterated;
-    . the iterators work on a slice (subarray) of an array.
+   [modifyi f a] applies f to (j, a[j]) and updates a[j] with the
+   result f(j, a[j]) for j=0,1,...,n-1.
 
-   [foldli f e (a, i, SOME n)] folds function f over the subarray
-   a[i..i+n-1] from left to right.  That is, computes 
-   f(i+n-1, a[i+n-1], f(..., f(i+1, a[i+1], f(i, a[i], e)) ...)).  
-   Raises Subscript if i<0 or n<0 or i+n > length a.
-
-   [foldli f e (a, i, NONE)] folds function f over the subarray
-   a[i..len-1] from left to right, where len =  length a.  That is, 
-   computes f(len-1, a[len-1], f(..., f(i+1, a[i+1], f(i, a[i], e)) ...)).  
-   Raises Subscript if i<0 or i > length a.
-
-   [foldri f e (a, i, SOME n)] folds function f over the subarray
-   a[i..i+n-1] from right to left.  That is, computes 
-   f(i, a[i], f(i+1, a[i+1], ..., f(i+n-1, a[i+n-1], e) ...)).
-   Raises Subscript if i<0 or n<0 or i+n > length a.
-
-   [foldri f e (a, i, NONE)] folds function f over the subarray
-   a[i..len-1] from right to left, where len = length a.  That is, 
-   computes f(i, a[i], f(i+1, a[i+1], ..., f(len-1, a[len-1], e) ...)).
-   Raises Subscript if i<0 or i > length a.
-
-   [appi f (a, i, SOME n)] applies f to successive pairs (j, a[j]) for
-   j=i,i+1,...,i+n-1.  Raises Subscript if i<0 or n<0 or i+n > length a.
-
-   [appi f (a, i, NONE)] applies f to successive pairs (j, a[j]) for
-   j=i,i+1,...,len-1, where len = length a.  Raises Subscript if i<0
-   or i > length a.
-
-   [modifyi f (a, i, SOME n)] applies f to (j, a[j]) and updates a[j]
-   with the result f(j, a[j]) for j=i,i+1,...,i+n-1.  Raises Subscript
-   if i<0 or n<0 or i+n > length a.
-
-   [modifyi f (a, i, NONE)] applies f to (j, a[j]) and updates a[j]
-   with the result f(j, a[j]) for j=i,i+1,...,len-1.  Raises Subscript
-   if i<0 or i > length a.
+   [collate cmp (xs, ys)] returns LESS, EQUAL or GREATER according as
+   xs precedes, equals or follows ys in the lexicographic ordering on
+   arrays induced by the ordering cmp on elements.  
 *)
 
 

 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/ArraySlice.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/ArraySlice.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/ArraySlice.html	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/ArraySlice.html	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,170 @@
+Structure ArraySlice
+
+
Structure ArraySlice

+

+
Identifier index
+Structure index
+

+
+(* ArraySlice -- SML Basis Library *)
+
+type 'a slice
+
+val length   : 'a slice -> int
+val sub      : 'a slice * int -> 'a
+val update   : 'a slice * int * 'a  -> unit
+val slice    : 'a Array.array * int * int option -> 'a slice
+val full     : 'a Array.array -> 'a slice
+val subslice : 'a slice * int * int option -> 'a slice
+val base     : 'a slice -> 'a Array.array * int * int
+val vector   : 'a slice -> 'a Vector.vector
+val copy     : {src: 'a slice, dst: 'a Array.array, di: int} -> unit
+val copyVec  : {src: 'a VectorSlice.slice, dst: 'a Array.array, di: int} 
+               -> unit 
+val isEmpty  : 'a slice -> bool
+val getItem  : 'a slice -> ('a * 'a slice) option
+
+val find     : ('a -> bool) -> 'a slice -> 'a option
+val exists   : ('a -> bool) -> 'a slice -> bool
+val all      : ('a -> bool) -> 'a slice -> bool
+
+val app      : ('a -> unit) -> 'a slice -> unit
+val foldl    : ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+val foldr    : ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+val modify   : ('a -> 'a) -> 'a slice -> unit
+
+val findi    : (int * 'a -> bool) -> 'a slice -> (int * 'a) option
+val appi     : (int * 'a -> unit) -> 'a slice -> unit
+val foldli   : (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+val foldri   : (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+val modifyi  : (int * 'a -> 'a) -> 'a slice -> unit
+
+val collate  : ('a * 'a -> order) -> 'a slice * 'a slice -> order
+
+(* 
+   ['ty slice] is the type of array slices, that is, sub-arrays.  
+   The slice (a,i,n) is valid if 0 <= i <= i+n <= size s, 
+                or equivalently, 0 <= i and 0 <= n and i+n <= size s.  
+   A valid slice sli = (a,i,n) represents the sub-array a[i...i+n-1],
+   so the elements of sli are a[i], a[i+1], ..., a[i+n-1], and n is
+   the length of the slice.  Only valid slices can be constructed by
+   the functions below.
+
+   [length sli] returns the number n of elements in sli = (s,i,n).
+
+   [sub (sli, k)] returns the k'th element of the slice, that is,
+   a(i+k) where sli = (a,i,n).  Raises Subscript if k<0 or k>=n.
+
+   [update (sli, k, x)] destructively replaces the k'th element of sli
+   by x.  That is, replaces a(k+i) by x, where sli = (a,i,n).  Raises
+   Subscript if i<0 or i>=n.
+
+   [slice (a, i, NONE)] creates the slice (a, i, length a-i),
+   consisting of the tail of a starting at i.  
+   Raises Subscript if i<0 or i > Array.length a.  
+   Equivalent to slice (a, i, SOME(Array.length a - i)).
+
+   [slice (a, i, SOME n)] creates the slice (a, i, n), consisting of
+   the sub-array of a with length n starting at i.  Raises Subscript
+   if i<0 or n<0 or i+n > Array.length a.  
+
+       slice             meaning 
+       ----------------------------------------------------------
+       (a, 0, NONE)      the whole array              a[0..len-1]   
+       (a, 0, SOME n)    a left sub-array (prefix)    a[0..n-1]
+       (a, i, NONE)      a right sub-array (suffix)   a[i..len-1]
+       (a, i, SOME n)    a general slice              a[i..i+n-1] 
+
+   [full a] creates the slice (a, 0, length a).  
+   Equivalent to slice(a,0,NONE)
+
+   [subslice (sli, i', NONE)] returns the slice (a, i+i', n-i') when
+   sli = (a,i,n).  Raises Subscript if i' < 0 or i' > n.
+
+   [subslice (sli, i', SOME n')] returns the slice (a, i+i', n') when
+   sli = (a,i,n).  Raises Subscript if i' < 0 or n' < 0 or i'+n' > n.
+
+   [base sli] is the concrete triple (a, i, n) when sli = (a, i, n).
+
+   [vector sli] creates and returns a vector consisting of the
+   elements of the slice, that is, a[i..i+n-1] when sli = (a,i,n).
+
+   [copy {src, dst, di}] copies the elements of slice src = (a,i,n),
+   that is, a[i..i+n-1], to the destination segment dst[di..di+n-1].
+   Raises Subscript if di<0 or if di+n > length dst.  Works also if
+   the array underlying sli is the same as dst, and the slice overlaps
+   with the destination segment.
+
+   [copyVec {src, dst, di}] copies the elements of the vector slice
+   src = (v,i,n), that is, v[i..i+n-1], to dst[di..di+n-1].  Raises
+   Subscript if di<0, or if len=NONE and di + n > length dst.  
+
+   [isEmpty sli] returns true if the slice sli = (a,i,n) is empty,
+   that is, if n=0.
+
+   [getItem sli] returns SOME(x, rst) where x is the first element and
+   rst the remainder of sli, if sli is non-empty; otherwise returns
+   NONE.  
+
+   [find p sli] applies p to each element x of sli, from left to
+   right, until p(x) evaluates to true; returns SOME x if such an x
+   exists, otherwise NONE.
+
+   [exists p sli] applies p to each element x of sli, from left to right,
+   until p(x) evaluates to true; returns true if such an x exists,
+   otherwise false.
+
+   [all p sli] applies p to each element x of sli, from left to right,
+   until p(x) evaluates to false; returns false if such an x exists,
+   otherwise true.
+
+   [app f sli] applies f to all elements of sli = (a,i,n), from
+   left to right.  That is, applies f to a[j+i] for j=0,1,...,n.
+
+   [foldl f e sli] folds function f over sli = (a,i,n) from left to right.  
+   That is, computes f(a[i+n-1], f(a[i+n-2],..., f(a[i+1], f(a[i], e))...)).
+
+   [foldr f e sli] folds function f over sli = (a,i,n) from right to left.  
+   That is, computes f(a[i], f(a[i+1],..., f(a[i+n-2], f(a[i+n-1], e))...)).
+
+   [modify f sli] modifies the elements of the slice sli = (a,i,n) by
+   function f.  That is, applies f to a[i+j] and updates a[i+j] with
+   the result f(a[i+j]) for j=0,1,...,n.
+
+   The following iterators generalize the above ones by also passing
+   the index into the array a underlying the slice to the function
+   being iterated.
+
+   [findi p sli] applies p to the elements of sli = (a,i,n) and the
+   underlying array indices, and returns the least (j, a[j]) for which
+   p(j, a[j]) evaluates to true, if any; otherwise returns NONE.  That
+   is, evaluates p(j, a[j]) for j=i,..i+n-1 until it evaluates to true
+   for some j, then returns SOME(j, a[j]); otherwise returns NONE.
+
+   [appi f sli] applies f to the slice sli = (a,i,n) and the
+   underlying array indices.  That is, applies f to successive pairs
+   (j, a[j]) for j=i,i+1,...,i+n-1.
+
+   [foldli f e sli] folds function f over the slice sli = (a,i,n) and
+   the underlying array indices from left to right.  That is, computes 
+   f(i+n-1, a[i+n-1], f(..., f(i+1, a[i+1], f(i, a[i], e)) ...)).  
+
+   [foldri f e sli] folds function f over the slice sli = (a,i,n) and
+   the underlying array indices from right to left.  That is, computes
+   f(i, a[i], f(i+1, a[i+1], ..., f(i+n-1, a[i+n-1], e) ...)).
+
+   [modifyi f sli] modifies the elements of the slice sli = (a,i,n) by
+   applying function f to the slice elements and the underlying array
+   indices.  That is, applies f to (j, a[j]) and updates a[j] with the
+   result f(j, a[j]) for j=i,i+1,...,i+n-1.  
+   
+   [collate cmp (sli1, sli2)] returns LESS, EQUAL or GREATER according
+   as sli1 precedes, equals or follows sli2 in the lexicographic
+   ordering on slices induced by the ordering cmp on elements.
+*)
+
+

+
Identifier index
+Structure index
+

+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Arraysort.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Arraysort.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Arraysort.html	2000-08-02 13:05:32.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Arraysort.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,12 +6,12 @@
 Structure index
 

 
-(* Arraysort -- Quicksort for arrays, from SML/NJ library *)
-
-val sort   : ('a * 'a -> order) -> 'a Array.array -> unit
-val sorted : ('a * 'a -> order) -> 'a Array.array -> bool
-
-(* 
+(* Arraysort -- Quicksort for arrays, from SML/NJ library *)
+
+val sort   : ('a * 'a -> order) -> 'a Array.array -> unit
+val sorted : ('a * 'a -> order) -> 'a Array.array -> bool
+
+(* 
    [sort ordr arr] sorts array arr in-place, using ordering relation ordr.
 
    [sorted ordr arr] returns true if the elements of array arr is
@@ -22,4 +22,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/BasicIO.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/BasicIO.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/BasicIO.html	2000-08-02 13:05:32.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/BasicIO.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,37 +6,37 @@
 Structure index
 

 
-(* BasicIO -- non-standard input-output; use BinIO and TextIO instead *)
-
-type instream
-type outstream
-
-val std_in        : instream;
-val open_in       : string -> instream;
-val open_in_bin   : string -> instream;
-val input         : instream * int -> string;
-val inputc        : instream -> int -> string;
-val lookahead     : instream -> string;
-val close_in      : instream -> unit;
-val end_of_stream : instream -> bool;
-
-val std_out       : outstream;
-val std_err       : outstream;
-val open_out      : string -> outstream;
-val open_out_bin  : string -> outstream;
-val output        : outstream * string -> unit;
-val outputc       : outstream -> string -> unit;
-val close_out     : outstream -> unit;
-val flush_out     : outstream -> unit;
-val input_line    : instream -> string;
-val can_input     : instream * int -> bool;
-val open_append   : string -> outstream;
-
-val exit          : int -> 'a
-val print         : string -> unit
-
+(* BasicIO -- non-standard input-output; use BinIO and TextIO instead *)
+
+type instream
+type outstream
+
+val std_in        : instream;
+val open_in       : string -> instream;
+val open_in_bin   : string -> instream;
+val input         : instream * int -> string;
+val inputc        : instream -> int -> string;
+val lookahead     : instream -> string;
+val close_in      : instream -> unit;
+val end_of_stream : instream -> bool;
+
+val std_out       : outstream;
+val std_err       : outstream;
+val open_out      : string -> outstream;
+val open_out_bin  : string -> outstream;
+val output        : outstream * string -> unit;
+val outputc       : outstream -> string -> unit;
+val close_out     : outstream -> unit;
+val flush_out     : outstream -> unit;
+val input_line    : instream -> string;
+val can_input     : instream * int -> bool;
+val open_append   : string -> outstream;
+
+val exit          : int -> 'a
+val print         : string -> unit
+
 

 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Binarymap.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Binarymap.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Binarymap.html	2000-08-02 13:05:32.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Binarymap.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,29 +6,29 @@
 Structure index
 

 
-(* Binarymap -- applicative maps as balanced ordered binary trees *)
-(* From SML/NJ lib 0.2, copyright 1993 by AT&T Bell Laboratories  *)
-(* Original implementation due to Stephen Adams, Southampton, UK  *)
-
-type ('key, 'a) dict
-
-exception NotFound
-
-val mkDict    : ('key * 'key -> order) -> ('key, 'a) dict
-val insert    : ('key, 'a) dict * 'key * 'a -> ('key, 'a) dict
-val find      : ('key, 'a) dict * 'key -> 'a
-val peek      : ('key, 'a) dict * 'key -> 'a option
-val remove    : ('key, 'a) dict * 'key -> ('key, 'a) dict * 'a
-val numItems  : ('key, 'a) dict -> int
-val listItems : ('key, 'a) dict -> ('key * 'a) list
-val app       : ('key * 'a -> unit) -> ('key,'a) dict -> unit
-val revapp    : ('key * 'a -> unit) -> ('key,'a) dict -> unit
-val foldr     : ('key * 'a * 'b -> 'b)-> 'b -> ('key,'a) dict -> 'b
-val foldl     : ('key * 'a * 'b -> 'b) -> 'b -> ('key,'a) dict -> 'b
-val map       : ('key * 'a -> 'b) -> ('key,'a) dict -> ('key, 'b) dict
-val transform : ('a -> 'b) -> ('key,'a) dict -> ('key, 'b) dict
-
-(* 
+(* Binarymap -- applicative maps as balanced ordered binary trees *)
+(* From SML/NJ lib 0.2, copyright 1993 by AT&T Bell Laboratories  *)
+(* Original implementation due to Stephen Adams, Southampton, UK  *)
+
+type ('key, 'a) dict
+
+exception NotFound
+
+val mkDict    : ('key * 'key -> order) -> ('key, 'a) dict
+val insert    : ('key, 'a) dict * 'key * 'a -> ('key, 'a) dict
+val find      : ('key, 'a) dict * 'key -> 'a
+val peek      : ('key, 'a) dict * 'key -> 'a option
+val remove    : ('key, 'a) dict * 'key -> ('key, 'a) dict * 'a
+val numItems  : ('key, 'a) dict -> int
+val listItems : ('key, 'a) dict -> ('key * 'a) list
+val app       : ('key * 'a -> unit) -> ('key,'a) dict -> unit
+val revapp    : ('key * 'a -> unit) -> ('key,'a) dict -> unit
+val foldr     : ('key * 'a * 'b -> 'b) -> 'b -> ('key,'a) dict -> 'b
+val foldl     : ('key * 'a * 'b -> 'b) -> 'b -> ('key,'a) dict -> 'b
+val map       : ('key * 'a -> 'b) -> ('key,'a) dict -> ('key, 'b) dict
+val transform : ('a -> 'b) -> ('key,'a) dict -> ('key, 'b) dict
+
+(* 
    [('key, 'a) dict] is the type of applicative maps from domain type
    'key to range type 'a, or equivalently, applicative dictionaries
    with keys of type 'key and values of type 'a.  They are implemented
@@ -39,7 +39,7 @@
 
    [insert(m, i, v)] extends (or modifies) map m to map i to v.
 
-   [find (m, k)] returns v if m maps k to v; otherwise raises NotFound.
+   [find(m, k)] returns v if m maps k to v; otherwise raises NotFound.
    
    [peek(m, k)] returns SOME v if m maps k to v; otherwise returns NONE.
 
@@ -77,4 +77,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Binaryset.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Binaryset.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Binaryset.html	2000-08-02 13:05:32.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Binaryset.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,37 +6,37 @@
 Structure index
 

 
-(* Binaryset -- sets implemented by ordered balanced binary trees *)
-(* From SML/NJ lib 0.2, copyright 1993 by AT&T Bell Laboratories  *)
-(* Original implementation due to Stephen Adams, Southampton, UK  *)
-
-type 'item set
-
-exception NotFound
-
-val empty        : ('item * 'item -> order) -> 'item set
-val singleton    : ('item * 'item -> order) -> 'item -> 'item set
-val add          : 'item set * 'item -> 'item set
-val addList      : 'item set * 'item list -> 'item set
-val retrieve     : 'item set * 'item -> 'item
-val peek         : 'item set * 'item -> 'item option
-val isEmpty      : 'item set -> bool
-val equal        : 'item set * 'item set -> bool
-val isSubset     : 'item set * 'item set -> bool
-val member       : 'item set * 'item -> bool
-val delete       : 'item set * 'item -> 'item set
-val numItems     : 'item set ->  int
-val union        : 'item set * 'item set -> 'item set
-val intersection : 'item set * 'item set -> 'item set
-val difference   : 'item set * 'item set -> 'item set
-val listItems    : 'item set -> 'item list
-val app          : ('item -> unit) -> 'item set -> unit
-val revapp       : ('item -> unit) -> 'item set -> unit
-val foldr        : ('item * 'b -> 'b) -> 'b -> 'item set -> 'b
-val foldl        : ('item * 'b -> 'b) -> 'b -> 'item set -> 'b
-val find         : ('item -> bool) -> 'item set -> 'item option
-
-(* 
+(* Binaryset -- sets implemented by ordered balanced binary trees *)
+(* From SML/NJ lib 0.2, copyright 1993 by AT&T Bell Laboratories  *)
+(* Original implementation due to Stephen Adams, Southampton, UK  *)
+
+type 'item set
+
+exception NotFound
+
+val empty        : ('item * 'item -> order) -> 'item set
+val singleton    : ('item * 'item -> order) -> 'item -> 'item set
+val add          : 'item set * 'item -> 'item set
+val addList      : 'item set * 'item list -> 'item set
+val retrieve     : 'item set * 'item -> 'item
+val peek         : 'item set * 'item -> 'item option
+val isEmpty      : 'item set -> bool
+val equal        : 'item set * 'item set -> bool
+val isSubset     : 'item set * 'item set -> bool
+val member       : 'item set * 'item -> bool
+val delete       : 'item set * 'item -> 'item set
+val numItems     : 'item set ->  int
+val union        : 'item set * 'item set -> 'item set
+val intersection : 'item set * 'item set -> 'item set
+val difference   : 'item set * 'item set -> 'item set
+val listItems    : 'item set -> 'item list
+val app          : ('item -> unit) -> 'item set -> unit
+val revapp       : ('item -> unit) -> 'item set -> unit
+val foldr        : ('item * 'b -> 'b) -> 'b -> 'item set -> 'b
+val foldl        : ('item * 'b -> 'b) -> 'b -> 'item set -> 'b
+val find         : ('item -> bool) -> 'item set -> 'item option
+
+(* 
    ['item set] is the type of sets of ordered elements of type 'item.
    The ordering relation on the elements is used in the representation
    of the set.  The result of combining two sets with different
@@ -100,4 +100,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/BinIO.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/BinIO.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/BinIO.html	2000-08-02 13:05:32.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/BinIO.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,43 +6,43 @@
 Structure index
 

 
-(* BinIO -- SML Basis Library *)
-
-type elem   = Word8.word
-type vector = Word8Vector.vector
-
-(* Binary input *)
-
-type instream 
-
-val openIn       : string -> instream
-val closeIn      : instream -> unit
-val input        : instream -> vector
-val inputAll     : instream -> vector
-val inputNoBlock : instream -> vector option
-val input1       : instream -> elem option
-val inputN       : instream * int -> vector
-val endOfStream  : instream -> bool
-val lookahead    : instream -> elem option
-
-(* Binary output *)
-
-type outstream
-
-val openOut      : string -> outstream
-val openAppend   : string -> outstream
-val closeOut     : outstream -> unit
-val output       : outstream * vector -> unit
-val output1      : outstream * elem -> unit
-val flushOut     : outstream -> unit
-
-(* 
-   This structure provides input/output functions on byte streams.
-   The functions are state-based: reading from or writing to a stream
-   changes the state of the stream.  The streams are buffered: output
-   to a stream may not immediately affect the underlying file or
-   device.
-
+(* BinIO -- SML Basis Library *)
+
+type elem   = Word8.word
+type vector = Word8Vector.vector
+
+(* Binary input *)
+
+type instream 
+
+val openIn       : string -> instream
+val closeIn      : instream -> unit
+val input        : instream -> vector
+val inputAll     : instream -> vector
+val inputNoBlock : instream -> vector option
+val input1       : instream -> elem option
+val inputN       : instream * int -> vector
+val endOfStream  : instream -> bool
+val lookahead    : instream -> elem option
+
+(* Binary output *)
+
+type outstream
+
+val openOut      : string -> outstream
+val openAppend   : string -> outstream
+val closeOut     : outstream -> unit
+val output       : outstream * vector -> unit
+val output1      : outstream * elem -> unit
+val flushOut     : outstream -> unit
+
+(* 
+   This structure provides input/output functions on byte streams.
+   The functions are state-based: reading from or writing to a stream
+   changes the state of the stream.  The streams are buffered: output
+   to a stream may not immediately affect the underlying file or
+   device.
+
    [instream] is the type of state-based byte input streams.
 
    [outstream] is the type of state-based byte output streams.
@@ -160,4 +160,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Bool.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Bool.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Bool.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Bool.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,17 +6,17 @@
 Structure index
 

 
-(* Bool -- SML Basis Library *)
-
-datatype bool = datatype bool
-
-val not        : bool -> bool
-
-val toString   : bool -> string
-val fromString : string -> bool option
-val scan       : (char, 'a) StringCvt.reader -> (bool, 'a) StringCvt.reader
-
-(* 
+(* Bool -- SML Basis Library *)
+
+datatype bool = datatype bool
+
+val not        : bool -> bool
+
+val toString   : bool -> string
+val fromString : string -> bool option
+val scan       : (char, 'a) StringCvt.reader -> (bool, 'a) StringCvt.reader
+
+(* 
    [bool] is the type of Boolean (logical) values: true and false.
 
    [not b] is the logical negation of b.
@@ -39,4 +39,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Buffer.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Buffer.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Buffer.html	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Buffer.html	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,61 @@
+Structure Buffer
+
+
Structure Buffer

+

+
Identifier index
+Structure index
+

+
+signature Buffer =
+sig
+    type buf
+    val new      : int -> buf
+    val contents : buf -> string
+    val size     : buf -> int
+    val clear    : buf -> unit
+    val reset    : buf -> unit
+
+    val addChar      : buf -> char -> unit
+    val addString    : buf -> string -> unit
+    val addSubString : buf -> substring -> unit
+end
+
+(* [buf] is the type of mutable string buffers that allows efficient
+   concatenation at the end and automatically expand as necessary.  It
+   provides accumulative concatenation of strings in quasi-linear time
+   (instead of quadratic time when strings are concatenated pairwise).
+
+   [new hint] creates a new empty buffer.  Raises Size if hint <= 0 or
+   hint > String.maxSize.
+   The argument hint is used as the initial size of the internal
+   string that holds the buffer contents.  The internal string is
+   automatically reallocated as contents is stored in the buffer.  For
+   best performance, hint should be of the same order of magnitude as
+   the number of characters that are expected to be stored in the
+   buffer (for instance, 80 for a buffer that holds one output line).
+   Nothing bad will happen if the buffer grows beyond that limit,
+   however.  In doubt, take hint = 16 for instance. 
+
+   [contents buf] returns the contents of buf.
+
+   [size buf] returns the size of the contents of buf.
+
+   [clear buf] emptys buf.
+
+   [reset buf] emptys buf and shrink the internal string to the
+   initial hint.
+
+   [addChar buf c] appends c at the end of buf.
+
+   [addString buf s] appends s at the end of buf.
+
+   [addSubString buf ss] appends ss at the end of buf.
+
+*)
+
+
+

+
Identifier index
+Structure index
+

+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Byte.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Byte.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Byte.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Byte.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,21 +6,21 @@
 Structure index
 

 
-(* Byte -- SML Basis Library *)
-
-val byteToChar      : Word8.word -> Char.char
-val charToByte      : Char.char -> Word8.word
-val bytesToString   : Word8Vector.vector -> String.string
-val stringToBytes   : String.string -> Word8Vector.vector
-
-val unpackStringVec : Word8Vector.vector * int * int option -> string
-val unpackString    : Word8Array.array * int * int option -> string
-val packString      : Substring.substring * Word8Array.array * int -> unit
-
-(* 
-   Conversions between bytes and characters, and between byte vectors 
-   and strings (character vectors).  
-
+(* Byte -- SML Basis Library *)
+
+val byteToChar      : Word8.word -> Char.char
+val charToByte      : Char.char -> Word8.word
+val bytesToString   : Word8Vector.vector -> String.string
+val stringToBytes   : String.string -> Word8Vector.vector
+
+val unpackStringVec : Word8VectorSlice.slice -> string
+val unpackString    : Word8ArraySlice.slice -> string
+val packString      : Word8Array.array * int * Substring.substring -> unit
+
+(* 
+   Conversions between bytes and characters, and between byte vectors 
+   and strings (character vectors).  
+
    [byteToChar w] is the character corresponding to the byte w.
 
    [charToByte c] is the byte corresponding to character c.
@@ -33,31 +33,19 @@
    In Moscow ML, all the above operations take constant time.  That
    is, no copying is done.
 
-   [unpackStringVec (v, i, NONE)] is the string whose character codes are
-   the bytes of v[i..length v-1].  Raises Subscript if i<0 or i>length v.
-   Equivalent to bytesToString(Word8Vector.extract (v, i, NONE)).
-   
-   [unpackStringVec (v, i, SOME n)] is the string whose character codes are
-   the bytes of v[i..i+n-1].  Raises Subscript if i<0 or n<0 or i+n>length v.
-   Equivalent to bytesToString(Word8Vector.extract (v, i, SOME n)).
-
-   [unpackString (a, i, NONE)] is the string whose character codes are
-   the bytes of a[i..length a-1].  Raises Subscript if i<0 or i>length a.
-   Equivalent to bytesToString(Word8Array.extract (v, i, NONE)).
-   
-   [unpackString (a, i, SOME n)] is the string whose character codes are
-   the bytes of a[i..i+n-1].  Raises Subscript if i<0 or n<0 or i+n>length a.
-   Equivalent to bytesToString(Word8Array.extract (a, i, SOME n)).
+   [unpackStringVec v] is the string whose character codes are the
+   bytes from the vector slice v.
 
-   [packString (ss, a, i)] copies the character codes of substring ss into
+   [unpackString a] is the string whose character codes are the bytes
+   from the array slice a.
+
+   [packString (a, i, ss)] copies the character codes of substring ss into
    the subarray a[i..i+n-1] where n = Substring.size ss.  Raises Subscript 
    if i<0 or i+n > length a.
-   Equivalent to Word8Array.copyVec{src=s, si=si, len=SOME n, dst=a, di=i} 
-   when (s, si, n) = Substring.base ss.
 *)
 
 

 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Callback.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Callback.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Callback.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Callback.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,79 +6,79 @@
 Structure index
 

 
-(* Callback -- registering ML values with C, and accessing C values from ML *)
-
-(* Registering ML values for access from C code: *)
-
-val register     : string -> 'a -> unit
-val unregister   : string -> unit
-val isRegistered : string -> bool
+(* Callback -- registering ML values with C, and accessing C values from ML *)
+
+(* Registering ML values for access from C code: *)
+
+val register     : string -> 'a -> unit
+val unregister   : string -> unit
+val isRegistered : string -> bool
+
 
-
-(* Accessing C variables and functions from ML: *)
-
-type cptr
-
-val getcptr : string -> cptr
-val var     : cptr -> 'b                            
-val app1    : cptr -> 'a1 -> 'b                     
-val app2    : cptr -> 'a1 -> 'a2 -> 'b              
-val app3    : cptr -> 'a1 -> 'a2 -> 'a3 -> 'b       
-val app4    : cptr -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'b
-val app5    : cptr -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5 -> 'b
-
-(* 
-   REGISTERING ML VALUES FOR ACCESS FROM C CODE
-   --------------------------------------------
-
-   This example shows how to register the ML function (fn n => 2*n) so
-   that it may be called from C code.
-
-   (0) The ML side registers the function:
-          Callback.register "myfun" (fn n => 2*n)               
-
-   (1) The C side first obtains an ML value pointer:
-          valueptr mvp = get_valueptr("myfun");
-   
-   (2) The C side then uses the ML value pointer to obtain an ML
-       value, and uses it:
-          callback(get_value(mvp), Val_long(42));
-
-   Operation (1) involves a callback to ML, and hence may be slow.
-   Calling get_valueptr may cause the garbage collector to run; hence
-   other live ML values must be registered as GC roots.  The garbage
-   collector will never move the ML value pointer; hence it need not
-   be registered as a GC root in the C code.
-
-   Operation (2) is very fast.  If the garbage collector is invoked
-   between the call of get_value() and the use of the ML value, then 
-   the value must be registered as a GC root.  However, the idiom
-        callback(get_value(mvp), arg1);
-   is safe provided the evaluation of arg1 does not provoke a garbage
-   collection (e.g. if arg1 is a variable).
-
-   The C function get_valueptr returns NULL if nam is not registered.
-
-   The C function get_value returns NULL if nam has been unregistered
-   (and not reregistered) since mvp was obtained; it raises exception
-   Fail if mvp itself is NULL.  Every access to the ML value from C
-   code should use the ML valueptr and get_valueptr, otherwise the C
-   code will not know when the value has been unregistered and
-   possibly deallocated.
-
-   The C functions (in mosml/src/runtime/callback.c)
-      void registervalue(char* nam, value mlval)
-      void unregistervalue(char* nam)
-   can be used just as Callback.register and Callback.unregister.
-
-   The C functions
-      value callbackptr (valueptr mvp, value arg1)
-      value callbackptr2(valueptr mvp, value arg1, value arg2)
-      value callbackptr3(valueptr mvp, value arg1, value arg2, value arg3)
-   can be used for callback via an ML value pointer; they will raise
-   exception Fail if the ML function indicated by mvp has been unregistered.
+(* Accessing C variables and functions from ML: *)
+
+type cptr
+
+val getcptr : string -> cptr
+val var     : cptr -> 'b                            
+val app1    : cptr -> 'a1 -> 'b                     
+val app2    : cptr -> 'a1 -> 'a2 -> 'b              
+val app3    : cptr -> 'a1 -> 'a2 -> 'a3 -> 'b       
+val app4    : cptr -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'b
+val app5    : cptr -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5 -> 'b
+
+(* 
+   REGISTERING ML VALUES FOR ACCESS FROM C CODE
+   --------------------------------------------
+
+   This example shows how to register the ML function (fn n => 2*n) so
+   that it may be called from C code.
+
+   (0) The ML side registers the function:
+          Callback.register "myfun" (fn n => 2*n)               
+
+   (1) The C side first obtains an ML value pointer:
+          valueptr mvp = get_valueptr("myfun");
+   
+   (2) The C side then uses the ML value pointer to obtain an ML
+       value, and uses it:
+          callback(get_value(mvp), Val_long(42));
+
+   Operation (1) involves a callback to ML, and hence may be slow.
+   Calling get_valueptr may cause the garbage collector to run; hence
+   other live ML values must be registered as GC roots.  The garbage
+   collector will never move the ML value pointer; hence it need not
+   be registered as a GC root in the C code.
+
+   Operation (2) is very fast.  If the garbage collector is invoked
+   between the call of get_value() and the use of the ML value, then 
+   the value must be registered as a GC root.  However, the idiom
+        callback(get_value(mvp), arg1);
+   is safe provided the evaluation of arg1 does not provoke a garbage
+   collection (e.g. if arg1 is a variable).
+
+   The C function get_valueptr returns NULL if nam is not registered.
+
+   The C function get_value returns NULL if nam has been unregistered
+   (and not reregistered) since mvp was obtained; it raises exception
+   Fail if mvp itself is NULL.  Every access to the ML value from C
+   code should use the ML valueptr and get_valueptr, otherwise the C
+   code will not know when the value has been unregistered and
+   possibly deallocated.
+
+   The C functions (in mosml/src/runtime/callback.c)
+      void registervalue(char* nam, value mlval)
+      void unregistervalue(char* nam)
+   can be used just as Callback.register and Callback.unregister.
+
+   The C functions
+      value callbackptr (valueptr mvp, value arg1)
+      value callbackptr2(valueptr mvp, value arg1, value arg2)
+      value callbackptr3(valueptr mvp, value arg1, value arg2, value arg3)
+   can be used for callback via an ML value pointer; they will raise
+   exception Fail if the ML function indicated by mvp has been unregistered.
+
 
-
    [register nam v] registers the ML value v, so that it can be
    retrieved from C code under the name nam.  If nam has previously
    been registered and then unregistered, it will be reregistered with
@@ -104,7 +104,7 @@
 
    This example shows how to register the C function 
 
-      value silly_cfun(value v) 
+      value sillycfun(value v) 
       { return copy_double(42.42 * Double_val(v)); }
 
    so that it may be called from ML.
@@ -123,6 +123,7 @@
           val result = sillyfun(3.4)
 
    The C function (in mosml/src/runtime/callback.c)
+
         void registercptr(char* nam, void* cptr);
 
    is used to register C pointers for access from ML.  Only pointers
@@ -156,4 +157,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/CharArray.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/CharArray.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/CharArray.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/CharArray.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,39 +6,44 @@
 Structure index
 

 
-(* CharArray -- SML Basis Library *)
-
-eqtype array
-type elem   = Char.char
-type vector = CharVector.vector
-
-val maxLen   : int
-
-val array    : int * elem -> array
-val tabulate : int * (int -> elem) -> array
-val fromList : elem list -> array
-
-val length   : array -> int
-val sub      : array * int -> elem
-val update   : array * int * elem -> unit
-val extract  : array * int * int option -> vector
-
-val copy     : {src: array,  si: int, len: int option, 
-                dst: array, di: int} -> unit
-val copyVec  : {src: vector, si: int, len: int option, 
-                dst: array, di: int} -> unit
-
-val app      : (elem -> unit) -> array -> unit
-val foldl    : (elem * 'b -> 'b) -> 'b -> array -> 'b
-val foldr    : (elem * 'b -> 'b) -> 'b -> array -> 'b
-val modify   : (elem -> elem) -> array -> unit
-
-val appi     : (int * elem -> unit) -> array * int * int option -> unit
-val foldli   : (int * elem * 'b -> 'b) -> 'b -> array * int * int option -> 'b
-val foldri   : (int * elem * 'b -> 'b) -> 'b -> array * int * int option -> 'b
-val modifyi  : (int * elem -> elem) -> array * int * int option -> unit
-
-(* 
+(* CharArray -- SML Basis Library *)
+
+eqtype array
+type elem   = Char.char
+type vector = CharVector.vector
+
+val maxLen   : int
+
+val array    : int * elem -> array
+val tabulate : int * (int -> elem) -> array
+val fromList : elem list -> array
+
+val length   : array -> int
+val sub      : array * int -> elem
+val update   : array * int * elem -> unit
+val vector   : array -> vector
+
+val copy     : {src: array,  dst: array, di: int} -> unit
+val copyVec  : {src: vector, dst: array, di: int} -> unit
+
+val find     : (elem -> bool) -> array -> elem option
+val exists   : (elem -> bool) -> array -> bool
+val all      : (elem -> bool) -> array -> bool
+
+val app      : (elem -> unit) -> array -> unit
+val foldl    : (elem * 'b -> 'b) -> 'b -> array -> 'b
+val foldr    : (elem * 'b -> 'b) -> 'b -> array -> 'b
+val modify   : (elem -> elem) -> array -> unit
+
+val findi    : (int * elem -> bool) -> array -> (int * elem) option
+val appi     : (int * elem -> unit) -> array -> unit
+val foldli   : (int * elem * 'b -> 'b) -> 'b -> array -> 'b
+val foldri   : (int * elem * 'b -> 'b) -> 'b -> array -> 'b
+val modifyi  : (int * elem -> elem) -> array -> unit
+
+val collate  : (elem * elem -> order) -> array * array -> order
+
+(* 
    [array] is the type of one-dimensional, mutable, zero-based
    constant-time-access arrays with elements of type Char.char, that
    is, characters.  Arrays a1 and a2 are equal if both were created by
@@ -51,4 +56,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/CharArraySlice.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/CharArraySlice.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/CharArraySlice.html	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/CharArraySlice.html	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,65 @@
+Structure CharArraySlice
+
+
Structure CharArraySlice

+

+
Identifier index
+Structure index
+

+
+(* CharArraySlice -- SML Basis Library *)
+
+type elem = char
+type array = CharArray.array
+type vector = CharVector.vector
+type vector_slice = CharVectorSlice.slice
+
+type slice
+
+val length   : slice -> int
+val sub      : slice * int -> elem
+val update   : slice * int * elem  -> unit
+val slice    : array * int * int option -> slice
+val full     : array -> slice
+val subslice : slice * int * int option -> slice
+val base     : slice -> array * int * int
+val vector   : slice -> vector
+val copy     : {src: slice, dst: array, di: int} -> unit
+val copyVec  : {src: vector_slice, dst: array, di: int} -> unit 
+val isEmpty  : slice -> bool
+val getItem  : slice -> (elem * slice) option
+
+val find     : (elem -> bool) -> slice -> elem option
+val exists   : (elem -> bool) -> slice -> bool
+val all      : (elem -> bool) -> slice -> bool
+
+val app      : (elem -> unit) -> slice -> unit
+val foldl    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+val foldr    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+val modify   : (elem -> elem) -> slice -> unit
+
+val findi    : (int * elem -> bool) -> slice -> (int * elem) option
+val appi     : (int * elem -> unit) -> slice -> unit
+val foldli   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+val foldri   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+val modifyi  : (int * elem -> elem) -> slice -> unit
+
+val collate  : (elem * elem -> order) -> slice * slice -> order
+
+(* 
+   [slice] is the type of CharArray slices, that is, sub-arrays of
+   CharArray.array values.
+   The slice (a,i,n) is valid if 0 <= i <= i+n <= size s, 
+                or equivalently, 0 <= i and 0 <= n and i+n <= size s.  
+   A valid slice sli = (a,i,n) represents the sub-array a[i...i+n-1],
+   so the elements of sli are a[i], a[i+1], ..., a[i+n-1], and n is
+   the length of the slice.  Only valid slices can be constructed by
+   the functions below.
+
+   All operations are as for ArraySlice.slice.
+*)
+
+

+
Identifier index
+Structure index
+

+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Char.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Char.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Char.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Char.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,51 +6,51 @@
 Structure index
 

 
-(* Char -- SML Basis Library *)
-
-type char = char
-
-val minChar : char
-val maxChar : char
-val maxOrd  : int       
-
-val chr     : int  -> char       (* May raise Chr *)
-val ord     : char -> int
-val succ    : char -> char       (* May raise Chr *)
-val pred    : char -> char       (* May raise Chr *)
-
-val isLower     : char -> bool   (* contains "abcdefghijklmnopqrstuvwxyz"  *)
-val isUpper     : char -> bool   (* contains "ABCDEFGHIJKLMNOPQRSTUVWXYZ"  *)
-val isDigit     : char -> bool   (* contains "0123456789"                  *)
-val isAlpha     : char -> bool   (* isUpper orelse isLower                 *)
-val isHexDigit  : char -> bool   (* isDigit orelse contains "abcdefABCDEF" *)
-val isAlphaNum  : char -> bool   (* isAlpha orelse isDigit                 *)
-val isPrint     : char -> bool   (* any printable character (incl. #" ")   *)
-val isSpace     : char -> bool   (* contains " \t\r\n\v\f"                 *)
-val isPunct     : char -> bool   (* printable, not space or alphanumeric   *) 
-val isGraph     : char -> bool   (* (not isSpace) andalso isPrint          *)
-val isAscii     : char -> bool   (* ord c < 128                            *)
-val isCntrl     : char -> bool   (* control character                      *)
-
-val toLower     : char -> char
-val toUpper     : char -> char
-
-val fromString  : string -> char option       (* ML escape sequences *)
-val toString    : char -> string              (* ML escape sequences *)
-
-val fromCString : string -> char option       (* C escape sequences  *)
-val toCString   : char -> string              (* C escape sequences  *)
-
-val contains    : string -> char -> bool
-val notContains : string -> char -> bool
-
-val <       : char * char -> bool
-val <=      : char * char -> bool
-val >       : char * char -> bool
-val >=      : char * char -> bool
-val compare : char * char -> order
-
-(* 
+(* Char -- SML Basis Library *)
+
+type char = char
+
+val minChar : char
+val maxChar : char
+val maxOrd  : int       
+
+val chr     : int  -> char       (* May raise Chr *)
+val ord     : char -> int
+val succ    : char -> char       (* May raise Chr *)
+val pred    : char -> char       (* May raise Chr *)
+
+val isLower     : char -> bool   (* contains "abcdefghijklmnopqrstuvwxyz"  *)
+val isUpper     : char -> bool   (* contains "ABCDEFGHIJKLMNOPQRSTUVWXYZ"  *)
+val isDigit     : char -> bool   (* contains "0123456789"                  *)
+val isAlpha     : char -> bool   (* isUpper orelse isLower                 *)
+val isHexDigit  : char -> bool   (* isDigit orelse contains "abcdefABCDEF" *)
+val isAlphaNum  : char -> bool   (* isAlpha orelse isDigit                 *)
+val isPrint     : char -> bool   (* any printable character (incl. #" ")   *)
+val isSpace     : char -> bool   (* contains " \t\r\n\v\f"                 *)
+val isPunct     : char -> bool   (* printable, not space or alphanumeric   *) 
+val isGraph     : char -> bool   (* (not isSpace) andalso isPrint          *)
+val isAscii     : char -> bool   (* ord c < 128                            *)
+val isCntrl     : char -> bool   (* control character                      *)
+
+val toLower     : char -> char
+val toUpper     : char -> char
+
+val fromString  : string -> char option       (* ML escape sequences *)
+val toString    : char -> string              (* ML escape sequences *)
+
+val fromCString : string -> char option       (* C escape sequences  *)
+val toCString   : char -> string              (* C escape sequences  *)
+
+val contains    : string -> char -> bool
+val notContains : string -> char -> bool
+
+val <       : char * char -> bool
+val <=      : char * char -> bool
+val >       : char * char -> bool
+val >=      : char * char -> bool
+val compare : char * char -> order
+
+(* 
    [char] is the type of characters.  
 
    [minChar] is the least character in the ordering <.
@@ -178,10 +178,10 @@
              toString (chr 127) equals "\\177"
              toString (chr 128) equals "\\200"
 
-   [<] 
-   [<=]
-   [>]
-   [>=] compares character codes.  For instance, c1 < c2 returns true 
+   [<] 
+   [<=]
+   [>]
+   [>=] compares character codes.  For instance, c1 < c2 returns true 
    if ord(c1) < ord(c2), and similarly for <=, >, >=.  
 
    [compare(c1, c2)] returns LESS, EQUAL, or GREATER, according as c1 is
@@ -192,4 +192,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/CharVector.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/CharVector.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/CharVector.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/CharVector.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,32 +6,39 @@
 Structure index
 

 
-(* CharVector -- SML Basis Library *)
-
-type vector = string
-type elem = Char.char
-
-val maxLen   : int
-
-val fromList : elem list -> vector
-val tabulate : int * (int -> elem) -> vector
-
-val length   : vector -> int
-val sub      : vector * int -> elem
-val extract  : vector * int * int option -> vector
-val concat   : vector list -> vector
-
-val app      : (elem -> unit) -> vector -> unit
-val map      : (elem -> elem) -> vector -> vector
-val foldl    : (elem * 'b -> 'b) -> 'b -> vector -> 'b
-val foldr    : (elem * 'b -> 'b) -> 'b -> vector -> 'b
-
-val appi     : (int * elem -> unit) -> vector * int * int option -> unit
-val mapi     : (int * elem -> elem) -> vector * int * int option -> vector
-val foldli   : (int * elem * 'b -> 'b) -> 'b -> vector*int*int option -> 'b
-val foldri   : (int * elem * 'b -> 'b) -> 'b -> vector*int*int option -> 'b
-
-(* 
+(* CharVector -- SML Basis Library *)
+
+type vector = string
+type elem = Char.char
+
+val maxLen   : int
+
+val fromList : elem list -> vector
+val tabulate : int * (int -> elem) -> vector
+
+val length   : vector -> int
+val sub      : vector * int -> elem
+val update   : vector * int * elem -> vector
+val concat   : vector list -> vector
+
+val find     : (elem -> bool) -> vector -> elem option
+val exists   : (elem -> bool) -> vector -> bool
+val all      : (elem -> bool) -> vector -> bool
+
+val app      : (elem -> unit) -> vector -> unit
+val map      : (elem -> elem) -> vector -> vector
+val foldl    : (elem * 'b -> 'b) -> 'b -> vector -> 'b
+val foldr    : (elem * 'b -> 'b) -> 'b -> vector -> 'b
+
+val findi    : (int * elem -> bool) -> vector -> (int * elem) option
+val appi     : (int * elem -> unit) -> vector -> unit
+val mapi     : (int * elem -> elem) -> vector -> vector
+val foldli   : (int * elem * 'b -> 'b) -> 'b -> vector -> 'b
+val foldri   : (int * elem * 'b -> 'b) -> 'b -> vector -> 'b
+
+val collate  : (elem * elem -> order) -> vector * vector -> order
+
+(* 
    [vector] is the type of one-dimensional, immutable, zero-based
    constant-time-access vectors with elements of type Char.char, that
    is, characters.  Type vector admits equality, and vectors v1 and v2
@@ -45,4 +52,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/CharVectorSlice.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/CharVectorSlice.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/CharVectorSlice.html	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/CharVectorSlice.html	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,64 @@
+Structure CharVectorSlice
+
+
Structure CharVectorSlice

+

+
Identifier index
+Structure index
+

+
+(* CharVectorSlice -- SML Basis Library *)
+
+type elem = Char.char
+type vector = CharVector.vector
+
+type slice = Substring.substring
+
+val length   : slice -> int
+val sub      : slice * int -> elem
+val slice    : vector * int * int option -> slice
+val full     : vector -> slice
+val subslice : slice * int * int option -> slice
+val base     : slice -> vector * int * int
+val vector   : slice -> vector
+val concat   : slice list -> vector
+val isEmpty  : slice -> bool
+val getItem  : slice -> (elem * slice) option
+
+val find     : (elem -> bool) -> slice -> elem option
+val exists   : (elem -> bool) -> slice -> bool
+val all      : (elem -> bool) -> slice -> bool
+
+val app      : (elem -> unit) -> slice -> unit
+val map      : (elem -> elem) -> slice -> vector
+val foldl    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+val foldr    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+
+val findi    : (int * elem -> bool) -> slice -> (int * elem) option
+val appi     : (int * elem -> unit) -> slice -> unit
+val mapi     : (int * elem -> elem) -> slice -> vector
+val foldli   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+val foldri   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+
+val collate  : (elem * elem -> order) -> slice * slice -> order
+
+(* 
+   [slice] is the type of CharVector slices, that is, sub-vectors of
+   CharVector.vector values.  Since a CharVector.vector is a string, a
+   slice is the same as a substring, and slices may be processed using
+   the functions defined as well as those in structure Substring.
+
+   The slice (a,i,n) is valid if 0 <= i <= i+n <= size s, 
+                or equivalently, 0 <= i and 0 <= n and i+n <= size s.  
+   A valid slice sli = (a,i,n) represents the sub-vector a[i...i+n-1],
+   so the elements of sli are a[i], a[i+1], ..., a[i+n-1], and n is
+   the length of the slice.  Only valid slices can be constructed by
+   these functions.
+
+   All operations are as for VectorSlice.slice.
+*)
+
+

+
Identifier index
+Structure index
+

+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/CommandLine.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/CommandLine.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/CommandLine.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/CommandLine.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,12 +6,12 @@
 Structure index
 

 
-(* CommandLine -- SML Basis Library *)
-
-val name      : unit -> string 
-val arguments : unit -> string list
-
-(* 
+(* CommandLine -- SML Basis Library *)
+
+val name      : unit -> string 
+val arguments : unit -> string list
+
+(* 
    [name ()] returns the name used to start the current process.
 
    [arguments ()] returns the command line arguments of the current process.
@@ -22,4 +22,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Date.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Date.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Date.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Date.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,54 +6,54 @@
 Structure index
 

 
-(* Date -- SML Basis Library *)
-
-datatype weekday = Mon | Tue | Wed | Thu | Fri | Sat | Sun
-
-datatype month = Jan | Feb | Mar | Apr | May | Jun
-               | Jul | Aug | Sep | Oct | Nov | Dec
-
-type date
-
-exception Date
-
-val date : {
-             year   : int,              (* e.g. 1999                     *)
-             month  : month,            (* Jan, Feb, ...                 *)
-             day    : int,              (* 1-31                          *)
-             hour   : int,              (* 0-23                          *)
-             minute : int,              (* 0-59                          *)
-             second : int,              (* 0-61, permitting leap seconds *)
-             offset : Time.time option  (* time zone west of UTC         *)
-           } -> date
-
-val year       : date -> int
-val month      : date -> month
-val day        : date -> int
-val hour       : date -> int
-val minute     : date -> int
-val second     : date -> int
-val weekDay    : date -> weekday
-val yearDay    : date -> int
-val isDst      : date -> bool option
-val offset     : date -> Time.time option
-
-val compare    : date * date -> order
-
-val toString   : date -> string
-val fmt        : string -> date -> string
-val fromString : string -> date option
-val scan       : (char, 'a) StringCvt.reader -> (date, 'a) StringCvt.reader
-
-val fromTimeLocal : Time.time -> date
-val fromTimeUniv  : Time.time -> date
-val toTime        : date -> Time.time
-val localOffset   : unit -> Time.time
-
-(* 
-   These functions convert times to dates and vice versa, and format
-   and scan dates.
-
+(* Date -- SML Basis Library *)
+
+datatype weekday = Mon | Tue | Wed | Thu | Fri | Sat | Sun
+
+datatype month = Jan | Feb | Mar | Apr | May | Jun
+               | Jul | Aug | Sep | Oct | Nov | Dec
+
+type date
+
+exception Date
+
+val date : {
+             year   : int,              (* e.g. 1999                     *)
+             month  : month,            (* Jan, Feb, ...                 *)
+             day    : int,              (* 1-31                          *)
+             hour   : int,              (* 0-23                          *)
+             minute : int,              (* 0-59                          *)
+             second : int,              (* 0-61, permitting leap seconds *)
+             offset : Time.time option  (* time zone west of UTC         *)
+           } -> date
+
+val year       : date -> int
+val month      : date -> month
+val day        : date -> int
+val hour       : date -> int
+val minute     : date -> int
+val second     : date -> int
+val weekDay    : date -> weekday
+val yearDay    : date -> int
+val isDst      : date -> bool option
+val offset     : date -> Time.time option
+
+val compare    : date * date -> order
+
+val toString   : date -> string
+val fmt        : string -> date -> string
+val fromString : string -> date option
+val scan       : (char, 'a) StringCvt.reader -> (date, 'a) StringCvt.reader
+
+val fromTimeLocal : Time.time -> date
+val fromTimeUniv  : Time.time -> date
+val toTime        : date -> Time.time
+val localOffset   : unit -> Time.time
+
+(* 
+   These functions convert times to dates and vice versa, and format
+   and scan dates.
+
    [date] is the type of points in time in a given time zone.  If the
    offset is NONE, then the date is in the local time zone.  If the
    offset is SOME t, then t is the offset of the main timezone
@@ -183,4 +183,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Dynarray.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Dynarray.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Dynarray.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Dynarray.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,20 +6,20 @@
 Structure index
 

 
-(* Dynarray -- polymorphic dynamic arrays a la SML/NJ library *)
-
-type 'a array
-
-val array    : int * '_a -> '_a array
-val subArray : '_a array * int * int -> '_a array
-val fromList : '_a list * '_a -> '_a array
-val tabulate : int * (int -> '_a) * '_a -> '_a array
-val sub      : 'a array * int -> 'a
-val update   : '_a array * int * '_a  -> unit
-val default  : 'a array -> 'a
-val bound    : 'a array -> int
-
-(* 
+(* Dynarray -- polymorphic dynamic arrays a la SML/NJ library *)
+
+type 'a array
+
+val array    : int * '_a -> '_a array
+val subArray : '_a array * int * int -> '_a array
+val fromList : '_a list * '_a -> '_a array
+val tabulate : int * (int -> '_a) * '_a -> '_a array
+val sub      : 'a array * int -> 'a
+val update   : '_a array * int * '_a  -> unit
+val default  : 'a array -> 'a
+val bound    : 'a array -> int
+
+(* 
    ['ty array] is the type of one-dimensional, mutable, zero-based
    unbounded arrays with elements of type 'ty.  Type 'ty array does
    not admit equality.
@@ -54,4 +54,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Dynlib.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Dynlib.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Dynlib.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Dynlib.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,40 +6,40 @@
 Structure index
 

 
-(* Dynlib -- dynamic linking with foreign functions *)
-
-type dlHandle
-type symHandle
-    
-exception Closed
-
-datatype flag = RTLD_LAZY | RTLD_NOW
-val dlopen  : { lib : string, flag : flag, global : bool } -> dlHandle
-val dlsym   : dlHandle -> string -> symHandle
-val dlclose : dlHandle -> unit
-
-val var  : symHandle -> 'b                            
-val app1 : symHandle -> 'a1 -> 'b                     
-val app2 : symHandle -> 'a1 -> 'a2 -> 'b              
-val app3 : symHandle -> 'a1 -> 'a2 -> 'a3 -> 'b       
-val app4 : symHandle -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'b
-val app5 : symHandle -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5 -> 'b
-
-(* 
-   Structure Dynlib provides dynamic loading and calling of C
-   functions, using the dlfcn interface.  A dynamic library is a
-   collection of symbols (C variables and functions).  
-
-   An ML value passed to or returned from a symbol has type `value' as
-   defined in src/runtime/mlvalues.h.  The C functions should use the
-   macroes defined there to access and produce ML values.  When
-   writing a C function, remember that the garbage collector may be
-   activated whenever you allocate an ML value.  Also, remember that
-   the garbage collector may move values from the young heap to the
-   old one, so that a C pointer pointing into the ML heap may need to
-   be updated. Use the Push_roots and Pop_roots macroes to achieve
-   this.
-
+(* Dynlib -- dynamic linking with foreign functions *)
+
+type dlHandle
+type symHandle
+    
+exception Closed
+
+datatype flag = RTLD_LAZY | RTLD_NOW
+val dlopen  : { lib : string, flag : flag, global : bool } -> dlHandle
+val dlsym   : dlHandle -> string -> symHandle
+val dlclose : dlHandle -> unit
+
+val var  : symHandle -> 'b                            
+val app1 : symHandle -> 'a1 -> 'b                     
+val app2 : symHandle -> 'a1 -> 'a2 -> 'b              
+val app3 : symHandle -> 'a1 -> 'a2 -> 'a3 -> 'b       
+val app4 : symHandle -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'b
+val app5 : symHandle -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5 -> 'b
+
+(* 
+   Structure Dynlib provides dynamic loading and calling of C
+   functions, using the dlfcn interface.  A dynamic library is a
+   collection of symbols (C variables and functions).  
+
+   An ML value passed to or returned from a symbol has type `value' as
+   defined in src/runtime/mlvalues.h.  The C functions should use the
+   macroes defined there to access and produce ML values.  When
+   writing a C function, remember that the garbage collector may be
+   activated whenever you allocate an ML value.  Also, remember that
+   the garbage collector may move values from the young heap to the
+   old one, so that a C pointer pointing into the ML heap may need to
+   be updated. Use the Push_roots and Pop_roots macroes to achieve
+   this.
+
    [dlHandle] is the type of dynamic library handles.  A dynamic
    library handle is created by opening a dynamic library using
    dlopen.  This will load the library into the runtime system.  The
@@ -139,4 +139,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/FileSys.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/FileSys.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/FileSys.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/FileSys.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,47 +6,47 @@
 Structure index
 

 
-(* OS.FileSys -- SML Basis Library *)
-
-type dirstream
-
-val openDir   : string -> dirstream
-val readDir   : dirstream -> string option
-val rewindDir : dirstream -> unit
-val closeDir  : dirstream -> unit
-
-val chDir     : string -> unit
-val getDir    : unit -> string
-val mkDir     : string -> unit
-val rmDir     : string -> unit
-val isDir     : string -> bool
-
-val realPath  : string -> string
-val fullPath  : string -> string
-val isLink    : string -> bool
-val readLink  : string -> string
-
-val modTime   : string -> Time.time
-val setTime   : string * Time.time option -> unit
-val remove    : string -> unit
-val rename    : {old: string, new: string} -> unit
-
-datatype access = A_READ | A_WRITE | A_EXEC
-val access    : string * access list -> bool
-
-val fileSize  : string -> int
-
-val tmpName   : unit -> string
-
-eqtype file_id
-val fileId    : string -> file_id
-val hash      : file_id -> word
-val compare   : file_id * file_id -> order
-
-(* 
-   These functions operate on the file system.  They raise OS.SysErr
-   in case of errors.
-
+(* OS.FileSys -- SML Basis Library *)
+
+type dirstream
+
+val openDir   : string -> dirstream
+val readDir   : dirstream -> string option
+val rewindDir : dirstream -> unit
+val closeDir  : dirstream -> unit
+
+val chDir     : string -> unit
+val getDir    : unit -> string
+val mkDir     : string -> unit
+val rmDir     : string -> unit
+val isDir     : string -> bool
+
+val realPath  : string -> string
+val fullPath  : string -> string
+val isLink    : string -> bool
+val readLink  : string -> string
+
+val modTime   : string -> Time.time
+val setTime   : string * Time.time option -> unit
+val remove    : string -> unit
+val rename    : {old: string, new: string} -> unit
+
+datatype access_mode = A_READ | A_WRITE | A_EXEC
+val access    : string * access_mode list -> bool
+
+val fileSize  : string -> int
+
+val tmpName   : unit -> string
+
+eqtype file_id
+val fileId    : string -> file_id
+val hash      : file_id -> word
+val compare   : file_id * file_id -> order
+
+(* 
+   These functions operate on the file system.  They raise OS.SysErr
+   in case of errors.
+
    [openDir p] opens directory p and returns a directory stream for
    use by readDir, rewindDir, and closeDir.  Subsequent calls to
    readDir will return the directory entries in some unspecified
@@ -116,7 +116,7 @@
 
    [rename {old, new}] changes the name of file `old' to `new'.
 
-   [access] is the type of access permissions:
+   [access_mode] is the type of access permissions:
 
    [A_READ] specifies read access.
 
@@ -169,4 +169,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Gdbm.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Gdbm.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Gdbm.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Gdbm.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,42 +6,42 @@
 Structure index
 

 
-(* Gdbm -- GNU gdbm persistent string hashtables -- requires Dynlib *)
-
-type table 
-
-datatype openmode =
-    READER                              (* read-only access (nonexclusive) *)
-  | WRITER                              (* read/write, table must exist    *)
-  | WRCREAT                             (* read/write, create if necessary *)
-  | NEWDB                               (* read/write, create empty table  *)
-
-type datum = string
-
-exception NotFound
-exception AlreadyThere
-exception NotWriter
-exception Closed
-exception GdbmError of string
-
-val withtable  : string * openmode -> (table -> 'a) -> 'a
-val withtables : (string * openmode) list -> (table list -> 'a) -> 'a
-val add        : table -> datum * datum -> unit 
-val insert     : table -> datum * datum -> unit
-val find       : table -> datum -> datum
-val peek       : table -> datum -> datum option
-val hasKey     : table -> datum -> bool
-val remove     : table -> datum -> unit
-val listKeys   : table -> datum list
-val numItems   : table -> int
-val listItems  : table -> (datum * datum) list
-val app        : (datum * datum -> unit) -> table -> unit
-val map        : (datum * datum -> 'a) -> table -> 'a list
-val fold       : (datum * datum * 'a -> 'a) -> 'a -> table -> 'a
-val fastwrite  : bool ref    
-val reorganize : table -> unit
-
-(* 
+(* Gdbm -- GNU gdbm persistent string hashtables -- requires Dynlib *)
+
+type table 
+
+datatype openmode =
+    READER                              (* read-only access (nonexclusive) *)
+  | WRITER                              (* read/write, table must exist    *)
+  | WRCREAT                             (* read/write, create if necessary *)
+  | NEWDB                               (* read/write, create empty table  *)
+
+type datum = string
+
+exception NotFound
+exception AlreadyThere
+exception NotWriter
+exception Closed
+exception GdbmError of string
+
+val withtable  : string * openmode -> (table -> 'a) -> 'a
+val withtables : (string * openmode) list -> (table list -> 'a) -> 'a
+val add        : table -> datum * datum -> unit 
+val insert     : table -> datum * datum -> unit
+val find       : table -> datum -> datum
+val peek       : table -> datum -> datum option
+val hasKey     : table -> datum -> bool
+val remove     : table -> datum -> unit
+val listKeys   : table -> datum list
+val numItems   : table -> int
+val listItems  : table -> (datum * datum) list
+val app        : (datum * datum -> unit) -> table -> unit
+val map        : (datum * datum -> 'a) -> table -> 'a list
+val fold       : (datum * datum * 'a -> 'a) -> 'a -> table -> 'a
+val fastwrite  : bool ref    
+val reorganize : table -> unit
+
+(* 
    [table] is the type of an opened table.  A value of type table can
    be used only in the argument f to the withtable function.  This
    makes sure that the table is closed after use.
@@ -135,4 +135,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Gdimage.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Gdimage.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Gdimage.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Gdimage.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,78 +6,78 @@
 Structure index
 

 
-(* Gdimage -- creating PNG images -- requires Dynlib *)
-
-type image
-
-type color
-
-datatype style = 
-    ColorS of color
-  | TransparentS
-
-datatype mode = 
-    Color of color
-  | Transparent
-  | Brushed of image
-  | Styled of style vector
-  | StyledBrushed of bool vector * image
-  | Tiled of image
-
-datatype font = 
-    Tiny 
-  | Small
-  | MediumBold
-  | Large 
-  | Giant
-
-type rgb = int * int * int           (* RGB color components, 0..255   *)
-type xy  = int * int                 (* points (x, y) and sizes (w, h) *)
-
-val image     : xy -> rgb -> image
-val fromPng   : string -> image
-val toPng     : image -> string -> unit
-val stdoutPng : image -> unit 
-val size      : image -> xy
-
-val color          : image -> rgb -> color
-val rgb            : image -> color -> rgb
-val htmlcolors     : image -> { aqua : color, black : color, blue : color,
-                                fuchsia : color, gray : color, 
-                                green : color, lime : color, maroon : color,
-                                navy : color, olive : color, purple : color,
-                                red : color, silver : color, teal : color,
-                                white : color, yellow : color }
-val getTransparent : image -> color option 
-val setTransparent : image -> color -> unit
-val noTransparent  : image -> unit 
-
-val drawPixel   : image -> mode -> xy -> unit
-val drawLine    : image -> mode -> xy * xy -> unit
-val drawRect    : image -> mode -> xy * xy -> unit
-val fillRect    : image -> mode -> xy * xy -> unit
-val drawPolygon : image -> mode -> xy vector -> unit
-val fillPolygon : image -> mode -> xy vector -> unit
-val drawArc     : image -> mode -> { c : xy, wh : xy, from : int, to : int }
-                  -> unit
-val fill        : image -> mode -> xy -> unit
-val fillBorder  : image -> mode -> xy -> color -> unit
- 
-val copy        : { src : image, srcxy : xy, srcwh : xy,
-                    dst : image, dstxy : xy } -> unit
-val copyResize  : { src : image, srcxy : xy, srcwh : xy,
-                    dst : image, dstxy : xy, dstwh : xy } -> unit
-
-val char        : image -> color -> font -> xy -> char -> unit
-val charUp      : image -> color -> font -> xy -> char -> unit
-val string      : image -> color -> font -> xy -> string -> unit
-val stringUp    : image -> color -> font -> xy -> string -> unit
-val charsize    : font -> xy
-
-(* 
-   This is an interface to version 1.7.3 of Thomas Boutell's gd image
-   package for creating PNG images.
-
+(* Gdimage -- creating PNG images -- requires Dynlib *)
+
+type image
+
+type color
+
+datatype style = 
+    ColorS of color
+  | TransparentS
+
+datatype mode = 
+    Color of color
+  | Transparent
+  | Brushed of image
+  | Styled of style vector
+  | StyledBrushed of bool vector * image
+  | Tiled of image
+
+datatype font = 
+    Tiny 
+  | Small
+  | MediumBold
+  | Large 
+  | Giant
+
+type rgb = int * int * int           (* RGB color components, 0..255   *)
+type xy  = int * int                 (* points (x, y) and sizes (w, h) *)
+
+val image     : xy -> rgb -> image
+val fromPng   : string -> image
+val toPng     : image -> string -> unit
+val stdoutPng : image -> unit 
+val size      : image -> xy
+
+val color          : image -> rgb -> color
+val rgb            : image -> color -> rgb
+val htmlcolors     : image -> { aqua : color, black : color, blue : color,
+                                fuchsia : color, gray : color, 
+                                green : color, lime : color, maroon : color,
+                                navy : color, olive : color, purple : color,
+                                red : color, silver : color, teal : color,
+                                white : color, yellow : color }
+val getTransparent : image -> color option 
+val setTransparent : image -> color -> unit
+val noTransparent  : image -> unit 
+
+val drawPixel   : image -> mode -> xy -> unit
+val drawLine    : image -> mode -> xy * xy -> unit
+val drawRect    : image -> mode -> xy * xy -> unit
+val fillRect    : image -> mode -> xy * xy -> unit
+val drawPolygon : image -> mode -> xy vector -> unit
+val fillPolygon : image -> mode -> xy vector -> unit
+val drawArc     : image -> mode -> { c : xy, wh : xy, from : int, to : int }
+                  -> unit
+val fill        : image -> mode -> xy -> unit
+val fillBorder  : image -> mode -> xy -> color -> unit
+ 
+val copy        : { src : image, srcxy : xy, srcwh : xy,
+                    dst : image, dstxy : xy } -> unit
+val copyResize  : { src : image, srcxy : xy, srcwh : xy,
+                    dst : image, dstxy : xy, dstwh : xy } -> unit
+
+val char        : image -> color -> font -> xy -> char -> unit
+val charUp      : image -> color -> font -> xy -> char -> unit
+val string      : image -> color -> font -> xy -> string -> unit
+val stringUp    : image -> color -> font -> xy -> string -> unit
+val charsize    : font -> xy
+
+(* 
+   This is an interface to version 1.7.3 of Thomas Boutell's gd image
+   package for creating PNG images.
+
    [image] is the type of images being drawn.  They can be created
    from scratch, imported from PNG files, and exported to PNG files.
 
@@ -213,4 +213,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/General.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/General.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/General.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/General.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,108 +6,110 @@
 Structure index
 

 
-(* SML Basis Library and Moscow ML top-level declarations *)
-
-(* SML Basis Library types *)
-
-type     exn
-eqtype   unit
-datatype order = LESS | EQUAL | GREATER
-
-(* Additional Moscow ML top-level types *)
-
-datatype bool = false | true
-eqtype char
-eqtype int
-datatype 'a option = NONE | SOME of 'a
-type ppstream
-eqtype real
-eqtype string
-type substring
-type syserror
-type 'a vector
-eqtype word
-eqtype word8
-datatype 'a list = nil | op :: of 'a * 'a list
-datatype 'a ref  = ref of 'a 
-datatype 'a frag = QUOTE of string | ANTIQUOTE of 'a
-
-(* SML Basis Library exceptions *)
-
-exception Bind
-exception Chr
-exception Div
-exception Domain
-exception Fail of string
-exception Match
-exception Overflow
+(* SML Basis Library and Moscow ML top-level declarations *)
+
+(* SML Basis Library types *)
+
+type     exn
+eqtype   unit
+datatype order = LESS | EQUAL | GREATER
+
+(* Additional Moscow ML top-level types *)
+
+datatype bool = false | true
+eqtype char
+eqtype int
+datatype 'a option = NONE | SOME of 'a
+type ppstream
+eqtype real
+eqtype string
+type substring
+type syserror
+type 'a vector
+eqtype word
+eqtype word8
+datatype 'a list = nil | op :: of 'a * 'a list
+datatype 'a ref  = ref of 'a 
+datatype 'a frag = QUOTE of string | ANTIQUOTE of 'a
+
+(* SML Basis Library exceptions *)
+
+exception Bind
+exception Chr
+exception Div
+exception Domain
+exception Fail of string
+exception Match
+exception Overflow
+exception Option
 exception Subscript
 exception Size
-
-(* Additional Moscow ML top-level exceptions *)
-
-exception Graphic of string
-exception Interrupt
-exception Invalid_argument of string
-exception Io of {function : string, name : string, cause : exn }
-exception Out_of_memory
-exception SysErr of string * syserror option
-
-(* SML Basis Library values *)
-
-val !          : 'a ref -> 'a
-val :=         : 'a ref * 'a -> unit
-
-val o          : ('b -> 'c) * ('a -> 'b) -> ('a -> 'c)
-val ignore     : 'a -> unit
-val before     : 'a * 'b -> 'a
-
-val exnName    : exn -> string
-val exnMessage : exn -> string
-
-(* Additional Moscow ML top-level values *)
-
-val not    : bool -> bool
-val ^      : string * string -> string
-
-val =      : ''a * ''a -> bool
-val <>     : ''a * ''a -> bool
-
-val ceil   : real -> int                (* round towards plus infinity  *)
-val floor  : real -> int                (* round towards minus infinity *)
-val real   : int -> real                (* equals Real.fromInt          *)
-val round  : real -> int                (* round to nearest even        *)
-val trunc  : real -> int                (* round towards zero           *)
-
-val vector : 'a list -> 'a vector
-
-(* Below, numtxt is int, Word.word, Word8.word, real, char, string: *)
-
-val <   : numtxt * numtxt -> bool
-val <=  : numtxt * numtxt -> bool
-val >   : numtxt * numtxt -> bool
-val >=  : numtxt * numtxt -> bool
-
-val makestring : numtxt -> string
-
-(* Below, realint is int or real:                                       *)
-
-val ~   : realint -> realint            (* raises Overflow              *)
-val abs : realint -> realint            (* raises Overflow              *)
-                                                                        
-(* Below, num is int, Word.word, Word8.word, or real:                   *)
-
-val +   : num * num -> num              (* raises Overflow              *)
-val -   : num * num -> num              (* raises Overflow              *)
-val *   : num * num -> num              (* raises Overflow              *)
-val /   : real * real -> real           (* raises Div, Overflow         *)
-                                                                        
-(* Below, wordint is int, Word.word or Word8.word:                      *)
-
-val div : wordint * wordint -> wordint  (* raises Div, Overflow         *)
-val mod : wordint * wordint -> wordint  (* raises Div                   *)
-
-(*
+exception Span
+
+(* Additional Moscow ML top-level exceptions *)
+
+exception Graphic of string
+exception Interrupt
+exception Invalid_argument of string
+exception Io of {function : string, name : string, cause : exn }
+exception Out_of_memory
+exception SysErr of string * syserror option
+
+(* SML Basis Library values *)
+
+val !          : 'a ref -> 'a
+val :=         : 'a ref * 'a -> unit
+
+val o          : ('b -> 'c) * ('a -> 'b) -> ('a -> 'c)
+val ignore     : 'a -> unit
+val before     : 'a * unit -> 'a
+
+val exnName    : exn -> string
+val exnMessage : exn -> string
+
+(* Additional Moscow ML top-level values *)
+
+val not    : bool -> bool
+val ^      : string * string -> string
+
+val =      : ''a * ''a -> bool
+val <>     : ''a * ''a -> bool
+
+val ceil   : real -> int                (* round towards plus infinity  *)
+val floor  : real -> int                (* round towards minus infinity *)
+val real   : int -> real                (* equals Real.fromInt          *)
+val round  : real -> int                (* round to nearest even        *)
+val trunc  : real -> int                (* round towards zero           *)
+
+val vector : 'a list -> 'a vector
+
+(* Below, numtxt is int, Word.word, Word8.word, real, char, string: *)
+
+val <   : numtxt * numtxt -> bool
+val <=  : numtxt * numtxt -> bool
+val >   : numtxt * numtxt -> bool
+val >=  : numtxt * numtxt -> bool
+
+val makestring : numtxt -> string
+
+(* Below, realint is int or real:                                       *)
+
+val ~   : realint -> realint            (* raises Overflow              *)
+val abs : realint -> realint            (* raises Overflow              *)
+                                                                        
+(* Below, num is int, Word.word, Word8.word, or real:                   *)
+
+val +   : num * num -> num              (* raises Overflow              *)
+val -   : num * num -> num              (* raises Overflow              *)
+val *   : num * num -> num              (* raises Overflow              *)
+val /   : real * real -> real           (* raises Div, Overflow         *)
+                                                                        
+(* Below, wordint is int, Word.word or Word8.word:                      *)
+
+val div : wordint * wordint -> wordint  (* raises Div, Overflow         *)
+val mod : wordint * wordint -> wordint  (* raises Div                   *)
+
+(*
    [exn] is the type of exceptions.
  
    [unit] is the type containing the empty tuple () which equals the 
@@ -167,6 +169,8 @@
    [Match] signals the failure to match a value against the patterns
    in a case, handle, or function application.
 
+   [Option] is raised by Option.valOf when applied to NONE.
+
    [Overflow] signals the attempt to compute an unrepresentable number.
 
    [Subscript] signals the attempt to use an illegal index in an
@@ -197,9 +201,9 @@
 
    SML Basis Library values 
 
-   [! rf] returns the value pointed to by reference rf.
+   [! rf] returns the value pointed to by reference rf.
 
-   [:=(rf, e)] evaluates rf and e, then makes the reference rf point to
+   [:=(rf, e)] evaluates rf and e, then makes the reference rf point to
    the value of e.  Since := has infix status, this is usually written
         rf := e
 
@@ -228,11 +232,11 @@
 
    [not b] returns the logical negation of b.
 
-   [^] is the string concatenation operator.
+   [^] is the string concatenation operator.
 
-   [=] is the polymorphic equality predicate.
+   [=] is the polymorphic equality predicate.
 
-   [<>] is the polymorphic inequality predicate.
+   [<>] is the polymorphic inequality predicate.
 
    [ceil r] is the smallest integer >= r (rounds towards plus infinity).
    May raise Overflow.
@@ -251,10 +255,10 @@
 
    [vector [x1, ..., xn]] returns the vector #[x1, ..., xn].
 
-   [< (x1, x2)] 
-   [<=(x1, x2)]
-   [> (x1, x2)]
-   [>=(x1, x2)]
+   [< (x1, x2)] 
+   [<=(x1, x2)]
+   [> (x1, x2)]
+   [>=(x1, x2)]
 
    These are the standard comparison operators for arguments of type
    int, Word.word, Word8.word, real, char or string.
@@ -262,21 +266,21 @@
    [makestring v] returns a representation of value v as a string, for
    v of type int, Word.word, Word8.word, real, char or string.
 
-   [~ x] is the numeric negation of x (which can be real or int).  May
+   [~ x] is the numeric negation of x (which can be real or int).  May
    raise Overflow.
 
    [abs x] is the absolute value of x (which can be real or int).  May
    raise Overflow.
                                                                         
-   [+ (e1, e2)]
+   [+ (e1, e2)]
    [- (e1, e2)]
-   [* (e1, e2)]
+   [* (e1, e2)]
 
    These are the standard arithmetic operations for arguments of type
    int, Word.word, Word8.word, and real.  They are unsigned in the
    case of Word.word and Word8.word.  May raise Overflow.
 
-   [/ (e1, e2)] is the floating-point result of dividing e1 by e2.
+   [/ (e1, e2)] is the floating-point result of dividing e1 by e2.
    May raise Div and Overflow.
                                                                         
    [div(e1, e2)] is the integral quotient of dividing e1 by e2 for
@@ -292,4 +296,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Hashset.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Hashset.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Hashset.html	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Hashset.html	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,104 @@
+Structure Hashset
+
+
Structure Hashset

+

+
Identifier index
+Structure index
+

+
+(* Hashset -- sets implemented by hashtables *)
+
+signature Hashset = sig
+type 'item set
+
+exception NotFound
+
+val empty        : ('_item -> word) * ('_item * '_item -> bool) -> '_item set
+val singleton    : ('_item -> word) * ('_item * '_item -> bool) -> '_item 
+                   -> '_item set
+
+val member       : '_item set * '_item -> bool
+val retrieve     : '_item set * '_item -> '_item
+val peek         : '_item set * '_item -> '_item option
+
+val add          : '_item set * '_item -> unit
+val addList      : '_item set * '_item list -> unit
+val delete       : '_item set * '_item -> unit
+
+val isEmpty      : '_item set -> bool
+val isSubset     : '_item set * '_item set -> bool
+val equal        : '_item set * '_item set -> bool
+val numItems     : '_item set ->  int
+val listItems    : '_item set -> '_item list
+
+val app          : ('_item -> unit) -> '_item set -> unit
+val fold         : ('_item * 'b -> 'b) -> 'b -> '_item set -> 'b
+val all          : ('_item -> bool) -> '_item set -> bool
+val exists       : ('_item -> bool) -> '_item set -> bool
+val find         : ('_item -> bool) -> '_item set -> '_item option
+val copy         : '_item set -> '_item set
+
+val hash         : '_item set -> word
+val polyHash     : 'a -> word
+
+end
+
+(* 
+   ['item set] is the type of sets of elements of type 'item, with a
+   given hash function and equality predicate.
+
+   [empty (hash, equal)] creates a new empty set with the given hash
+   function and equality predicate.  It must hold that equal(x, y)
+   implies hash x = hash y.
+
+   [singleton (hash, equal) i] creates the singleton set containing i,
+   with the given hash function and equality predicate.
+
+   [member(s, i)] returns true if and only if i is in s.
+
+   [retrieve(s, i)] returns i if it is in s; raises NotFound otherwise.
+
+   [peek(s, i)] returns SOME i if i is in s; returns NONE otherwise.
+
+   [add(s, i)] adds item i to set s.  
+
+   [addList(s, xs)] adds all items from the list xs to the set s.
+
+   [delete(s, i)] removes item i from s.  Raises NotFound if i is not in s.
+
+   [isEmpty s] returns true if the set is empty; false otherwise.
+
+   [equal(s1, s2)] returns true if and only if the two sets have the
+   same elements.  
+
+   [isSubset(s1, s2)] returns true if and only if s1 is a subset of s2.
+   
+   [numItems s] returns the number of items in set s.
+
+   [listItems s] returns a list of the items in set s, in some order.
+
+   [app f s] applies function f to the elements of s, in some order.
+
+   [fold f e s] applies the folding function f to the entries of the
+   set in some order.
+
+   [find p s] returns SOME i, where i is an item in s which satisfies
+   p, if one exists; otherwise returns NONE.  
+
+   [hash s] returns the hashcode of the set, which is the sum of the
+   hashcodes of its elements, as computed by the hash function given
+   when the set was created.  
+
+   [polyHash v] returns a system-defined hashcode for the value v.
+   This pseudo-polymorphic hash function can be used together with the
+   standard equality function (=) to create a Hashset for any type that 
+   admits equality, as follows:
+
+       val set = Hashset.empty (Hashset.hash, op =);
+*)
+
+

+
Identifier index
+Structure index
+

+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Help.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Help.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Help.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Help.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,19 +6,19 @@
 Structure index
 

 
-(* Help -- on-line help functions *)
-
-val help           : string -> unit
-
-val displayLines   : int ref
-val helpdirs       : string list ref
-val indexfiles     : string list ref
-val specialfiles   : {term : string, file : string, title : string} list ref
-val welcome        : string vector ref
-val browser        : (string -> unit) ref
-val defaultBrowser : string -> unit
-
-(* 
+(* Help -- on-line help functions *)
+
+val help           : string -> unit
+
+val displayLines   : int ref
+val helpdirs       : string list ref
+val indexfiles     : string list ref
+val specialfiles   : {term : string, file : string, title : string} list ref
+val welcome        : string vector ref
+val browser        : (string -> unit) ref
+val defaultBrowser : string -> unit
+
+(* 
    [help s] provides on-line help on the topic indicated by string s.  
 
       help "lib";   gives an overview of the Moscow ML library.
@@ -77,4 +77,4 @@
 Identifier index
 Structure index
 

-
Moscow ML 2.00
+
Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/idIndex.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/idIndex.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/idIndex.html	2000-08-02 13:05:32.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/idIndex.html	2014-08-28 08:47:22.000000000 +0000
@@ -9,7 +9,7 @@
 
A  B  C  D  E  F  G  H  I  J  K  L  M  N  O  P  Q  R  S  T  U  V  W  X  Y  Z  

 
 
Symbolic identifiers

-
@@ -108,25 +116,27 @@
 
B

 
 
@@ -507,9 +537,10 @@
 
  • h4 (value; Msp)
 
  • h5 (value; Msp)
 
  • h6 (value; Msp)
-
  • hash (value; FileSys, Polyhash)
+
  • hash (value; FileSys, Hashset, Polyhash, Rbset)
 
  • hash_param (value; Polyhash)
 
  • hash_table (type; Polyhash)
+
  • Hashset (structure)
 
  • hasKey (value; Gdbm, Polygdbm)
 
  • Hd (exception; NJ93)
 
  • hd (value; List, NJ93)
@@ -518,7 +549,7 @@
 
  • help (value; Help)
 
  • helpdirs (value; Help)
 
  • HEX (constructor; StringCvt)
-
  • host (value; Mysql, Postgres)
+
  • host (value; Mysql, Postgres)
 
  • hour (value; Date)
 
  • hr (value; Msp)
 
  • hra (value; Msp)
@@ -534,13 +565,13 @@
 
    I
    
 
 
    • Icase (constructor; Regex)
-
    • ignore (value; General)
+
    • ignore (value; General)
 
    • ill (value; Signal)
 
    • image (type; Gdimage)
 
    • image (value; Gdimage)
 
    • img (value; Msp)
 
    • imga (value; Msp)
-
    • implode (value; NJ93, SML90, String)
+
    • implode (value; NJ93, SML90, String)
 
    • in_flags (type; Socket)
 
    • in_stream_length (value; Nonstdio)
 
    • inc (value; NJ93)
@@ -566,48 +597,55 @@
 
    • inputNoBlock (value; BinIO, TextIO)
 
    • inradio (value; Msp)
 
    • inreset (value; Msp)
-
    • insert (value; Binarymap, Gdbm, Intmap, Polygdbm, Polyhash, Splaymap)
+
    • insert (value; Binarymap, Gdbm, Intmap, Polygdbm, Polyhash, Redblackmap, Splaymap)
 
    • installPP (value; Meta)
 
    • instream (type; BasicIO, BinIO, NJ93, SML90, TextIO)
 
    • insubmit (value; Msp)
-
    • Int (constructor; Mysql, Postgres)
+
    • Int (constructor; Mysql, Postgres)
 
    • Int (structure)
-
    • int (type; General, Int)
+
    • int (type; General, Int, IntInf)
 
    • int (value; Signal)
-
    • Interrupt (exception; General)
-
    • intersection (value; Binaryset, Intset, Splayset)
+
    • Interrupt (exception; General)
+
    • intersection (value; Binaryset, Intset, Rbset, Splayset)
 
    • intext (value; Msp)
+
    • IntInf (structure)
 
    • Intmap (structure)
 
    • intmap (type; Intmap)
 
    • Intset (structure)
 
    • intset (type; Intset)
-
    • IntTy (constructor; Mysql, Postgres)
-
    • Invalid_argument (exception; General)
-
    • Io (exception; General)
+
    • IntTy (constructor; Mysql, Postgres)
+
    • intv (type; Rbset)
+
    • Invalid_argument (exception; General)
+
    • InvalidArc (exception; Path)
+
    • Io (exception; General)
 
    • isAbsolute (value; Path)
 
    • isAlpha (value; Char)
 
    • isAlphaNum (value; Char)
 
    • isAscii (value; Char)
-
    • isCanonical (value; Path)
+
    • isCanonical (value; Path)
 
    • isCntrl (value; Char)
 
    • isdead (value; Weak)
 
    • isDigit (value; Char)
 
    • isDir (value; FileSys)
 
    • isDst (value; Date)
-
    • isEmpty (value; Binaryset, Intset, Splayset, Substring)
+
    • isEmpty (value; ArraySlice, Binaryset, CharArraySlice, CharVectorSlice, Hashset, Intset, Rbset, Splayset, Substring, VectorSlice, Word8ArraySlice, Word8VectorSlice)
 
    • isGraph (value; Char)
 
    • isHexDigit (value; Char)
 
    • isLink (value; FileSys)
 
    • isLower (value; Char)
-
    • isnull (value; Mysql, Postgres)
-
    • isPrefix (value; String, Substring)
+
    • isnull (value; Mysql, Postgres)
+
    • isPrefix (value; String, Substring)
 
    • isPrint (value; Char)
 
    • isPunct (value; Char)
 
    • isRegistered (value; Callback)
 
    • isRelative (value; Path)
+
    • isRoot (value; Path)
 
    • isSome (value; Option)
 
    • isSpace (value; Char)
-
    • isSubset (value; Binaryset, Intset, Splayset)
+
    • isSubset (value; Binaryset, Hashset, Intset, Rbset, Splayset)
+
    • isSubstring (value; String, Substring)
+
    • isSuccess (value; Process)
+
    • isSuffix (value; String, Substring)
 
    • isUpper (value; Char)
 
    • isweak (value; Weak)
 
    • itemEnd (value; Parsing)
@@ -620,8 +658,8 @@
 
 
      • Jan (constructor; Date)
 
      • join (value; Option)
-
      • joinBaseExt (value; Path)
-
      • joinDirFile (value; Path)
+
      • joinBaseExt (value; Path)
+
      • joinDirFile (value; Path)
 
      • Jul (constructor; Date)
 
      • Jun (constructor; Date)
 
@@ -630,7 +668,7 @@
 
 
        K
        
         
-
        • kill (value; Signal, Unix)
+
 
@@ -639,7 +677,7 @@
 
 
@@ -670,10 +709,12 @@
 
 
          M
          
           
-
          • makestring (value; General)
-
          • map (value; Binarymap, CharVector, Gdbm, Intmap, List, ListPair, Msp, Option, Polygdbm, Polyhash, Regex, Splaymap, String, Vector, Word8Vector)
+
            • makestring (value; General)
+
            • map (value; Binarymap, CharVector, CharVectorSlice, Gdbm, Intmap, List, ListPair, Msp, Option, Polygdbm, Polyhash, Rbset, Redblackmap, Regex, Splaymap, String, Vector, VectorSlice, Word8Vector, Word8VectorSlice)
 
            • mapa (value; Msp)
-
            • mapi (value; CharVector, Vector, Word8Vector)
+
            • mapEq (value; ListPair)
+
            • mapi (value; CharVector, CharVectorSlice, Vector, VectorSlice, Word8Vector, Word8VectorSlice)
+
            • mapMono (value; Rbset)
 
            • mapPartial (value; List, Option)
 
            • Mar (constructor; Date)
 
            • mark0 (value; Msp)
@@ -682,35 +723,37 @@
 
            • mark1a (value; Msp)
 
            • Match (exception; General)
 
            • Math (structure)
-
            • max (value; Int, NJ93, Real, Word, Word8)
+
            • max (value; Int, IntInf, NJ93, Rbset, Real, Word, Word8)
 
            • maxChar (value; Char)
-
            • maxInt (value; Int)
-
            • maxLen (value; Array, CharArray, CharVector, Vector, Weak, Word8Array, Word8Vector)
+
            • maxInt (value; Int, IntInf)
+
            • maxLen (value; Array, CharArray, CharVector, Vector, Weak, Word8Array, Word8Vector)
 
            • maxOrd (value; Char)
 
            • maxSize (value; String)
 
            • May (constructor; Date)
 
            • md5sum (value; Mosml)
 
            • MediumBold (constructor; Gdimage)
-
            • member (value; Binaryset, Intset, Splayset)
+
            • member (value; Binaryset, Hashset, Intset, Rbset, Splayset)
+
            • merge (value; Listsort)
+
            • mergeUniq (value; Listsort)
 
            • Meta (structure)
-
            • min (value; Int, NJ93, Real, Word, Word8)
+
            • min (value; Int, IntInf, NJ93, Rbset, Real, Word, Word8)
 
            • minChar (value; Char)
-
            • minInt (value; Int)
+
            • minInt (value; Int, IntInf)
 
            • minute (value; Date)
 
            • mk_ppstream (value; PP)
-
            • mkAbsolute (value; Path)
-
            • mkCanonical (value; Path)
-
            • mkDict (value; Binarymap, Splaymap)
+
            • mkAbsolute (value; Path)
+
            • mkCanonical (value; Path)
+
            • mkDict (value; Binarymap, Redblackmap, Splaymap)
 
            • mkDir (value; FileSys)
 
            • mkLoc (value; Location)
 
            • mkPolyTable (value; Polyhash)
-
            • mkRelative (value; Path)
+
            • mkRelative (value; Path)
 
            • mkTable (value; Polyhash)
 
            • Mod (exception; SML90)
-
            • mod (value; General, Int, Word, Word8)
+
            • mod (value; General, Int, IntInf, Word, Word8)
 
            • mode (type; Gdimage)
-
            • modify (value; Array, Array2, CharArray, Weak, Word8Array)
-
            • modifyi (value; Array, Array2, CharArray, Weak, Word8Array)
+
            • modify (value; Array, Array2, ArraySlice, CharArray, CharArraySlice, Weak, Word8Array, Word8ArraySlice)
+
            • modifyi (value; Array, Array2, ArraySlice, CharArray, CharArraySlice, Weak, Word8Array, Word8ArraySlice)
 
            • modTime (value; FileSys)
 
            • Mon (constructor; Date)
 
            • month (type; Date)
@@ -728,12 +771,14 @@
 
 
 
 
 
              O
              
               
-
              • o (value; General)
+
                • o (value; General)
 
                • OCT (constructor; StringCvt)
 
                • Oct (constructor; Date)
 
                • offset (value; Date)
-
                • Oid (constructor; Postgres)
-
                • oid (type; Postgres)
-
                • OidTy (constructor; Postgres)
+
                • Oid (constructor; Mysql, Postgres)
+
                • oid (type; Mysql, Postgres)
+
                • OidTy (constructor; Mysql, Postgres)
 
                • ol (value; Msp)
 
                • ola (value; Msp)
 
                • open_append (value; BasicIO, NJ93)
@@ -787,16 +833,16 @@
 
                • open_out_bin (value; BasicIO, NJ93, Nonstdio)
 
                • open_out_exe (value; Nonstdio)
 
                • openAppend (value; BinIO, TextIO)
-
                • openbase (value; Mysql, Postgres)
+
                • openbase (value; Mysql, Postgres)
 
                • openDir (value; FileSys)
 
                • openIn (value; BinIO, TextIO)
 
                • openmode (type; Gdbm)
 
                • openOut (value; BinIO, TextIO)
-
                • Option (exception; Option)
+
                • Option (exception; General, Option)
 
                • Option (structure)
 
                • option (type; General, Option)
 
                • option (value; Msp)
-
                • options (value; Mysql, Postgres)
+
                • options (value; Mysql, Postgres)
 
                • orb (value; Word, Word8)
 
                • ord (value; Char, NJ93, SML90)
 
                • order (type; General)
@@ -806,7 +852,7 @@
 
                • OSAerr (type; AppleScript)
 
                • OSAID (type; AppleScript)
 
                • out_flags (type; Socket)
-
                • Out_of_memory (exception; General)
+
                • Out_of_memory (exception; General)
 
                • output (value; BasicIO, BinIO, NJ93, SML90, TextIO)
 
                • output1 (value; BinIO, TextIO)
 
                • output_binary_int (value; Nonstdio)
@@ -844,7 +890,7 @@
 
                • passive (type; Socket)
 
                • Path (exception; Path)
 
                • Path (structure)
-
                • peek (value; Binarymap, Binaryset, Gdbm, Intmap, Polygdbm, Polyhash, Splaymap, Splayset)
+
                • peek (value; Binarymap, Binaryset, Gdbm, Hashset, Intmap, Polygdbm, Polyhash, Redblackmap, Splaymap, Splayset)
 
                • peekInsert (value; Polyhash)
 
                • peekVal (value; Parsing)
 
                • pf_file (type; Socket)
@@ -853,18 +899,19 @@
 
                • pipe (value; Signal)
 
                • Polygdbm (structure)
 
                • Polyhash (structure)
-
                • port (value; Mysql, Postgres)
+
                • polyHash (value; Hashset)
+
                • port (value; Mysql, Postgres)
 
                • pos_in (value; Nonstdio)
 
                • pos_out (value; Nonstdio)
-
                • position (value; Substring)
+
                • position (value; Substring)
 
                • Postgres (structure)
-
                • pow (value; Math)
+
                • pow (value; IntInf, Math)
 
                • PP (structure)
 
                • pp_to_string (value; PP)
 
                • ppconsumer (type; PP)
 
                • ppstream (type; General)
 
                • pre (value; Msp)
-
                • precision (value; Int)
+
                • precision (value; Int, IntInf)
 
                • pred (value; Char)
 
                • print (value; BasicIO, NJ93, TextIO)
 
                • printDepth (value; Meta)
@@ -885,9 +932,10 @@
 
 
@@ -900,19 +948,20 @@
 
                • randomlist (value; Random)
 
                • range (value; Random)
 
                • rangelist (value; Random)
+
                • Rbset (structure)
 
                • readDir (value; FileSys)
 
                • READER (constructor; Gdbm)
 
                • reader (type; StringCvt)
 
                • readLink (value; FileSys)
-
                • Real (constructor; Mysql, Postgres)
+
                • Real (constructor; Mysql, Postgres)
 
                • Real (structure)
 
                • real (type; General, Math, Real)
-
                • real (value; General)
+
                • real (value; General)
 
                • real_timer (type; Timer)
 
                • realfmt (type; StringCvt)
 
                • realPath (value; FileSys)
-
                • RealTy (constructor; Mysql, Postgres)
-
                • reap (value; Unix)
+
                • RealTy (constructor; Mysql, Postgres)
+
                • reap (value; Unix)
 
                • recvArr (value; Socket)
 
                • recvArr' (value; Socket)
 
                • recvArrFrom (value; Socket)
@@ -921,6 +970,7 @@
 
                • recvVec' (value; Socket)
 
                • recvVecFrom (value; Socket)
 
                • recvVecFrom' (value; Socket)
+
                • Redblackmap (structure)
 
                • ref (constructor; General)
 
                • ref (type; General)
 
                • regcomp (value; Regex)
@@ -935,25 +985,25 @@
 
                • regmatchBool (value; Regex)
 
                • regnexec (value; Regex)
 
                • regnexecBool (value; Regex)
-
                • rem (value; Int)
-
                • remove (value; Binarymap, FileSys, Gdbm, Intmap, Polygdbm, Polyhash, Splaymap)
+
                • rem (value; Int, IntInf)
+
                • remove (value; Binarymap, FileSys, Gdbm, Intmap, Polygdbm, Polyhash, Redblackmap, Splaymap)
 
                • rename (value; FileSys)
 
                • reorganize (value; Gdbm, Polygdbm)
 
                • replace (value; Regex)
 
                • replace1 (value; Regex)
 
                • replacer (type; Regex)
-
                • reset (value; Mysql, Postgres)
-
                • resultstatus (value; Mysql, Postgres)
-
                • retrieve (value; Binaryset, Intmap, Splayset)
+
                • reset (value; Buffer, Mysql, Postgres)
+
                • resultstatus (value; Mysql, Postgres)
+
                • retrieve (value; Binaryset, Hashset, Intmap, Splayset)
 
                • rev (value; List)
-
                • revapp (value; Binarymap, Binaryset, Intmap, Intset, NJ93, Splaymap, Splayset)
+
                • revapp (value; Binarymap, Binaryset, Intmap, Intset, NJ93, Rbset, Redblackmap, Splaymap, Splayset)
 
                • revAppend (value; List)
 
                • revfold (value; NJ93)
 
                • rewindDir (value; FileSys)
 
                • rgb (type; Gdimage)
 
                • rgb (value; Gdimage)
 
                • rmDir (value; FileSys)
-
                • round (value; General, Real)
+
                • round (value; General, Real)
 
                • row (value; Array2)
 
                • RowMajor (constructor; Array2)
 
                • RTLD_LAZY (constructor; Dynlib)
@@ -967,9 +1017,9 @@
 
                  S
                  
 
 
 
@@ -1093,78 +1149,83 @@
 
 
@@ -1173,15 +1234,16 @@
 
 
@@ -1224,7 +1288,9 @@
 
                • Word8 (structure)
 
                • word8 (type; General)
 
                • Word8Array (structure)
+
                • Word8ArraySlice (structure)
 
                • Word8Vector (structure)
+
                • Word8VectorSlice (structure)
 
                • wordSize (value; Word, Word8)
 
                • WRCREAT (constructor; Gdbm)
 
                • WRITER (constructor; Gdbm)
@@ -1260,7 +1326,8 @@
 
 
 
                  
 
                  A  B  C  D  E  F  G  H  I  J  K  L  M  N  O  P  Q  R  S  T  U  V  W  X  Y  Z  
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Int.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Int.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Int.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Int.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,47 +6,47 @@
 Structure index
 
                  
 
                  -(* Int -- SML Basis Library *)
-
-type int = int
-
-val precision : int option
-val minInt    : int option
-val maxInt    : int option
-
-val ~         : int -> int              (* Overflow      *)
-val *         : int * int -> int        (* Overflow      *)
-val div       : int * int -> int        (* Div, Overflow *)
-val mod       : int * int -> int        (* Div           *)
-val quot      : int * int -> int        (* Div, Overflow *)
-val rem       : int * int -> int        (* Div           *)
-val +         : int * int -> int        (* Overflow      *)
-val -         : int * int -> int        (* Overflow      *)
-val >         : int * int -> bool
-val >=        : int * int -> bool
-val <         : int * int -> bool
-val <=        : int * int -> bool
-val abs       : int -> int              (* Overflow      *)
-val min       : int * int -> int
-val max       : int * int -> int
-
-val sign      : int -> int
-val sameSign  : int * int -> bool
-val compare   : int * int -> order
-
-val toInt     : int -> int
-val fromInt   : int -> int
-val toLarge   : int -> int
-val fromLarge : int -> int
-
-val scan      : StringCvt.radix 
-                -> (char, 'a) StringCvt.reader -> (int, 'a) StringCvt.reader
-val fmt       : StringCvt.radix -> int -> string
-
-val toString  : int -> string
-val fromString : string -> int option   (* Overflow      *)
-
-(* 
+(* Int -- SML Basis Library *)
+
+type int = int
+
+val precision : int option
+val minInt    : int option
+val maxInt    : int option
+
+val ~         : int -> int              (* Overflow      *)
+val *         : int * int -> int        (* Overflow      *)
+val div       : int * int -> int        (* Div, Overflow *)
+val mod       : int * int -> int        (* Div           *)
+val quot      : int * int -> int        (* Div, Overflow *)
+val rem       : int * int -> int        (* Div           *)
+val +         : int * int -> int        (* Overflow      *)
+val -         : int * int -> int        (* Overflow      *)
+val >         : int * int -> bool
+val >=        : int * int -> bool
+val <         : int * int -> bool
+val <=        : int * int -> bool
+val abs       : int -> int              (* Overflow      *)
+val min       : int * int -> int
+val max       : int * int -> int
+
+val sign      : int -> int
+val sameSign  : int * int -> bool
+val compare   : int * int -> order
+
+val toInt     : int -> int
+val fromInt   : int -> int
+val toLarge   : int -> int
+val fromLarge : int -> int
+
+val scan      : StringCvt.radix 
+                -> (char, 'a) StringCvt.reader -> (int, 'a) StringCvt.reader
+val fmt       : StringCvt.radix -> int -> string
+
+val toString  : int -> string
+val fromString : string -> int option   (* Overflow      *)
+
+(* 
    [precision] is SOME n, where n is the number of significant bits in an
    integer.  In Moscow ML n is 31 in 32-bit architectures and 63 in 64-bit
    architectures.
@@ -55,9 +55,9 @@
 
    [maxInt] is SOME n, where n is the most positive integer.
 
-   [~]
-   [*]
-   [+]
+   [~]
+   [*]
+   [+]
    [-] are the usual operations on integers.  They raise Overflow if
    the result is not representable as an integer.
 
@@ -88,10 +88,10 @@
 
    [sign x] is ~1, 0, or 1, according as x is negative, zero, or positive.
 
-   [<]
-   [<=]
-   [>]
-   [>=] are the usual comparisons on integers.
+   [<]
+   [<=]
+   [>]
+   [>=] are the usual comparisons on integers.
 
    [compare(x, y)] returns LESS, EQUAL, or GREATER, according 
    as x is less than, equal to, or greater than y.
@@ -145,4 +145,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/IntInf.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/IntInf.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/IntInf.html	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/IntInf.html	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,61 @@
+Structure IntInf
+
+
                  Structure IntInf
                  
+
                  
+
                  Identifier index
+Structure index
+
                  
+
                  +(* LargeInt -- arbitrary-precision integers 1995-09-04, 1998-04-12     *)
+(* This module requires Dynlib and the GNU GMP package to be installed *)
+
+type int
+
+val precision : int option
+val minInt    : int option
+val maxInt    : int option
+
+val ~    : int -> int
+val +    : int * int -> int
+val -    : int * int -> int
+val *    : int * int -> int
+val div  : int * int -> int
+val mod  : int * int -> int
+val quot : int * int -> int
+val rem  : int * int -> int
+val <    : int * int -> bool
+val >    : int * int -> bool
+val <=   : int * int -> bool
+val >=   : int * int -> bool
+val eq   : int * int -> bool
+val ne   : int * int -> bool
+val abs  : int -> int
+val min  : int * int -> int
+val max  : int * int -> int
+
+val divMod   : int * int -> int * int
+val quotRem  : int * int -> int * int
+val pow      : int * Int.int -> int
+val log2     : int -> Int.int
+
+val sign     : int -> Int.int
+val sameSign : int * int -> bool
+val compare  : int * int -> order
+
+val fromInt    : Int.int -> int
+val toInt      : int -> Int.int		(* Overflow *)
+val toLarge    : int -> int
+val fromLarge  : int -> int
+
+val fromString : string -> int option
+val toString   : int -> string
+
+val scan : StringCvt.radix
+           -> (char, 'a) StringCvt.reader -> (int, 'a) StringCvt.reader
+val fmt  : StringCvt.radix -> int -> string
+
+
                  
+
                  Identifier index
+Structure index
+
                  
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Intmap.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Intmap.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Intmap.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Intmap.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,29 +6,29 @@
 Structure index
 
                  
 
                  -(* Intmap -- Applicative maps with integer keys                  *)
-(* From SML/NJ lib 0.2, copyright 1993 by AT&T Bell Laboratories *)
-(* Original implementation due to Stephen Adams, Southampton, UK *)
-
-type 'a intmap
-
-exception NotFound
-
-val empty     : unit -> 'a intmap
-val insert    : 'a intmap * int * 'a -> 'a intmap
-val retrieve  : 'a intmap * int -> 'a
-val peek      : 'a intmap * int -> 'a option
-val remove    : 'a intmap * int -> 'a intmap * 'a
-val numItems  : 'a intmap ->  int
-val listItems : 'a intmap -> (int * 'a) list
-val app       : (int * 'a -> unit) -> 'a intmap -> unit
-val revapp    : (int * 'a -> unit) -> 'a intmap -> unit
-val foldr     : (int * 'a * 'b -> 'b) -> 'b -> 'a intmap -> 'b
-val foldl     : (int * 'a * 'b -> 'b) -> 'b -> 'a intmap -> 'b
-val map       : (int * 'a -> 'b) -> 'a intmap -> 'b intmap
-val transform : ('a -> 'b) -> 'a intmap -> 'b intmap
-
-(* 
+(* Intmap -- Applicative maps with integer keys                  *)
+(* From SML/NJ lib 0.2, copyright 1993 by AT&T Bell Laboratories *)
+(* Original implementation due to Stephen Adams, Southampton, UK *)
+
+type 'a intmap
+
+exception NotFound
+
+val empty     : unit -> 'a intmap
+val insert    : 'a intmap * int * 'a -> 'a intmap
+val retrieve  : 'a intmap * int -> 'a
+val peek      : 'a intmap * int -> 'a option
+val remove    : 'a intmap * int -> 'a intmap * 'a
+val numItems  : 'a intmap ->  int
+val listItems : 'a intmap -> (int * 'a) list
+val app       : (int * 'a -> unit) -> 'a intmap -> unit
+val revapp    : (int * 'a -> unit) -> 'a intmap -> unit
+val foldr     : (int * 'a * 'b -> 'b) -> 'b -> 'a intmap -> 'b
+val foldl     : (int * 'a * 'b -> 'b) -> 'b -> 'a intmap -> 'b
+val map       : (int * 'a -> 'b) -> 'a intmap -> 'b intmap
+val transform : ('a -> 'b) -> 'a intmap -> 'b intmap
+
+(* 
    ['a intmap] is the type of applicative maps from int to 'a.
 
    [empty] creates a new empty map.
@@ -73,4 +73,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Intset.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Intset.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Intset.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Intset.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,35 +6,35 @@
 Structure index
 
                  
 
                  -(* Intset -- applicative sets of integers                        *)
-(* From SML/NJ lib 0.2, copyright 1993 by AT&T Bell Laboratories *)
-(* Original implementation due to Stephen Adams, Southampton, UK *)
-
-type intset
-
-exception NotFound
-
-val empty        : intset
-val singleton    : int -> intset
-val add          : intset * int -> intset
-val addList      : intset * int list -> intset
-val isEmpty      : intset -> bool
-val equal        : intset * intset -> bool
-val isSubset     : intset * intset -> bool
-val member       : intset * int -> bool
-val delete       : intset * int -> intset
-val numItems     : intset ->  int
-val union        : intset * intset -> intset
-val intersection : intset * intset -> intset
-val difference   : intset * intset -> intset
-val listItems    : intset -> int list
-val app          : (int -> unit) -> intset -> unit
-val revapp       : (int -> unit) -> intset -> unit
-val foldr        : (int * 'b -> 'b) -> 'b -> intset -> 'b
-val foldl        : (int * 'b -> 'b) -> 'b -> intset -> 'b
-val find         : (int -> bool) -> intset -> int option
-
-(* 
+(* Intset -- applicative sets of integers                        *)
+(* From SML/NJ lib 0.2, copyright 1993 by AT&T Bell Laboratories *)
+(* Original implementation due to Stephen Adams, Southampton, UK *)
+
+type intset
+
+exception NotFound
+
+val empty        : intset
+val singleton    : int -> intset
+val add          : intset * int -> intset
+val addList      : intset * int list -> intset
+val isEmpty      : intset -> bool
+val equal        : intset * intset -> bool
+val isSubset     : intset * intset -> bool
+val member       : intset * int -> bool
+val delete       : intset * int -> intset
+val numItems     : intset ->  int
+val union        : intset * intset -> intset
+val intersection : intset * intset -> intset
+val difference   : intset * intset -> intset
+val listItems    : intset -> int list
+val app          : (int -> unit) -> intset -> unit
+val revapp       : (int -> unit) -> intset -> unit
+val foldr        : (int * 'b -> 'b) -> 'b -> intset -> 'b
+val foldl        : (int * 'b -> 'b) -> 'b -> intset -> 'b
+val find         : (int -> bool) -> intset -> int option
+
+(* 
    [intset] is the type of sets of integers.  
 
    [empty] is the empty set of integers.
@@ -88,4 +88,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Lexing.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Lexing.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Lexing.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Lexing.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,46 +6,46 @@
 Structure index
 
                  
 
                  -(* Lexing -- run-time library for lexers generated by mosmllex             *)
-(* Closely based on the library for camllex.  Copyright 1993 INRIA, France *)
-
-local open Obj in
-
-type lexbuf
-
-val createLexerString : string -> lexbuf
-val createLexer       : (CharArray.array -> int -> int) -> lexbuf
-
-val getLexeme         : lexbuf -> string
-val getLexemeChar     : lexbuf -> int -> char
-val getLexemeStart    : lexbuf -> int
-val getLexemeEnd      : lexbuf -> int
-
-(* For internal use in generated lexers: *)
-
-val dummyAction       : lexbuf -> obj
-val backtrack         : lexbuf -> 'a
-prim_val getNextChar  : lexbuf -> char = 1 "get_next_char"
-
-prim_val getLexBuffer     : lexbuf -> string           = 1 "field1"
-prim_val getLexAbsPos     : lexbuf -> int              = 1 "field2"
-prim_val getLexStartPos   : lexbuf -> int              = 1 "field3"
-prim_val getLexCurrPos    : lexbuf -> int              = 1 "field4"
-prim_val getLexLastPos    : lexbuf -> int              = 1 "field5"
-prim_val getLexLastAction : lexbuf -> (lexbuf -> obj)  = 1 "field6"
-
-prim_val setLexAbsPos     : lexbuf -> int -> unit             = 2 "setfield2"
-prim_val setLexStartPos   : lexbuf -> int -> unit             = 2 "setfield3"
-prim_val setLexCurrPos    : lexbuf -> int -> unit             = 2 "setfield4"
-prim_val setLexLastPos    : lexbuf -> int -> unit             = 2 "setfield5"
-prim_val setLexLastAction : lexbuf -> (lexbuf -> obj) -> unit = 2 "setfield6"
-end
-
-(* 
-   These functions are for use in mosmllex-generated lexers.  For
-   further information, see the Moscow ML Owner's Manual.  For
-   examples, see mosml/examples/lexyacc and mosml/examples/calc.
-
+(* Lexing -- run-time library for lexers generated by mosmllex             *)
+(* Closely based on the library for camllex.  Copyright 1993 INRIA, France *)
+
+local open Obj in
+
+type lexbuf
+
+val createLexerString : string -> lexbuf
+val createLexer       : (CharArray.array -> int -> int) -> lexbuf
+
+val getLexeme         : lexbuf -> string
+val getLexemeChar     : lexbuf -> int -> char
+val getLexemeStart    : lexbuf -> int
+val getLexemeEnd      : lexbuf -> int
+
+(* For internal use in generated lexers: *)
+
+val dummyAction       : lexbuf -> obj
+val backtrack         : lexbuf -> 'a
+prim_val getNextChar  : lexbuf -> char = 1 "get_next_char"
+
+prim_val getLexBuffer     : lexbuf -> string           = 1 "field1"
+prim_val getLexAbsPos     : lexbuf -> int              = 1 "field2"
+prim_val getLexStartPos   : lexbuf -> int              = 1 "field3"
+prim_val getLexCurrPos    : lexbuf -> int              = 1 "field4"
+prim_val getLexLastPos    : lexbuf -> int              = 1 "field5"
+prim_val getLexLastAction : lexbuf -> (lexbuf -> obj)  = 1 "field6"
+
+prim_val setLexAbsPos     : lexbuf -> int -> unit             = 2 "setfield2"
+prim_val setLexStartPos   : lexbuf -> int -> unit             = 2 "setfield3"
+prim_val setLexCurrPos    : lexbuf -> int -> unit             = 2 "setfield4"
+prim_val setLexLastPos    : lexbuf -> int -> unit             = 2 "setfield5"
+prim_val setLexLastAction : lexbuf -> (lexbuf -> obj) -> unit = 2 "setfield6"
+end
+
+(* 
+   These functions are for use in mosmllex-generated lexers.  For
+   further information, see the Moscow ML Owner's Manual.  For
+   examples, see mosml/examples/lexyacc and mosml/examples/calc.
+
    [lexbuf] is the type of lexer buffers.  A lexer buffer is the
    argument passed to the scanning functions defined by the
    mosmllex-generated scanners.  The lexer buffer holds the current
@@ -97,4 +97,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/List.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/List.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/List.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/List.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,48 +6,50 @@
 Structure index
 
                  
 
                  -(* List -- SML Basis Library *)
-
-datatype list = datatype list
-
-exception Empty
-
-val null       : 'a list -> bool
-val hd         : 'a list -> 'a                          (* Empty     *)
-val tl         : 'a list -> 'a list                     (* Empty     *)
-val last       : 'a list -> 'a                          (* Empty     *)
-
-val nth        : 'a list * int -> 'a                    (* Subscript *)
-val take       : 'a list * int -> 'a list               (* Subscript *)
-val drop       : 'a list * int -> 'a list               (* Subscript *)
-
-val length     : 'a list -> int 
-
-val rev        : 'a list -> 'a list 
-
-val @          : 'a list * 'a list -> 'a list
-val concat     : 'a list list -> 'a list
-val revAppend  : 'a list * 'a list -> 'a list
-
-val app        : ('a -> unit) -> 'a list -> unit
-val map        : ('a -> 'b) -> 'a list -> 'b list
-val mapPartial : ('a -> 'b option) -> 'a list -> 'b list
-
-val find       : ('a -> bool) -> 'a list -> 'a option
-val filter     : ('a -> bool) -> 'a list -> 'a list
-val partition  : ('a -> bool ) -> 'a list -> ('a list * 'a list)
-
-val foldr      : ('a * 'b -> 'b) -> 'b -> 'a list -> 'b
-val foldl      : ('a * 'b -> 'b) -> 'b -> 'a list -> 'b
-
-val exists     : ('a -> bool) -> 'a list -> bool
-val all        : ('a -> bool) -> 'a list -> bool
-
-val tabulate   : int * (int -> 'a) -> 'a list           (* Size      *)
-
-val getItem    : 'a list -> ('a * 'a list) option
-
-(* 
+(* List -- SML Basis Library *)
+
+datatype list = datatype list
+
+exception Empty
+
+val null       : 'a list -> bool
+val hd         : 'a list -> 'a                          (* Empty     *)
+val tl         : 'a list -> 'a list                     (* Empty     *)
+val last       : 'a list -> 'a                          (* Empty     *)
+
+val nth        : 'a list * int -> 'a                    (* Subscript *)
+val take       : 'a list * int -> 'a list               (* Subscript *)
+val drop       : 'a list * int -> 'a list               (* Subscript *)
+
+val length     : 'a list -> int 
+
+val rev        : 'a list -> 'a list 
+
+val @          : 'a list * 'a list -> 'a list
+val concat     : 'a list list -> 'a list
+val revAppend  : 'a list * 'a list -> 'a list
+
+val app        : ('a -> unit) -> 'a list -> unit
+val map        : ('a -> 'b) -> 'a list -> 'b list
+val mapPartial : ('a -> 'b option) -> 'a list -> 'b list
+
+val find       : ('a -> bool) -> 'a list -> 'a option
+val filter     : ('a -> bool) -> 'a list -> 'a list
+val partition  : ('a -> bool ) -> 'a list -> ('a list * 'a list)
+
+val foldr      : ('a * 'b -> 'b) -> 'b -> 'a list -> 'b
+val foldl      : ('a * 'b -> 'b) -> 'b -> 'a list -> 'b
+
+val exists     : ('a -> bool) -> 'a list -> bool
+val all        : ('a -> bool) -> 'a list -> bool
+
+val collate    : ('a * 'a -> order) -> 'a list * 'a list -> order
+
+val tabulate   : int * (int -> 'a) -> 'a list           (* Size      *)
+
+val getItem    : 'a list -> ('a * 'a list) option
+
+(* 
    ['a list] is the type of lists of elements of type 'a.
 
    [null xs] is true iff xs is nil.
@@ -89,9 +91,9 @@
    to right, and returns the list of those y's for which f(x)
    evaluated to SOME y.
 
-   [find p xs] applies f to each element x of xs, from left to
-   right until p(x) evaluates to true; returns SOME x if such an x
-   exists otherwise NONE.
+   [find p xs] applies p to each element x of xs, from left to right,
+   until p(x) evaluates to true; returns SOME x if such an x exists,
+   otherwise NONE.
 
    [filter p xs] applies p to each element x of xs, from left to
    right, and returns the sublist of those x for which p(x) evaluated
@@ -116,6 +118,10 @@
    right until p(x) evaluates to false; returns false if such an x
    exists, otherwise true.
 
+   [collate cmp (xs, ys)] returns LESS, EQUAL or GREATER according as
+   xs precedes, equals or follows ys in the lexicographic ordering on
+   lists induced by the ordering cmp on elements.
+
    [tabulate(n, f)] returns a list of length n whose elements are
    f(0), f(1), ..., f(n-1), created from left to right.  Raises Size
    if n<0.
@@ -132,4 +138,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/ListPair.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/ListPair.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/ListPair.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/ListPair.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,22 +6,42 @@
 Structure index
 
                  
 
                  -(* ListPair -- SML Basis Library *)
-
-val zip    : 'a list * 'b list -> ('a * 'b) list
-val unzip  : ('a * 'b) list -> 'a list * 'b list
-val map    : ('a * 'b -> 'c)   -> 'a list * 'b list -> 'c list
-val app    : ('a * 'b -> unit) -> 'a list * 'b list -> unit
-val all    : ('a * 'b -> bool) -> 'a list * 'b list -> bool
-val exists : ('a * 'b -> bool) -> 'a list * 'b list -> bool
-val foldr  : ('a * 'b * 'c -> 'c) -> 'c -> 'a list * 'b list -> 'c
-val foldl  : ('a * 'b * 'c -> 'c) -> 'c -> 'a list * 'b list -> 'c
-
-(* 
-   These functions process pairs of lists.  No exception is raised
-   when the lists are found to be of unequal length.  Instead the
-   excess elements from the longer list are disregarded.
-
+(* ListPair -- SML Basis Library *)
+
+val zip    : 'a list * 'b list -> ('a * 'b) list
+val unzip  : ('a * 'b) list -> 'a list * 'b list
+val map    : ('a * 'b -> 'c)   -> 'a list * 'b list -> 'c list
+val app    : ('a * 'b -> unit) -> 'a list * 'b list -> unit
+val all    : ('a * 'b -> bool) -> 'a list * 'b list -> bool
+val exists : ('a * 'b -> bool) -> 'a list * 'b list -> bool
+val foldr  : ('a * 'b * 'c -> 'c) -> 'c -> 'a list * 'b list -> 'c
+val foldl  : ('a * 'b * 'c -> 'c) -> 'c -> 'a list * 'b list -> 'c
+
+val allEq    : ('a * 'b -> bool) -> 'a list * 'b list -> bool
+
+exception UnequalLengths
+
+val zipEq    : ('a list * 'b list) -> ('a * 'b) list
+val mapEq    : ('a * 'b -> 'c) -> 'a list * 'b list -> 'c list
+val appEq    : ('a * 'b -> 'c) -> 'a list * 'b list -> unit
+val foldrEq  : ('a * 'b * 'c -> 'c) -> 'c -> 'a list * 'b list -> 'c
+val foldlEq  : ('a * 'b * 'c -> 'c) -> 'c -> 'a list * 'b list -> 'c
+
+(* 
+   These functions process pairs (xs, ys) of lists.  
+   There are three groups of functions:
+
+     * zip, map, app, all, exists, foldr and foldl raise no exception
+       when the argument lists are found to be of unequal length; the
+       excess elements from the longer list are simply disregarded.
+
+     * zipEq, mapEq, appEq, foldrEq and foldlEq raise exception
+       UnequalLengths when the argument lists are found to be of
+       unequal length.
+
+     * allEq raises no exception but returns false if the lists are
+       found to have unequal lengths (after traversing the lists).
+
    [zip (xs, ys)] returns the list of pairs of corresponding elements
    from xs and ys.  
 
@@ -30,24 +50,28 @@
    xys.  Hence zip (unzip xys) has the same result and effect as xys.
 
    [map f (xs, ys)] applies function f to the pairs of corresponding
-   elements of xs and ys and returns the list of results.  Hence 
-   map f (xs, ys) has the same result and effect as List.map f (zip (xs, ys)).
+   elements of xs and ys from left to right and returns the list of
+   results.  Hence map f (xs, ys) has the same result and effect as
+   List.map f (zip (xs, ys)).
 
    [app f (xs, ys)] applies function f to the pairs of corresponding
-   elements of xs and ys and returns ().  Hence app f (xs, ys) has the
-   same result and effect as List.app f (zip (xs, ys)).
+   elements of xs and ys from left to right and returns ().  Hence 
+   app f (xs, ys) has the same result and effect as 
+   List.app f (zip (xs, ys)).
 
    [all p (xs, ys)] applies predicate p to the pairs of corresponding
-   elements of xs and ys until p evaluates to false or one or both
-   lists is exhausted; returns true if p is true of all such pairs;
-   otherwise false.  Hence all p (xs, ys) has the same result and
-   effect as Lisp.all p (zip (xs, ys)).
-
-   [exists p (xs, ys)] applies predicate p to the pairs of corresponding
-   elements of xs and ys until p evaluates to true or one or both
-   lists is exhausted; returns true if p is true of any such pair;
-   otherwise false.  Hence exists p (xs, ys) has the same result and
-   effect as Lisp.exists p (zip (xs, ys)).
+   elements of xs and ys from left to right until p evaluates to false
+   or one or both lists is exhausted; returns true if p is true of all
+   such pairs; otherwise false.  Hence all p (xs, ys) has the same
+   result and effect as List.all p (zip (xs, ys)).
+
+   [exists p (xs, ys)] applies predicate p to the pairs of
+   corresponding elements of xs and ys from left to right until p
+   evaluates to true or one or both lists is exhausted; returns true
+   if p is true of any such pair; otherwise false.  
+   Hence exists p (xs, ys) has the same result and effect as 
+   List.exists p (zip (xs, ys)).  Also, exists p (xs, ys) is equivalent 
+   to not(all (not o p) (xs, ys)).
 
    [foldr f e (xs, ys)] evaluates f(x1, y1, f(x2, y2, f(..., f(xn, yn, e))))
    where xs = [x1, x2, ..., x(n-1), xn, ...],
@@ -60,10 +84,45 @@
          ys = [y1, y2, ..., y(n-1), yn, ...], 
    and    n = min(length xs, length ys).
    Equivalent to List.foldl (fn ((x, y), r) => f(x, y, r)) e (zip(xs, ys)).
+
+   [zipEq (xs, ys)] returns the list of pairs of corresponding
+   elements from xs and ys.  Raises UnequalLengths if xs and ys do not
+   have the same length.
+
+   [mapEq f (xs, ys)] applies function f to pairs of corresponding
+   elements of xs and ys from left to right, and then returns the list
+   of results if xs and ys have the same length, otherwise raises
+   UnequalLengths.  If f has no side effects and terminates, then
+   it is equivalent to List.map f (zipEq (xs, ys)).
+
+   [appEq f (xs, ys)] applies function f to pairs of corresponding
+   elements of xs and ys from left to right, and then raises
+   UnequalLengths if xs and ys have the same length. 
+
+   [foldrEq f e (xs, ys)] raises UnequalLengths if xs and ys do not
+   have the same length.  Otherwise evaluates 
+         f(x1, y1, f(x2, y2, f(..., f(xn, yn, e))))
+   where xs = [x1, x2, ..., x(n-1), xn],
+         ys = [y1, y2, ..., y(n-1), yn], 
+   and n = length xs = length ys.
+   Equivalent to List.foldr (fn ((x,y),r) => f(x,y,r)) e (zipEq(xs, ys)).
+
+   [foldlEq f e (xs, ys)] evaluates 
+   f(xn, yn, f( ..., f(x2, y2, f(x1, y1, e))))
+   where xs = [x1, x2, ..., x(n-1), xn, ...], 
+         ys = [y1, y2, ..., y(n-1), yn, ...], 
+   and    n = min(length xs, length ys).
+   Then raises UnequalLengths if xs and ys do not have the same
+   length.  If f has no side effects and terminates normally, then it is
+   equivalent to List.foldl (fn ((x,y),r) => f(x,y,r)) e (zipEq(xs, ys)).
+
+   [allEq p (xs, ys)] works as all p (xs, ys) but returns false if xs
+   and ys do not have the same length.  Equivalent to 
+       all p (xs, ys) andalso length xs = length ys.
 *)
 
 
                  
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Listsort.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Listsort.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Listsort.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Listsort.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,22 +6,49 @@
 Structure index
 
                  
 
                  -(* Listsort *)
-
-val sort   : ('a * 'a -> order) -> 'a list -> 'a list
-val sorted : ('a * 'a -> order) -> 'a list -> bool
-
-(* 
+(* Listsort *)
+
+val sort      : ('a * 'a -> order) -> 'a list -> 'a list
+val sorted    : ('a * 'a -> order) -> 'a list -> bool
+val merge     : ('a * 'a -> order) -> 'a list * 'a list -> 'a list
+val mergeUniq : ('a * 'a -> order) -> 'a list * 'a list -> 'a list
+val eqclasses : ('a * 'a -> order) -> 'a list -> 'a list list
+
+(* 
    [sort ordr xs] sorts the list xs in nondecreasing order, using the
    given ordering.  Uses Richard O'Keefe's smooth applicative merge
    sort.
 
    [sorted ordr xs] checks that the list xs is sorted in nondecreasing
    order, in the given ordering.
+
+   [merge ordr (xs, ys)] returns a sorted list of the elements of the
+   sorted lists xs and ys, preserving duplicates.  Both xs and ys must
+   be already sorted by ordr, that is, must satisfy
+      sorted ordr xs andalso sorted ordr ys
+   Then the result satisfies 
+      sorted ordr (merge ordr (xs, ys))
+
+   [mergeUniq ordr (xs, ys)] returns a sorted list of the elements of
+   the sorted lists xs and ys, without duplicates: no elements in the
+   result are EQUAL by ordr.  Both xs and ys must be already sorted by
+   ordr.
+
+   [eqclasses ordr xs] returns a list [xs1, xs2, ..., xsn] of
+   non-empty equivalence classes of xs, obtained by sorting the list 
+   and then grouping consecutive runs of elements that are EQUAL by ordr.
+   If ordr is a total order, then it holds for xi in xsi and xj in xsj:
+      ordr(xi, xj) = EQUAL   iff i=j and 
+      ordr(xi, xj) = LESS    iff i<j and 
+      ordr(xi, xj) = GREATER iff i>j 
+   Thus ordr(xi, xj) = Int.compare(i, j).  A list of representatives
+   for the equivalence classes of xs under ordering ordr can be
+   obtained by
+      List.map List.hd (eqclasses ordr xs) 
 *)
 
 
                  
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Location.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Location.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Location.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Location.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,32 +6,32 @@
 Structure index
 
                  
 
                  -(* Location -- error reporting for mosmllex and mosmlyac               *)
-(* Based on src/compiler/location from the Caml Light 0.6 distribution *)
-
-datatype Location =  (* Source file positions                            *)
-    Loc of int       (* Position of the first character                  *)
-         * int       (* Position of the character following the last one *)
-
-val errLocation : string * BasicIO.instream * Lexing.lexbuf -> Location
-                  -> unit
-val errMsg      : string * BasicIO.instream * Lexing.lexbuf -> Location
-                  -> string -> 'a
-val errPrompt   : string -> unit; 
-val nilLocation : Location
-val getCurrentLocation : unit -> Location
-val mkLoc : 'a -> Location * 'a
-val xLR   : Location * 'a -> Location
-val xL    : Location * 'a -> int
-val xR    : Location * 'a -> int
-val xxLR  : Location * 'a -> Location * 'b -> Location
-val xxRL  : Location * 'a -> Location * 'b -> Location
-
-(* 
-   These functions support error reporting in lexers and parsers
-   generated with mosmllex and mosmlyac.  The directory
-   mosml/examples/lexyacc/ contains an example of their use.
- 
+(* Location -- error reporting for mosmllex and mosmlyac               *)
+(* Based on src/compiler/location from the Caml Light 0.6 distribution *)
+
+datatype Location =  (* Source file positions                            *)
+    Loc of int       (* Position of the first character                  *)
+         * int       (* Position of the character following the last one *)
+
+val errLocation : string * BasicIO.instream * Lexing.lexbuf -> Location
+                  -> unit
+val errMsg      : string * BasicIO.instream * Lexing.lexbuf -> Location
+                  -> string -> 'a
+val errPrompt   : string -> unit; 
+val nilLocation : Location
+val getCurrentLocation : unit -> Location
+val mkLoc : 'a -> Location * 'a
+val xLR   : Location * 'a -> Location
+val xL    : Location * 'a -> int
+val xR    : Location * 'a -> int
+val xxLR  : Location * 'a -> Location * 'b -> Location
+val xxRL  : Location * 'a -> Location * 'b -> Location
+
+(* 
+   These functions support error reporting in lexers and parsers
+   generated with mosmllex and mosmlyac.  The directory
+   mosml/examples/lexyacc/ contains an example of their use.
+ 
    [errLocation (file, stream, lexbuf) loc] prints the part of the lexer 
    input which is indicated by location loc.  
    
@@ -85,4 +85,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Math.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Math.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Math.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Math.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,30 +6,30 @@
 Structure index
 
                  
 
                  -(* Math -- SML Basis Library *)
-
-type real = real
-
-val pi    : real
-val e     : real
-
-val sqrt  : real -> real
-val sin   : real -> real
-val cos   : real -> real
-val tan   : real -> real
-val atan  : real -> real
-val asin  : real -> real
-val acos  : real -> real
-val atan2 : real * real -> real
-val exp   : real -> real
-val pow   : real * real -> real
-val ln    : real -> real
-val log10 : real -> real
-val sinh  : real -> real
-val cosh  : real -> real
-val tanh  : real -> real
-
-(*  
+(* Math -- SML Basis Library *)
+
+type real = real
+
+val pi    : real
+val e     : real
+
+val sqrt  : real -> real
+val sin   : real -> real
+val cos   : real -> real
+val tan   : real -> real
+val atan  : real -> real
+val asin  : real -> real
+val acos  : real -> real
+val atan2 : real * real -> real
+val exp   : real -> real
+val pow   : real * real -> real
+val ln    : real -> real
+val log10 : real -> real
+val sinh  : real -> real
+val cosh  : real -> real
+val tanh  : real -> real
+
+(*  
    [pi] is the circumference of the circle with diameter 1, that is,
    3.14159265358979323846.
 
@@ -42,18 +42,18 @@
    [cos r] is the cosine of r, where r is in radians.
 
    [tan r] is the tangent of r, where r is in radians.  Raises Domain if 
-   r is a multiple of pi/2.
+   r is a multiple of pi/2.0.
 
-   [atan t] is the arc tangent of t, in the open interval ] ~pi/2, pi/2 [.
+   [atan t] is the arc tangent of t, in the open interval ] ~pi/2.0, pi/2.0 [.
 
-   [asin t] is the arc sine of t, in the closed interval [ ~pi/2, pi/2 ].  
+   [asin t] is the arc sine of t, in the closed interval [ ~pi/2.0, pi/2.0 ].  
    Raises Domain if abs x > 1.
 
    [acos t] is the arc cosine of t, in the closed interval [ 0, pi ].
    Raises Domain if abs x > 1.
 
    [atan2(y, x)] is the arc tangent of y/x, in the interval ] ~pi, pi ],
-   except that atan2(y, 0) = sign y * pi/2.  The quadrant of the result
+   except that atan2(y, 0) = sign y * pi/2.0.  The quadrant of the result
    is the same as the quadrant of the point (x, y).
    Hence sign(cos(atan2(y, x))) = sign x 
    and   sign(sin(atan2(y, x))) = sign y. 
@@ -72,10 +72,10 @@
    [log10 x] is the base-10 logarithm of x.  Raises Domain if x <= 0.0.
 
    [sinh x] returns the hyperbolic sine of x, mathematically defined as
-   (exp x - exp (~x)) / 2.  Raises Overflow if x is too large.
+   (exp x - exp (~x)) / 2.0.  Raises Overflow if x is too large.
 
    [cosh x] returns the hyperbolic cosine of x, mathematically defined as
-   (exp x + exp (~x)) / 2.  Raises Overflow if x is too large.
+   (exp x + exp (~x)) / 2.0.  Raises Overflow if x is too large.
 
    [tanh x] returns the hyperbolic tangent of x, mathematically defined 
    as (sinh x) / (cosh x).  Raises Domain if x is too large.
@@ -85,4 +85,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Meta.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Meta.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Meta.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Meta.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,39 +6,39 @@
 Structure index
 
                  
 
                  -(* Meta -- functions available only in interactive Moscow ML sessions *)
-
-val printVal         : 'a -> 'a
-val printDepth       : int ref
-val printLength      : int ref
-val installPP        : (ppstream -> 'a -> unit) -> unit
-
-val liberal          : unit -> unit
-val conservative     : unit -> unit
-val orthodox         : unit -> unit
-
-val use              : string -> unit
-val compile          : string -> unit
-val compileToplevel  : string list -> string -> unit
-val compileStructure : string list -> string -> unit
-
-val load             : string -> unit
-val loadOne          : string -> unit
-val loaded           : unit -> string list
-val loadPath         : string list ref
-
-val quietdec         : bool ref
-val verbose          : bool ref
-
-val quotation        : bool ref
-val valuepoly        : bool ref
-
-val quit             : unit -> 'a
-
-(* 
-   These values and functions are available in the Moscow ML
-   interactive system only.
- 
+(* Meta -- functions available only in interactive Moscow ML sessions *)
+
+val printVal         : 'a -> 'a
+val printDepth       : int ref
+val printLength      : int ref
+val installPP        : (ppstream -> 'a -> unit) -> unit
+
+val liberal          : unit -> unit
+val conservative     : unit -> unit
+val orthodox         : unit -> unit
+
+val use              : string -> unit
+val compile          : string -> unit
+val compileToplevel  : string list -> string -> unit
+val compileStructure : string list -> string -> unit
+
+val load             : string -> unit
+val loadOne          : string -> unit
+val loaded           : unit -> string list
+val loadPath         : string list ref
+
+val quietdec         : bool ref
+val verbose          : bool ref
+
+val quotation        : bool ref
+val valuepoly        : bool ref
+
+val quit             : unit -> 'a
+
+(* 
+   These values and functions are available in the Moscow ML
+   interactive system only.
+ 
    [printVal e] prints the value of expression e to standard output
    exactly as it would be printed at top-level, and returns the value
    of e.  Output is flushed immediately.  This function is provided as
@@ -234,4 +234,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Mosmlcgi.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Mosmlcgi.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Mosmlcgi.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Mosmlcgi.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,77 +6,77 @@
 Structure index
 
                  
 
                  -(* Mosmlcgi -- support for writing CGI scripts in Moscow ML *)
-
-(* 1. Accessing the fields or parameters of a CGI call *)
-
-val cgi_fieldnames     : string list
-val cgi_field_strings  : string -> string list;
-val cgi_field_string   : string -> string option;
-val cgi_field_integer  : string * int -> int;
-
-(* 2. Accessing parts in multipart/form-data; form-based file upload *)
-
-val cgi_partnames      : string list
-
-type part
-val cgi_part           : string -> part option
-val cgi_parts          : string -> part list
-
-val part_fieldnames    : part -> string list
-val part_type          : part -> string option
-val part_data          : part -> string
-val part_field_strings : part -> string -> string list
-val part_field_string  : part -> string -> string option
-val part_field_integer : part -> string * int -> int
-
-(* 3. Administrative information *)
-
-val cgi_server_software       : string option
-val cgi_server_name           : string option
-val cgi_gateway_interface     : string option
-val cgi_server_protocol       : string option
-val cgi_server_port           : string option
-val cgi_request_method        : string option
-val cgi_http_accept           : string option
-val cgi_http_user_agent       : string option
-val cgi_http_referer          : string option
-val cgi_path_info             : string option
-val cgi_path_translated       : string option
-val cgi_script_name           : string option
-val cgi_query_string          : string option
-val cgi_remote_host           : string option
-val cgi_remote_addr           : string option
-val cgi_remote_user           : string option
-val cgi_remote_ident          : string option
-val cgi_auth_type             : string option
-val cgi_content_type          : string option
-val cgi_content_length        : string option
-val cgi_annotation_server     : string option
-
-val cgi_http_cookie           : string option
-val cgi_http_forwarded        : string option
-val cgi_http_host             : string option
-val cgi_http_proxy_connection : string option
-val cgi_script_filename       : string option
-val cgi_document_root         : string option
-val cgi_server_admin          : string option
-val cgi_api_version           : string option
-val cgi_the_request           : string option
-val cgi_request_uri           : string option
-val cgi_request_filename      : string option
-val cgi_is_subreq             : string option
-
-(* 
-   The Mosmlcgi library is for writing CGI programs in Moscow ML.  A
-   CGI program may be installed on a WWW server and is invoked in
-   response to HTTP requests sent to the server from a web browser,
-   typically from an HTML FORM element.
+(* Mosmlcgi -- support for writing CGI scripts in Moscow ML *)
+
+(* 1. Accessing the fields or parameters of a CGI call *)
+
+val cgi_fieldnames     : string list
+val cgi_field_strings  : string -> string list;
+val cgi_field_string   : string -> string option;
+val cgi_field_integer  : string * int -> int;
+
+(* 2. Accessing parts in multipart/form-data; form-based file upload *)
+
+val cgi_partnames      : string list
+
+type part
+val cgi_part           : string -> part option
+val cgi_parts          : string -> part list
+
+val part_fieldnames    : part -> string list
+val part_type          : part -> string option
+val part_data          : part -> string
+val part_field_strings : part -> string -> string list
+val part_field_string  : part -> string -> string option
+val part_field_integer : part -> string * int -> int
+
+(* 3. Administrative information *)
+
+val cgi_server_software       : string option
+val cgi_server_name           : string option
+val cgi_gateway_interface     : string option
+val cgi_server_protocol       : string option
+val cgi_server_port           : string option
+val cgi_request_method        : string option
+val cgi_http_accept           : string option
+val cgi_http_user_agent       : string option
+val cgi_http_referer          : string option
+val cgi_path_info             : string option
+val cgi_path_translated       : string option
+val cgi_script_name           : string option
+val cgi_query_string          : string option
+val cgi_remote_host           : string option
+val cgi_remote_addr           : string option
+val cgi_remote_user           : string option
+val cgi_remote_ident          : string option
+val cgi_auth_type             : string option
+val cgi_content_type          : string option
+val cgi_content_length        : string option
+val cgi_annotation_server     : string option
+
+val cgi_http_cookie           : string option
+val cgi_http_forwarded        : string option
+val cgi_http_host             : string option
+val cgi_http_proxy_connection : string option
+val cgi_script_filename       : string option
+val cgi_document_root         : string option
+val cgi_server_admin          : string option
+val cgi_api_version           : string option
+val cgi_the_request           : string option
+val cgi_request_uri           : string option
+val cgi_request_filename      : string option
+val cgi_is_subreq             : string option
+
+(* 
+   The Mosmlcgi library is for writing CGI programs in Moscow ML.  A
+   CGI program may be installed on a WWW server and is invoked in
+   response to HTTP requests sent to the server from a web browser,
+   typically from an HTML FORM element.
+
 
-
-   1. Obtaining field values sent from an ordinary HTML form
-   ---------------------------------------------------------
-
+   1. Obtaining field values sent from an ordinary HTML form
+   ---------------------------------------------------------
+
    [cgi_fieldnames] is a list of the names of fields present in the
    CGI call message.  If field name fnm is in cgi_fieldnames, then
    cgi_field_string fnm <> NONE.
@@ -118,7 +118,7 @@
    [part_type prt] is SOME(typ) if the part prt contains a specification
    `Context-Type: typ'; otherwise NONE.
 
-   [part_data prt] is the data contain in part prt; for instance, the
+   [part_data prt] is the data contained in part prt; for instance, the
    contents of a file uploaded via form-based file upload.
 
    [part_field_strings prt fnm] is a (possibly empty) list of the
@@ -216,4 +216,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Mosmlcookie.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Mosmlcookie.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Mosmlcookie.html	2000-08-02 13:05:29.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Mosmlcookie.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,31 +6,31 @@
 Structure index
 
                  
 
                  -(* Mosmlcookie -- getting and setting cookies in CGI scripts *)
-
-exception CookieError of string
-
-val allCookies     : string list
-val getCookieValue : string -> string option 
-val getCookie      : string -> string option 
-
-type cookiedata = 
-    { name   : string, 
-      value  : string, 
-      expiry : Date.date option, 
-      domain : string option, 
-      path   : string option, 
-      secure : bool }
-
-val setCookie    : cookiedata -> string
-val setCookies   : cookiedata list -> string
-
-val deleteCookie : { name : string, path : string option } -> string
-
-(* 
-   These functions may be used in CGI scripts to get and set cookies.
-   (c) Hans Molin, Computing Science Dept., Uppsala University, 1999.
-
+(* Mosmlcookie -- getting and setting cookies in CGI scripts *)
+
+exception CookieError of string
+
+val allCookies     : string list
+val getCookieValue : string -> string option 
+val getCookie      : string -> string option 
+
+type cookiedata = 
+    { name   : string, 
+      value  : string, 
+      expiry : Date.date option, 
+      domain : string option, 
+      path   : string option, 
+      secure : bool }
+
+val setCookie    : cookiedata -> string
+val setCookies   : cookiedata list -> string
+
+val deleteCookie : { name : string, path : string option } -> string
+
+(* 
+   These functions may be used in CGI scripts to get and set cookies.
+   (c) Hans Molin, Computing Science Dept., Uppsala University, 1999.
+
    [getCookieValue ck] returns SOME(v) where v is the value associated
    with the cookie ck, if any; otherwise returns NONE.
 
@@ -58,4 +58,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Mosml.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Mosml.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Mosml.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Mosml.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,24 +6,26 @@
 Structure index
 
                  
 
                  -(* Mosml -- some Moscow ML specific functions *)
-
-val argv      : unit -> string list
-val time      : ('a -> 'b) -> ('a -> 'b)
-val listDir   : string -> string list
-val doubleVec : real -> Word8Vector.vector
-val vecDouble : Word8Vector.vector -> real
-val floatVec  : real -> Word8Vector.vector
-val vecFloat  : Word8Vector.vector -> real
-val md5sum    : string -> string
-
-datatype runresult = 
-    Success of string
-  | Failure of string
-
-val run : string -> string list -> string -> runresult
-
-(* 
+(* Mosml -- some Moscow ML specific functions *)
+
+val argv      : unit -> string list
+val time      : ('a -> 'b) -> ('a -> 'b)
+val listDir   : string -> string list
+val doubleVec : real -> Word8Vector.vector
+val vecDouble : Word8Vector.vector -> real
+val floatVec  : real -> Word8Vector.vector
+val vecFloat  : Word8Vector.vector -> real
+val md5sum    : string -> string
+
+datatype runresult = 
+    Success of string
+  | Failure of string
+
+val run : string -> string list -> string -> runresult
+
+val systemInfo: string list -> (string * string) list
+
+(* 
    [argv ()] returns the command line strings of the current process.
    Hence List.nth(argv (), 0) is the command used to invoke the SML
    process, List.nth(argv (), 1) is its first argument, and so on.
@@ -64,10 +66,18 @@
    is the program's (standard and error) output as a string, if it
    executed successfully; otherwise returns Failure s where s is its
    (standard and error) output as a string.
+       Extreme care should be taken when calling this function in web
+   scripts and similar, since the cmd is executed by the shell, so
+   even the args can be abused for attacks.
+
+   [systemInfo query] returns a pair (p, v) for each property p in
+   query, where v is the value associated with p. If query is the
+   empty list, then all properties and values are returned.  The
+   property "version" is always guaranteed to have a value associated.
 *)
 
 
                  
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Msp.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Msp.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Msp.html	2000-08-02 13:05:29.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Msp.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,161 +6,161 @@
 Structure index
 
                  
 
                  -(* Msp -- utilities for CGI scripts and ML Server Pages *)
-
-(* Efficiently concatenable word sequences *)
-
-datatype wseq = 
-    Empty                               (* The empty sequence         *)
-  | Nl                                  (* Newline                    *)
-  | $ of string                         (* A string                   *)
-  | $$ of string list                   (* A sequence of strings      *)
-  | && of wseq * wseq;                  (* Concatenation of sequences *)
-
-(* Manipulating wseqs *)
-
-val prmap    : ('a -> wseq) -> 'a list -> wseq
-val prsep    : wseq -> ('a -> wseq) -> 'a list -> wseq
-val flatten  : wseq -> string
-val printseq : wseq -> unit
-val vec2list : 'a vector -> 'a list
+(* Msp -- utilities for CGI scripts and ML Server Pages *)
+
+(* Efficiently concatenable word sequences *)
+
+datatype wseq = 
+    Empty                               (* The empty sequence         *)
+  | Nl                                  (* Newline                    *)
+  | $ of string                         (* A string                   *)
+  | $$ of string list                   (* A sequence of strings      *)
+  | && of wseq * wseq;                  (* Concatenation of sequences *)
+
+(* Manipulating wseqs *)
+
+val prmap    : ('a -> wseq) -> 'a list -> wseq
+val prsep    : wseq -> ('a -> wseq) -> 'a list -> wseq
+val flatten  : wseq -> string
+val printseq : wseq -> unit
+val vec2list : 'a vector -> 'a list
+
 
-
-(* Shorthands for accessing CGI parameters *)
-
-exception ParamMissing of string
-exception NotInt of string * string
-
-val %        : string -> string      
-val %?       : string -> bool
-val %#       : string -> int
-val %%       : string * string -> string
-val %%#      : string * int -> int
+(* Shorthands for accessing CGI parameters *)
+
+exception ParamMissing of string
+exception NotInt of string * string
+
+val %        : string -> string      
+val %?       : string -> bool
+val %#       : string -> int
+val %%       : string * string -> string
+val %%#      : string * int -> int
+
 
-
-(* HTML generic marks *)
-
-val mark0    : string -> wseq
-val mark0a   : string -> string -> wseq
-val mark1    : string -> wseq -> wseq
-val mark1a   : string -> string -> wseq -> wseq
-val comment  : wseq -> wseq
-
-(* HTML documents and headers *)
-
-val html     : wseq -> wseq
-val head     : wseq -> wseq
-val title    : wseq -> wseq
-val body     : wseq -> wseq
-val bodya    : string -> wseq -> wseq
-val htmldoc  : wseq -> wseq -> wseq
-
-(* HTML headings and vertical format *)
-
-val h1       : wseq -> wseq
-val h2       : wseq -> wseq
-val h3       : wseq -> wseq
-val h4       : wseq -> wseq
-val h5       : wseq -> wseq
-val h6       : wseq -> wseq
-val p        : wseq -> wseq
-val pa       : string -> wseq -> wseq
-val br       : wseq
-val bra      : string -> wseq
-val hr       : wseq
-val hra      : string -> wseq
-
-val divi        : wseq -> wseq
-val divia       : string -> wseq -> wseq
-val blockquote  : wseq -> wseq
-val blockquotea : string -> wseq -> wseq
-val center      : wseq -> wseq
-val address     : wseq -> wseq
-val pre         : wseq -> wseq
-
-(* HTML anchors and hyperlinks *)
-
-val ahref    : string -> wseq -> wseq
-val ahrefa   : string -> string -> wseq -> wseq
-val aname    : string -> wseq -> wseq
-
-(* HTML text formats and style *)
-
-val em       : wseq -> wseq
-val strong   : wseq -> wseq
-val tt       : wseq -> wseq
-val sub      : wseq -> wseq
-val sup      : wseq -> wseq
-val fonta    : string -> wseq -> wseq
-
-(* HTML lists *)
-
-val ul       : wseq -> wseq
-val ula      : string -> wseq -> wseq
-val ol       : wseq -> wseq
-val ola      : string -> wseq -> wseq
-val li       : wseq -> wseq
-val dl       : wseq -> wseq
-val dla      : string -> wseq -> wseq
-val dt       : wseq -> wseq
-val dd       : wseq -> wseq
-
-(* HTML tables *)
-
-val table    : wseq -> wseq
-val tablea   : string -> wseq -> wseq
-val tr       : wseq -> wseq
-val tra      : string -> wseq -> wseq
-val td       : wseq -> wseq
-val tda      : string -> wseq -> wseq
-val th       : wseq -> wseq
-val tha      : string -> wseq -> wseq
-val caption  : wseq -> wseq
-val captiona : string -> wseq -> wseq
-
-(* HTML images and image maps *)
-
-val img      : string -> wseq
-val imga     : string -> string -> wseq
-val map      : string -> wseq -> wseq
-val mapa     : string -> string -> wseq -> wseq
-val area     : { alt : string option, coords : string, 
-                 href : string option, shape : string} -> wseq
-
-(* HTML forms etc *)
-
-val form       : string -> wseq -> wseq
-val forma      : string -> string -> wseq -> wseq
-val input      : string -> wseq
-val inputa     : string -> string -> wseq
-val intext     : string -> string -> wseq
-val inpassword : string -> string -> wseq
-val incheckbox : {name : string, value : string} -> string -> wseq
-val inradio    : {name : string, value : string} -> string -> wseq
-val inreset    : string -> string -> wseq
-val insubmit   : string -> string -> wseq
-val inhidden   : {name : string, value : string} -> wseq
-val textarea   : string -> wseq -> wseq
-val textareaa  : string -> string -> wseq -> wseq
-val select     : string -> string -> wseq -> wseq
-val option     : string -> wseq
-
-(* HTML frames and framesets *)
-
-val frameset   : string -> wseq -> wseq
-val frame      : { src : string, name : string } -> wseq
-val framea     : { src : string, name : string } -> string -> wseq
-
-(* HTML encoding  *)
-
-val urlencode  : string -> string
-val htmlencode : string -> string
+(* HTML generic marks *)
+
+val mark0    : string -> wseq
+val mark0a   : string -> string -> wseq
+val mark1    : string -> wseq -> wseq
+val mark1a   : string -> string -> wseq -> wseq
+val comment  : wseq -> wseq
+
+(* HTML documents and headers *)
+
+val html     : wseq -> wseq
+val head     : wseq -> wseq
+val title    : wseq -> wseq
+val body     : wseq -> wseq
+val bodya    : string -> wseq -> wseq
+val htmldoc  : wseq -> wseq -> wseq
+
+(* HTML headings and vertical format *)
+
+val h1       : wseq -> wseq
+val h2       : wseq -> wseq
+val h3       : wseq -> wseq
+val h4       : wseq -> wseq
+val h5       : wseq -> wseq
+val h6       : wseq -> wseq
+val p        : wseq -> wseq
+val pa       : string -> wseq -> wseq
+val br       : wseq
+val bra      : string -> wseq
+val hr       : wseq
+val hra      : string -> wseq
+
+val divi        : wseq -> wseq
+val divia       : string -> wseq -> wseq
+val blockquote  : wseq -> wseq
+val blockquotea : string -> wseq -> wseq
+val center      : wseq -> wseq
+val address     : wseq -> wseq
+val pre         : wseq -> wseq
+
+(* HTML anchors and hyperlinks *)
+
+val ahref    : string -> wseq -> wseq
+val ahrefa   : string -> string -> wseq -> wseq
+val aname    : string -> wseq -> wseq
+
+(* HTML text formats and style *)
+
+val em       : wseq -> wseq
+val strong   : wseq -> wseq
+val tt       : wseq -> wseq
+val sub      : wseq -> wseq
+val sup      : wseq -> wseq
+val fonta    : string -> wseq -> wseq
+
+(* HTML lists *)
+
+val ul       : wseq -> wseq
+val ula      : string -> wseq -> wseq
+val ol       : wseq -> wseq
+val ola      : string -> wseq -> wseq
+val li       : wseq -> wseq
+val dl       : wseq -> wseq
+val dla      : string -> wseq -> wseq
+val dt       : wseq -> wseq
+val dd       : wseq -> wseq
+
+(* HTML tables *)
+
+val table    : wseq -> wseq
+val tablea   : string -> wseq -> wseq
+val tr       : wseq -> wseq
+val tra      : string -> wseq -> wseq
+val td       : wseq -> wseq
+val tda      : string -> wseq -> wseq
+val th       : wseq -> wseq
+val tha      : string -> wseq -> wseq
+val caption  : wseq -> wseq
+val captiona : string -> wseq -> wseq
+
+(* HTML images and image maps *)
+
+val img      : string -> wseq
+val imga     : string -> string -> wseq
+val map      : string -> wseq -> wseq
+val mapa     : string -> string -> wseq -> wseq
+val area     : { alt : string option, coords : string, 
+                 href : string option, shape : string} -> wseq
+
+(* HTML forms etc *)
+
+val form       : string -> wseq -> wseq
+val forma      : string -> string -> wseq -> wseq
+val input      : string -> wseq
+val inputa     : string -> string -> wseq
+val intext     : string -> string -> wseq
+val inpassword : string -> string -> wseq
+val incheckbox : {name : string, value : string} -> string -> wseq
+val inradio    : {name : string, value : string} -> string -> wseq
+val inreset    : string -> string -> wseq
+val insubmit   : string -> string -> wseq
+val inhidden   : {name : string, value : string} -> wseq
+val textarea   : string -> wseq -> wseq
+val textareaa  : string -> string -> wseq -> wseq
+val select     : string -> string -> wseq -> wseq
+val option     : string -> wseq
+
+(* HTML frames and framesets *)
+
+val frameset   : string -> wseq -> wseq
+val frame      : { src : string, name : string } -> wseq
+val framea     : { src : string, name : string } -> string -> wseq
+
+(* HTML encoding  *)
+
+val urlencode  : string -> string
+val htmlencode : string -> string
+
 
-
-(* 
-   This module provides support functions for writing CGI scripts and
-   ML Server Page scripts.
-
+(* 
+   This module provides support functions for writing CGI scripts and
+   ML Server Page scripts.
+
    [wseq] is the type of efficiently concatenable word sequences.
    Building an HTML page (functionally) as a wseq is more efficient
    than building it (functionally) as a string, and more convenient
@@ -170,11 +170,11 @@
 
    [Nl] represents the string "\n" consisting of a single newline character.
 
-   [$ s] represents the string s.
+   [$ s] represents the string s.
 
-   [$$ ss] represents the string String.concat(ss).
+   [$$ ss] represents the string String.concat(ss).
 
-   [&&(ws1, ws2)] represents the concatenation of the strings
+   [&&(ws1, ws2)] represents the concatenation of the strings
    represented by ws1 and ws2.  The function && should be declared
         infix &&
 
@@ -196,10 +196,10 @@
 
    Shorthands for accessing CGI parameters:
 
-   [%? fnm] returns true if there is a string associated with CGI
+   [%? fnm] returns true if there is a string associated with CGI
    parameter fnm; otherwise returns false.
 
-   [% fnm] returns a string associated with CGI parameter fnm if there
+   [% fnm] returns a string associated with CGI parameter fnm if there
    is any; raises ParamMissing(fnm) if no strings are associated with
    fnm.  Equivalent to
        case Mosmlcgi.cgi_field_string fnm of 
@@ -208,16 +208,16 @@
    In general, multiple strings may be associated with a CGI parameter; 
    use Mosmlcgi.cgi_field_strings if you need to access all of them.
 
-   [%# fnm] returns the integer i if there is a string associated with
+   [%# fnm] returns the integer i if there is a string associated with
    CGI parameter fnm, and that string is parsable as ML integer i.
    Raises ParamMissing(fnm) if no string is associated with fnm.
    Raises NotInt(fnm, s) if there is a string but it is not parsable
    as an ML int.
 
-   [%%(fnm, dflt)] returns a string associated with CGI parameter fnm
+   [%%(fnm, dflt)] returns a string associated with CGI parameter fnm
    if there is any; otherwise returns the string dflt.
 
-   [%%#(fnm, dflt)] returns the integer i if there is a string
+   [%%#(fnm, dflt)] returns the integer i if there is a string
    associated with CGI parameter fnm, and that string is parsable as
    an ML int; otherwise returns the string dflt.
 
@@ -415,9 +415,10 @@
    HTML encoding functions:
 
    [urlencode s] returns the url-encoding of s.  That is, space (ASCII 32) 
-   is replaced by `+' and every non-alphanumeric character c except 
-   the characters - _ . is replaced by %hh, where hh is the hexadecimal 
-   representation of the ASCII code of c.
+   is replaced by `+' and every non-alphanumeric character c except
+   the three characters hyphen (-), underscore (_) and full stop (.)
+   is replaced by %hh, where hh is the hexadecimal representation of
+   the ASCII code of c.
 
    [htmlencode s] returns the html-encoding of s.  That is, < and >
    are replaced by &lt; and &gt; respectively, and & is replaced by 
@@ -428,4 +429,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Mysql.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Mysql.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Mysql.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Mysql.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,10 +6,11 @@
 Structure index
 
                  
 
                  -(* Mysql -- interface to the MySQL database server -- requires Dynlib *)
-
-type dbconn                                   (* Connection to server *)
-type dbresult                                 (* Result of a query    *)
+(* Mysql -- interface to the MySQL database server -- requires Dynlib *)
+
+type dbconn                                   (* Connection to server *)
+type dbresult                                 (* Result of a query    *)
+eqtype oid                                    (* (not used by Mysql)  *)
 
 exception Closed                              (* Connection is closed *)
 exception Null                                (* Field value is NULL  *)
@@ -18,10 +19,10 @@
 
 val openbase : { dbhost    : string option,   (* database server host *)
                  dbname    : string option,   (* database name        *)
-                 dboptions : string option,   (* (not used by MySQL)  *)
+                 dboptions : string option,   (* (not used by Mysql)  *)
                  dbport    : string option,   (* database server port *)
                  dbpwd     : string option,   (* user passwd          *)
-                 dbtty     : string option,   (* (not used by MySQL)  *)
+                 dbtty     : string option,   (* (not used by Mysql)  *)
                  dbuser    : string option    (* database user        *)
                } -> dbconn
 
@@ -39,12 +40,12 @@
 (* Query execution and result set information *)
 
 datatype dbresultstatus =
-    Bad_response            (* (not used by mysql)                    *)
+    Bad_response            (* (not used by Mysql)                    *)
   | Command_ok              (* The query was a command                *)
-  | Copy_in                 (* (not used by mysql)                    *)
-  | Copy_out                (* (not used by mysql)                    *)
+  | Copy_in                 (* (not used by Mysql)                    *)
+  | Copy_out                (* (not used by Mysql)                    *)
   | Empty_query
-  | Fatal_error             (* (not used by mysql)                    *)
+  | Fatal_error             (* (not used by Mysql)                    *)
   | Nonfatal_error
   | Tuples_ok               (* The query successfully returned tuples *)
 
@@ -69,47 +70,53 @@
 val isnull       : dbresult -> int -> int -> bool
 
 datatype dynval =
-    Int of int                          (* MySQL int4            *)
-  | Real of real                        (* MySQL float8 (float4) *)
-  | String of string                    (* MySQL text (varchar)  *)
-  | Date of int * int * int             (* MySQL date yyyy-mm-dd *)
-  | Time of int * int * int             (* MySQL time hh:mm:ss   *)
-  | DateTime of Date.date               (* MySQL datetime        *)
-  | NullVal                             (* MySQL NULL value      *)
-
-val getdynfield  : dbresult -> int -> int -> dynval
-val getdyntup    : dbresult -> int -> dynval vector
-val getdyntups   : dbresult -> dynval vector vector 
-val dynval2s     : dynval -> string
-
-(* Bulk copying to or from a table *)
-
-val copytableto   : dbconn * string * (string -> unit) -> unit
-val copytablefrom : dbconn * string * ((string -> unit) -> unit) -> unit
+    Bool of bool                        (* (not used by Mysql)   *)
+  | Int of int                          (* Mysql int4            *)
+  | Real of real                        (* Mysql float8 (float4) *)
+  | String of string                    (* Mysql text (varchar)  *)
+  | Date of int * int * int             (* Mysql date yyyy-mm-dd *)
+  | Time of int * int * int             (* Mysql time hh:mm:ss   *)
+  | DateTime of Date.date               (* Mysql datetime        *)
+  | Oid of oid                          (* (not used by Mysql)   *)
+  | Bytea of Word8Array.array           (* (not used by Mysql)   *)
+  | NullVal                             (* Mysql NULL value      *)
+
+val getdynfield  : dbresult -> int -> int -> dynval
+val getdyntup    : dbresult -> int -> dynval vector
+val getdyntups   : dbresult -> dynval vector vector 
+val dynval2s     : dynval -> string
+
+(* Bulk copying to or from a table *)
 
-(* Some standard ML and MySQL types: *)
-
-datatype dyntype = 
-    IntTy               (* ML int               MySQL int4              *)
-  | RealTy              (* ML real              MySQL float8, float4    *)
-  | StringTy            (* ML string            MySQL text, varchar     *) 
-  | DateTy              (* ML (yyyy, mth, day)  MySQL date              *)
-  | TimeTy              (* ML (hh, mm, ss)      MySQL time              *)
-  | DateTimeTy          (* ML Date.date         MySQL datetime, abstime *)
-  | UnknownTy
-
-val fromtag : dyntype -> string
-val ftype   : dbresult -> int -> dyntype
-val ftypes  : dbresult -> dyntype Vector.vector
-
-val applyto : 'a -> ('a -> 'b) -> 'b
+val copytableto   : dbconn * string * (string -> unit) -> unit
+val copytablefrom : dbconn * string * ((string -> unit) -> unit) -> unit
+
+(* Some standard ML and MySQL types: *)
+
+datatype dyntype = 
+    BoolTy              (* ML bool              (not used by Mysql)     *)
+  | IntTy               (* ML int               Mysql int4              *)
+  | RealTy              (* ML real              Mysql float8, float4    *)
+  | StringTy            (* ML string            Mysql text, varchar     *) 
+  | DateTy              (* ML (yyyy, mth, day)  Mysql date              *)
+  | TimeTy              (* ML (hh, mm, ss)      Mysql time              *)
+  | DateTimeTy          (* ML Date.date         Mysql datetime, abstime *)
+  | OidTy               (* ML oid               (not used by Mysql)     *)
+  | ByteArrTy           (* ML Word8Array.array  (not used by Mysql)     *)
+  | UnknownTy of oid
 
-(* Formatting the result of a database query as an HTML table *)
-
-val formattable : dbresult -> Msp.wseq
-val showquery   : dbconn -> string -> Msp.wseq
-
-(*
+val fromtag : dyntype -> string
+val ftype   : dbresult -> int -> dyntype
+val ftypes  : dbresult -> dyntype Vector.vector
+
+val applyto : 'a -> ('a -> 'b) -> 'b
+
+(* Formatting the result of a database query as an HTML table *)
+
+val formattable : dbresult -> Msp.wseq
+val showquery   : dbconn -> string -> Msp.wseq
+
+(*
    [dbconn] is the type of connections to a MySQL database.
 
    [dbresult] is the type of result sets from MySQL queries.
@@ -281,4 +288,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/NJ93.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/NJ93.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/NJ93.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/NJ93.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,88 +6,88 @@
 Structure index
 
                  
 
                  -(* NJ93 -- compatibility SML/NJ 0.93 top-level environment *)
-
-val print     : string -> unit
-
-(* NJ93 Integer *)
-
-val max       : int * int -> int
-val min       : int * int -> int
-
-(* NJ93 List *)
-
-exception Hd and Tl and Nth and NthTail
-
-val hd        : 'a list -> 'a             (* Hd *)
-val tl        : 'a list -> 'a list        (* Tl *)
-val nth       : 'a list * int -> 'a       (* Nth *)
-val nthtail   : 'a list * int -> 'a list  (* NthTail *)
-val app       : ('a -> 'b) -> 'a list -> unit
-val revapp    : ('a -> 'b) -> 'a list -> unit
-val fold      : ('a * 'b -> 'b) -> 'a list -> 'b -> 'b
-val revfold   : ('a * 'b -> 'b) -> 'a list -> 'b -> 'b
-
-(* NJ93 Real *)
-
-val ceiling   : real -> int
-val truncate  : real -> int 
-
-(* NJ93 Ref *)
-
-val inc       : int ref -> unit
-val dec       : int ref -> unit
-
-(* NJ93 String *)
-
-exception Substring
-
-val ordof     : string * int -> int
-val ord       : string -> int                   (* Ord *)
-val chr       : int -> string                   (* Chr *)
-val substring : string * int * int -> string    (* Substring *)
-val explode   : string -> string list
-val implode   : string list -> string
-
-(* NJ93 top-level math functions *)
-
-val sqrt      : real -> real
-val sin       : real -> real
-val cos       : real -> real
-val arctan    : real -> real
-val exp       : real -> real
-val ln        : real -> real
-
-(* NJ93 top-level input/output, standard *)
-
-type instream and outstream
-
-val std_in        : instream
-val open_in       : string -> instream
-val input         : instream * int -> string
-val lookahead     : instream -> string
-val close_in      : instream -> unit
-val end_of_stream : instream -> bool
-
-val std_out       : outstream
-val open_out      : string -> outstream
-val output        : outstream * string -> unit
-val close_out     : outstream -> unit
-
-(* NJ93 top-level input/output, non-standard *)
-
-val open_in_bin   : string -> instream
-val open_out_bin  : string -> outstream
-val inputc        : instream -> int -> string
-val std_err       : outstream
-val outputc       : outstream -> string -> unit
-val flush_out     : outstream -> unit
-val input_line    : instream -> string
-val can_input     : instream * int -> bool
-val open_append   : string -> outstream
-
+(* NJ93 -- compatibility SML/NJ 0.93 top-level environment *)
+
+val print     : string -> unit
+
+(* NJ93 Integer *)
+
+val max       : int * int -> int
+val min       : int * int -> int
+
+(* NJ93 List *)
+
+exception Hd and Tl and Nth and NthTail
+
+val hd        : 'a list -> 'a             (* Hd *)
+val tl        : 'a list -> 'a list        (* Tl *)
+val nth       : 'a list * int -> 'a       (* Nth *)
+val nthtail   : 'a list * int -> 'a list  (* NthTail *)
+val app       : ('a -> 'b) -> 'a list -> unit
+val revapp    : ('a -> 'b) -> 'a list -> unit
+val fold      : ('a * 'b -> 'b) -> 'a list -> 'b -> 'b
+val revfold   : ('a * 'b -> 'b) -> 'a list -> 'b -> 'b
+
+(* NJ93 Real *)
+
+val ceiling   : real -> int
+val truncate  : real -> int 
+
+(* NJ93 Ref *)
+
+val inc       : int ref -> unit
+val dec       : int ref -> unit
+
+(* NJ93 String *)
+
+exception Substring
+
+val ordof     : string * int -> int
+val ord       : string -> int                   (* Ord *)
+val chr       : int -> string                   (* Chr *)
+val substring : string * int * int -> string    (* Substring *)
+val explode   : string -> string list
+val implode   : string list -> string
+
+(* NJ93 top-level math functions *)
+
+val sqrt      : real -> real
+val sin       : real -> real
+val cos       : real -> real
+val arctan    : real -> real
+val exp       : real -> real
+val ln        : real -> real
+
+(* NJ93 top-level input/output, standard *)
+
+type instream and outstream
+
+val std_in        : instream
+val open_in       : string -> instream
+val input         : instream * int -> string
+val lookahead     : instream -> string
+val close_in      : instream -> unit
+val end_of_stream : instream -> bool
+
+val std_out       : outstream
+val open_out      : string -> outstream
+val output        : outstream * string -> unit
+val close_out     : outstream -> unit
+
+(* NJ93 top-level input/output, non-standard *)
+
+val open_in_bin   : string -> instream
+val open_out_bin  : string -> outstream
+val inputc        : instream -> int -> string
+val std_err       : outstream
+val outputc       : outstream -> string -> unit
+val flush_out     : outstream -> unit
+val input_line    : instream -> string
+val can_input     : instream * int -> bool
+val open_append   : string -> outstream
+
 
                  
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Nonstdio.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Nonstdio.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Nonstdio.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Nonstdio.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,36 +6,36 @@
 Structure index
 
                  
 
                  -(* Nonstdio -- non-standard I/O -- use BinIO and TextIO instead *)
-
-local open BasicIO in
-
-val open_in_bin       : string -> instream
-val buff_input        : instream -> CharArray.array -> int -> int -> int
-val input_char        : instream -> char		(* Raises Size *)
-val input_binary_int  : instream -> int
-val input_value       : instream -> 'a
-val seek_in           : instream -> int -> unit
-val pos_in            : instream -> int
-val in_stream_length  : instream -> int
-val fast_really_input : instream -> string -> int ->  int -> unit
-
-val open_out_bin      : string -> outstream
-val open_out_exe      : string -> outstream
-val output_char       : outstream -> Char.char -> unit
-val output_byte       : outstream -> int -> unit
-val buff_output       : outstream -> CharArray.array -> int -> int -> unit
-val output_binary_int : outstream -> int -> unit
-val output_value      : outstream -> 'a -> unit
-val seek_out          : outstream -> int -> unit
-val pos_out           : outstream -> int
-
-val file_exists       : string -> bool
-
-end
-
+(* Nonstdio -- non-standard I/O -- use BinIO and TextIO instead *)
+
+local open BasicIO in
+
+val open_in_bin       : string -> instream
+val buff_input        : instream -> CharArray.array -> int -> int -> int
+val input_char        : instream -> char		(* Raises Size *)
+val input_binary_int  : instream -> int
+val input_value       : instream -> 'a
+val seek_in           : instream -> int -> unit
+val pos_in            : instream -> int
+val in_stream_length  : instream -> int
+val fast_really_input : instream -> string -> int ->  int -> unit
+
+val open_out_bin      : string -> outstream
+val open_out_exe      : string -> outstream
+val output_char       : outstream -> Char.char -> unit
+val output_byte       : outstream -> int -> unit
+val buff_output       : outstream -> CharArray.array -> int -> int -> unit
+val output_binary_int : outstream -> int -> unit
+val output_value      : outstream -> 'a -> unit
+val seek_out          : outstream -> int -> unit
+val pos_out           : outstream -> int
+
+val file_exists       : string -> bool
+
+end
+
 
                  
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Option.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Option.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Option.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Option.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,24 +6,24 @@
 Structure index
 
                  
 
                  -(* Option -- SML Basis Library *)
-
-exception Option
-
-datatype option = datatype option
-
-val getOpt         : 'a option * 'a -> 'a 
-val isSome         : 'a option -> bool 
-val valOf          : 'a option -> 'a 
-val filter         : ('a -> bool) -> 'a -> 'a option 
-val map            : ('a -> 'b) -> 'a option -> 'b option
-val app            : ('a -> unit) -> 'a option -> unit
-val join           : 'a option option -> 'a option
-val compose        : ('a -> 'b) * ('c -> 'a option) -> ('c -> 'b option)
-val mapPartial     : ('a -> 'b option) -> ('a option -> 'b option)
-val composePartial : ('a -> 'b option) * ('c -> 'a option) -> ('c -> 'b option)
-
-(* 
+(* Option -- SML Basis Library *)
+
+exception Option
+
+datatype option = datatype option
+
+val getOpt         : 'a option * 'a -> 'a 
+val isSome         : 'a option -> bool 
+val valOf          : 'a option -> 'a 
+val filter         : ('a -> bool) -> 'a -> 'a option 
+val map            : ('a -> 'b) -> 'a option -> 'b option
+val app            : ('a -> unit) -> 'a option -> unit
+val join           : 'a option option -> 'a option
+val compose        : ('a -> 'b) * ('c -> 'a option) -> ('c -> 'b option)
+val mapPartial     : ('a -> 'b option) -> ('a option -> 'b option)
+val composePartial : ('a -> 'b option) * ('c -> 'a option) -> ('c -> 'b option)
+
+(* 
    [getOpt (xopt, d)] returns x if xopt is SOME x; returns d otherwise.
 
    [isSome vopt] returns true if xopt is SOME x; returns false otherwise.
@@ -54,4 +54,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/OS.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/OS.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/OS.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/OS.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,24 +6,24 @@
 Structure index
 
                  
 
                  -(* OS -- SML Basis Library *)
-
-signature OS = sig
-
-type syserror = syserror
-
-exception SysErr of string * syserror option
-
-val errorMsg      : syserror -> string
-
-structure FileSys : FileSys
-structure Path    : Path
-structure Process : Process
-
-end
-
-(*  Various functions for interacting with the operating system.
-
+(* OS -- SML Basis Library *)
+
+signature OS = sig
+
+type syserror = syserror
+
+exception SysErr of string * syserror option
+
+val errorMsg      : syserror -> string
+
+structure FileSys : FileSys
+structure Path    : Path
+structure Process : Process
+
+end
+
+(*  Various functions for interacting with the operating system.
+
    [errorMsg err] returns a string explaining the error message system
    error code err, as found in a SysErr exception.  The precise form
    of the string depends on the operating system.  
@@ -33,4 +33,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Parsing.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Parsing.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Parsing.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Parsing.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,60 +6,60 @@
 Structure index
 
                  
 
                  -(* Parsing -- runtime library for parsers generated by mosmlyac            *)
-(* Based on the runtime library for camlyacc; copyright 1993 INRIA, France *)
-
-local open Vector Obj Lexing in
-
-val symbolStart : unit -> int
-val symbolEnd   : unit -> int
-val itemStart   : int -> int
-val itemEnd     : int -> int
-val clearParser : unit -> unit
-
-(* For internal use in generated parsers: *)
-
-type parseTables =
-    (* actions *)    (unit -> obj) vector  *
-    (* transl *)     int vector *
-    (* lhs *)        string *
-    (* len *)        string *
-    (* defred *)     string *
-    (* dgoto *)      string *
-    (* sindex *)     string *
-    (* rindex *)     string *
-    (* gindex *)     string *
-    (* tablesize *)  int *
-    (* table *)      string *
-    (* check *)      string
-
-exception yyexit of obj
-exception ParseError of (obj -> bool)
-
-val yyparse : parseTables -> int -> (lexbuf -> 'a) -> lexbuf -> 'b
-val peekVal : int -> 'a
-
-end
-
-(*
-   These functions are for use in mosmlyac-generated parsers.  For
-   further information, see the Moscow ML Owner's Manual.  For
-   examples, see mosml/examples/lexyacc and mosml/examples/calc.
-
-   A grammar definition (input to mosmlyac) consists of fragments of
-   this form
-
-       nonterm :
-          grsyms1   { action1 }
-        | grsyms2   { action2 }
-        | grsyms3   { action3 }
-        | ...
-
-   where the grsyms are sequences of grammar symbols, matching some
-   string of characters, and the actions are corresponding semantic
-   actions, written in ML.  The following functions can be used in the
-   semantic actions:
-
+(* Parsing -- runtime library for parsers generated by mosmlyac            *)
+(* Based on the runtime library for camlyacc; copyright 1993 INRIA, France *)
+
+local open Vector Obj Lexing in
+
+val symbolStart : unit -> int
+val symbolEnd   : unit -> int
+val itemStart   : int -> int
+val itemEnd     : int -> int
+val clearParser : unit -> unit
+
+(* For internal use in generated parsers: *)
+
+type parseTables =
+    (* actions *)    (unit -> obj) vector  *
+    (* transl *)     int vector *
+    (* lhs *)        string *
+    (* len *)        string *
+    (* defred *)     string *
+    (* dgoto *)      string *
+    (* sindex *)     string *
+    (* rindex *)     string *
+    (* gindex *)     string *
+    (* tablesize *)  int *
+    (* table *)      string *
+    (* check *)      string
+
+exception yyexit of obj
+exception ParseError of (obj -> bool)
+
+val yyparse : parseTables -> int -> (lexbuf -> 'a) -> lexbuf -> 'b
+val peekVal : int -> 'a
+
+end
+
+(*
+   These functions are for use in mosmlyac-generated parsers.  For
+   further information, see the Moscow ML Owner's Manual.  For
+   examples, see mosml/examples/lexyacc and mosml/examples/calc.
+
+   A grammar definition (input to mosmlyac) consists of fragments of
+   this form
+
+       nonterm :
+          grsyms1   { action1 }
+        | grsyms2   { action2 }
+        | grsyms3   { action3 }
+        | ...
+
+   where the grsyms are sequences of grammar symbols, matching some
+   string of characters, and the actions are corresponding semantic
+   actions, written in ML.  The following functions can be used in the
+   semantic actions:
+
    [symbolStart ()] returns the start position of the string that
    matches the sequence of grammar symbols.  The first character in
    the input stream has position 0.  May be called in a semantic
@@ -91,4 +91,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Path.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Path.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Path.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Path.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,24 +6,25 @@
 Structure index
 
                  
 
                  -(* OS.Path -- SML Basis Library *)
-
-exception Path
-
-val parentArc    : string
-val currentArc   : string
-
-val fromString   : string -> {isAbs : bool, vol : string, arcs : string list}
-val toString     : {isAbs : bool, vol : string, arcs : string list} -> string
-
-val getVolume    : string -> string 
-val validVolume  : {isAbs : bool, vol : string} -> bool
-val getParent    : string -> string
-
-val isAbsolute   : string -> bool
-val isRelative   : string -> bool
-val mkAbsolute   : string * string -> string
-val mkRelative   : string * string -> string
+(* OS.Path -- SML Basis Library *)
+
+exception Path
+
+val parentArc    : string
+val currentArc   : string
+
+val fromString   : string -> {isAbs : bool, vol : string, arcs : string list}
+val toString     : {isAbs : bool, vol : string, arcs : string list} -> string
+
+val getVolume    : string -> string 
+val validVolume  : {isAbs : bool, vol : string} -> bool
+val getParent    : string -> string
+
+val isAbsolute   : string -> bool
+val isRelative   : string -> bool
+val isRoot       : string -> bool
+val mkAbsolute   : { path : string, relativeTo : string } -> string
+val mkRelative   : { path : string, relativeTo : string } -> string
 
 val concat       : string * string -> string
 
@@ -40,67 +41,71 @@
 val base         : string -> string    
 val ext          : string -> string option
 
-(* 
-   This module provides OS-independent functions for manipulating
-   strings that represent file names and paths in a directory
-   structure.  None of these functions accesses the actual filesystem.
-   
-   Definitions: 
-
-   * An arc denotes a directory or file.  Under Unix or DOS, an arc may
-   have form "..", ".", "", or "abc", or similar.
-
-   * An absolute path has a root: Unix examples include "/", "/a/b";
-   DOS examples include "\", "\a\b", "A:\a\b".  
-
-   * A relative path is one without a root: Unix examples include
-   "..", "a/b"; DOS examples include "..", "a\b", "A:a\b".
-
-   * A path has an associated volume.  Under Unix, there is only one
-   volume, whose name is "".  Under DOS, the volume names are "",
-   "A:", "C:", and similar.
+exception InvalidArc
+val fromUnixPath : string -> string
+val toUnixPath   : string -> string
+
+(* 
+   This module provides OS-independent functions for manipulating
+   strings that represent file names and paths in a directory
+   structure.  None of these functions accesses the actual filesystem.
+   
+   Definitions: 
+
+   * An arc denotes a directory or file.  Under Unix or DOS, an arc may
+   have form "..", ".", "", or "abc", or similar.
+
+   * An absolute path has a root: Unix examples include "/", "/a/b";
+   DOS examples include "\", "\a\b", "A:\a\b".  
+
+   * A relative path is one without a root: Unix examples include
+   "..", "a/b"; DOS examples include "..", "a\b", "A:a\b".
 
-   * A canonical path contains no occurrences of the empty arc "" or
-   the current arc ".", and contains or the parent arc ".." only at
-   the beginning and only if the path is relative.  
+   * A path has an associated volume.  Under Unix, there is only one
+   volume, whose name is "".  Under DOS, the volume names are "",
+   "A:", "C:", and similar.
 
-   * All functions (except concat) preserve canonical paths.  That is,
-   if all arguments are canonical, then so will the result be.
-
-   * All functions are defined so that they work sensibly on canonical 
-   paths.
-
-   * There are three groups of functions, corresponding to three ways
-   to look at paths, exemplified by the following paths:
-
-        Unix:    d/e/f/a.b.c       and     /d/e/f/a.b.c 
-        DOS:     A:d\e\f\a.b.c     and     A:d\e\f\a.b.c     
-
-   (1) A path consists of a sequence of arcs, possibly preceded by a
-       volume and a root:
-
-                          vol  [--- arcs ---]        vol  root  [--- arcs ---]
-        ---------------------------------------------------------------------- 
-        Unix examples:         d  e  f  a.b.c               /   d  e  f  a.b.c
-        DOS examples:     A:   d  e  f  a.b          A:     \   d  e  f  a.b
-
-   (2) A path consists of a directory part and a (last) file name part:
-
-                          directory   file            directory  file 
-        ------------------------------------------------------------------
-        Unix examples:    d/e/f       a.b.c           /d/e/f     a.b.c
-        DOS examples:     A:d\e\f     a.b             A:\d\e\f   a.b
-
-   (3) A path consists of a base and an extension:
-
-                          base       extension       base        extension
-        ------------------------------------------------------------------
-        Unix examples:    d/e/f/a.b      c           /d/e/f/a.b      c
-        DOS examples:     A:d\e\f\a      b           A:\d\e\f\a      b
-
-
-   GROUP 0: General functions on paths:
-
+   * A canonical path contains no occurrences of the empty arc "" or
+   the current arc ".", and contains or the parent arc ".." only at
+   the beginning and only if the path is relative.  
+
+   * All functions (except concat) preserve canonical paths.  That is,
+   if all arguments are canonical, then so will the result be.
+
+   * All functions are defined so that they work sensibly on canonical 
+   paths.
+
+   * There are three groups of functions, corresponding to three ways
+   to look at paths, exemplified by the following paths:
+
+        Unix:    d/e/f/a.b.c       and     /d/e/f/a.b.c 
+        DOS:     A:d\e\f\a.b.c     and     A:\d\e\f\a.b.c     
+
+   (1) A path consists of a sequence of arcs, possibly preceded by a
+       volume and a root:
+
+                          vol  [--- arcs ---]        vol  root  [--- arcs ---]
+        ---------------------------------------------------------------------- 
+        Unix examples:         d  e  f  a.b.c               /   d  e  f  a.b.c
+        DOS examples:     A:   d  e  f  a.b          A:     \   d  e  f  a.b
+
+   (2) A path consists of a directory part and a (last) file name part:
+
+                          directory   file            directory  file 
+        ------------------------------------------------------------------
+        Unix examples:    d/e/f       a.b.c           /d/e/f     a.b.c
+        DOS examples:     A:d\e\f     a.b             A:\d\e\f   a.b
+
+   (3) A path consists of a base and an extension:
+
+                          base       extension       base        extension
+        ------------------------------------------------------------------
+        Unix examples:    d/e/f/a.b      c           /d/e/f/a.b      c
+        DOS examples:     A:d\e\f\a      b           A:\d\e\f\a      b
+
+
+   GROUP 0: General functions on paths:
+
    [parentArc] is the arc denoting a parent directory: ".." under 
    DOS and Unix.
 
@@ -112,6 +117,9 @@
    [isAbsolute p] returns true if p is an absolute path.  
    Equals not (isRelative p).
 
+   [isRoot p] returns true if p is a canonical specification of a root
+   directory. That is, if p is an absolute path with no arcs.
+
    [validVolume {isAbs, vol}] returns true if vol is a valid volume
    name for an absolute path (if isAbs=true) resp. for a relative path
    (if isAbs=false).  Under Unix, the only valid volume name is "";
@@ -127,16 +135,17 @@
    equivalent in the presence of symbolic links.  Raises Path if p2 is
    not a relative path.
 
-   [mkAbsolute(p1, p2)] returns the absolute path made by taking path
-   p2, then p1.  That is, returns p1 if p1 is absolute; otherwise
-   returns the canonicalized concatenation of p2 and p1.  Raises Path
-   if p2 is not absolute (even if p1 is absolute).
-
-   [mkRelative(p1, p2)] returns p1 relative to p2.  That is, returns
-   p1 if p1 is already relative; otherwise returns the relative path
-   leading from p2 to p1.  Raises Path if p2 is not absolute (and even
-   if p1 is relative), or if p1 and p2 are both absolute but have
-   different roots.
+   [mkAbsolute { path=p1, relativeTo=p2 }] returns the absolute path
+   made by taking path p2, then p1.  That is, returns p1 if p1 is
+   absolute; otherwise returns the canonicalized concatenation of p2
+   and p1.  Raises Path if p2 is not absolute (even if p1 is
+   absolute).
+
+   [mkRelative { path=p1, relativeTo=p2 }] returns p1 relative to p2.
+   That is, returns p1 if p1 is already relative; otherwise returns
+   the relative path leading from p2 to p1.  Raises Path if p2 is not
+   absolute (and even if p1 is relative), or if p1 and p2 are both
+   absolute but have different roots.
 
    [mkCanonical p] returns a canonical path which is equivalent to p.
    Redundant occurrences of the parent arc, the current arc, and the
@@ -203,10 +212,24 @@
    [ext s] equals #ext (splitBaseExt s).
 
    [base s] equals #base (splitBaseExt s).
+
+   
+   GROUP 4: Convenience functions for manipulating Unix-style paths.
+
+   [fromUnixPath s] returns a path in the style of the host OS from
+   the Unix-style path s. Slash characters are translated to the
+   directory separators of the local system, as are parent arcs and
+   current arcs.  Raises InvalidArc if any arc in s is invalid in the
+   host OS's path syntax.
+
+   [toUnixPath s] returns a Unix-style path from the path s in the
+   style of the host OS. If the path s has a non-empty volume name,
+   then the Path exception is raised. Raises InvalidArc if any arc
+   contains a slash character.
 *)
 
 
                  
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Polygdbm.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Polygdbm.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Polygdbm.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Polygdbm.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,33 +6,33 @@
 Structure index
 
                  
 
                  -(* Polygdbm -- GNU gdbm persistent polymorphic hashtables -- requires Dynlib *)
-
-type ('key, 'data) table 
-
-exception NotFound
-exception AlreadyThere
-exception NotWriter
-exception Closed
-exception GdbmError of string
-
-val withtable  : string * Gdbm.openmode -> (('key, 'data) table -> 'a) -> 'a
-val add        : ('key, 'data) table -> 'key * 'data -> unit 
-val insert     : ('key, 'data) table -> 'key * 'data -> unit
-val find       : ('key, 'data) table -> 'key -> 'data
-val peek       : ('key, 'data) table -> 'key -> 'data option
-val hasKey     : ('key, 'data) table -> 'key -> bool
-val remove     : ('key, 'data) table -> 'key -> unit
-val listKeys   : ('key, 'data) table -> 'key list
-val numItems   : ('key, 'data) table -> int
-val listItems  : ('key, 'data) table -> ('key * 'data) list
-val app        : ('key * 'data -> unit) -> ('key, 'data) table -> unit
-val map        : ('key * 'data -> 'a) -> ('key, 'data) table -> 'a list
-val fold       : ('key * 'data * 'a -> 'a) -> 'a -> ('key, 'data) table -> 'a
-val fastwrite  : bool ref    
-val reorganize : ('key, 'data) table -> unit
-
-(* 
+(* Polygdbm -- GNU gdbm persistent polymorphic hashtables -- requires Dynlib *)
+
+type ('key, 'data) table 
+
+exception NotFound
+exception AlreadyThere
+exception NotWriter
+exception Closed
+exception GdbmError of string
+
+val withtable  : string * Gdbm.openmode -> (('key, 'data) table -> 'a) -> 'a
+val add        : ('key, 'data) table -> 'key * 'data -> unit 
+val insert     : ('key, 'data) table -> 'key * 'data -> unit
+val find       : ('key, 'data) table -> 'key -> 'data
+val peek       : ('key, 'data) table -> 'key -> 'data option
+val hasKey     : ('key, 'data) table -> 'key -> bool
+val remove     : ('key, 'data) table -> 'key -> unit
+val listKeys   : ('key, 'data) table -> 'key list
+val numItems   : ('key, 'data) table -> int
+val listItems  : ('key, 'data) table -> ('key * 'data) list
+val app        : ('key * 'data -> unit) -> ('key, 'data) table -> unit
+val map        : ('key * 'data -> 'a) -> ('key, 'data) table -> 'a list
+val fold       : ('key * 'data * 'a -> 'a) -> 'a -> ('key, 'data) table -> 'a
+val fastwrite  : bool ref    
+val reorganize : ('key, 'data) table -> unit
+
+(* 
    [('key, 'data) table] is the type of an opened table with keys of
    type 'key and associated values of type 'data.  The actual values
    of type 'key and 'data cannot contain function closures or abstract
@@ -115,4 +115,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Polyhash.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Polyhash.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Polyhash.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Polyhash.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,36 +6,36 @@
 Structure index
 
                  
 
                  -(* Polyhash -- polymorphic hashtables as in the SML/NJ Library *)
-
-type ('key, 'data) hash_table
-
-val mkTable     : ('_key -> int) * ('_key * '_key -> bool) -> int * exn 
-                  -> ('_key, '_data) hash_table
-val numItems    : ('key, 'data) hash_table -> int
-val insert      : ('_key, '_data) hash_table -> '_key * '_data -> unit
-val peekInsert  : ('_key, '_data) hash_table -> '_key * '_data 
-                  -> '_data option
-val find        : ('key, 'data) hash_table -> 'key -> 'data
-val peek        : ('key, 'data) hash_table -> 'key -> 'data option
-val remove      : ('key, 'data) hash_table -> 'key -> 'data
-val listItems   : ('key, 'data) hash_table -> ('key * 'data) list
-val apply       : ('key * 'data -> unit) -> ('key, 'data) hash_table -> unit
-val map         : ('_key * 'data -> '_res) -> ('_key, 'data) hash_table 
-                  -> ('_key, '_res) hash_table
-val filter      : ('key * 'data -> bool) -> ('key, 'data) hash_table -> unit
-val transform   : ('data -> '_res) -> ('_key, 'data) hash_table 
-                  -> ('_key, '_res) hash_table
-val copy        : ('_key, '_data) hash_table -> ('_key, '_data) hash_table
-val bucketSizes : ('key, 'data) hash_table -> int list
-
-(* Polymorphic hash primitives from Caml Light *)
-
-val hash        : 'key -> int
-val hash_param  : int -> int -> 'key -> int
-val mkPolyTable : int * exn -> (''_key, '_data) hash_table
-
-(* 
+(* Polyhash -- polymorphic hashtables as in the SML/NJ Library *)
+
+type ('key, 'data) hash_table
+
+val mkTable     : ('_key -> int) * ('_key * '_key -> bool) -> int * exn 
+                  -> ('_key, '_data) hash_table
+val numItems    : ('key, 'data) hash_table -> int
+val insert      : ('_key, '_data) hash_table -> '_key * '_data -> unit
+val peekInsert  : ('_key, '_data) hash_table -> '_key * '_data 
+                  -> '_data option
+val find        : ('key, 'data) hash_table -> 'key -> 'data
+val peek        : ('key, 'data) hash_table -> 'key -> 'data option
+val remove      : ('key, 'data) hash_table -> 'key -> 'data
+val listItems   : ('key, 'data) hash_table -> ('key * 'data) list
+val apply       : ('key * 'data -> unit) -> ('key, 'data) hash_table -> unit
+val map         : ('_key * 'data -> '_res) -> ('_key, 'data) hash_table 
+                  -> ('_key, '_res) hash_table
+val filter      : ('key * 'data -> bool) -> ('key, 'data) hash_table -> unit
+val transform   : ('data -> '_res) -> ('_key, 'data) hash_table 
+                  -> ('_key, '_res) hash_table
+val copy        : ('_key, '_data) hash_table -> ('_key, '_data) hash_table
+val bucketSizes : ('key, 'data) hash_table -> int list
+
+(* Polymorphic hash primitives from Caml Light *)
+
+val hash        : 'key -> int
+val hash_param  : int -> int -> 'key -> int
+val mkPolyTable : int * exn -> (''_key, '_data) hash_table
+
+(* 
    [('key, 'data) hash_table] is the type of hashtables with keys of type
    'key and data values of type 'data.
 
@@ -109,4 +109,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Postgres.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Postgres.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Postgres.html	2000-08-02 13:05:29.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Postgres.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,117 +6,126 @@
 Structure index
 
                  
 
                  -(* Postgres -- interface to PostgreSQL database server -- requires Dynlib *)
-
-type dbconn                                   (* Connection to server *)
-type dbresult                                 (* Result of a query    *)
-type oid                                      (* Internal object id   *)
-
-exception Closed                              (* Connection is closed *)
-exception Null                                (* Field value is NULL  *)
-
-(* Opening, closing, and maintaining database connections *)
-
-val openbase : { dbhost    : string option,   (* database server host *)
-                 dbname    : string option,   (* database name        *)
-                 dboptions : string option,   (* options              *)
-                 dbport    : string option,   (* database server port *)
-                 dbpwd     : string option,   (* user passwd          *)
-                 dbtty     : string option,   (* tty for error log    *)
-                 dbuser    : string option    (* database user        *)
-               } -> dbconn
-
-val closebase    : dbconn -> unit
-val db           : dbconn -> string
-val host         : dbconn -> string option
-val options      : dbconn -> string
-val port         : dbconn -> string
-val tty          : dbconn -> string
-
-val status       : dbconn -> bool
-val reset        : dbconn -> unit
-val errormessage : dbconn -> string option
-
-(* Query execution and result set information *)
-
-datatype dbresultstatus =
-    Bad_response            (* An unexpected response was received    *)
-  | Command_ok              (* The query was a command                *)
-  | Copy_in                 (* The query was "copy <table> from ..."  *)
-  | Copy_out                (* The query was "copy <table> to ..."    *)
-  | Empty_query
-  | Fatal_error
-  | Nonfatal_error
-  | Tuples_ok               (* The query successfully returned tuples *)
-
-val execute      : dbconn -> string -> dbresult
-val resultstatus : dbresult -> dbresultstatus
-val ntuples      : dbresult -> int
-val cmdtuples    : dbresult -> int
-val nfields      : dbresult -> int
-val fname        : dbresult -> int -> string
-val fnames       : dbresult -> string vector
-val fnumber      : dbresult -> string -> int option
-
-(* Accessing the fields of a resultset *)
-
-val getint       : dbresult -> int -> int -> int
-val getreal      : dbresult -> int -> int -> real
-val getstring    : dbresult -> int -> int -> string
-val getdate      : dbresult -> int -> int -> int * int * int (* Y M D *)
-val gettime      : dbresult -> int -> int -> int * int * int (* H M S *)
-val getdatetime  : dbresult -> int -> int -> Date.date
-val getbool      : dbresult -> int -> int -> bool
-val isnull       : dbresult -> int -> int -> bool
-
-datatype dynval =
-    Bool of bool                        (* psql bool            *)
-  | Int of int                          (* psql int4            *)
-  | Real of real                        (* psql float8, float4  *)
-  | String of string                    (* psql text, varchar   *)
-  | Date of int * int * int             (* psql date yyyy-mm-dd *)
-  | Time of int * int * int             (* psql time hh:mm:ss   *)
-  | DateTime of Date.date               (* psql datetime        *)
-  | Oid of oid                          (* psql oid             *)
-  | Bytea of Word8Array.array           (* psql bytea           *)
-  | NullVal                             (* psql NULL            *)
-
-val getdynfield : dbresult -> int -> int -> dynval
-val getdyntup   : dbresult -> int -> dynval vector
-val getdyntups  : dbresult -> dynval vector vector 
-val dynval2s    : dynval -> string
-
-(* Bulk copying to or from a table *)
-
-val copytableto   : dbconn * string * (string -> unit) -> unit
-val copytablefrom : dbconn * string * ((string -> unit) -> unit) -> unit
-
-(* Some standard ML and Postgres types: *)
-
-datatype dyntype = 
-    BoolTy              (* ML bool              psql bool              *)
-  | IntTy               (* ML int               psql int4              *)
-  | RealTy              (* ML real              psql float8, float4    *)
-  | StringTy            (* ML string            psql text, varchar     *) 
-  | DateTy              (* ML (yyyy, mth, day)  psql date              *)
-  | TimeTy              (* ML (hh, mm, ss)      psql time              *)
-  | DateTimeTy          (* ML Date.date         psql datetime, abstime *)
-  | OidTy               (* ML oid               psql oid               *)
-  | ByteArrTy           (* ML Word8Array.array  psql bytea             *)
-  | UnknownTy of oid
-
-val fromtag : dyntype -> string
-val ftype   : dbresult -> int -> dyntype
-val ftypes  : dbresult -> dyntype Vector.vector
-
-val applyto : 'a -> ('a -> 'b) -> 'b
-
-(* Formatting the result of a database query as an HTML table *)
-
-val formattable : dbresult -> Msp.wseq
-val showquery   : dbconn -> string -> Msp.wseq
-
-(*
+(* Postgres -- interface to PostgreSQL database server -- requires Dynlib *)
+
+type dbconn                                   (* Connection to server *)
+type dbresult                                 (* Result of a query    *)
+eqtype oid                                    (* Internal object id   *)
+
+exception Closed                              (* Connection is closed *)
+exception Null                                (* Field value is NULL  *)
+
+(* Opening, closing, and maintaining database connections *)
+
+val openbase : { dbhost    : string option,   (* database server host *)
+                 dbname    : string option,   (* database name        *)
+                 dboptions : string option,   (* options              *)
+                 dbport    : string option,   (* database server port *)
+                 dbpwd     : string option,   (* user passwd          *)
+                 dbtty     : string option,   (* tty for error log    *)
+                 dbuser    : string option    (* database user        *)
+               } -> dbconn
+
+val closebase    : dbconn -> unit
+val db           : dbconn -> string
+val host         : dbconn -> string option
+val options      : dbconn -> string
+val port         : dbconn -> string
+val tty          : dbconn -> string
+
+val status       : dbconn -> bool
+val reset        : dbconn -> unit
+val errormessage : dbconn -> string option
+
+(* Query execution and result set information *)
+
+datatype dbresultstatus =
+    Bad_response            (* An unexpected response was received    *)
+  | Command_ok              (* The query was a command                *)
+  | Copy_in                 (* The query was "copy <table> from ..."  *)
+  | Copy_out                (* The query was "copy <table> to ..."    *)
+  | Empty_query
+  | Fatal_error
+  | Nonfatal_error
+  | Tuples_ok               (* The query successfully returned tuples *)
+
+val execute      : dbconn -> string -> dbresult
+val resultstatus : dbresult -> dbresultstatus
+val ntuples      : dbresult -> int
+val cmdtuples    : dbresult -> int
+val nfields      : dbresult -> int
+val fname        : dbresult -> int -> string
+val fnames       : dbresult -> string vector
+val fnumber      : dbresult -> string -> int option
+
+(* Accessing the fields of a resultset *)
+
+val getint       : dbresult -> int -> int -> int
+val getreal      : dbresult -> int -> int -> real
+val getstring    : dbresult -> int -> int -> string
+val getdate      : dbresult -> int -> int -> int * int * int   (* Y M D *)
+val gettime      : dbresult -> int -> int -> int * int * int   (* H M S *)
+val getdatetime  : dbresult -> int -> int -> Date.date
+val getbool      : dbresult -> int -> int -> bool
+val isnull       : dbresult -> int -> int -> bool
+
+datatype dynval =
+    Bool of bool                        (* psql bool            *)
+  | Int of int                          (* psql int4            *)
+  | Real of real                        (* psql float8, float4  *)
+  | String of string                    (* psql text, varchar   *)
+  | Date of int * int * int             (* psql date yyyy-mm-dd *)
+  | Time of int * int * int             (* psql time hh:mm:ss   *)
+  | DateTime of Date.date               (* psql datetime        *)
+  | Oid of oid                          (* psql oid             *)
+  | Bytea of Word8Array.array           (* psql bytea           *)
+  | NullVal                             (* psql NULL            *)
+
+val getdynfield : dbresult -> int -> int -> dynval
+val getdyntup   : dbresult -> int -> dynval vector
+val getdyntups  : dbresult -> dynval vector vector 
+val dynval2s    : dynval -> string
+
+(* Bulk copying to or from a table *)
+
+val copytableto   : dbconn * string * (string -> unit) -> unit
+val copytablefrom : dbconn * string * ((string -> unit) -> unit) -> unit
+
+(* Some standard ML and Postgres types: *)
+
+datatype dyntype = 
+    BoolTy              (* ML bool              psql bool              *)
+  | IntTy               (* ML int               psql int4              *)
+  | RealTy              (* ML real              psql float8, float4    *)
+  | StringTy            (* ML string            psql text, varchar     *) 
+  | DateTy              (* ML (yyyy, mth, day)  psql date              *)
+  | TimeTy              (* ML (hh, mm, ss)      psql time              *)
+  | DateTimeTy          (* ML Date.date         psql datetime, abstime *)
+  | OidTy               (* ML oid               psql oid               *)
+  | ByteArrTy           (* ML Word8Array.array  psql bytea             *)
+  | UnknownTy of oid
+
+val fromtag : dyntype -> string
+val ftype   : dbresult -> int -> dyntype
+val ftypes  : dbresult -> dyntype Vector.vector
+
+val applyto : 'a -> ('a -> 'b) -> 'b
+
+(* Formatting the result of a database query as an HTML table *)
+
+val formattable : dbresult -> Msp.wseq
+val showquery   : dbconn -> string -> Msp.wseq
+
+(* 
+
+   (Technical warning: This expects the PostgreSQL server to use ISO
+   date format, such as 2002-07-25.  Also, if the PostgreSQL server
+   was compiled with support for multibyte-encodings (Unicode), the
+   database must be created with
+     createdb -E LATIN1 <dbname>
+   or you should set the environment variable PGCLIENTENCODING to
+   LATIN1 in the SML program's environment.)
+ 
    [dbconn] is the type of connections to a PostgreSQL database.
 
    [dbresult] is the type of result sets from SQL queries.
@@ -290,4 +299,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/PP.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/PP.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/PP.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/PP.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,41 +6,41 @@
 Structure index
 
                  
 
                  -(* PP -- pretty-printing -- from the SML/NJ library *)
-
-type ppconsumer = { consumer  : string -> unit,
-                    linewidth : int,
-                    flush     : unit -> unit }
-
-datatype break_style = 
-    CONSISTENT
-  | INCONSISTENT
-
-val mk_ppstream    : ppconsumer -> ppstream
-val dest_ppstream  : ppstream -> ppconsumer
-val add_break      : ppstream -> int * int -> unit
-val add_newline    : ppstream -> unit
-val add_string     : ppstream -> string -> unit
-val begin_block    : ppstream -> break_style -> int -> unit
-val end_block      : ppstream -> unit
-val clear_ppstream : ppstream -> unit
-val flush_ppstream : ppstream -> unit
-val with_pp        : ppconsumer -> (ppstream -> unit) -> unit
-val pp_to_string   : int -> (ppstream -> 'a -> unit) -> 'a -> string
-
-(* 
-   This structure provides tools for creating customized Oppen-style
-   pretty-printers, based on the type ppstream.  A ppstream is an
-   output stream that contains prettyprinting commands.  The commands
-   are placed in the stream by various function calls listed below.
-
-   There following primitives add commands to the stream:
-   begin_block, end_block, add_string, add_break, and add_newline.
-   All calls to add_string, add_break, and add_newline must happen
-   between a pair of calls to begin_block and end_block must be
-   properly nested dynamically.  All calls to begin_block and
-   end_block must be properly nested (dynamically).
-
+(* PP -- pretty-printing -- from the SML/NJ library *)
+
+type ppconsumer = { consumer  : string -> unit,
+                    linewidth : int,
+                    flush     : unit -> unit }
+
+datatype break_style = 
+    CONSISTENT
+  | INCONSISTENT
+
+val mk_ppstream    : ppconsumer -> ppstream
+val dest_ppstream  : ppstream -> ppconsumer
+val add_break      : ppstream -> int * int -> unit
+val add_newline    : ppstream -> unit
+val add_string     : ppstream -> string -> unit
+val begin_block    : ppstream -> break_style -> int -> unit
+val end_block      : ppstream -> unit
+val clear_ppstream : ppstream -> unit
+val flush_ppstream : ppstream -> unit
+val with_pp        : ppconsumer -> (ppstream -> unit) -> unit
+val pp_to_string   : int -> (ppstream -> 'a -> unit) -> 'a -> string
+
+(* 
+   This structure provides tools for creating customized Oppen-style
+   pretty-printers, based on the type ppstream.  A ppstream is an
+   output stream that contains prettyprinting commands.  The commands
+   are placed in the stream by various function calls listed below.
+
+   There following primitives add commands to the stream:
+   begin_block, end_block, add_string, add_break, and add_newline.
+   All calls to add_string, add_break, and add_newline must happen
+   between a pair of calls to begin_block and end_block must be
+   properly nested dynamically.  All calls to begin_block and
+   end_block must be properly nested (dynamically).
+
    [ppconsumer] is the type of sinks for pretty-printing.  A value of 
    type ppconsumer is a record 
                  { consumer  : string -> unit,
@@ -103,11 +103,11 @@
 
    [with_pp consumer f] makes a new ppstream from the consumer and
    applies f (which can be thought of as a producer) to that
-   ppstream, then flushed the ppstream and returns the value of f.
+   ppstream, then flushes the ppstream and returns the value of f.
 
    [pp_to_string linewidth printit x] constructs a new ppstream
    ppstrm whose consumer accumulates the output in a string s.  Then
-   evaluates (printit ppstrm x) and finally returns the string s.
+   it evaluates (printit ppstrm x) and finally returns the string s.
 
    
    Example 1: A simple prettyprinter for Booleans:
@@ -192,4 +192,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Process.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Process.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Process.html	2000-08-02 13:05:31.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Process.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,31 +6,39 @@
 Structure index
 
                  
 
                  -(* OS.Process -- SML Basis Library *)
-
-eqtype status
-
-val success   : status
-val failure   : status
-
-val system    : string -> status
-
-val atExit    : (unit -> unit) -> unit
-val exit      : status -> 'a
-val terminate : status -> 'a
-
-val getEnv    : string -> string option
+(* OS.Process -- SML Basis Library *)
+
+type status
+
+val success   : status
+val failure   : status
+
+val isSuccess : status -> bool
+
+val system    : string -> status
+
+val atExit    : (unit -> unit) -> unit
+val exit      : status -> 'a
+val terminate : status -> 'a
+val sleep     : Time.time -> unit 
 
-(* 
-   Portable functions for manipulating processes.
-
+val getEnv    : string -> string option
+
+(* 
+   Portable functions for manipulating processes.
+
    [success] is the unique status value that signifies successful
    termination of a process.  Note: MS DOS (sometimes) believes that
    all processes are successful.
 
    [failure] is a status value that signifies an error during
    execution of a process.  Note that in contrast to the success
-   value, there may be several distinct failure values.
+   value, there may be several distinct failure values.  Use function
+   isSuccess to reliably test for success.
+
+   [isSuccess sv] returns true if the status value sv represents a
+   successful execution, false otherwise.  It holds that 
+   isSuccess success = true and isSuccess failure = false.
 
    [system cmd] asks the operating system to execute command cmd, and
    returns a status value.
@@ -45,6 +53,11 @@
    [terminate i] terminates the SML process with completion code i 
    (but without executing the registered actions).
 
+   [sleep t] suspends this process for approximately the time
+   indicated by t.  The actual time slept depends on the capabilities
+   of the underlying system and the system load.  Does not sleep at
+   all if t <= Time.zeroTime.
+
    [getEnv evar] returns SOME s if the environment variable evar is
    defined and is associated with the string s; otherwise NONE.
 *)
@@ -53,4 +66,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Random.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Random.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Random.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Random.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,22 +6,24 @@
 Structure index
 
                  
 
                  -(* Random -- random number generator *)
-
-type generator
-
-val newgenseed : real -> generator
-val newgen     : unit -> generator
-val random     : generator -> real
-val randomlist : int * generator -> real list
-val range      : int * int -> generator -> int
-val rangelist  : int * int -> int * generator -> int list
-
-(* 
+(* Random -- random number generator *)
+
+type generator
+
+val newgenseed : real -> generator
+val newgen     : unit -> generator
+val random     : generator -> real
+val randomlist : int * generator -> real list
+val range      : int * int -> generator -> int
+val rangelist  : int * int -> int * generator -> int list
+
+(* 
    [generator] is the type of random number generators, here the
    linear congruential generators from Paulson 1991, 1996.
 
-   [newgenseed seed] returns a random number generator with the given seed.
+   [newgenseed seed] returns a random number generator with the given
+   seed.  Throws exception Fail on seed 0.0 (which would give rise to
+   a degenerate sequence of random numbers).
 
    [newgen ()] returns a random number generator, taking the seed from
    the system clock.
@@ -32,14 +34,14 @@
    interval [0,1).
 
    [range (min, max) gen] returns an integral random number in the
-   range [min, max).  Raises Fail if min > max.
+   range [min, max).  Raises Fail if min >= max.
 
    [rangelist (min, max) (n, gen)] returns a list of n integral random
-   numbers in the range [min, max).  Raises Fail if min > max.  
+   numbers in the range [min, max).  Raises Fail if min >= max.  
 *)
 
 
                  
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Rbset.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Rbset.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Rbset.html	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Rbset.html	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,165 @@
+Structure Rbset
+
+
                  Structure Rbset
                  
+
                  
+
                  Identifier index
+Structure index
+
                  
+
                  +(* Rbset -- ordered sets implemented by red-black trees *)
+(* Intention: should resemble SML/NJs ORD_SET signature *)
+
+signature Rbset = sig
+type 'item set
+
+exception NotFound
+exception NonMonotonic
+
+val empty        : ('item * 'item -> order) -> 'item set
+val singleton    : ('item * 'item -> order) -> 'item -> 'item set
+val add          : 'item set * 'item -> 'item set
+val add'         : 'item * 'item set -> 'item set
+val addList      : 'item set * 'item list -> 'item set
+val isEmpty      : 'item set -> bool
+val isSubset     : 'item set * 'item set -> bool
+val member       : 'item set * 'item -> bool
+val delete       : 'item set * 'item -> 'item set
+val numItems     : 'item set ->  int
+val getOrder     : 'item set -> ('item * 'item -> order)
+val union        : 'item set * 'item set -> 'item set
+val intersection : 'item set * 'item set -> 'item set
+val difference   : 'item set * 'item set -> 'item set
+val listItems    : 'item set -> 'item list
+val app          : ('item -> unit) -> 'item set -> unit
+val revapp       : ('item -> unit) -> 'item set -> unit
+val foldr        : ('item * 'b -> 'b) -> 'b -> 'item set -> 'b
+val foldl        : ('item * 'b -> 'b) -> 'b -> 'item set -> 'b
+val map          : ('item -> 'newitem) * ('newitem * 'newitem -> order) 
+                   -> 'item set -> 'newitem set
+val mapMono      : ('item -> 'newitem) * ('newitem * 'newitem -> order) 
+                   -> 'item set -> 'newitem set
+val find         : ('item -> bool) -> 'item set -> 'item option
+val min          : 'item set -> 'item option
+val max          : 'item set -> 'item option
+val hash         : ('item -> word) -> 'item set -> word
+val equal        : 'item set * 'item set -> bool
+val compare      : 'item set * 'item set -> order 
+
+val depth        : 'item set -> int
+
+datatype 'item intv = 
+    All
+  | From of 'item
+  | To   of 'item
+  | FromTo of 'item * 'item
+
+val subset  : 'item set * 'item intv -> 'item set
+val sublist : 'item set * 'item intv -> 'item list
+
+end
+
+(* 
+
+   ['item set] is the type of sets of ordered elements of type 'item.
+   The ordering relation on the elements is used in the representation
+   of the set.  The result of combining or comparing two sets with
+   different underlying ordering relations is undefined.  The
+   implementation uses Okasaki-style red-black trees.
+
+   [empty ordr] creates a new empty set with the given ordering
+   relation.  
+
+   [singleton ordr i] creates the singleton set containing i, with the
+   given ordering relation.
+
+   [add(s, i)] adds item i to set s.  
+
+   [addList(s, xs)] adds all items from the list xs to the set s.
+
+   [isEmpty s] returns true if and only if the set is empty.
+
+   [equal(s1, s2)] returns true if and only if the two sets have the
+   same elements, as determined by the ordering relation given when
+   the sets were created.  
+
+   [isSubset(s1, s2)] returns true if and only if s1 is a subset of s2.
+
+   [member(s, i)] returns true if and only if i is in s.
+
+   [delete(s, i)] removes item i from s.  Raises NotFound if i is not in s.
+   
+   [numItems s] returns the number of items in set s.
+
+   [union(s1, s2)] returns the union of s1 and s2.  
+
+   [intersection(s1, s2)] returns the intersection of s1 and s2.
+
+   [difference(s1, s2)] returns the difference between s1 and s2 (that
+   is, the set of elements in s1 but not in s2).
+
+   [listItems s] returns a list of the items in set s, in increasing
+   order.
+
+   [app f s] applies function f to the elements of s, in increasing
+   order.
+
+   [revapp f s] applies function f to the elements of s, in decreasing
+   order. 
+
+   [foldl f e s] applies the folding function f to the entries of the
+   set in increasing order.
+
+   [foldr f e s] applies the folding function f to the entries of the
+   set in decreasing order. 
+
+   [map (f, ordr) s] creates a new set with underlying ordering ordr
+   by applying function f to all elements of the set s.
+
+   [mapMono (f, ordr) s] creates a new set by applying the strictly
+   monotonically increasing function f to all elements of s.  The new
+   set will have ordering ordr.  This is faster than map (f, ordr) s by 
+   a logarithmic factor, but the function must satisfy 
+      ordr(f x, f y) = ordr'(x, y) 
+   for all elements x, y in s, where ordr' is the ordering relation 
+   on s; otherwise exception NonMonotonic is thrown.
+
+   [find p s] returns SOME i, where i is an item in s which satisfies
+   p, if one exists; otherwise returns NONE.  Traverses the entries of
+   the set in increasing order.
+
+   [min s] returns SOME i, where i is the least item in the set s, if s is 
+   non-empty; returns NONE if s is empty.
+
+   [max s] returns SOME i, where i is the greatest item in the set s,
+   if s is non-empty; returns NONE if s is empty.
+
+   [hashCode h s] returns the hashcode of the set, which is the sum of
+   the hashcodes of its elements, as computed by the function h.
+
+   [compare (s1, s2)] returns LESS, EQUAL or GREATER according as s1
+   precedes, equals or follows s2 in the lexicographic ordering that
+   would be obtained by comparing the sorted lists of elements of the
+   two sets.  It holds that 
+      equal(s1, s2)    if and only if compare(s1, s2) = EQUAL
+      isSubset(s1, s2) implies compare(s1, s2) = LESS
+      isSubset(s2, s1) implies compare(s1, s2) = GREATER
+
+   [subset(s, intv)] returns a set of those elements of s that belong
+   to the interval intv.  The intervals have the following meaning:
+
+       All             denotes  all elements
+       From e1         denotes  elements e for which cmp(e1, e) <> GREATER
+       To e2           denotes  elements e for which cmp(e, e2) = LESS
+       FromTo(e1, e2)  denotes  elements e for which cmp(e1, e) <> GREATER
+                                                 and cmp(e, e2) = LESS
+
+   [sublist(s, intv)] returns a list, in order, of those elements of s
+   that belong to the interval intv.  Thus sublist(s, All) is equivalent 
+   to listItems s.
+*)
+
+
                  
+
                  Identifier index
+Structure index
+
                  
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Real.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Real.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Real.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Real.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,57 +6,57 @@
 Structure index
 
                  
 
                  -(* Real -- SML Basis Library *)
-
-type real = real
-
-exception Div
-and Overflow
-
-val ~           : real -> real
-val +           : real * real -> real
-val -           : real * real -> real
-val *           : real * real -> real
-val /           : real * real -> real
-val abs         : real -> real
-val min         : real * real -> real
-val max         : real * real -> real
-val sign        : real -> int
-val compare     : real * real -> order
-
-val sameSign    : real * real -> bool
-val toDefault   : real -> real
-val fromDefault : real -> real
-val fromInt     : int -> real
-
-val floor       : real -> int
-val ceil        : real -> int
-val trunc       : real -> int
-val round       : real -> int
-
-val >           : real * real -> bool
-val >=          : real * real -> bool
-val <           : real * real -> bool
-val <=          : real * real -> bool
-val ==          : real * real -> bool
-val !=          : real * real -> bool
-val ?=          : real * real -> bool
-
-val toString    : real -> string
-val fromString  : string -> real option
-val scan        : (char, 'a) StringCvt.reader -> (real, 'a) StringCvt.reader
-val fmt         : StringCvt.realfmt -> real -> string
-
-(* 
-   [~]
-   [*]
-   [/]
-   [+]
+(* Real -- SML Basis Library *)
+
+type real = real
+
+exception Div
+and Overflow
+
+val ~           : real -> real
+val +           : real * real -> real
+val -           : real * real -> real
+val *           : real * real -> real
+val /           : real * real -> real
+val abs         : real -> real
+val min         : real * real -> real
+val max         : real * real -> real
+val sign        : real -> int
+val compare     : real * real -> order
+
+val sameSign    : real * real -> bool
+val toDefault   : real -> real
+val fromDefault : real -> real
+val fromInt     : int -> real
+
+val floor       : real -> int
+val ceil        : real -> int
+val trunc       : real -> int
+val round       : real -> int
+
+val >           : real * real -> bool
+val >=          : real * real -> bool
+val <           : real * real -> bool
+val <=          : real * real -> bool
+val ==          : real * real -> bool
+val !=          : real * real -> bool
+val ?=          : real * real -> bool
+
+val toString    : real -> string
+val fromString  : string -> real option
+val scan        : (char, 'a) StringCvt.reader -> (real, 'a) StringCvt.reader
+val fmt         : StringCvt.realfmt -> real -> string
+
+(* 
+   [~]
+   [*]
+   [/]
+   [+]
    [-]
-   [>]
-   [>=]
-   [<]
-   [<=] are the usual operations on defined reals (excluding NaN and Inf).
+   [>]
+   [>=]
+   [<]
+   [<=] are the usual operations on defined reals (excluding NaN and Inf).
 
    [abs x] is x if x >= 0, and ~x if x < 0, that is, the absolute value of x.
 
@@ -89,13 +89,13 @@
    [round r] is the integer nearest to r, using the default rounding
    mode.  May raise Overflow.
 
-   [==(x, y)] is equivalent to x=y in Moscow ML (because of the
+   [==(x, y)] is equivalent to x=y in Moscow ML (because of the
    absence of NaNs and Infs).
 
-   [!=(x, y)] is equivalent to x<>y in Moscow ML (because of the
+   [!=(x, y)] is equivalent to x<>y in Moscow ML (because of the
    absence of NaNs and Infs).
 
-   [?=(x, y)] is false in Moscow ML (because of the absence of NaNs
+   [?=(x, y)] is false in Moscow ML (because of the absence of NaNs
    and Infs).
 
    [fmt spec r] returns a string representing r, in the format
@@ -135,4 +135,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Redblackmap.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Redblackmap.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Redblackmap.html	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Redblackmap.html	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,80 @@
+Structure Redblackmap
+
+
                  Structure Redblackmap
                  
+
                  
+
                  Identifier index
+Structure index
+
                  
+
                  +(* Redblackmap -- applicative maps as Red-black trees *)
+signature Redblackmap =
+sig
+type ('key, 'a) dict
+
+exception NotFound
+
+val mkDict    : ('key * 'key -> order) -> ('key, 'a) dict
+val insert    : ('key, 'a) dict * 'key * 'a -> ('key, 'a) dict
+val find      : ('key, 'a) dict * 'key -> 'a
+val peek      : ('key, 'a) dict * 'key -> 'a option
+val remove    : ('key, 'a) dict * 'key -> ('key, 'a) dict * 'a
+val numItems  : ('key, 'a) dict -> int
+val listItems : ('key, 'a) dict -> ('key * 'a) list
+val app       : ('key * 'a -> unit) -> ('key,'a) dict -> unit
+val revapp    : ('key * 'a -> unit) -> ('key,'a) dict -> unit
+val foldr     : ('key * 'a * 'b -> 'b)-> 'b -> ('key,'a) dict -> 'b
+val foldl     : ('key * 'a * 'b -> 'b) -> 'b -> ('key,'a) dict -> 'b
+val map       : ('key * 'a -> 'b) -> ('key,'a) dict -> ('key, 'b) dict
+val transform : ('a -> 'b) -> ('key,'a) dict -> ('key, 'b) dict
+end
+
+(* 
+   [('key, 'a) dict] is the type of applicative maps from domain type
+   'key to range type 'a, or equivalently, applicative dictionaries
+   with keys of type 'key and values of type 'a.  They are implemented
+   as Okasaki-style red-black trees.
+
+   [mkDict ordr] returns a new, empty map whose keys have ordering
+   ordr.
+
+   [insert(m, i, v)] extends (or modifies) map m to map i to v.
+
+   [find (m, k)] returns v if m maps k to v; otherwise raises NotFound.
+   
+   [peek(m, k)] returns SOME v if m maps k to v; otherwise returns NONE.
+
+   [remove(m, k)] removes k from the domain of m and returns the
+   modified map and the element v corresponding to k.  Raises NotFound
+   if k is not in the domain of m.
+
+   [numItems m] returns the number of entries in m (that is, the size
+   of the domain of m).
+
+   [listItems m] returns a list of the entries (k, v) of keys k and
+   the corresponding values v in m, in order of increasing key values.
+
+   [app f m] applies function f to the entries (k, v) in m, in
+   increasing order of k (according to the ordering ordr used to
+   create the map or dictionary).
+
+   [revapp f m] applies function f to the entries (k, v) in m, in
+   decreasing order of k.
+
+   [foldl f e m] applies the folding function f to the entries (k, v)
+   in m, in increasing order of k.
+
+   [foldr f e m] applies the folding function f to the entries (k, v)
+   in m, in decreasing order of k.
+
+   [map f m] returns a new map whose entries have form (k, f(k,v)),
+   where (k, v) is an entry in m.
+
+   [transform f m] returns a new map whose entries have form (k, f v),
+   where (k, v) is an entry in m.
+*)
+
+
                  
+
                  Identifier index
+Structure index
+
                  
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Regex.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Regex.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Regex.html	2000-08-02 13:05:29.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Regex.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,108 +6,108 @@
 Structure index
 
                  
 
                  -(* Regex -- regular expressions a la POSIX 1003.2 -- requires Dynlib *)
-
-exception Regex of string
-
-type regex                      (* A compiled regular expression         *)
-
-datatype cflag = 
-    Extended                    (* Compile POSIX extended REs            *)
-  | Icase                       (* Compile case-insensitive match        *)
-  | Newline                     (* Treat \n in target string as new line *)
-
-datatype eflag = 
-    Notbol                      (* Do not match ^ at beginning of string *)
-  | Noteol                      (* Do not match $ at end of string       *)
-
-val regcomp      : string -> cflag list -> regex
-
-val regexec      : regex -> eflag list -> string -> substring vector option
-val regexecBool  : regex -> eflag list -> string -> bool
-
-val regnexec     : regex -> eflag list -> substring 
-                   -> substring vector option
-val regnexecBool : regex -> eflag list -> substring -> bool
-
-val regmatch     : { pat : string, tgt : string } -> cflag list 
-                     -> eflag list -> substring vector option
-val regmatchBool : { pat : string, tgt : string } -> cflag list 
-                     -> eflag list -> bool
-
-datatype replacer =
-    Str of string                       (* A literal string             *)
-  | Sus of int                          (* The i'th parenthesized group *)
-  | Tr  of (string -> string) * int     (* Transformation of i'th group *)
-  | Trs of substring vector -> string   (* Transformation of all groups *)
-
-val replace1     : regex -> replacer list -> string -> string
-val replace      : regex -> replacer list -> string -> string
-
-val substitute1  : regex -> (string -> string) -> string -> string
-val substitute   : regex -> (string -> string) -> string -> string
-
-val tokens       : regex -> string -> substring list
-val fields       : regex -> string -> substring list
-
-val map          : regex -> (substring vector -> 'a) -> string -> 'a list
-val app          : regex -> (substring vector -> unit) -> string -> unit
-val fold         : regex 
-                   -> (substring * 'a -> 'a) * (substring vector * 'a -> 'a) 
-                   -> 'a -> string -> 'a
-
-(* 
-   This structure provides pattern matching with POSIX 1003.2 regular
-   expressions.  
-
-   The form and meaning of Extended and Basic regular expressions are
-   described below.  Here R and S denote regular expressions; m and n
-   denote natural numbers; L denotes a character list; and d denotes a
-   decimal digit:
-
-        Extended    Basic       Meaning
-       ---------------------------------------------------------------
-        c           c           Match the character c
-        .           .           Match any character
-        R*          R*          Match R zero or more times
-        R+          R\+         Match R one or more times
-        R|S         R\|S        Match R or S
-        R?          R\?         Match R or the empty string
-        R{m}        R\{m\}      Match R exactly m times
-        R{m,}       R\{m,\}     Match R at least m times
-        R{m,n}      R\{m,n\}    Match R at least m and at most n times
-        [L]         [L]         Match any character in L
-        [^L]        [^L]        Match any character not in L
-        ^           ^           Match at string's beginning
-        $           $           Match at string's end
-        (R)         \(R\)       Match R as a group; save the match
-        \d          \d          Match the same as previous group d
-        \\          \\          Match \ --- similarly for *.[]^$
-        \+          +           Match + --- similarly for |?{}()
-
-   Some example character lists L:
-
-        [aeiou]         Match vowel: a or e or i or o or u
-        [0-9]           Match digit: 0 or 1 or 2 or ... or 9
-        [^0-9]          Match non-digit
-        [-+*/^]         Match - or + or * or / or ^
-        [-a-z]          Match lowercase letter or hyphen (-)
-        [0-9a-fA-F]     Match hexadecimal digit
-        [[:alnum:]]     Match letter or digit
-        [[:alpha:]]     Match letter 
-        [[:cntrl:]]     Match ASCII control character
-        [[:digit:]]     Match decimal digit; same as [0-9]
-        [[:graph:]]     Same as [:print:] but not [:space:]
-        [[:lower:]]     Match lowercase letter
-        [[:print:]]     Match printable character
-        [[:punct:]]     Match punctuation character
-        [[:space:]]     Match SML #" ", #"\r", #"\n", #"\t", #"\v", #"\f"
-        [[:upper:]]     Match uppercase letter
-        [[:xdigit:]]    Match hexadecimal digit; same as [0-9a-fA-F]
-        [[:lower:]æøå]  Match lowercase Danish letters (ISO Latin 1)
-
-   Remember that backslash (\) must be escaped as "\\" in SML strings.
-
+(* Regex -- regular expressions a la POSIX 1003.2 -- requires Dynlib *)
+
+exception Regex of string
+
+type regex                      (* A compiled regular expression         *)
+
+datatype cflag = 
+    Extended                    (* Compile POSIX extended REs            *)
+  | Icase                       (* Compile case-insensitive match        *)
+  | Newline                     (* Treat \n in target string as new line *)
+
+datatype eflag = 
+    Notbol                      (* Do not match ^ at beginning of string *)
+  | Noteol                      (* Do not match $ at end of string       *)
+
+val regcomp      : string -> cflag list -> regex
+
+val regexec      : regex -> eflag list -> string -> substring vector option
+val regexecBool  : regex -> eflag list -> string -> bool
+
+val regnexec     : regex -> eflag list -> substring 
+                   -> substring vector option
+val regnexecBool : regex -> eflag list -> substring -> bool
+
+val regmatch     : { pat : string, tgt : string } -> cflag list 
+                     -> eflag list -> substring vector option
+val regmatchBool : { pat : string, tgt : string } -> cflag list 
+                     -> eflag list -> bool
+
+datatype replacer =
+    Str of string                       (* A literal string             *)
+  | Sus of int                          (* The i'th parenthesized group *)
+  | Tr  of (string -> string) * int     (* Transformation of i'th group *)
+  | Trs of substring vector -> string   (* Transformation of all groups *)
+
+val replace1     : regex -> replacer list -> string -> string
+val replace      : regex -> replacer list -> string -> string
+
+val substitute1  : regex -> (string -> string) -> string -> string
+val substitute   : regex -> (string -> string) -> string -> string
+
+val tokens       : regex -> string -> substring list
+val fields       : regex -> string -> substring list
+
+val map          : regex -> (substring vector -> 'a) -> string -> 'a list
+val app          : regex -> (substring vector -> unit) -> string -> unit
+val fold         : regex 
+                   -> (substring * 'a -> 'a) * (substring vector * 'a -> 'a) 
+                   -> 'a -> string -> 'a
+
+(* 
+   This structure provides pattern matching with POSIX 1003.2 regular
+   expressions.  
+
+   The form and meaning of Extended and Basic regular expressions are
+   described below.  Here R and S denote regular expressions; m and n
+   denote natural numbers; L denotes a character list; and d denotes a
+   decimal digit:
+
+        Extended    Basic       Meaning
+       ---------------------------------------------------------------
+        c           c           Match the character c
+        .           .           Match any character
+        R*          R*          Match R zero or more times
+        R+          R\+         Match R one or more times
+        R|S         R\|S        Match R or S
+        R?          R\?         Match R or the empty string
+        R{m}        R\{m\}      Match R exactly m times
+        R{m,}       R\{m,\}     Match R at least m times
+        R{m,n}      R\{m,n\}    Match R at least m and at most n times
+        [L]         [L]         Match any character in L
+        [^L]        [^L]        Match any character not in L
+        ^           ^           Match at string's beginning
+        $           $           Match at string's end
+        (R)         \(R\)       Match R as a group; save the match
+        \d          \d          Match the same as previous group d
+        \\          \\          Match \ --- similarly for *.[]^$
+        \+          +           Match + --- similarly for |?{}()
+
+   Some example character lists L:
+
+        [aeiou]         Match vowel: a or e or i or o or u
+        [0-9]           Match digit: 0 or 1 or 2 or ... or 9
+        [^0-9]          Match non-digit
+        [-+*/^]         Match - or + or * or / or ^
+        [-a-z]          Match lowercase letter or hyphen (-)
+        [0-9a-fA-F]     Match hexadecimal digit
+        [[:alnum:]]     Match letter or digit
+        [[:alpha:]]     Match letter 
+        [[:cntrl:]]     Match ASCII control character
+        [[:digit:]]     Match decimal digit; same as [0-9]
+        [[:graph:]]     Same as [:print:] but not [:space:]
+        [[:lower:]]     Match lowercase letter
+        [[:print:]]     Match printable character
+        [[:punct:]]     Match punctuation character
+        [[:space:]]     Match SML #" ", #"\r", #"\n", #"\t", #"\v", #"\f"
+        [[:upper:]]     Match uppercase letter
+        [[:xdigit:]]    Match hexadecimal digit; same as [0-9a-fA-F]
+        [[:lower:]æøå]  Match lowercase Danish letters (ISO Latin 1)
+
+   Remember that backslash (\) must be escaped as "\\" in SML strings.
+
    [regcomp pat cflags] returns a compiled representation of the
    regular expression pat.  Raises Regex in case of failure.  
 
@@ -267,4 +267,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Signal.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Signal.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Signal.html	2000-08-02 13:05:29.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Signal.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,35 +6,35 @@
 Structure index
 
                  
 
                  -(* Signal -- SML Basis Library *)
-
-eqtype signal
-
-val abrt : signal 
-val alrm : signal 
-val bus  : signal 
-val fpe  : signal 
-val hup  : signal 
-val ill  : signal 
-val int  : signal 
-val kill : signal 
-val pipe : signal 
-val quit : signal 
-val segv : signal 
-val term : signal 
-val usr1 : signal 
-val usr2 : signal 
-val chld : signal 
-val cont : signal 
-val stop : signal 
-val tstp : signal 
-val ttin : signal 
-val ttou : signal 
-
-val toWord   : signal -> Word.word 
-val fromWord : Word.word -> signal 
-
-(* 
+(* Signal -- SML Basis Library *)
+
+eqtype signal
+
+val abrt : signal 
+val alrm : signal 
+val bus  : signal 
+val fpe  : signal 
+val hup  : signal 
+val ill  : signal 
+val int  : signal 
+val kill : signal 
+val pipe : signal 
+val quit : signal 
+val segv : signal 
+val term : signal 
+val usr1 : signal 
+val usr2 : signal 
+val chld : signal 
+val cont : signal 
+val stop : signal 
+val tstp : signal 
+val ttin : signal 
+val ttou : signal 
+
+val toWord   : signal -> Word.word 
+val fromWord : Word.word -> signal 
+
+(* 
    [signal] is the type of Unix/Posix-style signals, which can be sent
    to another process.  
 
@@ -87,4 +87,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/SML90.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/SML90.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/SML90.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/SML90.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,53 +6,53 @@
 Structure index
 
                  
 
                  -(* SML90 -- part of the initial basis of the 1990 Definition *)
-
-(* Math *)
-
-val sqrt    : real -> real
-val sin     : real -> real
-val cos     : real -> real
-val arctan  : real -> real
-val exp     : real -> real
-val ln      : real -> real
-
-(* Strings *)
-
-val chr     : int -> string
-val ord     : string -> int
-
-val explode : string -> string list
-val implode : string list -> string
-
-exception Abs  
-      and Diff 
-      and Exp  
-      and Floor
-      and Neg  
-      and Prod 
-      and Sum  
-      and Mod  
-      and Quot
-
-(* Input/output *)
-
-type instream and outstream
-
-val std_in        : instream
-val open_in       : string -> instream
-val input         : instream * int -> string
-val lookahead     : instream -> string
-val close_in      : instream -> unit
-val end_of_stream : instream -> bool
-
-val std_out       : outstream
-val open_out      : string -> outstream
-val output        : outstream * string -> unit
-val close_out     : outstream -> unit
-
+(* SML90 -- part of the initial basis of the 1990 Definition *)
+
+(* Math *)
+
+val sqrt    : real -> real
+val sin     : real -> real
+val cos     : real -> real
+val arctan  : real -> real
+val exp     : real -> real
+val ln      : real -> real
+
+(* Strings *)
+
+val chr     : int -> string
+val ord     : string -> int
+
+val explode : string -> string list
+val implode : string list -> string
+
+exception Abs  
+      and Diff 
+      and Exp  
+      and Floor
+      and Neg  
+      and Prod 
+      and Sum  
+      and Mod  
+      and Quot
+
+(* Input/output *)
+
+type instream and outstream
+
+val std_in        : instream
+val open_in       : string -> instream
+val input         : instream * int -> string
+val lookahead     : instream -> string
+val close_in      : instream -> unit
+val end_of_stream : instream -> bool
+
+val std_out       : outstream
+val open_out      : string -> outstream
+val output        : outstream * string -> unit
+val close_out     : outstream -> unit
+
 
                  
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Socket.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Socket.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Socket.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Socket.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,102 +6,102 @@
 Structure index
 
                  
 
                  -(* Socket -- SML Basis Library -- requires Dynlib *)
-
-type ('addressfam, 'socktype) sock
-type 'addressfam sock_addr
-
-(* Socket types *)
-type dgram                              (* A datagram socket             *)
-type 'a stream                          (* A stream socket               *)
-type passive                            (* A passive stream              *)
-type active                             (* An active, connected, stream  *)
-
-(* Socket protocol families *)
-type pf_file                            (* The Unix file protocol family *)
-type pf_inet                            (* The Internet protocol family  *)
-
-(* Address constructors *)
-val fileAddr   : string -> pf_file sock_addr
-val inetAddr   : string -> int -> pf_inet sock_addr
-
-(* Socket constructors *)
-val fileStream : unit -> (pf_file, 'a stream) sock
-val fileDgram  : unit -> (pf_file, dgram) sock
-val inetStream : unit -> (pf_inet, 'a stream) sock
-val inetDgram  : unit -> (pf_inet, dgram) sock
-
-val accept     : ('a, passive stream) sock 
-                 -> ('a, active stream) sock * 'a sock_addr
-val bind       : ('a, 'b) sock * 'a sock_addr -> unit
-val connect    : ('a, 'b) sock * 'a sock_addr -> unit
-val listen     : ('a, passive stream) sock * int -> unit
-val close      : ('a, 'b) sock -> unit
-
-(* Socket management *)
-datatype shutdown_mode = 
-    NO_RECVS                            (* No further receives   *)
-  | NO_SENDS                            (* No further sends      *)
-  | NO_RECVS_OR_SENDS                   (* No receives nor sends *)
-
-val shutdown   : ('a, 'b stream) sock * shutdown_mode -> unit
-
-type sock_desc
-
-val sockDesc   : ('a, 'b) sock -> sock_desc
-val sameDesc   : sock_desc * sock_desc -> bool
-val compare    : sock_desc * sock_desc -> order
-val select     : 
-    { rds : sock_desc list, wrs : sock_desc list, exs : sock_desc list, 
-      timeout : Time.time option } 
-    -> { rds : sock_desc list, wrs : sock_desc list, exs : sock_desc list }
-
-val getinetaddr : pf_inet sock_addr -> string
-
-(* Sock I/O option types *)
-type out_flags = { don't_route : bool, oob : bool }
-type in_flags  = { peek : bool, oob : bool }
-
-type 'a buf = { buf : 'a, ofs : int, size : int option }
+(* Socket -- SML Basis Library -- requires Dynlib *)
+
+type ('addressfam, 'socktype) sock
+type 'addressfam sock_addr
+
+(* Socket types *)
+type dgram                              (* A datagram socket             *)
+type 'a stream                          (* A stream socket               *)
+type passive                            (* A passive stream              *)
+type active                             (* An active, connected, stream  *)
+
+(* Socket protocol families *)
+type pf_file                            (* The Unix file protocol family *)
+type pf_inet                            (* The Internet protocol family  *)
+
+(* Address constructors *)
+val fileAddr   : string -> pf_file sock_addr
+val inetAddr   : string -> int -> pf_inet sock_addr
+
+(* Socket constructors *)
+val fileStream : unit -> (pf_file, 'a stream) sock
+val fileDgram  : unit -> (pf_file, dgram) sock
+val inetStream : unit -> (pf_inet, 'a stream) sock
+val inetDgram  : unit -> (pf_inet, dgram) sock
+
+val accept     : ('a, passive stream) sock 
+                 -> ('a, active stream) sock * 'a sock_addr
+val bind       : ('a, 'b) sock * 'a sock_addr -> unit
+val connect    : ('a, 'b) sock * 'a sock_addr -> unit
+val listen     : ('a, passive stream) sock * int -> unit
+val close      : ('a, 'b) sock -> unit
+
+(* Socket management *)
+datatype shutdown_mode = 
+    NO_RECVS                            (* No further receives   *)
+  | NO_SENDS                            (* No further sends      *)
+  | NO_RECVS_OR_SENDS                   (* No receives nor sends *)
+
+val shutdown   : ('a, 'b stream) sock * shutdown_mode -> unit
+
+type sock_desc
+
+val sockDesc   : ('a, 'b) sock -> sock_desc
+val sameDesc   : sock_desc * sock_desc -> bool
+val compare    : sock_desc * sock_desc -> order
+val select     : 
+    { rds : sock_desc list, wrs : sock_desc list, exs : sock_desc list, 
+      timeout : Time.time option } 
+    -> { rds : sock_desc list, wrs : sock_desc list, exs : sock_desc list }
+
+val getinetaddr : pf_inet sock_addr -> string
+
+(* Sock I/O option types *)
+type out_flags = { don't_route : bool, oob : bool }
+type in_flags  = { peek : bool, oob : bool }
+
+type 'a buf = { buf : 'a, ofs : int, size : int option }
+
 
-
-(* Socket output operations *)
-val sendVec    : ('a, active stream) sock * Word8Vector.vector buf -> int
-val sendArr    : ('a, active stream) sock * Word8Array.array buf -> int
-val sendVec'   : ('a, active stream) sock * Word8Vector.vector buf 
-                 * out_flags -> int
-val sendArr'   : ('a, active stream) sock * Word8Array.array buf 
-                 * out_flags -> int
-val sendVecTo  : ('a, dgram) sock * 'a sock_addr * Word8Vector.vector buf
-                 -> int
-val sendArrTo  : ('a, dgram) sock * 'a sock_addr * Word8Array.array buf 
-                 -> int
-val sendVecTo' : ('a, dgram) sock * 'a sock_addr * Word8Vector.vector buf
-                 * out_flags -> int
-val sendArrTo' : ('a, dgram) sock * 'a sock_addr * Word8Array.array buf
-                 * out_flags -> int
-
-(* Socket input operations *)
-val recvVec      : ('a, active stream) sock * int -> Word8Vector.vector
-val recvArr      : ('a, active stream) sock * Word8Array.array buf -> int
-val recvVec'     : ('a, active stream) sock * int * in_flags
-                   -> Word8Vector.vector
-val recvArr'     : ('a, active stream) sock * Word8Array.array buf * in_flags
-                   -> int
-val recvVecFrom  : ('a, dgram) sock * int 
-                   -> Word8Vector.vector * 'a sock_addr
-val recvArrFrom  : ('a, dgram) sock * Word8Array.array buf 
-                   -> int * 'a sock_addr
-val recvVecFrom' : ('a, dgram) sock * int * in_flags
-                   -> Word8Vector.vector * 'a sock_addr
-val recvArrFrom' : ('a, dgram) sock * Word8Array.array buf * in_flags
-                   -> int * 'a sock_addr
-
-(* 
-   Structure Socket defines functions for creating and using sockets,
-   a means for communication between SML processes on the same machine
-   or via a network.
-
+(* Socket output operations *)
+val sendVec    : ('a, active stream) sock * Word8Vector.vector buf -> int
+val sendArr    : ('a, active stream) sock * Word8Array.array buf -> int
+val sendVec'   : ('a, active stream) sock * Word8Vector.vector buf 
+                 * out_flags -> int
+val sendArr'   : ('a, active stream) sock * Word8Array.array buf 
+                 * out_flags -> int
+val sendVecTo  : ('a, dgram) sock * 'a sock_addr * Word8Vector.vector buf
+                 -> int
+val sendArrTo  : ('a, dgram) sock * 'a sock_addr * Word8Array.array buf 
+                 -> int
+val sendVecTo' : ('a, dgram) sock * 'a sock_addr * Word8Vector.vector buf
+                 * out_flags -> int
+val sendArrTo' : ('a, dgram) sock * 'a sock_addr * Word8Array.array buf
+                 * out_flags -> int
+
+(* Socket input operations *)
+val recvVec      : ('a, active stream) sock * int -> Word8Vector.vector
+val recvArr      : ('a, active stream) sock * Word8Array.array buf -> int
+val recvVec'     : ('a, active stream) sock * int * in_flags
+                   -> Word8Vector.vector
+val recvArr'     : ('a, active stream) sock * Word8Array.array buf * in_flags
+                   -> int
+val recvVecFrom  : ('a, dgram) sock * int 
+                   -> Word8Vector.vector * 'a sock_addr
+val recvArrFrom  : ('a, dgram) sock * Word8Array.array buf 
+                   -> int * 'a sock_addr
+val recvVecFrom' : ('a, dgram) sock * int * in_flags
+                   -> Word8Vector.vector * 'a sock_addr
+val recvArrFrom' : ('a, dgram) sock * Word8Array.array buf * in_flags
+                   -> int * 'a sock_addr
+
+(* 
+   Structure Socket defines functions for creating and using sockets,
+   a means for communication between SML processes on the same machine
+   or via a network.
+
    [('addressfam, 'socktype) sock] is the type of sockets with address
    family 'addressfam and having type 'socktype.
 
@@ -160,7 +160,7 @@
    [listen (sock, queuelen)] enables the passive stream socket sock to
    accept incoming connections.  The parameter queuelen specifies the
    maximal number of pending connections.  Further connections from
-   clients may be refised when this limit is reached.
+   clients may be refused when this limit is reached.
 
    [close sock] closes the socket.
 
@@ -189,7 +189,7 @@
 
    [sendArr (sock, arrbuf)] is analogous til sendVec.
 
-   [sendVec' (sock, vecbuf, out_flags)] transmits the bytes from
+   [sendVec' (sock, vecbuf, out_flags)] transmits the bytes from
    buffer vecbuf on the active stream socket sock, observing the
    out_flags.  Returns the number of bytes sent.  Blocks until
    sufficient space is available at the socket.
@@ -198,7 +198,7 @@
    the field don't_route specifies whether routing should be bypassed,
    and the field oob specifies whether data should be sent out-of-band.
 
-   [sendArr' (sock, arrbuf, out_flags)] is analogous til sendVec'.
+   [sendArr' (sock, arrbuf, out_flags)] is analogous til sendVec'.
 
    [sendVecTo (sock, addr, vecbuf)] transmits the bytes from buffer
    vecbuf on the datagram socket sock to the target address addr.
@@ -207,13 +207,13 @@
 
    [sendArrTo (sock, addr, arrbuf)] is analogous til sendVecTo.
 
-   [sendVecTo' (sock, addr, vecbuf, out_flags)] transmits the bytes
+   [sendVecTo' (sock, addr, vecbuf, out_flags)] transmits the bytes
    from buffer vecbuf on the datagram socket sock to the target
    address addr, observing the out_flags.  Returns the number of bytes
    sent.  Blocks until sufficient space is available at the socket.
    See above for a description of vecbuf and out_flags.
 
-   [sendArrTo' (sock, addr, arrbuf, out_flags)] is analogous til sendVecTo'.
+   [sendArrTo' (sock, addr, arrbuf, out_flags)] is analogous til sendVecTo'.
 
    [recvVec (sock, n)] receives up to n bytes from the active stream
    socket sock.  Returns a byte vector containing the bytes actually
@@ -229,7 +229,7 @@
    until some data become available at the socket.  Excess data are
    not lost; they are available for subsequent receive calls.
 
-   [recvVec' (sock, n, in_flags)] receives up to n bytes from the
+   [recvVec' (sock, n, in_flags)] receives up to n bytes from the
    active stream socket sock, observing the in_flags.  Returns a byte
    vector containing the bytes actually received.  Blocks until some
    data become available at the socket, then returns any available
@@ -241,7 +241,7 @@
    receive queue, and the field oob specifies that data may be
    received out-of-band.
 
-   [recvArr' (sock, arrbuf, in_flags)] receives bytes from the active
+   [recvArr' (sock, arrbuf, in_flags)] receives bytes from the active
    stream socket sock into the subarray arrbuf, observing the
    in_flags, up to the available space..  Returns the number of bytes
    actually received.  Blocks until some data become available at the
@@ -258,14 +258,14 @@
    actually received.  Blocks until some data become available at the
    socket.
 
-   [recvVecFrom' (sock, n, in_flags)] receives up to n bytes from the
+   [recvVecFrom' (sock, n, in_flags)] receives up to n bytes from the
    datagram socket sock, observing the in_flags (see above).  Returns
    (vec, addr) where vec is a byte vector containing the bytes
    actually received, and addr is the source address of the message.
    Blocks until some data become available at the socket, then returns
    any available data, up to n bytes.
 
-   [recvArrFrom' (sock, arrbuf, in_flags)] receives bytes from the
+   [recvArrFrom' (sock, arrbuf, in_flags)] receives bytes from the
    datagram socket sock into the array buffer arrbuf, observing the
    in_flags (see above).  Returns (n, addr) where n is the number of
    bytes actually received, and addr is the source address of the
@@ -303,4 +303,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Splaymap.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Splaymap.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Splaymap.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Splaymap.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,28 +6,28 @@
 Structure index
 
                  
 
                  -(* Splaymap -- applicative maps implemented by splay-trees       *)
-(* From SML/NJ lib 0.2, copyright 1993 by AT&T Bell Laboratories *)
-
-type ('key, 'a) dict
-
-exception NotFound
-
-val mkDict    : ('_key * '_key -> order) -> ('_key, '_a) dict
-val insert    : ('_key, '_a) dict * '_key * '_a -> ('_key, '_a) dict
-val find      : ('key, 'a) dict * 'key -> 'a
-val peek      : ('key, 'a) dict * 'key -> 'a option
-val remove    : ('_key, '_a) dict * '_key -> ('_key, '_a) dict * '_a
-val numItems  : ('key, 'a) dict -> int
-val listItems : ('key, 'a) dict -> ('key * 'a) list
-val app       : ('key * 'a -> unit) -> ('key,'a) dict -> unit
-val revapp    : ('key * 'a -> 'b) -> ('key,'a) dict -> unit
-val foldr     : ('key * 'a * 'b -> 'b)-> 'b -> ('key,'a) dict -> 'b
-val foldl     : ('key * 'a * 'b -> 'b) -> 'b -> ('key,'a) dict -> 'b
-val map       : ('_key * 'a -> '_b) -> ('_key,'a) dict -> ('_key, '_b) dict
-val transform : ('a -> '_b) -> ('_key,'a) dict -> ('_key, '_b) dict
-
-(* 
+(* Splaymap -- applicative maps implemented by splay-trees       *)
+(* From SML/NJ lib 0.2, copyright 1993 by AT&T Bell Laboratories *)
+
+type ('key, 'a) dict
+
+exception NotFound
+
+val mkDict    : ('_key * '_key -> order) -> ('_key, '_a) dict
+val insert    : ('_key, '_a) dict * '_key * '_a -> ('_key, '_a) dict
+val find      : ('key, 'a) dict * 'key -> 'a
+val peek      : ('key, 'a) dict * 'key -> 'a option
+val remove    : ('_key, '_a) dict * '_key -> ('_key, '_a) dict * '_a
+val numItems  : ('key, 'a) dict -> int
+val listItems : ('key, 'a) dict -> ('key * 'a) list
+val app       : ('key * 'a -> unit) -> ('key,'a) dict -> unit
+val revapp    : ('key * 'a -> 'b) -> ('key,'a) dict -> unit
+val foldr     : ('key * 'a * 'b -> 'b)-> 'b -> ('key,'a) dict -> 'b
+val foldl     : ('key * 'a * 'b -> 'b) -> 'b -> ('key,'a) dict -> 'b
+val map       : ('_key * 'a -> '_b) -> ('_key,'a) dict -> ('_key, '_b) dict
+val transform : ('a -> '_b) -> ('_key,'a) dict -> ('_key, '_b) dict
+
+(* 
    [('key, 'a) dict] is the type of applicative maps from domain type
    'key to range type 'a, or equivalently, applicative dictionaries
    with keys of type 'key and values of type 'a.  They are implemented
@@ -76,4 +76,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Splayset.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Splayset.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Splayset.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Splayset.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,36 +6,36 @@
 Structure index
 
                  
 
                  -(* Splayset -- applicative sets implemented by splay-trees       *)
-(* From SML/NJ lib 0.2, copyright 1993 by AT&T Bell Laboratories *)
-
-type 'item set
-
-exception NotFound
-
-val empty        : ('_item * '_item -> order) -> '_item set
-val singleton    : ('_item * '_item -> order) -> '_item -> '_item set
-val add          : '_item set * '_item -> '_item set
-val addList      : '_item set * '_item list -> '_item set
-val retrieve     : 'item set * 'item -> 'item
-val peek         : 'item set * 'item -> 'item option
-val isEmpty      : 'item set -> bool
-val equal        : 'item set * 'item set -> bool
-val isSubset     : 'item set * 'item set -> bool
-val member       : 'item set * 'item -> bool
-val delete       : '_item set * '_item -> '_item set
-val numItems     : 'item set ->  int
-val union        : '_item set * '_item set -> '_item set
-val intersection : '_item set * '_item set -> '_item set
-val difference   : '_item set * '_item set -> '_item set
-val listItems    : 'item set -> 'item list
-val app          : ('item -> unit) -> 'item set -> unit
-val revapp       : ('item -> unit) -> 'item set -> unit
-val foldr        : ('item * 'b -> 'b) -> 'b -> 'item set -> 'b
-val foldl        : ('item * 'b -> 'b) -> 'b -> 'item set -> 'b
-val find         : ('item -> bool) -> 'item set -> 'item option
-
-(* 
+(* Splayset -- applicative sets implemented by splay-trees       *)
+(* From SML/NJ lib 0.2, copyright 1993 by AT&T Bell Laboratories *)
+
+type 'item set
+
+exception NotFound
+
+val empty        : ('_item * '_item -> order) -> '_item set
+val singleton    : ('_item * '_item -> order) -> '_item -> '_item set
+val add          : '_item set * '_item -> '_item set
+val addList      : '_item set * '_item list -> '_item set
+val retrieve     : 'item set * 'item -> 'item
+val peek         : 'item set * 'item -> 'item option
+val isEmpty      : 'item set -> bool
+val equal        : 'item set * 'item set -> bool
+val isSubset     : 'item set * 'item set -> bool
+val member       : 'item set * 'item -> bool
+val delete       : '_item set * '_item -> '_item set
+val numItems     : 'item set ->  int
+val union        : '_item set * '_item set -> '_item set
+val intersection : '_item set * '_item set -> '_item set
+val difference   : '_item set * '_item set -> '_item set
+val listItems    : 'item set -> 'item list
+val app          : ('item -> unit) -> 'item set -> unit
+val revapp       : ('item -> unit) -> 'item set -> unit
+val foldr        : ('item * 'b -> 'b) -> 'b -> 'item set -> 'b
+val foldl        : ('item * 'b -> 'b) -> 'b -> 'item set -> 'b
+val find         : ('item -> bool) -> 'item set -> 'item option
+
+(* 
    ['item set] is the type of sets of ordered elements of type 'item.
    The ordering relation on the elements is used in the representation
    of the set.  The result of combining two sets with different
@@ -99,4 +99,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/StringCvt.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/StringCvt.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/StringCvt.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/StringCvt.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,34 +6,34 @@
 Structure index
 
                  
 
                  -(* StringCvt -- SML Basis Library *)
-
-datatype radix = BIN | OCT | DEC | HEX
-
-datatype realfmt = 
-    SCI of int option   (* scientific,  arg = # dec. digits, dflt=6 *)
-  | FIX of int option   (* fixed-point, arg = # dec. digits, dflt=6 *)
-  | GEN of int option   (* auto choice of the above,                *)
-                        (* arg = # significant digits, dflt=12      *)
-
-type cs                 (* character source state *)
-
-type ('a, 'b) reader = 'b -> ('a * 'b) option
-
-val scanString : ((char, cs) reader -> ('a, cs) reader) -> string -> 'a option
-
-val splitl     : (char -> bool) -> (char, 'a) reader -> 'a -> string * 'a
-val takel      : (char -> bool) -> (char, 'a) reader -> 'a -> string 
-val dropl      : (char -> bool) -> (char, 'a) reader -> 'a -> 'a 
-val skipWS     : (char, 'a) reader -> 'a -> 'a 
-
-val padLeft    : char -> int -> string -> string
-val padRight   : char -> int -> string -> string
-
-(* 
-   This structure presents tools for scanning strings and values from
-   functional character streams, and for simple formatting.
-
+(* StringCvt -- SML Basis Library *)
+
+datatype radix = BIN | OCT | DEC | HEX
+
+datatype realfmt = 
+    SCI of int option   (* scientific,  arg = # dec. digits, dflt=6 *)
+  | FIX of int option   (* fixed-point, arg = # dec. digits, dflt=6 *)
+  | GEN of int option   (* auto choice of the above,                *)
+                        (* arg = # significant digits, dflt=12      *)
+
+type cs                 (* character source state *)
+
+type ('a, 'b) reader = 'b -> ('a * 'b) option
+
+val scanString : ((char, cs) reader -> ('a, cs) reader) -> string -> 'a option
+
+val splitl     : (char -> bool) -> (char, 'a) reader -> 'a -> string * 'a
+val takel      : (char -> bool) -> (char, 'a) reader -> 'a -> string 
+val dropl      : (char -> bool) -> (char, 'a) reader -> 'a -> 'a 
+val skipWS     : (char, 'a) reader -> 'a -> 'a 
+
+val padLeft    : char -> int -> string -> string
+val padRight   : char -> int -> string -> string
+
+(* 
+   This structure presents tools for scanning strings and values from
+   functional character streams, and for simple formatting.
+
    [('elm, 'src) reader] is the type of source readers for reading a
    sequence of 'elm values from a source of type 'src.  For instance, 
    a character source reader
@@ -85,4 +85,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/String.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/String.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/String.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/String.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,44 +6,48 @@
 Structure index
 
                  
 
                  -(* String -- SML Basis Library *)
-
-local 
-    type char = Char.char
-in
-    type string = string
-    val maxSize   : int
-    val size      : string -> int
-    val sub       : string * int -> char
-    val substring : string * int * int -> string
-    val extract   : string * int * int option -> string
-    val concat    : string list -> string
-    val ^         : string * string -> string
-    val str       : char -> string
-    val implode   : char list -> string 
-    val explode   : string -> char list
+(* String -- SML Basis Library *)
+
+local 
+    type char = Char.char
+in
+    type string = string
+    val maxSize     : int
+    val size        : string -> int
+    val sub         : string * int -> char
+    val substring   : string * int * int -> string
+    val extract     : string * int * int option -> string
+    val ^           : string * string -> string
+    val concat      : string list -> string
+    val concatWith  : string -> string list -> string
+    val str         : char -> string
+    val implode     : char list -> string 
+    val explode     : string -> char list
 
-    val map       : (char -> char) -> string -> string 
-    val translate : (char -> string) -> string -> string
-    val tokens    : (char -> bool) -> string -> string list
-    val fields    : (char -> bool) -> string -> string list
-    val isPrefix  : string -> string -> bool
-
-    val compare   : string * string -> order
-    val collate   : (char * char -> order) -> string * string -> order
-
-    val fromString  : string -> string option     (* ML escape sequences *)
-    val toString    : string -> string            (* ML escape sequences *)
-    val fromCString : string -> string option     (* C escape sequences *)
-    val toCString   : string -> string            (* C escape sequences *)
-
-    val <  : string * string -> bool
-    val <= : string * string -> bool
-    val >  : string * string -> bool
-    val >= : string * string -> bool
-end
-
-(* 
+    val map         : (char -> char) -> string -> string 
+    val translate   : (char -> string) -> string -> string
+    val tokens      : (char -> bool) -> string -> string list
+    val fields      : (char -> bool) -> string -> string list
+
+    val compare     : string * string -> order
+    val collate     : (char * char -> order) -> string * string -> order
+
+    val isPrefix    : string -> string -> bool
+    val isSuffix    : string -> string -> bool
+    val isSubstring : string -> string -> bool
+
+    val fromString  : string -> string option     (* ML escape sequences *)
+    val toString    : string -> string            (* ML escape sequences *)
+    val fromCString : string -> string option     (* C escape sequences *)
+    val toCString   : string -> string            (* C escape sequences *)
+
+    val <  : string * string -> bool
+    val <= : string * string -> bool
+    val >  : string * string -> bool
+    val >= : string * string -> bool
+end
+
+(* 
    [string] is the type of immutable strings of characters, with
    constant-time indexing.
 
@@ -63,10 +67,18 @@
    [extract (s, i, SOME n)] is the string s[i..i+n-1].
    Raises Subscript if i<0 or n<0 or i+n>size s. 
 
+   [s1 ^ s2] is the concatenation of strings s1 and s2.
+
    [concat ss] is the concatenation of all the strings in ss.
    Raises Size if the sum of their sizes is greater than maxSize.
 
-   [s1 ^ s2] is the concatenation of strings s1 and s2.
+   [concatWith sep ss] is the concatenation of all the strings in ss,
+   using sep as a separator.  Thus 
+      concatWith sep ss             is  the empty string ""
+      concatWith sep [s]            is  s
+      concatWith sep [s1, ..., sn]  is  concat[s1, sep, ..., sep, sn].
+   Raises Size if the resulting string would have more than maxSize 
+   characters.
 
    [str c] is the string of size one which contains the character c.
 
@@ -100,7 +112,13 @@
         "abc||def" contains three fields: "abc" and "" and "def"
 
    [isPrefix s1 s2] is true if s1 is a prefix of s2.  
-   That is, if there exists a string t such that s1 ^ t = s2.
+   That is, if there exists a string u such that s1 ^ u = s2.
+
+   [isSuffix s1 s2] is true if s1 is a suffix of s2.  
+   That is, if there exists a string t such that t ^ s1 = s2.
+
+   [isSubstring s1 s2] is true if s1 is a substring of s2.  
+   That is, if there exist strings t and u such that t ^ s1 ^ u = s2.
 
    [fromString s] scans the string s as an ML source program string,
    converting escape sequences into the appropriate characters.  Does
@@ -126,10 +144,10 @@
    [collate cmp (s1, s2)] performs lexicographic comparison, using the 
    given ordering cmp on characters.  
 
-   [<]
-   [<=]
-   [>]
-   [>=] compare strings lexicographically, using the representation 
+   [<]
+   [<=]
+   [>]
+   [>=] compare strings lexicographically, using the representation 
    ordering on characters.
 *)
 
@@ -137,4 +155,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Substring.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Substring.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Substring.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Substring.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,53 +6,57 @@
 Structure index
 
                  
 
                  -(* Substring -- SML Basis Library *)
-
-type substring
-
-val substring : string * int * int -> substring
-val extract   : string * int * int option -> substring
-val all       : string -> substring
-val string    : substring -> string
-val base      : substring -> (string * int * int)
+(* Substring -- SML Basis Library *)
+
+type substring
+
+val substring   : string * int * int -> substring
+val extract     : string * int * int option -> substring
+val full        : string -> substring
+val all         : string -> substring
+val string      : substring -> string
+val base        : substring -> (string * int * int)
 
-val isEmpty   : substring -> bool
-val getc      : substring -> (char * substring) option
-val first     : substring -> char option
-val triml     : int -> substring -> substring
-val trimr     : int -> substring -> substring
-val sub       : substring * int -> char
-val size      : substring -> int
-val slice     : substring * int * int option -> substring
-val concat    : substring list -> string
-val explode   : substring -> char list
-val isPrefix  : string -> substring -> bool
-val compare   : substring * substring -> order
-val collate   : (char * char -> order) -> substring * substring -> order
+val isEmpty     : substring -> bool
+val getc        : substring -> (char * substring) option
+val first       : substring -> char option
+val triml       : int -> substring -> substring
+val trimr       : int -> substring -> substring
+val sub         : substring * int -> char
+val size        : substring -> int
+val slice       : substring * int * int option -> substring
+val concat      : substring list -> string
+val concatWith  : string -> substring list -> string
+val explode     : substring -> char list
+val compare     : substring * substring -> order
+val collate     : (char * char -> order) -> substring * substring -> order
 
-val dropl     : (char -> bool) -> substring -> substring
-val dropr     : (char -> bool) -> substring -> substring
-val takel     : (char -> bool) -> substring -> substring
-val taker     : (char -> bool) -> substring -> substring
-val splitl    : (char -> bool) -> substring -> substring * substring
-val splitr    : (char -> bool) -> substring -> substring * substring
-val splitAt   : substring * int -> substring * substring
+val dropl       : (char -> bool) -> substring -> substring
+val dropr       : (char -> bool) -> substring -> substring
+val takel       : (char -> bool) -> substring -> substring
+val taker       : (char -> bool) -> substring -> substring
+val splitl      : (char -> bool) -> substring -> substring * substring
+val splitr      : (char -> bool) -> substring -> substring * substring
+val splitAt     : substring * int -> substring * substring
 
-val position  : string -> substring -> substring * substring
-
-exception Span
-val span      : substring * substring -> substring
+val position    : string -> substring -> substring * substring
+val isPrefix    : string -> substring -> bool
+val isSuffix    : string -> substring -> bool
+val isSubstring : string -> substring -> bool
 
-val translate : (char -> string) -> substring -> string
-
-val tokens    : (char -> bool) -> substring -> substring list
-val fields    : (char -> bool) -> substring -> substring list
+exception Span
+val span        : substring * substring -> substring
+
+val translate   : (char -> string) -> substring -> string
 
-val foldl     : (char * 'a -> 'a) -> 'a -> substring -> 'a
-val foldr     : (char * 'a -> 'a) -> 'a -> substring -> 'a
-val app       : (char -> unit) -> substring -> unit
-
-(* 
+val tokens      : (char -> bool) -> substring -> substring list
+val fields      : (char -> bool) -> substring -> substring list
+
+val foldl       : (char * 'a -> 'a) -> 'a -> substring -> 'a
+val foldr       : (char * 'a -> 'a) -> 'a -> substring -> 'a
+val app         : (char -> unit) -> substring -> unit
+
+(* 
    [substring] is the type of substrings of a basestring, an efficient 
    representation of a piece of a string.
    A substring (s,i,n) is valid if 0 <= i <= i+n <= size s, 
@@ -60,6 +64,9 @@
    A valid substring (s, i, n) represents the string s[i...i+n-1].  
    Invariant in the implementation: Any value of type substring is valid.
 
+   A substring is the same as a CharVectorSlice.slice, so substrings
+   may be processed using the functions declared in CharVectorSlice.
+
    [substring(s, i, n)] creates the substring (s, i, n), consisting of
    the substring of s with length n starting at i.  Raises Subscript
    if i<0 or n<0 or i+n > size s.  Equivalent to extract(s, i, SOME n).
@@ -72,7 +79,9 @@
    consisting of the substring of s with length n starting at i.
    Raises Subscript if i<0 or n<0 or i+n > size s.
 
-   [all s] is the substring (s, 0, size s).
+   [full s] is the substring (s, 0, size s).
+
+   [all s] is the same as full(s).  Its use is deprecated.
 
    [string sus] is the string s[i..i+n-1] represented by sus = (s, i, n).
 
@@ -101,24 +110,27 @@
    [sub (sus, k)] returns the k'th character of the substring; that is,
    s(i+k) where sus = (s, i, n).  Raises Subscript if k<0 or k>=n.
 
-   [size (s, i, n)] returns the size of the substring, that is, n.
+   [size sus] returns the size n of the substring sus = (s, i, n).
 
    [slice (sus, i', NONE)] returns the substring (s, i+i', n-i'), where
    sus = (s, i, n).  Raises Subscript if i' < 0 or i' > n.
 
    [slice (sus, i', SOME n')] returns the substring (s, i+i', n'), where
-   sus = (s, i, n).  Raises Subscript if i' < 0 or n' < 0 or i'+n' >= n.
+   sus = (s, i, n).  Raises Subscript if i' < 0 or n' < 0 or i'+n' > n.
 
    [concat suss] returns a string consisting of the concatenation of
-   the substrings.  Equivalent to String.concat (List.map string suss).
+   the substrings.  Equivalent to String.concat (List.map string suss).  
+   Raises Size if the resulting string would be longer than String.maxSize.
+
+   [concatWith sep suss] returns a string consisting of the
+   concatenation of the substrings in suss, using sep as a separator.
+   Equivalent to String.concatWith sep (List.map string suss).  Raises
+   Size if the resulting string would be longer than String.maxSize.
 
    [explode sus] returns the list of characters of sus, that is,
         [s(i), s(i+1), ..., s(i+n-1)]
    where sus = (s, i, n).  Equivalent to String.explode(string ss).
 
-   [isPrefix s1 s2] is true if s1 is a prefix of s2. That is, if there 
-   exists a string t such that string s1 ^ t = string s2.
-
    [compare (sus1, sus2)] performs lexicographic comparison, using the
    standard ordering Char.compare on the characters.  Returns LESS,
    EQUAL, or GREATER, according as sus1 is less than, equal to, or
@@ -180,6 +192,15 @@
    where sus1 contains the first k characters of sus, and sus2
    contains the rest.  Raises Subscript if k < 0 or k > size sus.
 
+   [isPrefix s1 s2] is true if s1 is a prefix of s2. That is, if there 
+   exists a string u such that  s1 ^ u = string s2.
+
+   [isSuffix s1 s2] is true if s1 is a suffix of s2. That is, if there
+   exists a string t such that  t ^ s1 = string s2.
+
+   [isSubstring s1 s2] is true if s1 is a substring of s2. That is, if
+   there exist strings t and u such that  t ^ s1 ^ u = string s2.
+
    [position s (s',i,n)] splits the substring into a pair (pref, suff)
    of substrings, where suff is the longest suffix of (s', i, n) which
    has s as a prefix.  More precisely, let m = size s.  If there is a
@@ -227,11 +248,10 @@
 
    [app f sus] applies f to all characters of sus, from left to right.
    Equivalent to List.app f (explode sus).
-
 *)
 
 
                  
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Susp.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Susp.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Susp.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Susp.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,14 +6,14 @@
 Structure index
 
                  
 
                  -(* Susp -- support for lazy evaluation *)
-
-type 'a susp
-
-val delay : (unit -> 'a) -> 'a susp
-val force : 'a susp -> 'a
-
-(* 
+(* Susp -- support for lazy evaluation *)
+
+type 'a susp
+
+val delay : (unit -> 'a) -> 'a susp
+val force : 'a susp -> 'a
+
+(* 
    ['a susp] is the type of lazily evaluated expressions with result
    type 'a.
 
@@ -32,4 +32,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/TextIO.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/TextIO.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/TextIO.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/TextIO.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,62 +6,62 @@
 Structure index
 
                  
 
                  -(* TextIO -- SML Basis Library *)
-
-type elem   = Char.char
-type vector = string
-
-(* Text input *)
-
-type instream 
-
-val openIn       : string -> instream
-val closeIn      : instream -> unit
-val input        : instream -> vector
-val inputAll     : instream -> vector
-val inputNoBlock : instream -> vector option
-val input1       : instream -> elem option
-val inputN       : instream * int -> vector
-val inputLine    : instream -> string
-val endOfStream  : instream -> bool
-val lookahead    : instream -> elem option
-
-type cs (* character source state *)
-
-val scanStream   : ((char, cs) StringCvt.reader -> ('a, cs) StringCvt.reader) 
-                   -> instream -> 'a option
-
-val stdIn        : instream
-
-(* Text output *)
-
-type outstream
-
-val openOut      : string -> outstream
-val openAppend   : string -> outstream
-val closeOut     : outstream -> unit
-val output       : outstream * vector -> unit
-val output1      : outstream * elem -> unit
-val outputSubstr : outstream * substring -> unit
-val flushOut     : outstream -> unit
-
-val stdOut       : outstream
-val stdErr       : outstream
-
-val print        : string -> unit
-
-(* 
-   This structure provides input/output functions on text streams.
-   The functions are state-based: reading from or writing to a stream
-   changes the state of the stream.  The streams are buffered: output
-   to a stream may not immediately affect the underlying file or
-   device.
-
-   Note that under DOS, Windows, OS/2, and MacOS, text streams will be
-   `translated' by converting (e.g.) the double newline CRLF to a
-   single newline character \n.
-
-   [instream] is the type of state-based characters input streams.
+(* TextIO -- SML Basis Library *)
+
+type elem   = Char.char
+type vector = string
+
+(* Text input *)
+
+type instream 
+
+val openIn       : string -> instream
+val closeIn      : instream -> unit
+val input        : instream -> vector
+val inputAll     : instream -> vector
+val inputNoBlock : instream -> vector option
+val input1       : instream -> elem option
+val inputN       : instream * int -> vector
+val inputLine    : instream -> string option
+val endOfStream  : instream -> bool
+val lookahead    : instream -> elem option
+
+type cs (* character source state *)
+
+val scanStream   : ((char, cs) StringCvt.reader -> ('a, cs) StringCvt.reader) 
+                   -> instream -> 'a option
+
+val stdIn        : instream
+
+(* Text output *)
+
+type outstream
+
+val openOut      : string -> outstream
+val openAppend   : string -> outstream
+val closeOut     : outstream -> unit
+val output       : outstream * vector -> unit
+val output1      : outstream * elem -> unit
+val outputSubstr : outstream * substring -> unit
+val flushOut     : outstream -> unit
+
+val stdOut       : outstream
+val stdErr       : outstream
+
+val print        : string -> unit
+
+(* 
+   This structure provides input/output functions on text streams.
+   The functions are state-based: reading from or writing to a stream
+   changes the state of the stream.  The streams are buffered: output
+   to a stream may not immediately affect the underlying file or
+   device.
+
+   Note that under DOS, Windows, OS/2, and MacOS, text streams will be
+   `translated' by converting (e.g.) the double newline CRLF to a
+   single newline character \n.
+
+   [instream] is the type of state-based character input streams.
 
    [outstream] is the type of state-based character output streams.
 
@@ -104,11 +104,11 @@
    (This is the behaviour of the `input' function prescribed in the
    1990 Definition of Standard ML).
 
-   [inputLine istr] returns one line of text, including the
-   terminating newline character.  If end of stream is reached before
-   a newline character, then the remaining part of the stream is
-   returned, with a newline character added.  If istr is at end of
-   stream or is closed, then the empty string "" is returned.
+   [inputLine istr] returns SOME ln, where ln is one line of text,
+   including the terminating newline character.  If end of stream is
+   reached before a newline character, then the remaining part of the
+   stream is returned, with a newline character added.  If istr is at
+   end of stream or is closed, then NONE is returned.
 
    [endOfStream istr] returns false if any elements are available in
    istr; returns true if istr is at end of stream or closed; blocks if
@@ -204,4 +204,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Time.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Time.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Time.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Time.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,44 +6,44 @@
 Structure index
 
                  
 
                  -(* Time -- SML Basis Library *)
-
-eqtype time
-
-exception Time
-
-val zeroTime         : time
-val now              : unit -> time
-
-val toSeconds        : time -> int
-val toMilliseconds   : time -> int
-val toMicroseconds   : time -> int
-val fromSeconds      : int -> time
-val fromMilliseconds : int -> time
-val fromMicroseconds : int -> time
-
-val fromReal         : real -> time
-val toReal           : time -> real
-
-val toString         : time -> string	(* rounded to millisecond precision *)
-val fmt              : int -> time -> string
-val fromString       : string -> time option
-val scan             : (char, 'a) StringCvt.reader 
-                       -> (time, 'a) StringCvt.reader
-
-val +       : time * time -> time
-val -       : time * time -> time
-val <       : time * time -> bool
-val <=      : time * time -> bool
-val >       : time * time -> bool
-val >=      : time * time -> bool
-
-val compare : time * time -> order
-
-(* 
+(* Time -- SML Basis Library *)
+
+eqtype time
+
+exception Time
+
+val zeroTime         : time
+val now              : unit -> time
+
+val toSeconds        : time -> int
+val toMilliseconds   : time -> int
+val toMicroseconds   : time -> int
+val fromSeconds      : int -> time
+val fromMilliseconds : int -> time
+val fromMicroseconds : int -> time
+
+val fromReal         : real -> time
+val toReal           : time -> real
+
+val toString         : time -> string	(* rounded to millisecond precision *)
+val fmt              : int -> time -> string
+val fromString       : string -> time option
+val scan             : (char, 'a) StringCvt.reader 
+                       -> (time, 'a) StringCvt.reader
+
+val +       : time * time -> time
+val -       : time * time -> time
+val <       : time * time -> bool
+val <=      : time * time -> bool
+val >       : time * time -> bool
+val >=      : time * time -> bool
+
+val compare : time * time -> order
+
+(* 
    [time] is a type for representing durations as well as absolute
    points in time (which can be thought of as durations since some
-   fixed time zero).
+   fixed time zero).  Times can be negative, zero, or positive.
 
    [zeroTime] represents the 0-second duration, and the origin of time, 
    so zeroTime + t = t + zeroTime = t for all t.
@@ -51,62 +51,59 @@
    [now ()] returns the point in time at which the application occurs.
 
    [fromSeconds s] returns the time value corresponding to s seconds.  
-   Raises Time if s < 0.
 
    [fromMilliseconds ms] returns the time value corresponding to ms
-   milliseconds.  Raises Time if ms < 0.
+   milliseconds.  
 
    [fromMicroseconds us] returns the time value corresponding to us
-   microseconds.  Raises Time if us < 0.
+   microseconds.  
 
    [toSeconds t] returns the number of seconds represented by t,
-   truncated.  Raises Overflow if that number is not representable as
-   an int.
-
-   [toMilliseconds t] returns the number of milliseconds
-   represented by t, truncated.  Raises Overflow if that number is not
+   truncated (towards zero).  Raises Overflow if that number is not
    representable as an int.
 
-   [toMicroseconds t] returns the number of microseconds
-   represented by t, truncated.  Raises Overflow if t that number is
+   [toMilliseconds t] returns the number of milliseconds represented
+   by t, truncated (towards zero).  Raises Overflow if that number is
    not representable as an int.
 
-   [fromReal r] converts a real to a time value representing that
-   many seconds.  Raises Time if r < 0 or if r is not representable
-   as a time value.  It holds that realToTime 0.0 = zeroTime.  
-
-   [toReal t] converts a time the number of seconds it represents;
-   hence realToTime and timeToReal are inverses of each other when 
-   defined.  Raises Overflow if t is not representable as a real.
+   [toMicroseconds t] returns the number of microseconds represented
+   by t, truncated (towards zero).  Raises Overflow if t that number
+   is not representable as an int.
+
+   [fromReal r] converts a real to a time value representing that many
+   seconds.  It holds that fromReal 0.0 = zeroTime.
+
+   [toReal t] converts a time to the number of seconds it represents;
+   hence fromReal and toReal are inverses of each other.
 
    [fmt n t] returns as a string the number of seconds represented by
    t, rounded to n decimal digits.  If n <= 0, then no decimal digits
-   are reported. 
+   are reported.
 
    [toString t] returns as a string the number of seconds represented
    by t, rounded to 3 decimal digits.  Equivalent to (fmt 3 t).  
 
    [fromString s] returns SOME t where t is the time value represented
-   by the string s of form [\n\t ]*([0-9]+(\.[0-9]+)?)|(\.[0-9]+); 
+   by the string s of form [\n\t ]*[+~-]?(([0-9]+(\.[0-9]+)?)|(\.[0-9]+)); 
    or returns NONE if s cannot be parsed as a time value.
 
    [scan getc src], where getc is a character accessor, returns SOME
    (t, rest) where t is a time and rest is rest of the input, or NONE
    if s cannot be parsed as a time value.
 
-   [+] adds two time values. For reals r1, r2 >= 0.0, it holds that
-   realToTime r1 + realToTime r2 = realToTime(Real.+(r1,r2)).  
+   [+] adds two time values. For reals r1, r2 >= 0.0, it holds that
+   fromReal r1 + fromReal r2 = fromReal(Real.+(r1,r2)).  
    Raises Overflow if the result is not representable as a time value.
 
    [-] subtracts a time value from another.  That is, t1 - t2 is the
-   duration from t2 to t1.  Raises Time if t1 < t2 or if the result is
-   not representable as a time value.  It holds that t - zeroTime = t.
+   duration from t2 to t1 (which may be negative).  
+   It holds that t - zeroTime = t.
 
-   [<]
-   [<=]
-   [>]
-   [>=] compares time values.  For instance, for reals r1, r2 >= 0.0 
-   it holds that realToTime r1 < realToTime r2 iff Real.<(r1, r2)
+   [<]
+   [<=]
+   [>]
+   [>=] compares time values.  For instance, for reals r1, r2 >= 0.0 
+   it holds that  fromReal r1 < fromReal r2  iff Real.<(r1, r2)
 
    [compare(t1, t2)] returns LESS, EQUAL, or GREATER, according 
    as t1 precedes, equals, or follows t2 in time.
@@ -116,4 +113,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Timer.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Timer.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Timer.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Timer.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,21 +6,24 @@
 Structure index
 
                  
 
                  -(* Timer -- SML Basis Library *)
-
-type cpu_timer
-type real_timer
-
-val startCPUTimer  : unit -> cpu_timer
-val totalCPUTimer  : unit -> cpu_timer
-val checkCPUTimer  : cpu_timer -> 
-                     { usr : Time.time, sys : Time.time, gc : Time.time }
-
-val startRealTimer : unit -> real_timer
-val totalRealTimer : unit -> real_timer
-val checkRealTimer : real_timer -> Time.time
-
-(* 
+(* Timer -- SML Basis Library *)
+
+type cpu_timer
+type real_timer
+
+val startCPUTimer  : unit -> cpu_timer
+val totalCPUTimer  : unit -> cpu_timer
+val checkCPUTimer  : cpu_timer -> { usr : Time.time, sys : Time.time }
+val checkGCTime    : cpu_timer -> Time.time
+val checkCPUTimes  : cpu_timer -> { nongc : {usr : Time.time, sys : Time.time},
+                                    gc    : {usr : Time.time, sys : Time.time}
+                                  }
+
+val startRealTimer : unit -> real_timer
+val totalRealTimer : unit -> real_timer
+val checkRealTimer : real_timer -> Time.time
+
+(* 
    [cpu_timer] is the type of timers for measuring CPU time consumption
    (user time, garbage collection time, and system time).
 
@@ -33,12 +36,24 @@
    [totalCPUTimer ()] returns a cpu_timer started at the moment the 
    library was loaded.
 
-   [checkCPUTimer tmr] returns {usr, sys, gc} where usr is the amount
-   of user CPU time consumed since tmr was started, gc is the amount
-   of user CPU time spent on garbage collection, and sys is the
-   amount of system CPU time consumed since tmr was started.  Note
-   that gc time is included in the usr time.  Under MS DOS, usr time
-   and gc time are measured in real time.
+   [checkCPUTimer tmr] returns {usr, sys} where usr is the amount of
+   user CPU time consumed since tmr was started and sys is the amount
+   of system CPU time consumed since tmr was started.  Note that
+   garbage collection time is included in the usr time.  Under MS DOS
+   and MS Windows, usr time is measured as real time.
+
+   [checkGCTime tmr] returns the amount of user CPU time spent on
+   garbage collection since tmr was started.  Under MS DOS and MS
+   Windows, gc time is measured in real time.
+
+   [checkCPUTimes tmr] returns the amount of CPU time consumed since
+   tmr was started spilt into time spend in the program (nongc) and on
+   garbage collecttion (gc). For both nongc and gc a record {usr, sys}
+   is returned where usr is the amount of user CPU time consumed since
+   tmr was started and sys is the amount of system CPU time consumed
+   since tmr was started.  Note that Moscow ML will allways attribute
+   all the system CPU time to the program (nongc).  That is,
+   #sys(#gc(checkCPUTimes tmr)) is always 0.
 
    [startRealTimer ()] returns a real_timer started at the moment of 
    the call.
@@ -54,4 +69,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Unix.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Unix.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Unix.html	2000-08-02 13:05:29.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Unix.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,30 +6,36 @@
 Structure index
 
                  
 
                  -(* Unix -- SML Basis Library *)
-
-type proc
-type signal = Signal.signal
-
-val executeInEnv : string * string list * string list -> proc 
-val execute      : string * string list -> proc 
-val streamsOf    : proc -> TextIO.instream * TextIO.outstream
-val kill         : proc * signal -> unit
-val reap         : proc -> Process.status 
-
-(* 
-   This structure allows Moscow ML programs to start other processes
-   and to communicate with them.  
-
-   Child processes are not automatically terminated when the parent
-   (ML) process terminates.  To forcibly terminate a child process pr,
-   use Unix.kill(pr, Signal.term).  Then, to remove the terminated
-   process from the operating system tables, call Unix.reap(pr).
+(* Unix -- SML Basis Library *)
+signature Unix = sig 
+type ('a, 'b) proc
+type signal = Signal.signal
+
+val executeInEnv    : string * string list * string list -> ('a, 'b) proc 
+val execute         : string * string list -> ('a, 'b) proc
+
+val streamsOf       : (TextIO.instream, TextIO.outstream) proc 
+                       -> TextIO.instream * TextIO.outstream
+val textInstreamOf  : (TextIO.instream, 'a) proc -> TextIO.instream
+val textOutstreamOf : ('a, TextIO.outstream) proc -> TextIO.outstream
+val binInstreamOf   : (BinIO.instream, 'a) proc -> BinIO.instream
+val binOutstreamOf  : ('a, BinIO.outstream) proc -> BinIO.outstream 
+val kill            : ('a, 'b) proc * signal -> unit
+val reap            : ('a, 'b) proc -> OS.Process.status 
+end
+(* 
+   This structure allows Moscow ML programs to start other processes
+   and to communicate with them.  
 
-   The protocol for communication between the ML program and its child
-   process must be designed with some care, typically using
-   non-blocking input for reading from the child process.
-
+   Child processes are not automatically terminated when the parent
+   (ML) process terminates.  To forcibly terminate a child process pr,
+   use Unix.kill(pr, Signal.term).  Then, to remove the terminated
+   process from the operating system tables, call Unix.reap(pr).
+
+   The protocol for communication between the ML program and its child
+   process must be designed with some care, typically using
+   non-blocking input for reading from the child process.
+
    [proc] is the type of processes started by the ML program.
 
    [signal] is the type of Unix-style signals, which can be sent to
@@ -62,6 +68,18 @@
    the source for the input stream ins, and the standard input of pr
    is the sink for the output stream outs.
 
+   [textInstreamOf pr] returns the text input stream associated with
+   process pr.  That is, the standard output of pr.
+
+   [textOutstreamOf pr] returns the text output stream associated with
+   process pr.  That is, the standard input of pr.
+
+   [binInstreamOf pr] returns the binary input stream associated with
+   process pr.  That is, the standard output of pr.
+
+   [binOutstreamOf pr] returns the binary output stream associated
+   with process pr.  That is, the standard input of pr.
+ 
    [reap pr] closes the input and output streams associated with pr,
    and then suspends the current (ML) process until the process
    corresponding to pr terminates.  Returns the exit status given by
@@ -81,4 +99,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Vector.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Vector.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Vector.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Vector.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,30 +6,37 @@
 Structure index
 
                  
 
                  -(* Vector -- SML Basis Library *)
-
-type 'a vector = 'a vector
-val maxLen   : int
-
-val fromList : 'a list -> 'a vector
-val tabulate : int * (int -> 'a) -> 'a vector
-
-val length   : 'a vector -> int
-val sub      : 'a vector * int -> 'a
-val extract  : 'a vector * int * int option -> 'a vector
-val concat   : 'a vector list -> 'a vector
-
-val app      : ('a -> unit) -> 'a vector -> unit
-val map      : ('a -> 'b) -> 'a vector -> 'b vector
-val foldl    : ('a * 'b -> 'b) -> 'b -> 'a vector -> 'b
-val foldr    : ('a * 'b -> 'b) -> 'b -> 'a vector -> 'b
-
-val appi     : (int * 'a -> unit) -> 'a vector * int * int option -> unit
-val mapi     : (int * 'a -> 'b) -> 'a vector * int * int option -> 'b vector
-val foldli   : (int * 'a * 'b -> 'b) -> 'b -> 'a vector*int*int option -> 'b
-val foldri   : (int * 'a * 'b -> 'b) -> 'b -> 'a vector*int*int option -> 'b
-
-(* 
+(* Vector -- SML Basis Library *)
+
+type 'a vector = 'a vector
+val maxLen   : int
+
+val fromList : 'a list -> 'a vector
+val tabulate : int * (int -> 'a) -> 'a vector
+
+val length   : 'a vector -> int
+val sub      : 'a vector * int -> 'a
+val update   : 'a vector * int * 'a -> 'a vector
+val concat   : 'a vector list -> 'a vector
+
+val find     : ('a -> bool) -> 'a vector -> 'a option
+val exists   : ('a -> bool) -> 'a vector -> bool
+val all      : ('a -> bool) -> 'a vector -> bool
+
+val app      : ('a -> unit) -> 'a vector -> unit
+val map      : ('a -> 'b) -> 'a vector -> 'b vector
+val foldl    : ('a * 'b -> 'b) -> 'b -> 'a vector -> 'b
+val foldr    : ('a * 'b -> 'b) -> 'b -> 'a vector -> 'b
+
+val findi    : (int * 'a -> bool) -> 'a vector -> (int * 'a) option
+val appi     : (int * 'a -> unit) -> 'a vector -> unit
+val mapi     : (int * 'a -> 'b) -> 'a vector -> 'b vector
+val foldli   : (int * 'a * 'b -> 'b) -> 'b -> 'a vector -> 'b
+val foldri   : (int * 'a * 'b -> 'b) -> 'b -> 'a vector -> 'b
+
+val collate  : ('a * 'a -> order) -> 'a vector * 'a vector -> order
+
+(* 
    ['ty vector] is the type of one-dimensional, immutable, zero-based
    constant-time-access vectors with elements of type 'ty.  
    Type 'ty vector admits equality if 'ty does.  Vectors v1 and v2 are 
@@ -49,16 +56,27 @@
    [sub(v, i)] returns the i'th element of v, counting from 0.
    Raises Subscript if i<0 or i>=length v.
 
-   [extract(v, i, NONE)] returns a vector of the elements v[i..length v-1]
-   of v.  Raises Subscript if i<0 or i>length v.
-
-   [extract(v, i, SOME n)] returns a vector of the elements v[i..i+n-1]
-   of v.  Raises Subscript if i<0 or n<0 or i+n>length v.
+   [update(v, i, x)] creates a copy of v, sets position i to x, and
+   returns the new vector.  In contrast to Array.update, this is not a
+   constant-time operation, because it must copy the entire vector.
+   Raises Subscript if i<0 or i>=length v.
 
    [concat vs] returns a vector which is the concatenation from left
    to right og the vectors in vs.  Raises Size if the sum of the
    sizes of the vectors in vs is larger than maxLen.
 
+   [find p v] applies p to each element x of v, from left to right,
+   until p(x) evaluates to true; returns SOME x if such an x exists,
+   otherwise NONE.
+
+   [exists p v] applies p to each element x of v, from left to right,
+   until p(x) evaluates to true; returns true if such an x exists,
+   otherwise false.
+
+   [all p v] applies p to each element x of v, from left to right,
+   until p(x) evaluates to false; returns false if such an x exists,
+   otherwise true.
+
    [foldl f e v] folds function f over v from left to right.  That is,
    computes f(v[len-1], f(v[len-2], ..., f(v[1], f(v[0], e)) ...)),
    where len is the length of v.
@@ -72,66 +90,35 @@
    [map f v] applies f to v[j] for j=0,1,...,length v-1 and returns a 
    new vector containing the results.
    
+   The following iterators generalize the above ones by passing also
+   the vector element index j to the function being iterated.
 
-   The following iterators generalize the above ones in two ways:
-
-    * the index j is also being passed to the function being iterated;
-    * the iterators work on a slice (subvector) of a vector.
-
-   The slice (v, i, SOME n) denotes the subvector v[i..i+n-1].  That is,
-   v[i] is the first element of the slice, and n is the length of the
-   slice.  Valid only if 0 <= i <= i+n <= length v.
-
-   The slice (v, i, NONE) denotes the subvector v[i..length v-1].  That
-   is, the slice denotes the suffix of the vector starting at i.  Valid
-   only if 0 <= i <= length v.  Equivalent to (v, i, SOME(length v - i)).
-
-       slice             meaning 
-       ----------------------------------------------------------
-       (v, 0, NONE)      the whole vector             v[0..len-1]   
-       (v, 0, SOME n)    a left subvector (prefix)    v[0..n-1]
-       (v, i, NONE)      a right subvector (suffix)   v[i..len-1]
-       (v, i, SOME n)    a general slice              v[i..i+n-1] 
-
-   [foldli f e (v, i, SOME n)] folds function f over the subvector
-   v[i..i+n-1] from left to right.  That is, computes 
-   f(i+n-1, v[i+n-1], f(..., f(i+1, v[i+1], f(i, v[i], e)) ...)).  
-   Raises Subscript if i<0 or n<0 or i+n > length v.
-
-   [foldli f e (v, i, NONE)] folds function f over the subvector
-   v[i..len-1] from left to right, where len =  length v.  That is, 
-   computes f(len-1, v[len-1], f(..., f(i+1, v[i+1], f(i, v[i], e)) ...)).  
-   Raises Subscript if i<0 or i > length v.
-
-   [foldri f e (v, i, SOME n)] folds function f over the subvector
-   v[i..i+n-1] from right to left.  That is, computes 
-   f(i, v[i], f(i+1, v[i+1], ..., f(i+n-1, v[i+n-1], e) ...)).
-   Raises Subscript if i<0 or n<0 or i+n > length v.
-
-   [foldri f e (v, i, NONE)] folds function f over the subvector
-   v[i..len-1] from right to left, where len = length v.  That is, 
-   computes f(i, v[i], f(i+1, v[i+1], ..., f(len-1, v[len-1], e) ...)).
-   Raises Subscript if i<0 or i > length v.
-
-   [appi f (v, i, SOME n)] applies f to successive pairs (j, v[j]) for
-   j=i,i+1,...,i+n-1.  Raises Subscript if i<0 or n<0 or i+n > length v.
-
-   [appi f (v, i, NONE)] applies f to successive pairs (j, v[j]) for
-   j=i,i+1,...,len-1, where len = length v.  Raises Subscript if i<0
-   or i > length v.
-
-   [mapi f (v, i, SOME n)] applies f to successive pairs (j, v[j]) for 
-   j=i,i+1,...,i+n-1 and returns a new vector (of length n) containing 
-   the results.  Raises Subscript if i<0 or n<0 or i+n > length v.
-
-   [mapi f (v, i, NONE)] applies f to successive pairs (j, v[j]) for 
-   j=i,i+1,...,len-1, where len = length v, and returns a new vector
-   (of length len-i) containing the results.  Raises Subscript if i<0
-   or i > length v.
+   [findi p a] applies f to successive pairs (j, a[j]) for j=0,1,...,n-1, 
+   until p(j, a[j]) evaluates to true; returns SOME (j, a[j]) if such
+   a pair exists, otherwise NONE.
+
+   [foldli f e v] folds function f over the vector from left to right.
+   That is, computes f(n-1, v[n-1], f(..., f(1, v[1], f(0, v[0], e)) ...))  
+   where n = length v.
+
+   [foldri f e v] folds function f over the vector from right to left.  
+   That is, computes f(0, v[0], f(1, v[1], ..., f(n-1, v[n-1], e) ...))
+   where n = length v.
+
+   [appi f v] applies f to successive pairs (j, v[j]) for j=0,1,...,n-1
+   where n = length v.
+
+   [mapi f v] applies f to successive pairs (j, v[j]) for
+   j=0,1,...,n-1 where n = length v and returns a new vector
+   containing the results.  
+
+   [collate cmp (xs, ys)] returns LESS, EQUAL or GREATER according as
+   xs precedes, equals or follows ys in the lexicographic ordering on
+   vectors induced by the ordering cmp on elements.
 *)
 
 
                  
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/VectorSlice.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/VectorSlice.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/VectorSlice.html	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/VectorSlice.html	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,155 @@
+Structure VectorSlice
+
+
                  Structure VectorSlice
                  
+
                  
+
                  Identifier index
+Structure index
+
                  
+
                  +(* VectorSlice -- SML Basis Library *)
+
+type 'a slice
+
+val length   : 'a slice -> int
+val sub      : 'a slice * int -> 'a
+val slice    : 'a Vector.vector * int * int option -> 'a slice
+val full     : 'a Vector.vector -> 'a slice
+val subslice : 'a slice * int * int option -> 'a slice
+val base     : 'a slice -> 'a Vector.vector * int * int
+val vector   : 'a slice -> 'a Vector.vector
+val concat   : 'a slice list -> 'a Vector.vector
+val isEmpty  : 'a slice -> bool
+val getItem  : 'a slice -> ('a * 'a slice) option
+
+val find     : ('a -> bool) -> 'a slice -> 'a option
+val exists   : ('a -> bool) -> 'a slice -> bool
+val all      : ('a -> bool) -> 'a slice -> bool
+
+val app      : ('a -> unit) -> 'a slice -> unit
+val map      : ('a -> 'b) -> 'a slice -> 'b Vector.vector
+val foldl    : ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+val foldr    : ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+
+val findi    : (int * 'a -> bool) -> 'a slice -> (int * 'a) option
+val appi     : (int * 'a -> unit) -> 'a slice -> unit
+val mapi     : (int * 'a -> 'b) -> 'a slice -> 'b Vector.vector
+val foldli   : (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+val foldri   : (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+
+val collate  : ('a * 'a -> order) -> 'a slice * 'a slice -> order
+
+(* 
+   ['ty slice] is the type of vector slices, that is, sub-vectors.  
+   The slice (a,i,n) is valid if 0 <= i <= i+n <= size s, 
+                or equivalently, 0 <= i and 0 <= n and i+n <= size s.  
+   A valid slice sli = (a,i,n) represents the sub-vector a[i...i+n-1],
+   so the elements of sli are a[i], a[i+1], ..., a[i+n-1], and n is
+   the length of the slice.  Only valid slices can be constructed by
+   the functions below.
+
+   [length sli] returns the number n of elements in sli = (s,i,n).
+
+   [sub (sli, k)] returns the k'th element of the slice, that is,
+   a(i+k) where sli = (a,i,n).  Raises Subscript if k<0 or k>=n.
+
+   [slice (a, i, NONE)] creates the slice (a, i, length a-i),
+   consisting of the tail of a starting at i.  
+   Raises Subscript if i<0 or i > Vector.length a.  
+   Equivalent to slice (a, i, SOME(Vector.length a - i)).
+
+   [slice (a, i, SOME n)] creates the slice (a, i, n), consisting of
+   the sub-vector of a with length n starting at i.  Raises Subscript
+   if i<0 or n<0 or i+n > Vector.length a.  
+
+       slice             meaning 
+       -----------------------------------------------------------
+       (a, 0, NONE)      the whole vector              a[0..len-1]   
+       (a, 0, SOME n)    a left sub-vector (prefix)    a[0..n-1]
+       (a, i, NONE)      a right sub-vector (suffix)   a[i..len-1]
+       (a, i, SOME n)    a general slice               a[i..i+n-1] 
+
+   [full a] creates the slice (a, 0, Vector.length a).  
+   Equivalent to slice(a,0,NONE)
+
+   [subslice (sli, i', NONE)] returns the slice (a, i+i', n-i') when
+   sli = (a,i,n).  Raises Subscript if i' < 0 or i' > n.
+
+   [subslice (sli, i', SOME n')] returns the slice (a, i+i', n') when
+   sli = (a,i,n).  Raises Subscript if i' < 0 or n' < 0 or i'+n' > n.
+
+   [base sli] is the concrete triple (a, i, n) when sli = (a, i, n).
+
+   [vector sli] creates and returns a vector consisting of the
+   elements of the slice, that is, a[i..i+n-1] when sli = (a,i,n).
+
+   [concat slis] creates a vector containing the concatenation of the
+   slices in slis.
+
+   [isEmpty sli] returns true if the slice sli = (a,i,n) is empty,
+   that is, if n=0.
+
+   [getItem sli] returns SOME(x, rst) where x is the first element and
+   rst the remainder of sli, if sli is non-empty; otherwise returns
+   NONE.  
+
+   [find p sli] applies p to each element x of sli, from left to
+   right, until p(x) evaluates to true; returns SOME x if such an x
+   exists, otherwise NONE.
+
+   [exists p sli] applies p to each element x of sli, from left to right,
+   until p(x) evaluates to true; returns true if such an x exists,
+   otherwise false.
+
+   [all p sli] applies p to each element x of sli, from left to right,
+   until p(x) evaluates to false; returns false if such an x exists,
+   otherwise true.
+
+   [app f sli] applies f to all elements of sli = (a,i,n), from
+   left to right.  That is, applies f to a[j+i] for j=0,1,...,n.
+
+   [map f sli] applies f to all elements of sli = (a,i,n), from left
+   to right, and returns a vector of the results.
+
+   [foldl f e sli] folds function f over sli = (a,i,n) from left to right.  
+   That is, computes f(a[i+n-1], f(a[i+n-2],..., f(a[i+1], f(a[i], e))...)).
+
+   [foldr f e sli] folds function f over sli = (a,i,n) from right to left.  
+   That is, computes f(a[i], f(a[i+1],..., f(a[i+n-2], f(a[i+n-1], e))...)).
+
+   The following iterators generalize the above ones by also passing
+   the index into the vector a underlying the slice to the function
+   being iterated.
+
+   [findi p sli] applies p to the elements of sli = (a,i,n) and the
+   underlying vector indices, and returns the least (j, a[j]) for
+   which p(j, a[j]) evaluates to true, if any; otherwise returns NONE.
+   That is, evaluates p(j, a[j]) for j=i,..i+n-1 until it evaluates to
+   true for some j, then returns SOME(j, a[j]); otherwise returns NONE.
+
+   [appi f sli] applies f to the slice sli = (a,i,n) and the
+   underlying vector indices.  That is, applies f to successive pairs
+   (j, a[j]) for j=i,i+1,...,i+n-1.
+
+   [mapi f sli] applies f to the slice sli = (a,i,n) and the
+   underlying vector indices, and returns a vector of the results.
+   That is, applies f to successive pairs (j, a[j]) for
+   j=i,i+1,...,i+n-1, and returns #[f(i,a[i]), ..., f(i+n-1,a[i+n-1])].
+
+   [foldli f e sli] folds function f over the slice sli = (a,i,n) and
+   the underlying vector indices from left to right.  That is, computes 
+   f(i+n-1, a[i+n-1], f(..., f(i+1, a[i+1], f(i, a[i], e)) ...)).  
+
+   [foldri f e sli] folds function f over the slice sli = (a,i,n) and
+   the underlying vector indices from right to left.  That is, computes
+   f(i, a[i], f(i+1, a[i+1], ..., f(i+n-1, a[i+n-1], e) ...)).
+  
+   [collate cmp (sli1, sli2)] returns LESS, EQUAL or GREATER according
+   as sli1 precedes, equals or follows sli2 in the lexicographic
+   ordering on slices induced by the ordering cmp on elements.
+*)
+
+
                  
+
                  Identifier index
+Structure index
+
                  
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Weak.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Weak.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Weak.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Weak.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,41 +6,41 @@
 Structure index
 
                  
 
                  -(* Weak --- weak pointers and arrays of weak pointers *)
-
-(* Single weak pointers *)
-
-type 'a weak
-val weak    : 'a -> 'a weak
-val set     : 'a weak * 'a -> unit
-val get     : 'a weak -> 'a                  (* Raises Fail *)
-val isweak  : 'a weak -> bool
-
-(* Arrays of weak pointers *)
-
-prim_EQtype 'a array
-
-val maxLen  : int
-
-val array   : int -> '_a array               (* Raises Size               *)
-val sub     : 'a array * int -> 'a           (* Raises Fail and Subscript *)
-val update  : 'a array * int * 'a -> unit    (* Raises Subscript          *)
-val isdead  : 'a array * int -> bool         (* Raises Subscript          *)
-val length  : 'a array -> int
-
-val app     : ('a -> unit) -> 'a array -> unit
-val foldl   : ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
-val foldr   : ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
-val modify  : ('a -> 'a) -> 'a array -> unit
-
-val appi    : (int * 'a -> unit) -> 'a array * int * int option -> unit
-val foldli  : (int * 'a * 'b -> 'b) -> 'b -> 'a array * int * int option 
-              -> 'b
-val foldri  : (int * 'a * 'b -> 'b) -> 'b -> 'a array * int * int option 
-              -> 'b
-val modifyi : (int * 'a -> 'a) -> 'a array * int * int option -> unit
-
-(*
+(* Weak --- weak pointers and arrays of weak pointers *)
+
+(* Single weak pointers *)
+
+type 'a weak
+val weak    : 'a -> 'a weak
+val set     : 'a weak * 'a -> unit
+val get     : 'a weak -> 'a                  (* Raises Fail *)
+val isweak  : 'a weak -> bool
+
+(* Arrays of weak pointers *)
+
+prim_EQtype 'a array
+
+val maxLen  : int
+
+val array   : int -> '_a array               (* Raises Size               *)
+val sub     : 'a array * int -> 'a           (* Raises Fail and Subscript *)
+val update  : 'a array * int * 'a -> unit    (* Raises Subscript          *)
+val isdead  : 'a array * int -> bool         (* Raises Subscript          *)
+val length  : 'a array -> int
+
+val app     : ('a -> unit) -> 'a array -> unit
+val foldl   : ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
+val foldr   : ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
+val modify  : ('a -> 'a) -> 'a array -> unit
+
+val appi    : (int * 'a -> unit) -> 'a array * int * int option -> unit
+val foldli  : (int * 'a * 'b -> 'b) -> 'b -> 'a array * int * int option 
+              -> 'b
+val foldri  : (int * 'a * 'b -> 'b) -> 'b -> 'a array * int * int option 
+              -> 'b
+val modifyi : (int * 'a -> 'a) -> 'a array * int * int option -> unit
+
+(*
    ['a weak] is the type of weak pointers to objects of type 'a.  A
    weak pointer is a pointer that cannot itself keep an object alive.
    Hence the object pointed to by a weak pointer may be deallocated by
@@ -54,8 +54,8 @@
    Integers, characters, words and booleans will not be deallocated by
    the garbage collector and will remain reachable forever by a weak
    pointer.  Reals, strings, tuples and other non-nullary constructors
-   may be deallocated by the garbage collector.  Constants, even
-   composite ones, will not be deallocated either.
+   may be deallocated by the garbage collector.  Compile-time constants, 
+   even composite ones, will not be deallocated either.
 
    [weak v] creates and returns a weak pointer to value v.
 
@@ -183,4 +183,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Word8Array.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Word8Array.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Word8Array.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Word8Array.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,39 +6,44 @@
 Structure index
 
                  
 
                  -(* Word8Array -- SML Basis Library *)
-
-eqtype array
-type elem   = Word8.word
-type vector = Word8Vector.vector
-
-val maxLen   : int
-
-val array    : int * elem -> array
-val tabulate : int * (int -> elem) -> array
-val fromList : elem list -> array
-
-val length   : array -> int
-val sub      : array * int -> elem
-val update   : array * int * elem -> unit
-val extract  : array * int * int option -> vector
-
-val copy     : {src: array,  si: int, len: int option, 
-                dst: array, di: int} -> unit
-val copyVec  : {src: vector, si: int, len: int option, 
-                dst: array, di: int} -> unit
-
-val app      : (elem -> unit) -> array -> unit
-val foldl    : (elem * 'b -> 'b) -> 'b -> array -> 'b
-val foldr    : (elem * 'b -> 'b) -> 'b -> array -> 'b
-val modify   : (elem -> elem) -> array -> unit
-
-val appi     : (int * elem -> unit) -> array * int * int option -> unit
-val foldli   : (int * elem * 'b -> 'b) -> 'b -> array * int * int option -> 'b
-val foldri   : (int * elem * 'b -> 'b) -> 'b -> array * int * int option -> 'b
-val modifyi  : (int * elem -> elem) -> array * int * int option -> unit
-
-(* 
+(* Word8Array -- SML Basis Library *)
+
+eqtype array
+type elem   = Word8.word
+type vector = Word8Vector.vector
+
+val maxLen   : int
+
+val array    : int * elem -> array
+val tabulate : int * (int -> elem) -> array
+val fromList : elem list -> array
+
+val length   : array -> int
+val sub      : array * int -> elem
+val update   : array * int * elem -> unit
+val vector   : array -> vector
+
+val copy     : {src: array,  dst: array, di: int} -> unit
+val copyVec  : {src: vector, dst: array, di: int} -> unit
+
+val find     : (elem -> bool) -> array -> elem option
+val exists   : (elem -> bool) -> array -> bool
+val all      : (elem -> bool) -> array -> bool
+
+val app      : (elem -> unit) -> array -> unit
+val foldl    : (elem * 'b -> 'b) -> 'b -> array -> 'b
+val foldr    : (elem * 'b -> 'b) -> 'b -> array -> 'b
+val modify   : (elem -> elem) -> array -> unit
+
+val findi    : (int * elem -> bool) -> array -> (int * elem) option
+val appi     : (int * elem -> unit) -> array -> unit
+val foldli   : (int * elem * 'b -> 'b) -> 'b -> array -> 'b
+val foldri   : (int * elem * 'b -> 'b) -> 'b -> array -> 'b
+val modifyi  : (int * elem -> elem) -> array -> unit
+
+val collate  : (elem * elem -> order) -> array * array -> order
+
+(* 
    [array] is the type of one-dimensional, mutable, zero-based
    constant-time-access arrays with elements of type Word8.word, that
    is, 8-bit words.  Arrays a1 and a2 are equal if both were created
@@ -51,4 +56,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Word8ArraySlice.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Word8ArraySlice.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Word8ArraySlice.html	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Word8ArraySlice.html	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,65 @@
+Structure Word8ArraySlice
+
+
                  Structure Word8ArraySlice
                  
+
                  
+
                  Identifier index
+Structure index
+
                  
+
                  +(* Word8ArraySlice -- SML Basis Library *)
+
+type elem = Word8.word
+type array = Word8Array.array
+type vector = Word8Vector.vector
+type vector_slice = Word8VectorSlice.slice
+
+type slice
+
+val length   : slice -> int
+val sub      : slice * int -> elem
+val update   : slice * int * elem  -> unit
+val slice    : array * int * int option -> slice
+val full     : array -> slice
+val subslice : slice * int * int option -> slice
+val base     : slice -> array * int * int
+val vector   : slice -> vector
+val copy     : {src: slice, dst: array, di: int} -> unit
+val copyVec  : {src: vector_slice, dst: array, di: int} -> unit 
+val isEmpty  : slice -> bool
+val getItem  : slice -> (elem * slice) option
+
+val find     : (elem -> bool) -> slice -> elem option
+val exists   : (elem -> bool) -> slice -> bool
+val all      : (elem -> bool) -> slice -> bool
+
+val app      : (elem -> unit) -> slice -> unit
+val foldl    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+val foldr    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+val modify   : (elem -> elem) -> slice -> unit
+
+val findi    : (int * elem -> bool) -> slice -> (int * elem) option
+val appi     : (int * elem -> unit) -> slice -> unit
+val foldli   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+val foldri   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+val modifyi  : (int * elem -> elem) -> slice -> unit
+
+val collate  : (elem * elem -> order) -> slice * slice -> order
+
+(* 
+   [slice] is the type of Word8Array slices, that is, sub-arrays of
+   Word8Array.array values.
+   The slice (a,i,n) is valid if 0 <= i <= i+n <= size s, 
+                or equivalently, 0 <= i and 0 <= n and i+n <= size s.  
+   A valid slice sli = (a,i,n) represents the sub-array a[i...i+n-1],
+   so the elements of sli are a[i], a[i+1], ..., a[i+n-1], and n is
+   the length of the slice.  Only valid slices can be constructed by
+   the functions below.
+
+   All operations are as for ArraySlice.slice.
+*)
+
+
                  
+
                  Identifier index
+Structure index
+
                  
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Word8.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Word8.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Word8.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Word8.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,31 +6,32 @@
 Structure index
 
                  
 
                  -(* Word8 -- SML Basis Library *)
-
-type word = word8
-
-val wordSize   : int
-
-val orb        : word * word -> word
-val andb       : word * word -> word
-val xorb       : word * word -> word
-val notb       : word -> word
+(* Word8 -- SML Basis Library *)
+
+type word = word8
+
+val wordSize   : int
+
+val orb        : word * word -> word
+val andb       : word * word -> word
+val xorb       : word * word -> word
+val notb       : word -> word
+val ~          : word -> word
 
-val <<         : word * Word.word -> word
-val >>         : word * Word.word -> word
-val ~>>        : word * Word.word -> word
+val <<         : word * Word.word -> word
+val >>         : word * Word.word -> word
+val ~>>        : word * Word.word -> word
 
-val +          : word * word -> word
+val +          : word * word -> word
 val -          : word * word -> word
-val *          : word * word -> word
+val *          : word * word -> word
 val div        : word * word -> word
 val mod        : word * word -> word
 
-val >          : word * word -> bool
-val <          : word * word -> bool
-val >=         : word * word -> bool
-val <=         : word * word -> bool
+val >          : word * word -> bool
+val <          : word * word -> bool
+val >=         : word * word -> bool
+val <=         : word * word -> bool
 val compare    : word * word -> order
 
 val min        : word * word -> word
@@ -50,11 +51,15 @@
 val toLargeIntX   : word -> int         (* with sign extension *)
 val fromLargeInt  : int -> word
 
-val toLargeWord   : word -> Word.word
-val toLargeWordX  : word -> Word.word   (* with sign extension *)
-val fromLargeWord : Word.word -> word
+val toLarge   : word -> Word.word
+val toLargeX  : word -> Word.word   (* with sign extension *)
+val fromLarge : Word.word -> word
 
-(* 
+val toLargeWord   : word -> Word.word
+val toLargeWordX  : word -> Word.word   (* with sign extension *)
+val fromLargeWord : Word.word -> word
+
+(* 
    [word] is the type of 8-bit words, or 8-bit unsigned integers in
    the range 0..255.
 
@@ -66,17 +71,19 @@
 
    [xorb(w1, w2)] returns the bitwise `exclusive or' or w1 and w2.
 
-   [notb w] returns the bitwise negation of w.
+   [notb w] returns the bitwise negation (one's complement) of w.
 
-   [<<(w, k)] returns the word resulting from shifting w left by k
+   [~ w] returns the arithmetic negation (two's complement) of w.
+
+   [<<(w, k)] returns the word resulting from shifting w left by k
    bits.  The bits shifted in are zero, so this is a logical shift.
    Consequently, the result is 0-bits when k >= wordSize.
 
-   [>>(w, k)] returns the word resulting from shifting w right by k
+   [>>(w, k)] returns the word resulting from shifting w right by k
    bits.  The bits shifted in are zero, so this is a logical shift.
    Consequently, the result is 0-bits when k >= wordSize.
 
-   [~>>(w, k)] returns the word resulting from shifting w right by k
+   [~>>(w, k)] returns the word resulting from shifting w right by k
    bits.  The bits shifted in are replications of the left-most bit:
    the `sign bit', so this is an arithmetical shift.  Consequently,
    for k >= wordSize and wordToInt w >= 0 the result is all 0-bits, and 
@@ -85,19 +92,19 @@
    To make <<, >>, and ~>> infix, use the declaration:
                           infix 5 << >> ~>>
 
-   [+]
+   [+]
    [-]
-   [*]
+   [*]
    [div]
    [mod] represent unsigned integer addition, subtraction,
    multiplication, division, and remainder, modulus 256.  The
    operations (i div j) and (i mod j) raise Div when j = 0.  Otherwise
    no exceptions are raised.
 
-   [<]
-   [<=]
-   [>]
-   [>=] compare words as unsigned integers.
+   [<]
+   [<=]
+   [>]
+   [>=] compare words as unsigned integers.
 
    [compare(w1, w2)] returns LESS, EQUAL, or GREATER, according 
    as w1 is less than, equal to, or greater than w2 (as unsigned integers).
@@ -156,18 +163,22 @@
    
    [fromLargeInt i] returns the word holding the 8 least significant bits of i.
 
-   [toLargeWord w] returns the Word.word value corresponding to w.
+   [toLarge w] returns the Word.word value corresponding to w.
 
-   [toLargeWordX w] returns the Word.word value corresponding to w,
+   [toLargeX w] returns the Word.word value corresponding to w,
    with sign extension.  That is, the 8 least significant bits of the
    result are those of w, and the remaining bits are all equal to the
    most significant bit of w: its `sign bit'.
 
-   [fromLargeWord w] returns w modulo 256.
+   [fromLarge w] returns w modulo 256.
+
+   [toLargeWord w] 
+   [toLargeWordX w]
+   [fromLargeWord w] synonyms for toLarge, toLargeX and fromLarge, (deprecated)
 *)
 
 
                  
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Word8Vector.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Word8Vector.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Word8Vector.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Word8Vector.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,32 +6,39 @@
 Structure index
 
                  
 
                  -(* Word8Vector -- SML Basis Library *)
-
-eqtype vector
-type elem = Word8.word
-
-val maxLen   : int
-
-val fromList : elem list -> vector
-val tabulate : int * (int -> elem) -> vector
-
-val length   : vector -> int
-val sub      : vector * int -> elem
-val extract  : vector * int * int option -> vector
-val concat   : vector list -> vector
-
-val app      : (elem -> unit) -> vector -> unit
-val map      : (elem -> elem) -> vector -> vector
-val foldl    : (elem * 'b -> 'b) -> 'b -> vector -> 'b
-val foldr    : (elem * 'b -> 'b) -> 'b -> vector -> 'b
-
-val appi     : (int * elem -> unit) -> vector * int * int option -> unit
-val mapi     : (int * elem -> elem) -> vector * int * int option -> vector
-val foldli   : (int * elem * 'b -> 'b) -> 'b -> vector*int*int option -> 'b
-val foldri   : (int * elem * 'b -> 'b) -> 'b -> vector*int*int option -> 'b
-
-(* 
+(* Word8Vector -- SML Basis Library *)
+
+eqtype vector
+type elem = Word8.word
+
+val maxLen   : int
+
+val fromList : elem list -> vector
+val tabulate : int * (int -> elem) -> vector
+
+val length   : vector -> int
+val sub      : vector * int -> elem
+val update   : vector * int * elem -> vector
+val concat   : vector list -> vector
+
+val find     : (elem -> bool) -> vector -> elem option
+val exists   : (elem -> bool) -> vector -> bool
+val all      : (elem -> bool) -> vector -> bool
+
+val app      : (elem -> unit) -> vector -> unit
+val map      : (elem -> elem) -> vector -> vector
+val foldl    : (elem * 'b -> 'b) -> 'b -> vector -> 'b
+val foldr    : (elem * 'b -> 'b) -> 'b -> vector -> 'b
+
+val findi    : (int * elem -> bool) -> vector -> (int * elem) option
+val appi     : (int * elem -> unit) -> vector -> unit
+val mapi     : (int * elem -> elem) -> vector -> vector
+val foldli   : (int * elem * 'b -> 'b) -> 'b -> vector -> 'b
+val foldri   : (int * elem * 'b -> 'b) -> 'b -> vector -> 'b
+
+val collate  : (elem * elem -> order) -> vector * vector -> order
+
+(* 
    [vector] is the type of one-dimensional, immutable, zero-based
    constant-time-access vectors with elements of type Word8.word, that
    is, 8-bit words.  Type vector admits equality, and vectors v1 and
@@ -45,4 +52,4 @@
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Word8VectorSlice.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Word8VectorSlice.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Word8VectorSlice.html	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Word8VectorSlice.html	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,61 @@
+Structure Word8VectorSlice
+
+
                  Structure Word8VectorSlice
                  
+
                  
+
                  Identifier index
+Structure index
+
                  
+
                  +(* Word8VectorSlice -- SML Basis Library *)
+
+type elem = Word8.word
+type vector = Word8Vector.vector
+
+type slice
+
+val length   : slice -> int
+val sub      : slice * int -> elem
+val slice    : vector * int * int option -> slice
+val full     : vector -> slice
+val subslice : slice * int * int option -> slice
+val base     : slice -> vector * int * int
+val vector   : slice -> vector
+val concat   : slice list -> vector
+val isEmpty  : slice -> bool
+val getItem  : slice -> (elem * slice) option
+
+val find     : (elem -> bool) -> slice -> elem option
+val exists   : (elem -> bool) -> slice -> bool
+val all      : (elem -> bool) -> slice -> bool
+
+val app      : (elem -> unit) -> slice -> unit
+val map      : (elem -> elem) -> slice -> vector
+val foldl    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+val foldr    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+
+val findi    : (int * elem -> bool) -> slice -> (int * elem) option
+val appi     : (int * elem -> unit) -> slice -> unit
+val mapi     : (int * elem -> elem) -> slice -> vector
+val foldli   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+val foldri   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+
+val collate  : (elem * elem -> order) -> slice * slice -> order
+
+(* 
+   [slice] is the type of Word8Vector slices, that is, sub-vectors of
+   Word8Vector.vector values.
+   The slice (a,i,n) is valid if 0 <= i <= i+n <= size s, 
+                or equivalently, 0 <= i and 0 <= n and i+n <= size s.  
+   A valid slice sli = (a,i,n) represents the sub-vector a[i...i+n-1],
+   so the elements of sli are a[i], a[i+1], ..., a[i+n-1], and n is
+   the length of the slice.  Only valid slices can be constructed by
+   these functions.
+
+   All operations are as for VectorSlice.slice.
+*)
+
+
                  
+
                  Identifier index
+Structure index
+
                  
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/htmlsigs/Word.html mosml-2.10.1/src/doc/helpsigs/htmlsigs/Word.html
--- mosml-2.01/src/doc/helpsigs/htmlsigs/Word.html	2000-08-02 13:05:30.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/htmlsigs/Word.html	2014-08-28 08:47:22.000000000 +0000
@@ -6,31 +6,32 @@
 Structure index
 
                  
 
                  -(* Word -- SML Basis Library *)
-
-type word = word
-
-val wordSize   : int
-
-val orb        : word * word -> word
-val andb       : word * word -> word
-val xorb       : word * word -> word
-val notb       : word -> word
+(* Word -- SML Basis Library *)
+
+type word = word
+
+val wordSize   : int
+
+val orb        : word * word -> word
+val andb       : word * word -> word
+val xorb       : word * word -> word
+val notb       : word -> word
+val ~          : word -> word
 
-val <<         : word * word -> word
-val >>         : word * word -> word
-val ~>>        : word * word -> word
+val <<         : word * word -> word
+val >>         : word * word -> word
+val ~>>        : word * word -> word
 
-val +          : word * word -> word
+val +          : word * word -> word
 val -          : word * word -> word
-val *          : word * word -> word
+val *          : word * word -> word
 val div        : word * word -> word
 val mod        : word * word -> word
 
-val >          : word * word -> bool
-val <          : word * word -> bool
-val >=         : word * word -> bool
-val <=         : word * word -> bool
+val >          : word * word -> bool
+val <          : word * word -> bool
+val >=         : word * word -> bool
+val <=         : word * word -> bool
 val compare    : word * word -> order
 
 val min        : word * word -> word
@@ -46,15 +47,19 @@
 val toIntX     : word -> int            (* with sign extension *)
 val fromInt    : int -> word
 
-val toLargeWord   : word -> word
-val toLargeWordX  : word -> word        (* with sign extension *)
-val fromLargeWord : word -> word
+val toLarge    : word -> word
+val toLargeX   : word -> word        (* with sign extension *)
+val fromLarge  : word -> word
 
-val toLargeInt    : word -> int
-val toLargeIntX   : word -> int         (* with sign extension *)
-val fromLargeInt  : int -> word
+val toLargeWord   : word -> word
+val toLargeWordX  : word -> word        (* with sign extension *)
+val fromLargeWord : word -> word
 
-(* 
+val toLargeInt    : word -> int
+val toLargeIntX   : word -> int         (* with sign extension *)
+val fromLargeInt  : int -> word
+
+(* 
    [word] is the type of n-bit words, or n-bit unsigned integers.
 
    [wordSize] is the value of n above.  In Moscow ML, n=31 on 32-bit
@@ -66,17 +71,19 @@
 
    [xorb(w1, w2)] returns the bitwise `exclusive or' or w1 and w2.
 
-   [notb w] returns the bitwise negation of w.
+   [notb w] returns the bitwise negation (one's complement) of w.
 
-   [<<(w, k)] returns the word resulting from shifting w left by k
+   [~ w] returns the arithmetic negation (two's complement) of w.
+
+   [<<(w, k)] returns the word resulting from shifting w left by k
    bits.  The bits shifted in are zero, so this is a logical shift.
    Consequently, the result is 0-bits when k >= wordSize.
 
-   [>>(w, k)] returns the word resulting from shifting w right by k
+   [>>(w, k)] returns the word resulting from shifting w right by k
    bits.  The bits shifted in are zero, so this is a logical shift.
    Consequently, the result is 0-bits when k >= wordSize.
 
-   [~>>(w, k)] returns the word resulting from shifting w right by k
+   [~>>(w, k)] returns the word resulting from shifting w right by k
    bits.  The bits shifted in are replications of the left-most bit:
    the `sign bit', so this is an arithmetical shift.  Consequently,
    for k >= wordSize and wordToInt w >= 0 the result is all 0-bits, and 
@@ -85,19 +92,19 @@
    To make <<, >>, and ~>> infix, use the declaration 
                           infix 5 << >> ~>>
 
-   [+]
+   [+]
    [-]
-   [*]
+   [*]
    [div]
    [mod] represent unsigned integer addition, subtraction,
    multiplication, division, and remainder, modulus 2 raised to the n'th 
    power, where n=wordSize.  The operations (i div j) and (i mod j)
    raise Div when j=0.  Otherwise no exceptions are raised.
 
-   [<]
-   [<=]
-   [>]
-   [>=] compare words as unsigned integers.
+   [<]
+   [<=]
+   [>]
+   [>=] compare words as unsigned integers.
 
    [compare(w1, w2)] returns LESS, EQUAL, or GREATER, according 
    as w1 is less than, equal to, or greater than w2 (as unsigned integers).
@@ -142,21 +149,35 @@
       DEC     (0w)?[0-9]+
       HEX     (0wx|0wX|0x|0X)?[0-9a-fA-F]+
 
-   [toInt w] returns the (signed) integer represented by bit-pattern w.
-   [toIntX w] returns the (signed) integer represented by bit-pattern w.
-   [fromInt i] returns the word representing integer i.
+   [toInt w] returns the (non-negative) default size int represented
+   by bit-pattern w.  Raises Overflow in case w is not representable
+   as an integer.
+
+   [toIntX w] returns the (signed) default size int represented by
+   twos's complement bit-pattern w.
+
+   [fromInt i] returns the word (bit-pattern) representing integer i.
+
+   [toLargeInt w] returns the (non-negative) largest size int
+   represented by bit-pattern w.  Raises Overflow in case w is not
+   representable as an integer.
+
+   [toLargeIntX w] returns the (signed) largest size int represented
+   by two's complement bit-pattern w.  
 
-   [toLargeInt w] returns the (signed) integer represented by bit-pattern w.
-   [toLargeIntX w] returns the (signed) integer represented by bit-pattern w.
    [fromLargeInt i] returns the word representing integer i.
 
-   [toLargeWord w] returns w.
-   [toLargeWordX w] returns w.
-   [fromLargeWord w] returns w.
+   [toLarge w] returns w.
+   [toLargeX w] returns w.
+   [fromLarge w] returns w.
+
+   [toLargeWord w] returns w (deprecated).
+   [toLargeWordX w] returns w (deprecated).
+   [fromLargeWord w] returns w (deprecated).
 *)
 
 
                  
 Identifier index
 Structure index
 
                  
-
                  Moscow ML 2.00
+
                  Moscow ML 2.10
diff -Nru mosml-2.01/src/doc/helpsigs/Htmlsigs.sml mosml-2.10.1/src/doc/helpsigs/Htmlsigs.sml
--- mosml-2.01/src/doc/helpsigs/Htmlsigs.sml	2000-06-01 19:55:05.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/Htmlsigs.sml	2014-08-28 08:47:22.000000000 +0000
@@ -118,17 +118,6 @@
 	fun name anchor target = 
 	    (out ""; out anchor; out "")
 
-(*	fun definition susline =
-	    let open Substring
-		val (id, rest) = splitl smlIdChar (triml 4 susline)
-	    in
-		if isEmpty id then (* no identifier defined here *)
-		    outSubstr susline
-		else
-		    (out "   ["; nameSubstr id id; outSubstr rest)
-	    end
-*)
-
 	fun idhref link id = 
 	    (out ""; out id; out"")
 
@@ -146,7 +135,7 @@
 		if id="" then () 
 		else if Polyhash.peek anchors link = NONE then 
 		    out id
-		else idhref link id;
+		else idhref (Msp.urlencode link) id;
 		outSubstr after
 	    end
 
@@ -155,7 +144,7 @@
 	fun outisdef susline id after comp = 
 	    let open Substring 
 		fun namebold id s =
-		    (out ""; out id; out "")
 		val preflen = size susline - size after - String.size id
 		val pref = slice(susline, 0, SOME preflen)
@@ -200,7 +189,7 @@
 	    let fun loop []        lineno = ()
 		  | loop (ln::lnr) lineno = 
 		    (process ln lineno; loop lnr (lineno+1))
-	    in loop lines 1 end
+	    in loop lines 0 end
     in
 	print "Creating "; print htmlfile; print " from "; 
 	print sigfile; print "\n"; 
@@ -293,7 +282,7 @@
 	    let val key = Database.getname e1
 	    in 
 		separator (String.sub(key, 0));
-		out "
                • "; out key; out " (";
+		out "
                • "; out (Msp.htmlencode key); out " (";
 		(case comp of
 		     Str    => strhref key "structure"
 		   | Val id => (out "value; ";       
diff -Nru mosml-2.01/src/doc/helpsigs/index.html mosml-2.10.1/src/doc/helpsigs/index.html
--- mosml-2.01/src/doc/helpsigs/index.html	2000-08-02 13:56:08.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/index.html	2014-08-28 08:47:22.000000000 +0000
@@ -4,15 +4,9 @@
 
                  Moscow ML Library
                  
 
 
                  The Moscow ML Library consists of large parts of the SML Basis Library and
+HREF="http://www.standardml.org/Basis/">SML Basis Library and
 a number of extensions.
 
-
                  The HTML files referred below may be downloaded to your local site:
-gzipped
-tar file or zip
-file.
 
 
                  Identifier index
                  
 
@@ -23,25 +17,31 @@
 
 Array   
 Array2   
+ArraySlice   
 Arraysort   
 BasicIO   
 Binarymap   
 Binaryset   
 BinIO   
 Bool   
+Buffer   
 Byte   
 Callback   
 Char   
 CharArray   
+CharArraySlice   
 CharVector   
+CharVectorSlice   
 CommandLine   
 Date   
 Dynarray   
 Dynlib   
-FileSys   
+FileSys    
 Gdbm   
 Gdimage   
 General   
+Graphics   
+Hashset   
 Help   
 Int   
 Intmap   
@@ -53,15 +53,16 @@
 Location   
 Math   
 Meta   
+Misc   
 Mosml   
 Mosmlcgi   
 Mosmlcookie   
-Msp   
-Mysql   
+Msp    
+MySQL   
 NJ93   
 Nonstdio   
-OS   
 Option   
+OS   
 Parsing   
 Path   
 Polygdbm   
@@ -70,10 +71,12 @@
 PP   
 Process   
 Random   
+Rbset   
 Real   
+Redblackmap   
 Regex   
+Real   
 Signal   
-SML90   
 Socket   
 Splaymap   
 Splayset   
@@ -86,228 +89,105 @@
 Timer   
 Unix   
 Vector   
+VectorSlice   
 Weak   
 Word   
 Word8   
 Word8Array   
-Word8Vector
+Word8ArraySlice   
+Word8Vector   
+Word8VectorSlice   
 
 
 
                  Description of the structures
                  
 
 
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
                  
 
                  NameContentsCompatibility
-
                  Array
-mutable constant-time-access arraysSDFNO
-
-
                  Array2
-two-dimensional arraysS     
-
-
                  Arraysort
-array sorting (quicksort)L  
-
-
                  BasicIO
-input-output as in SML'90DF  
-
-
                  Binarymap
-binary tree implementation of finite mapsL
-
-
                  Binaryset
-binary tree implementation of finite setsSF
-
-
                  BinIO
-binary input-output streams (imperative)L
-
-
                  Bool
-BooleansSF
-
-
                  Byte
-character-byte conversionSF
-
-
                  Callback
-registering ML values for access from C code
-
-
                  Char
-charactersSDFNO
-
-
                  CharArray
-arrays of charactersSF
-
-
                  CharVector
-vectors of characters (= strings)SF
-
-
                  CommandLine
-program name and argumentsSF
-
-
                  Date
-manipulation of calendar datesSF   
-
-
                  Dynarray
-dynamic arraysL
-
-
                  Dynlib
-dynamic linking of foreign (C) functions 
-
-
                  FileSys
-interaction with the file systemSF   
-
-
                  General
-various top-level primitivesSD
-
-
                  Gdbm
-persistent hash tables of strings (gdbm)C
-
-
                  Gdimage
-generation of PNG images (Boutell's GD package)C
-
-
                  Help
-on-line helpDFNO
-
-
                  Int
-operations on integersSF
-
-
                  Intmap
-finite maps from integersL
-
-
                  Intset
-finite sets of integersL
-
-
                  Lexing
-support for lexers generated by mosmllex 
-
-
                  List
-classic list manipulation functionsSDFNO
-
-
                  ListPair
-operations on pairs of listsSF
-
-
                  Listsort
-list sorting (mergesort) 
-
-
                  Location
-error reporting for lexers and parsers 
-
-
                  Math
-trigonometric functions etc.SF
-
-
                  Meta
-functions specific to the interactive system 
-
-
                  Mosml
-various non-standard utilitiesF  
-
-
                  Mosmlcgi
-utilities for writing CGI programs 
-
-
                  Mosmlcookie
-manipulating cookies in CGI programs 
-
-
                  Msp
-ML Server Pages, mixing HTML and SML 
-
-
                  Mysql
-interface to the Mysql database serverC
-
-
                  NJ93
-top-level compatibility with SML/NJ 0.93N
-
-
                  Nonstdio
-non-standard I/O, used by lexers 
-
-
                  OS
-operating system informationSF
-
-
                  Option
-partial functionsSDFNO
-
-
                  Parsing
-support for parsers generated by mosmlyac 
-
-
                  Path
-file-system independent path manipulationSF
-
-
                  Polygdbm
-polymorphic persistent hash tables (gdbm)C
-
-
                  Polyhash
-polymorphic hash tables 
-
-
                  Postgres
-interface to the PostgreSQL database serverC
-
-
                  PP
-general prettyprintersL 
-
-
                  Process
-manipulating processesSF
-
-
                  Random
-generation of pseudo-random numbers 
-
-
                  Real
-arithmetics on floating-point numbersSF
-
-
                  Regex
-regular expressions as in POSIX 1003.2C
-
-
                  Signal
-Unix signalsS
-
-
                  SML90
-top-level compatibility with SML'90SO
-
-
                  Socket
-interface to socketsC
-
-
                  Splaymap
-splay-tree implementation of finite mapsL 
-
-
                  Splayset
-splay-tree implementation of finite setsL 
-
-
                  String
-string manipulationSDFNO
-
-
                  StringCvt
-conversion to and from stringsSF
-
-
                  Substring
-manipulation of constant-time substringsSF
-
-
                  Susp
-support for lazy evaluation 
-
-
                  TextIO
-text input-output streams (imperative)SDF
-
-
                  Time
-time points and durationsSF
-
-
                  Timer
-measuring real time and cpu timeSF
-
-
                  Unix
-starting concurrent subprocesses under UnixS
-
-
                  Vector
-immutable constant-time-access vectorsSDFNO
-
-
                  Weak
-arrays of weak pointers
-
-
                  Word
-words (31-bit unsigned integers)SF
-
-
                  Word8
-bytes (8-bit unsigned integers)SF
-
-
                  Word8Array
-arrays of bytesSF
-
-
                  Word8Vector
-vectors of bytesSF
+
                  Arraymutable constant-time-access arrays         SDF NO  
                  Array2two-dimensional arrays                      S       
                  ArraySlicemutable sub-arrays                          S F     
                  Arraysortarray sorting (quicksort)                      L    
                  BasicIOinput-output, see Definition (temporary)     DF     
                  Binarymapbinary tree implementation of finite maps      L    
                  Binarysetbinary tree implementation of finite sets      L    
                  BinIObinary input-output streams (imperative)    S F     
                  BoolBooleans                                    S F     
                  Buffermutable string buffer                               
                  Bytecharacter-byte conversion                   S F     
                  Callbackregistering ML values for access from C             
                  Charcharacters                                  SDF NO  
                  CharArrayarrays of characters                        S F     
                  CharArraySlicesub-arrays of characters                    S F     
                  CharVectorvectors of characters (= strings)           S F     
                  CharVectorSlicesub-vectors of characters (= substrings)    S F     
                  CommandLineprogram name and arguments                  S F     
                  Datemanipulation of calendar dates              S F     
                  Dynarraydynamic arrays                                 L    
                  Dynlibdynamic linking with C                              
                  FileSysinteraction with the file system            S F     
                  Gdbmpersistent hash tables of strings (gdbm)          C 
                  Gdimagegeneration of PNG images (Boutell's GD)           C 
                  Generalvarious top-level primitives                SD      
                  Graphicsgraphics primitives (DOS version only)              
                  Hashsetsets implemented by hashtables                 L    
                  Helpon-line help                                 DF NO  
                  Intoperations on integers                      S F     
                  Intmapfinite maps from integers                      L    
                  Intsetfinite sets of integers                        L    
                  Lexingsupport for lexers generated by mosmllex            
                  Listclassic list manipulation functions         SDF NO  
                  ListPairoperations on pairs of lists                S F     
                  Listsortlist sorting (mergesort)                            
                  Locationerror reporting for lexers and parsers              
                  Mathtrigonometric functions etc.                S F     
                  Metafunctions specific to the interactive system        
                  Miscvarious for initial top-level environment    DF NO  
                  Mosmlvarious non-standard utilities                F     
                  Mosmlcgiutilities for writing CGI programs                  
                  Mosmlcookiemanipulating cookies in CGI programs                
                  Msputilities for generating HTML code                  
                  MySQLinterface to the Mysql database server            C 
                  NJ93top-level compatibility with SML/NJ 0.93        N   
                  Nonstdionon-standard I/O, used by lexers                    
                  Optionpartial functions                           SDF NO  
                  OSoperating system information                S F     
                  Parsingsupport for parsers generated by mosmlyac           
                  Pathfile-system independent path manipulation   S F     
                  Polygdbmpolymorphic persistent hash tables (gdbm)         C 
                  Polyhashpolymorphic hash tables                             
                  Postgresinterface to PostgreSQL database server             
                  PPgeneral prettyprinters                         L    
                  Processmanipulating processes                      S F     
                  Randomgeneration of pseudo-random numbers                 
                  Rbsetsets implemented by red-black trees                 
                  Realarithmetic on floating-point numbers        S F     
                  Redblackmapmaps implemented by red-black trees                 
                  Regexregular expressions as in POSIX 1003.2            C 
                  Realarithmetic on floating-point numbers        S F     
                  SignalUnix signals                                S       
                  Socketinterface to sockets                              C 
                  Splaymapsplay-tree implementation of finite maps       L    
                  Splaysetsplay-tree implementation of finite sets       L    
                  Stringstring manipulation                         SDF NO  
                  StringCvtconversion to and from strings              S F     
                  Substringmanipulation of constant-time substrings    S F     
                  Suspsupport for lazy evaluation                         
                  TextIOtext input-output streams (imperative)      SDF     
                  Timetime points and durations                   S F     
                  Timermeasuring real time and cpu time            S F     
                  Unixstarting concurrent subprocesses            S       
                  Vectorimmutable constant-time-access vectors      SDF NO  
                  VectorSliceimmutable sub-vectors                       S F     
                  Weakarrays of weak pointers                             
                  Wordwords (31-bit unsigned integers)            S F     
                  Word8bytes (8-bit unsigned integers)             S F     
                  Word8Arrayarrays of bytes                             S F     
                  Word8ArraySlicesub-arrays of byte arrays                   S F     
                  Word8Vectorvectors of bytes                            S F     
                  Word8VectorSlicesub-vectors of byte vectors                 S F     
                  
 
                  
 
+
 
                  The compatibility field is interpreted as follows:
 
 
                  
@@ -339,8 +219,8 @@
    help "tostring";
 
                  • 
 
-
                  
-Moscow ML 2.00,
-Peter Sestoft
-(sestoft@dina.kvl.dk)
-2000-08-02
+
                  
+Moscow ML 2.10,
+Peter Sestoft
+(sestoft@itu.dk)
+
diff -Nru mosml-2.01/src/doc/helpsigs/Lexer.lex mosml-2.10.1/src/doc/helpsigs/Lexer.lex
--- mosml-2.01/src/doc/helpsigs/Lexer.lex	2000-05-17 10:21:35.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/Lexer.lex	2014-08-28 08:47:22.000000000 +0000
@@ -72,9 +72,11 @@
   ("exception",    EXCEPTION),
   ("fn",           FN),
   ("fun",          FUN),
+  ("functor",      FUNCTOR),
   ("handle",       HANDLE),
   ("if",           IF),
   ("in",           IN),
+  ("include",      INCLUDE),
   ("infix",        INFIX),
   ("infixr",       INFIXR),
   ("let",          LET),
@@ -90,6 +92,7 @@
   ("prim_val",     PRIM_VAL),
   ("raise",        RAISE),
   ("rec",          REC),
+  ("sharing",      SHARING),
   ("sig",          SIG),
   ("signature",    SIGNATURE),
   ("struct",       STRUCT),
@@ -97,12 +100,14 @@
   ("then",         THEN),
   ("type",         TYPE),
   ("val",          VAL),
+  ("where",        WHERE),
   ("while",        WHILE),
   ("with",         WITH),
   ("withtype",     WITHTYPE),
   ("#",            HASH),
   ("->",           ARROW),
   ("|",            BAR),
+  (":>",           COLONGT),
   (":",            COLON),
   ("=>",           DARROW),
   ("=",            EQUALS),
@@ -145,8 +150,7 @@
   in
     if !string_index >= len then
       let val new_buff = array(len * 2, #"\000") in
-        copy
-          { src = !string_buff, si = 0, len = NONE, dst = new_buff, di = 0 };
+        copy { src = !string_buff, dst = new_buff, di = 0 };
         string_buff := new_buff
       end
     else ();
@@ -155,34 +159,35 @@
   end;
 
 fun get_stored_string() =
-  let open CharArray
-      val s = extract(!string_buff, 0, SOME (!string_index))
+  let open CharArraySlice
+      val s = vector(slice(!string_buff, 0, SOME (!string_index)))
   in
     string_buff := initial_string_buffer;
     s
   end;
 
+(* cvr: NOTE normalizeUnitName done elsewhere now *)
 fun splitQualId s =
-  let open CharVector
-      val len' = size s - 1
-      fun parse n =
+  let open CharVectorSlice
+      val len' = size s
+      fun parse i n acc =
         if n >= len' then
-          ("", s)
-        else if sub(s, n) = #"." then
-          ( extract(s, 0, SOME n),
-            extract(s, n + 1, SOME(len' - n)) )
+	  vector(slice(s, i, SOME (len' - i))) :: acc
+        else if CharVector.sub(s, n) = #"." then
+          parse (n+1) (n+1) (vector(slice(s, i, SOME (n - i)))::acc)
         else
-          parse (n+1)
-  in parse 0 end;
+          parse i (n+1) acc
+  in parse 0 0 [] end
+
+
 
 fun mkQualId lexbuf =
-  let val (qual, id) = splitQualId(getLexeme lexbuf) in
-    if id = "*" then
-      QUAL_STAR { qual=qual, id=id }
+  let val  id = splitQualId(getLexeme lexbuf) in
+    if id = ["*"] then
+      QUAL_STAR { qual="", id=id }
     else
-      QUAL_ID   { qual=qual, id=id }
-  end
-;
+      QUAL_ID   { qual="", id=id }
+  end;
 
 fun charCodeOfDecimal lexbuf i =
   100 * (Char.ord(getLexemeChar lexbuf i) - 48) +
@@ -190,6 +195,17 @@
         (Char.ord(getLexemeChar lexbuf (i+2)) - 48)
 ;
 
+fun charCodeOfHexadecimal lexbuf i =
+    let fun hexval c = 
+	    if #"0" <= c andalso c <= #"9" then Char.ord c - 48
+	    else (Char.ord c - 55) mod 32;
+    in 
+       4096 * hexval(getLexemeChar lexbuf (i+1)) +
+        256 * hexval(getLexemeChar lexbuf (i+2)) +
+         16 * hexval(getLexemeChar lexbuf (i+3)) +
+              hexval(getLexemeChar lexbuf (i+4)) 
+    end;
+
 fun lexError msg lexbuf =
 (
   resetLexerState();
@@ -339,10 +355,10 @@
     | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\`
        `~` `\`` `^` `|` `*`]+ )
       { mkKeyword lexbuf }
-  | ( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]*
-    | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\`
-       `~` `\`` `^` `|` `*`]+ )
-    "."
+  | ((  [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]*
+      | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\`
+        `~` `\`` `^` `|` `*`]+ )
+      ".")+
     ( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]*
     | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\`
        `~` `\`` `^` `|` `*`]+ )
@@ -355,10 +371,10 @@
     | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\`
        `~` `^` `|` `*`]+ )
       { mkKeyword lexbuf }
-  | ( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]*
-    | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\`
-       `~` `^` `|` `*`]+ )
-    "."
+  | ((  [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]*
+      | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\`
+        `~` `^` `|` `*`]+ )
+     ".")+
     ( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]*
     | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\`
        `~` `^` `|` `*`]+ )
@@ -396,6 +412,15 @@
           if code >= 256 then
             skipString "character code is too large" SkipString lexbuf
           else ();
+          store_string_char(Char.chr code);
+          String lexbuf
+        end }
+  | "\\u" [`0`-`9``a`-`f``A`-`F`] [`0`-`9``a`-`f``A`-`F`] 
+          [`0`-`9``a`-`f``A`-`F`] [`0`-`9``a`-`f``A`-`F`]
+      { let val code = charCodeOfHexadecimal lexbuf 1 in
+          if code >= 256 then
+            skipString "character code is too large" SkipString lexbuf
+          else ();
           store_string_char(Char.chr code);
           String lexbuf
         end }
diff -Nru mosml-2.01/src/doc/helpsigs/makebase.sml mosml-2.10.1/src/doc/helpsigs/makebase.sml
--- mosml-2.01/src/doc/helpsigs/makebase.sml	2000-06-29 00:28:14.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/makebase.sml	2014-08-28 08:47:22.000000000 +0000
@@ -3,8 +3,7 @@
  *)
 
 (* The version number inserted in generated files: *)
-val version = "\
-    \Moscow ML 2.00";
+val version = "Moscow ML 2.10";
 
 (* Default directory containing the signature files: *)
 val libdirDef = "../../../lib/"
@@ -102,6 +101,8 @@
 	Database.writebase(filename, db)
     end
     handle exn as OS.SysErr (str, _) => (print(str ^ "\n\n"); raise exn)
+        |  exn as Lexer.LexicalError(msg,start,_) => (print(msg ^ " starting at " 
+                                                            ^ Int.toString start ^ "\n\n"); raise exn) 
 
 fun process (libdir, helpfile, txtIndex, texIndex, htmldir, htmlIndex) =
     (print ("Reading signatures in directory " ^ libdir ^ 
diff -Nru mosml-2.01/src/doc/helpsigs/Makefile mosml-2.10.1/src/doc/helpsigs/Makefile
--- mosml-2.01/src/doc/helpsigs/Makefile	2000-08-02 12:06:16.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -19,13 +19,13 @@
 	$(MOSMLL) -o makebase makebase.uo
 
 base:
-	makebase $(LIBDIR)
+	./makebase $(LIBDIR)
 
 install:
-	cp helpsigs.val $(LIBDIR)
-	test -d $(DOCDIR)/mosmllib || mkdir -p $(DOCDIR)/mosmllib
-	cp htmlsigs/*.html $(DOCDIR)/mosmllib
-	cp index.html $(DOCDIR)/mosmllib
+	$(INSTALL_DATA) helpsigs.val $(DESTDIR)$(LIBDIR)
+	test -d $(DESTDIR)$(DOCDIR)/mosmllib || mkdir -p $(DESTDIR)$(DOCDIR)/mosmllib
+	$(INSTALL_DATA) htmlsigs/*.html $(DESTDIR)$(DOCDIR)/mosmllib
+	$(INSTALL_DATA) index.html $(DESTDIR)$(DOCDIR)/mosmllib
 
 depend: Lexer.sml Parser.sml 
 	rm -f Makefile.bak
diff -Nru mosml-2.01/src/doc/helpsigs/Parser.grm mosml-2.10.1/src/doc/helpsigs/Parser.grm
--- mosml-2.01/src/doc/helpsigs/Parser.grm	2000-05-17 10:21:35.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/Parser.grm	2014-08-28 08:47:22.000000000 +0000
@@ -7,14 +7,14 @@
 
 %token ABSTYPE AND ANDALSO AS CASE DATATYPE DO ELSE END
 %token EQTYPE EXCEPTION
-%token FN FUN HANDLE IF IN INFIX INFIXR LET LOCAL
-%token NONFIX OF OP ORELSE RAISE REC SIG SIGNATURE STRUCT STRUCTURE
-%token THEN TYPE VAL WHILE WITH WITHTYPE
+%token FN FUN FUNCTOR HANDLE IF IN INCLUDE INFIX INFIXR LET LOCAL
+%token NONFIX OF OP ORELSE RAISE REC SHARING SIG SIGNATURE STRUCT STRUCTURE
+%token THEN TYPE VAL WHERE WHILE WITH WITHTYPE
 
 %token EQUALS
 %token COMMA ARROW DARROW BAR STAR HASH
 %token LBRACE RBRACE HASHLBRACKET LBRACKET RBRACKET LPAREN RPAREN
-%token COLON SEMICOLON UNDERBAR DOTDOTDOT
+%token COLON COLONGT SEMICOLON UNDERBAR DOTDOTDOT
 
 %token OPEN PRIM_VAL PRIM_TYPE PRIM_EQTYPE PRIM_REFTYPE
 
@@ -91,13 +91,13 @@
     Ident       { mkLoc($1) }
 
 OpIdent :
-    Ident       { mkIdInfo (mkLoc { qual="", id=$1 }) false }
-  | OP Ident    { mkIdInfo (mkLoc { qual="", id=$2 }) true }
+    Ident       { mkIdInfo (mkLoc { qual="", id=[$1] }) false }
+  | OP Ident    { mkIdInfo (mkLoc { qual="", id=[$2] }) true }
 ;
 
 OpEqIdent :
-    EqIdent     { mkIdInfo (mkLoc { qual="", id=$1 }) false }
-  | OP Ident    { mkIdInfo (mkLoc { qual="", id=$2 }) true }
+    EqIdent     { mkIdInfo (mkLoc { qual="", id=[$1] }) false }
+  | OP Ident    { mkIdInfo (mkLoc { qual="", id=[$2] }) true }
 ;
 
 EqIdent :
@@ -115,7 +115,7 @@
 ;
 
 TypeIdent :
-    ID          { mkIdInfo (mkLoc { qual="", id=$1 }) false }
+    ID          { mkIdInfo (mkLoc { qual="", id=[$1] }) false }
 ;
 
 LongTypeIdent :
@@ -124,7 +124,7 @@
 ;
 
 TyVar :
-    TYVAR    { mkIdInfo (mkLoc { qual="", id=$1 }) false }
+    TYVAR    { mkIdInfo (mkLoc { qual="", id=[$1] }) false }
 ;
 
 UnitName_seq1 :
diff -Nru mosml-2.01/src/doc/helpsigs/Parsspec.sml mosml-2.10.1/src/doc/helpsigs/Parsspec.sml
--- mosml-2.01/src/doc/helpsigs/Parsspec.sml	2000-05-17 10:21:35.000000000 +0000
+++ mosml-2.10.1/src/doc/helpsigs/Parsspec.sml	2014-08-28 08:47:22.000000000 +0000
@@ -32,7 +32,7 @@
 	    else line
 	val lineno = (Nonstdio.seek_in is 0; getline 0 0)
 	open Asynt Database
-	fun getId ({qualid = {id, ...}, ...} : IdInfo) = id
+	fun getId ({qualid = {id, ...}, ...} : IdInfo) = hd id
 	fun valdesc ((idInfo, ty), res) = 
 	    {comp = Val (getId idInfo), file = str, line = lineno} :: res
 	fun pvaldesc ((idInfo, ty, arity, cfun), res) = 
diff -Nru mosml-2.01/src/doc/macmosml.tex mosml-2.10.1/src/doc/macmosml.tex
--- mosml-2.01/src/doc/macmosml.tex	2000-07-19 21:13:44.000000000 +0000
+++ mosml-2.10.1/src/doc/macmosml.tex	2014-08-28 08:47:22.000000000 +0000
@@ -8,8 +8,9 @@
 
 \documentclass[fleqn]{article}
 
-\usepackage{a4,isolatin1,a4wide,pslatex}
+\usepackage{a4,a4wide,pslatex}
 \usepackage[T1]{fontenc}
+\usepackage[latin1]{inputenc}
 
 %\pdfcompresslevel=9
 
diff -Nru mosml-2.01/src/doc/Makefile mosml-2.10.1/src/doc/Makefile
--- mosml-2.01/src/doc/Makefile	2000-06-29 14:44:27.000000000 +0000
+++ mosml-2.10.1/src/doc/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -5,13 +5,13 @@
 
 include ../Makefile.inc
 
-all: helpsigs allps allpdf
+all: helpsigs allpdf
 
-allpdf: manual.pdf mosmlref.pdf mosmllib.pdf mosmllib2up.pdf 
+allpdf: manual.pdf mosmlref.pdf mosmllib.pdf
 
-allps: manual.ps mosmlref.ps mosmllib.ps mosmllib2up.ps 
+#allps: manual.ps mosmlref.ps mosmllib.ps mosmllib2up.ps 
 
-LATEX=latex -interaction=batchmode
+LATEX=pdflatex
 
 helpsigs:
 	cd helpsigs; make all base 
@@ -24,7 +24,7 @@
 	${LATEX} macmosml
 	${LATEX} macmosml
 
-manual.dvi: manual.tex manual.bbl mosml.sty
+manual.pdf: manual.tex manual.bbl mosml.sty
 	${LATEX} manual
 	bibtex manual
 	${LATEX} manual
@@ -33,25 +33,25 @@
 index.tex texsigsigs.tex:
 	cd helpsigs; make all base
 
-mosmlref.dvi: mosmlref.tex mosml.sty
+mosmlref.pdf: mosmlref.tex mosml.sty
 	${LATEX} mosmlref
 	${LATEX} mosmlref
 
-mosmllib.dvi: mosmllib.tex texsigsigs.tex
+mosmllib.pdf: mosmllib.tex texsigsigs.tex
 	touch mosmllib.ind
 	${LATEX} mosmllib
 	makeindex mosmllib
 	${LATEX} mosmllib
 	${LATEX} mosmllib
 
-mosmllib2up.ps: mosmllib.ps
-	psnup -pa4 -2 mosmllib.ps mosmllib2up.ps
+#mosmllib2up.ps: mosmllib.ps
+#	psnup -pa4 -2 mosmllib.ps mosmllib2up.ps
 
 install:
-	cp mosmlref.pdf $(DOCDIR)
-	cp manual.pdf $(DOCDIR)
-	cp mosmllib.pdf $(DOCDIR)
-	cp mosmllib2up.pdf $(DOCDIR)
+	$(INSTALL_DATA) mosmlref.pdf $(DESTDIR)$(DOCDIR)
+	$(INSTALL_DATA) manual.pdf $(DESTDIR)$(DOCDIR)
+	$(INSTALL_DATA) mosmllib.pdf $(DESTDIR)$(DOCDIR)
+#	cp mosmllib2up.pdf $(DOCDIR)
 	cd helpsigs; make install
 
 clean:
@@ -61,10 +61,10 @@
 	cd helpsigs; make clean
 
 .SUFFIXES :
-.SUFFIXES : .aux .bbl .tex .bib .dvi .ps .pdf 
+.SUFFIXES : .aux .bbl .tex .bib .dvi .ps
 
-.ps.pdf:
-	ps2pdf $<
+#.ps.pdf:
+#	ps2pdf $<
 
 .dvi.ps:
 	dvips -ta4 $< -o
Binary files /tmp/HAzJFmIrvn/mosml-2.01/src/doc/manual.pdf and /tmp/A1vl5z0ZBv/mosml-2.10.1/src/doc/manual.pdf differ
diff -Nru mosml-2.01/src/doc/manual.tex mosml-2.10.1/src/doc/manual.tex
--- mosml-2.01/src/doc/manual.tex	2000-07-20 10:20:39.000000000 +0000
+++ mosml-2.10.1/src/doc/manual.tex	2014-08-28 08:47:22.000000000 +0000
@@ -1,4 +1,4 @@
-% manual.tex v. 2.00.4 Copyright (C) Peter Sestoft 1994, 2000-07-20
+% manual.tex v. 2.00.5 Copyright (C) Peter Sestoft 1994, 2000-09-22
 %
 % You may edit for lay-out, or leave out irrelevant sections (if
 % such omissions are marked somehow), but you may not redistribute the
@@ -6,9 +6,11 @@
 
 \documentclass[fleqn,a4paper]{article}
 
-\usepackage{isolatin1,mosml,pslatex}
+\usepackage{mosml,pslatex}
 \usepackage{geometry}
 \usepackage[T1]{fontenc}
+\usepackage[latin1]{inputenc}
+\nonstopmode
 
 % True if running pdflatex
 \newif\ifpdf
@@ -34,7 +36,7 @@
 
   {\huge\bf Moscow ML Owner's Manual}\\[0.5cm]
 
-Version 2.00 of June 2000\\[0.5cm]
+Version 2.10 of August 2013\\[0.5cm]
 
 Sergei Romanenko, Russian Academy of Sciences, Moscow, Russia\\
 Claudio Russo, Cambridge University, Cambridge, United Kingdom\\
@@ -76,7 +78,7 @@
 \begin{center}
 \begin{tabular}{|c|}\hline
 \rule[-0.4cm]{0cm}{1cm}The Moscow ML home page is\ \
-    \url{http://www.dina.kvl.dk/~sestoft/mosml.html}\\\hline
+    \url{http://mosml.org}\\\hline
 \end{tabular}
 \end{center}
 
@@ -106,7 +108,7 @@
 
 \begin{program}
 \$ mosml
-Moscow ML version 2.00 (June 2000)
+Moscow ML version 2.10 (August 2013)
 Enter `quit();' to quit.
 -  fun fac n = if n = 0 then 1 else n * fac (n-1);
 > val fac = fn : int -> int
@@ -135,12 +137,12 @@
 
 The Moscow ML Modules language is a conservative extension of the
 Standard ML Modules language, so that any Standard ML program can be
-compiled with Moscow ML 2.00, using toplevel-mode compilation; see
+compiled with Moscow ML 2.10, using toplevel-mode compilation; see
 Section~\ref{sec-toplevel-mode}.
 
 Moreover, the Moscow ML Modules language is backwards compatible with
 Moscow ML versions 1.44 and before, so that any existing Moscow ML
-program can be compiled with Moscow ML 2.00, using structure-mode
+program can be compiled with Moscow ML 2.10, using structure-mode
 compilation; see Section~\ref{sec-structure-mode}.
 
 
@@ -382,7 +384,7 @@
 
 \begin{program}
 \$ mosml
-Moscow ML version 2.00 (June 2000)
+Moscow ML version 2.10 (August 2013)
 Enter `quit();' to quit.
 - 
 \end{program}
@@ -639,7 +641,7 @@
   listed in $opnunits$ are added to the compilation context in
   which the specifications in U.sig are compiled.
   
-  Evaluating \texttt{compileStructure $opnunits$ "{\rm U.sml}"
+  Evaluating \texttt{compileToplevel $opnunits$ "{\rm U.sml}"
     } will elaborate and compile the declarations in file U.sig in
   toplevel mode, producing a bytecode file U.uo.  The contents of the
   units listed in $opnunits$ are added to the compilation
@@ -781,14 +783,6 @@
   symbolic identifiers, and a quotation {\tt `a b c`} will be
   evaluated to an object of type {\tt 'a frag list}.
 
-\item[{\tt system :\ string -> int}]\mbox{ }
-
-  Evaluating {\tt system "$com$"} causes the command $com$ to be
-  executed by the operating system.  If a non-zero integer is
-  returned, this must indicate that the operating system has failed to
-  execute the command.  Under MS DOS, the integer returned always
-  equals 0.
-
 \item[{\tt use :\ string -> unit}]\mbox{ }
 
   Evaluating {\tt use "$f$"} causes ML declarations to be read from
@@ -3603,7 +3597,8 @@
 \item Michael R. Hansen and Hans Rischel, \emph{Introduction to
     Programming using SML}, Addison-Wesley 1999, ISBN 0-201-39820-6.
 \item Greg Michaelson, {\em Elementary Standard ML\/}, UCL Press 1995,
-  ISBN 1-85728-398-8.
+  ISBN 1-85728-398-8. At
+\url{ftp://ftp.macs.hw.ac.uk/pub/funcprog/gjm.book95.ps.Z}
 \item Colin Myers, Chris Clack, and Ellen Poon, {\em Programming with
     Standard ML\/}, Prentice Hall 1993, ISBN 0-13-722075-8.
 \item Lawrence C. Paulson, {\em ML for the Working Programmer\/},
diff -Nru mosml-2.01/src/doc/mosml.bib mosml-2.10.1/src/doc/mosml.bib
--- mosml-2.01/src/doc/mosml.bib	2000-06-27 17:14:38.000000000 +0000
+++ mosml-2.10.1/src/doc/mosml.bib	2014-08-28 08:47:22.000000000 +0000
@@ -434,8 +434,8 @@
   OPTedition =	 "",
   year =	 "2000",
   month =	 "June",
-  note = 	 "Available from ftp://ftp.dina.kvl.dk/pub/mosml/doc/mosmlref.pdf",
-  OPTannote = 	 ""
+  note =	 "24 pages",
+  OPTannote =	 ""
 }
 
 @Manual{MoscowML:2000:OwnersManual,
@@ -444,7 +444,7 @@
   organization = "",
   year =	 2000,
   month =	 "June",
-  note =	 "Available from ftp://ftp.dina.kvl.dk/pub/mosml/doc/manual.pdf"
+  note =	 "35 pages"
 }
 
 @Manual{MoscowML:2000:MoscowMLLibrary,
@@ -453,7 +453,7 @@
   organization = "",
   year =	 2000,
   month =	 "June",
-  note =	 "Available from ftp://ftp.dina.kvl.dk/pub/mosml/doc/mosmllib.pdf"
+  note =	 "171 pages"
 }
 
 @InProceedings{Russo:FirstClassStructures,
Binary files /tmp/HAzJFmIrvn/mosml-2.01/src/doc/mosmllib2up.pdf and /tmp/A1vl5z0ZBv/mosml-2.10.1/src/doc/mosmllib2up.pdf differ
Binary files /tmp/HAzJFmIrvn/mosml-2.01/src/doc/mosmllib.pdf and /tmp/A1vl5z0ZBv/mosml-2.10.1/src/doc/mosmllib.pdf differ
diff -Nru mosml-2.01/src/doc/mosmllib.tex mosml-2.10.1/src/doc/mosmllib.tex
--- mosml-2.01/src/doc/mosmllib.tex	2000-06-28 22:53:38.000000000 +0000
+++ mosml-2.10.1/src/doc/mosmllib.tex	2014-08-28 08:47:22.000000000 +0000
@@ -7,9 +7,10 @@
 \documentclass[fleqn,twoside,a4paper]{article}
 \usepackage{geometry}
 
-\usepackage{isolatin1,program,pslatex}
+\usepackage{program,pslatex}
 \usepackage[T1]{fontenc}
-
+\usepackage[latin1]{inputenc}
+\nonstopmode
 \makeindex
 \pagestyle{headings}
 \thispagestyle{empty}
@@ -50,7 +51,7 @@
 \subsubsection*{Hypertext on the World-Wide Web}
   
 The manual is available at
-\verb$http://www.dina.kvl.dk/~sestoft/mosmllib/$ for online browsing.
+\verb$http://mosml.org/mosmllib/$ for online browsing.
 
 
 \subsubsection*{Hypertext in the Moscow ML distribution}
@@ -90,7 +91,7 @@
 \begin{center}
 \begin{tabular}{|c|}\hline
 \rule[-0.4cm]{0cm}{1cm}The Moscow ML home page is\ \
-    \verb$http://www.dina.kvl.dk/~sestoft/mosml.html$\\\hline
+    \verb$http://mosml.org$\\\hline
 \end{tabular}
 \end{center}
 
diff -Nru mosml-2.01/src/doc/mosmlnet.txt mosml-2.10.1/src/doc/mosmlnet.txt
--- mosml-2.01/src/doc/mosmlnet.txt	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/doc/mosmlnet.txt	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,120 @@
+Calling .Net static methods from Moscow ML .Net programs
+--------------------------------------------------------
+
+External (.Net) static methods can be accessed and called through the
+prim_val mechanism.  For instance (from src/mosmllib/Math.sml):
+
+   prim_val sqrt : real -> real = 1 "sml_sqrt";
+
+This binds variable sqrt to a 1-argument function of type real ->
+real, implemented by a static method 
+
+   public static double sml_sqrt(double x) { ... }
+
+in class Mosml.Stdlib, whose source is found in src/runtime/Stdlib.cs.
+
+Class Stdlib is a container for static methods to be referenced as
+prim_vals in the standard library. A prim_val defined with a fname not
+containing an assembly ref or namespace part will point to a method in
+this class.
+
+If the method name on the prim_val right-hand side contains an
+assembly ref or a namespace part, then a static method in a class in
+that assembly and/or namespace will be called. 
+
+For example, this binds variable rtcg_create_assembly to the method
+create_assembly from class RTCG in namespace Mosml:
+
+  prim_val rtcg_create_assembly : string -> rtcg_t = 1 "RTCG::create_assembly";
+
+Similarly, this binds variable Mosml_load_one to the method load_one
+from class main in namespace Mosml.Top:
+
+  prim_val Mosml_load_one : string -> unit = 1 "Top.main::load_one";
+
+More generally, you can specify the assembly, the namespace and the
+class that declares the method that you need.  For instance, the full
+specification of the sml_sqrt method indicated above would be:
+
+   prim_val sqrt : real -> real = 1 "[Mosml.Runtime]Mosml.Stdlib::sml_sqrt";
+
+Here, the assembly is Mosml.Runtime (in file Mosml.Runtime.dll), the
+namespace is Mosml, the class us Stdlib, and sml_sqrt is the method.
+
+
+An example
+----------
+
+Assume that the C# file Hello.cs contains this class declaration:
+
+   using System;
+   using Mosml;
+
+   public class MyTest {
+     public static Value Print(Value v) {
+       System.Console.WriteLine(v);
+       return Value.unit;
+     }
+   }
+
+This file contains a reference to the Mosml namespace in the
+Mosml.Runtime assembly.  To compile it into a library (a .dll file),
+use:
+
+   csc /target:library /reference:c:\mosmlnet\bin\Mosml.Runtime.dll Hello.cs
+
+Assume the SML file hello.sml contains the following declarations:
+
+   prim_val hello : string -> unit = 1 "[Hello]MyTest::Print";
+
+   val _ = hello "Hello, world!\n";
+
+Then running 
+
+   mosmlnet hello.sml
+
+in the directory holding Hello.dll will produce this result:
+
+   C:\tmp>mosmlnet hello.sml
+   Moscow dot ML version 0.8.0 (June 2003)
+   Enter `quit();' to quit.
+   [opening file "hello.sml"]
+   > val hello = fn : string -> unit
+   Hello, world!
+
+   [closing file "hello.sml"]
+
+
+Passing arguments and using results
+-----------------------------------
+
+Arguments are passed by value (not ref or out), as objects of
+subclasses of class Value from namespace Mosml, declared in
+file src/runtime/Values.cs.  The ML value class hierarchy is
+
+     Value                      All Moscow ML .Net values (abstract)
+       MLInt                    32-bit integers (SML int and char, C# int)
+       MLFloat                  64-bit floating-point (SML real, C# double)
+       MLAbstractString         (Internal use) (abstract)
+         MLString               Strings (SML string, C# String)
+         MLByteArray            (Internal use)
+         MLCharArray            (Internal use)
+       MLVector                 Vectors (SML 'a vector, C# Value[])
+       MLBlock0                 Tuples, records, datatypes
+         MLBlock1               Tuples, records, datatypes
+           ...                  ...
+             MLBlock6           Tuples, records, datatypes
+               MLBlockInf       Tuples, records, datatypes
+       MLInChannel              Input channel (abstract)
+         MLInFileStream         SML BinIO.in_channel
+         MLTextReader           SML {TextIO,BasicIO}.in_channel
+       MLOutChannel             Output channel (abstract)
+         MLOutFileStream        SML BinIO.out_channel
+         MLTextWriter           SML {TextIO,BasicIO}.out_channel
+       MLClosure_               SML functions (abstract)
+         Concrete closures
+       ANY
+       MLDirHandle
+       MLExcReturn 
+
+Niels Jørgen Kokholm and Peter Sestoft * 2003-06-25
Binary files /tmp/HAzJFmIrvn/mosml-2.01/src/doc/mosmlref.pdf and /tmp/A1vl5z0ZBv/mosml-2.10.1/src/doc/mosmlref.pdf differ
diff -Nru mosml-2.01/src/doc/mosmlref.tex mosml-2.10.1/src/doc/mosmlref.tex
--- mosml-2.01/src/doc/mosmlref.tex	2000-08-02 13:56:08.000000000 +0000
+++ mosml-2.10.1/src/doc/mosmlref.tex	2014-08-28 08:47:22.000000000 +0000
@@ -18,8 +18,9 @@
 \nonstopmode
 \usepackage{alltt}
 
-\usepackage{isolatin1,mosml,pslatex}
+\usepackage{mosml,pslatex}
 \usepackage[T1]{fontenc}
+\usepackage[latin1]{inputenc}
 \usepackage{geometry}
 
 % \documentstyle[A4,fleqn,notesart]{article}
@@ -86,7 +87,7 @@
 \begin{center}
 \begin{tabular}{|c|}\hline
 \rule[-0.4cm]{0cm}{1cm}The Moscow ML home page is\ \
-    \url{http://www.dina.kvl.dk/~sestoft/mosml.html}\\\hline
+    \url{http://mosml.org}\\\hline
 \end{tabular}
 \end{center}
 
diff -Nru mosml-2.01/src/dynlibs/interface/cside.c mosml-2.10.1/src/dynlibs/interface/cside.c
--- mosml-2.01/src/dynlibs/interface/cside.c	2000-07-19 21:13:44.000000000 +0000
+++ mosml-2.10.1/src/dynlibs/interface/cside.c	2014-08-28 08:47:22.000000000 +0000
@@ -163,7 +163,7 @@
 long treesum(value v)
 {
   long sum = 0;
-  int contag = Tag_val(v);	/* 0 = Lf, 1 = Br, 2 = Brs */
+  int contag = Tag_val(v);	/* 0 = Br, 1 = Brs, 2 = Lf */
   switch (contag) {
   case 2: /* Lf */
     sum = 0; break;
@@ -186,11 +186,11 @@
 }
 
 
-/* SML type: (int -> string) -> int -> string */
+/* SML type: (int -> real) -> int -> string */
 
 EXTERNML value cffun(value vf, value vi)
 {
-  int count = Val_long(vi);
+  int count = Long_val(vi);
   int ok = 1;
   value res;
   int i;
diff -Nru mosml-2.01/src/dynlibs/intinf/.gitignore mosml-2.10.1/src/dynlibs/intinf/.gitignore
--- mosml-2.01/src/dynlibs/intinf/.gitignore	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/dynlibs/intinf/.gitignore	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,4 @@
+/intinf.o
+/libmgmp.so
+IntInf.ui
+IntInf.uo
diff -Nru mosml-2.01/src/dynlibs/intinf/intinf.c mosml-2.10.1/src/dynlibs/intinf/intinf.c
--- mosml-2.01/src/dynlibs/intinf/intinf.c	2000-01-24 22:14:26.000000000 +0000
+++ mosml-2.10.1/src/dynlibs/intinf/intinf.c	2014-08-28 08:47:22.000000000 +0000
@@ -2,6 +2,7 @@
    sestoft@dina.kvl.dk 1995, 1998-04-20 */
 
 #include 
+#include 
 
 /* Access to the camlrunm/Moscow ML runtime data representation: */
 
@@ -50,7 +51,7 @@
    and realloc provide two benefits: (1) they call the runtime's
    adjust_gc_speed() function to inform the gc about the external
    allocations, and (2) they raise mosml exceptions for out-of-memory
-   errors. These changes are marked with a "/* adjust_gc_speed tweak *"
+   errors. These changes are marked with a "* adjust_gc_speed tweak *"
    comment.
 
    A macro MAX_GMP_ALLOC is defined below. It determines how much gmp
@@ -63,7 +64,7 @@
    The second change is to integrate the MP_INT structure into the
    mosml largeint rather than pointing to it. This provides a modest
    speed improvement by avoiding a malloc()/free() for each Largeint.
-   These changes are marked with a "/* inline MPINT tweak *" comment.
+   These changes are marked with a "* inline MPINT tweak *" comment.
 
    A largeint is now a finalized object: a structure,
 
@@ -307,10 +308,9 @@
   if (changesign) { Byte(str, 0) = '-'; }
   res = mpz_set_str(Large_val(dest), String_val(str), Long_val(base));
   if (changesign) { Byte(str, 0) = '~'; }
-  if (0 == res)
-    { return Val_unit; }
-  else
+  if (0 != res)
     { failwith("Ill-formed number string"); }
+  return Val_unit;
 }
 
 value largeint_get_str(value src, value base)		
diff -Nru mosml-2.01/src/dynlibs/intinf/Makefile mosml-2.10.1/src/dynlibs/intinf/Makefile
--- mosml-2.01/src/dynlibs/intinf/Makefile	2000-02-16 15:36:57.000000000 +0000
+++ mosml-2.10.1/src/dynlibs/intinf/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -5,31 +5,36 @@
 
 # Where to find GMP header file and compiled library
 
-GMPDIR=${HOME}/c/gmp-2.0.2
+#GMPDIR=${HOME}/c/gmp-2.0.2
+GMPINCDIR=/usr/local/include
+GMPLIBDIR=/usr/local/lib
 
 include ../../Makefile.inc
 
-OPTS=-fno-defer-pop
-CFLAGS=-Dunix -O2 $(OPTS) $(ADDDYNLIBCFLAGS) -I$(INCDIR) -I ${GMPDIR}
+#OPTS=-fno-defer-pop
+ROOTDIR:=../..
+CFLAGS=-Dunix -O3 $(OPTS) $(ADDDYNLIBCFLAGS) -I$(CAMLRT) -I${GMPINCDIR}
+#CFLAGS=-Dunix -O2 $(OPTS) $(ADDDYNLIBCFLAGS) -I$(INCDIR) -I ${GMPDIR}
 
-MOSMLTOOLS=camlrunm $(MOSMLHOME)/tools
-MOSMLC=mosmlc -c
-MOSMLL=mosmlc
-MOSMLLEX=mosmllex
-MOSMLYACC=mosmlyac
+MOSMLTOOLS=camlrunm $(TOOLDIR)
 
 all: libmgmp.so IntInf.uo
 
+
 install:
-	cp libmgmp.so $(LIBDIR)
+	$(INSTALL_DATA) libmgmp.so $(DESTDIR)$(LIBDIR)
+	$(INSTALL_DATA) IntInf.sig $(DESTDIR)$(LIBDIR)
+	$(INSTALL_DATA) IntInf.ui $(DESTDIR)$(LIBDIR)
+	$(INSTALL_DATA) IntInf.uo $(DESTDIR)$(LIBDIR)
 
 intinf.o: intinf.c
 	$(CC) $(CFLAGS) -c -o intinf.o intinf.c
 
 libmgmp.so: intinf.o
-	$(DYNLD) -o libmgmp.so intinf.o ${GMPDIR}/libgmp.a
+	$(DYNLD) -o libmgmp.so intinf.o -L$(GMPLIBDIR) -lgmp -lc
 
 test:
+	echo $(CURDIR)
 	mosml testintinf.sml
 
 clean:
diff -Nru mosml-2.01/src/dynlibs/mgd/Makefile mosml-2.10.1/src/dynlibs/mgd/Makefile
--- mosml-2.01/src/dynlibs/mgd/Makefile	2000-02-23 17:11:42.000000000 +0000
+++ mosml-2.10.1/src/dynlibs/mgd/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -24,7 +24,8 @@
 	$(CC) $(CFLAGS) -c -o mgd.o mgd.c
 
 libmgd.so: mgd.o
-	$(DYNLD) -o libmgd.so mgd.o ${GDDIR}/libgd.a -L/usr/X11R6/lib -lpng -lz
+	$(DYNLD) -o libmgd.so mgd.o ${GDDIR}/libgd.a -L/usr/lib -lpng -lz
+#	$(DYNLD) -o libmgd.so mgd.o ${GDDIR}/libgd.a -L/usr/X11R6/lib -lpng -lz
 #	$(DYNLD) -o libmgd.so mgd.o ${GDDIR}/libgd.a -R/pack/libs/lib -L/pack/libs/lib -lpng -lz
 
 test: Graphs.uo
diff -Nru mosml-2.01/src/dynlibs/mmysql/mmysql.c mosml-2.10.1/src/dynlibs/mmysql/mmysql.c
--- mosml-2.01/src/dynlibs/mmysql/mmysql.c	2000-05-30 14:34:21.000000000 +0000
+++ mosml-2.10.1/src/dynlibs/mmysql/mmysql.c	2014-08-28 08:47:22.000000000 +0000
@@ -1,6 +1,6 @@
 /* mmysql.c -- Moscow ML interface interface to the mysql library.
    thomassi@dina.kvl.dk 1999-07-06  
-   sestoft@dina.kvl.dk 1999-08-07, 2000-05-30 */
+   sestoft@dina.kvl.dk 1999-08-07, 2000-05-30, 2002-07-25 */
 
 #include 
 
@@ -497,8 +497,9 @@
     return Atom(Empty_query);
   case 0:                       /* No error */
     {
-      /* If mysql_num_fields==0, query was a command */
-      if (mysql_num_fields(mysql) == 0)
+      /* If mysql_field_count==0, query was a command */
+      /* 2002-07-25: In MySQL 3.23 and later, must use mysql_field_count */
+      if (mysql_field_count(mysql) == 0)
         return Atom(Command_ok);
       else
         return Atom(Tuples_ok);
diff -Nru mosml-2.01/src/dynlibs/mmysql/testmysql.sml mosml-2.10.1/src/dynlibs/mmysql/testmysql.sml
--- mosml-2.01/src/dynlibs/mmysql/testmysql.sml	2000-05-30 14:34:21.000000000 +0000
+++ mosml-2.10.1/src/dynlibs/mmysql/testmysql.sml	2014-08-28 08:47:22.000000000 +0000
@@ -236,19 +236,19 @@
 in
 
 val test4 = check'(fn _ => (copytableto (pc, "t", append1); 
-			    expected = return1 ()))
+			    expected = return1 ()));
 
 val res5 = execute pc "delete from t";
  
 val test5a = check' 
     (fn _ => errormessage pc = NONE
-     (* MYSQLCMDTUPLES: andalso cmdtuples res5 = 2 *))
+     (* MYSQLCMDTUPLES: andalso cmdtuples res5 = 2 *));
 
 val test6 = check'(fn _ => (copytableto (pc, "t", append2); 
-			    [] = return2 ()))
+			    [] = return2 ()));
 
 val _ = copytablefrom (pc, "t", 
-		       fn put => app (fn s => (put s; put "\n"))  expected)
+		       fn put => app (fn s => (put s; put "\n"))  expected);
 
 val test7 = check'(fn _ => (copytableto (pc, "t", append3); 
 			    expected = return3 ()));
@@ -257,7 +257,7 @@
 
 val _ = copytablefrom (pc, "t", 
 		       fn put => app (fn s => (app (put o str) (explode s); 
-					       put "\n")) expected)
+					       put "\n")) expected);
 
 val test8 = check'(fn _ => (copytableto (pc, "t", append4); 
 			    expected = return4 ()));
diff -Nru mosml-2.01/src/dynlibs/mpq/Makefile mosml-2.10.1/src/dynlibs/mpq/Makefile
--- mosml-2.01/src/dynlibs/mpq/Makefile	2000-06-27 16:38:25.000000000 +0000
+++ mosml-2.10.1/src/dynlibs/mpq/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -8,7 +8,9 @@
 #       and PGSQLINCDIR locations
 
 PGSQLLIBDIR=/usr/lib
-PGSQLINCDIR=/usr/include/pgsql
+PGSQLINCDIR=/usr/include/postgresql
+#PGSQLLIBDIR=/usr/lib
+#PGSQLINCDIR=/usr/include/pgsql
 #PGSQLLIBDIR=/usr/local/pgsql/lib
 #PGSQLINCDIR=/usr/local/pgsql/include
 #PGSQLLIBDIR=/usr/lib/pgsql/lib
diff -Nru mosml-2.01/src/dynlibs/mpq/testpsql.sml mosml-2.10.1/src/dynlibs/mpq/testpsql.sml
--- mosml-2.01/src/dynlibs/mpq/testpsql.sml	2000-06-27 16:38:25.000000000 +0000
+++ mosml-2.10.1/src/dynlibs/mpq/testpsql.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,5 +1,5 @@
 (* Testing the Postgres interface -- 1998-10-29, 1998-11-07,
-   1999-08-08, 1999-09-14, 2000-05-30 *)
+   1999-08-08, 1999-09-14, 2000-05-30, 2001-02-03, 2004-01-12 *)
 
 app load ["Int", "Postgres", "Mosml"];
 
@@ -25,11 +25,11 @@
 val _ = (execute pc "drop table t"; ()) handle Fail _ => ();
 
 val _ = execute pc "create table t (fb bool, fi int4, ff8 float8,\
-        \ ff4 float4, ftx text, fv varchar, fd date, ftm time, fdt datetime)";
+        \ ff4 float4, ftx text, fv varchar, fd date, ftm time, fdt timestamp)";
 
 fun inst tup = execute pc ("insert into t values " ^ tup)
 
-val res1 = inst "('false', 1234, 1234.1, 1234.2, 'Abc dEf', 'Abc DEF',\
+val res1 = inst "('false', 1234, 1234.1, 1234.2, 'Abc dEf', 'Abc DEFøa',\
                  \ '1998-12-24', '23:59:42', '1975-06-25 13:45:56')"
 
 val test1a = check' 
@@ -142,7 +142,7 @@
 	     NullVal
      andalso vcheck 
              (Vector.sub(tups3, 1)) 
-	     (false, 1234, 1234.1, 1234.2, "Abc dEf", "Abc DEF", 
+	     (false, 1234, 1234.1, 1234.2, "Abc dEf", "Abc DEFøa", 
 	      (1998, 12, 24), (23, 59, 42))
 	     (DateTime date)
      andalso vcheck 
@@ -151,7 +151,7 @@
 	     NullVal
      andalso vcheck 
              (getdyntup res3 1)
-	     (false, 1234, 1234.1, 1234.2, "Abc dEf", "Abc DEF", 
+	     (false, 1234, 1234.1, 1234.2, "Abc dEf", "Abc DEFøa", 
 	      (1998, 12, 24), (23, 59, 42))
 	     (DateTime date)
      andalso vcheck 
@@ -160,7 +160,7 @@
 	     NullVal
      andalso vcheck 
              (Vector.map (applyto 1) (Vector.tabulate(nfields res3, getdynfield res3)))
-	     (false, 1234, 1234.1, 1234.2, "Abc dEf", "Abc DEF", 
+	     (false, 1234, 1234.1, 1234.2, "Abc dEf", "Abc DEFøa", 
 	      (1998, 12, 24), (23, 59, 42))
 	     (DateTime date))
 
@@ -183,7 +183,7 @@
      andalso getreal res3 2 1 = 1234.1
      andalso getreal res3 3 1 = 1234.2
      andalso getstring res3 4 1 = "Abc dEf"
-     andalso getstring res3 5 1 = "Abc DEF"
+     andalso getstring res3 5 1 = "Abc DEFøa"
      andalso getdate res3 6 1 = (1998, 12, 24)
      andalso gettime res3 7 1 = (23, 59, 42)
      andalso Date.compare(getdatetime res3 8 1, date) = EQUAL
@@ -197,18 +197,24 @@
 val test3hb = checkallbounds1 false 9
 val test3hc = checkallbounds1 true 8
 
-end             
+end
 
-local 
+local
     fun collector () =
 	let val buf = ref []
 	    fun append s = buf := s :: !buf
 	    fun return () = rev (!buf)
 	in (append, return) end
-    val expected =   
-	["f\t1234\t1234.1\t1234.2\tAbc dEf\tAbc DEF\t12-24-1998\t23:59:42\
+(* Date format changed in Postgres 7, from this:
+   val expected =   
+	["f\t1234\t1234.1\t1234.2\tAbc dEf\tAbc DEFøa\t12-24-1998\t23:59:42\
 	 \\tWed Jun 25 13:45:56 1975 CET",
 	 "t\t-1234\t-1234.1\t-1234.2\t\t\t03-01-1752\t04:59:42\t\\N"]
+*)
+    val expected =   
+	["f\t1234\t1234.1\t1234.2\tAbc dEf\tAbc DEFøa\t1998-12-24\t23:59:42\
+	 \\t1975-06-25 13:45:56",
+	 "t\t-1234\t-1234.1\t-1234.2\t\t\t1752-03-01\t04:59:42\t\\N"]
     val (append1, return1) = collector ()
     val (append2, return2) = collector ()
     val (append3, return3) = collector ()
@@ -218,6 +224,7 @@
 in
 
 val test4 = check'(fn _ => (copytableto (pc, "t", append1); 
+			    app print (return1 ());
 			    expected = return1 ()))
 
 val res5 = execute pc "delete from t";
diff -Nru mosml-2.01/src/dynlibs/msocket/.gitignore mosml-2.10.1/src/dynlibs/msocket/.gitignore
--- mosml-2.01/src/dynlibs/msocket/.gitignore	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/dynlibs/msocket/.gitignore	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,2 @@
+/libmsocket.so
+/msocket.o
diff -Nru mosml-2.01/src/dynlibs/msocket/Makefile mosml-2.10.1/src/dynlibs/msocket/Makefile
--- mosml-2.01/src/dynlibs/msocket/Makefile	2000-02-16 15:36:57.000000000 +0000
+++ mosml-2.10.1/src/dynlibs/msocket/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -5,14 +5,11 @@
 
 include ../../Makefile.inc
 
-OPTS=-fno-defer-pop
-CFLAGS=-Dunix -O2 $(OPTS) $(ADDDYNLIBCFLAGS) -I$(INCDIR)
+#OPTS=-fno-defer-pop
+ROOTDIR:=../..
+CFLAGS=-Dunix -O3 $(OPTS) $(ADDDYNLIBCFLAGS) -I$(CAMLRT)
 
-MOSMLTOOLS=camlrunm $(MOSMLHOME)/tools
-MOSMLC=mosmlc -c
-MOSMLL=mosmlc
-MOSMLLEX=mosmllex
-MOSMLYACC=mosmlyac
+MOSMLTOOLS=camlrunm $(TOOLSDIR)
 
 all: libmsocket.so 
 
@@ -25,7 +22,7 @@
 #	$(DYNLD) -o libmsocket.so -lsocket msocket.o 
 
 install:
-	cp libmsocket.so $(LIBDIR)
+	$(INSTALL_DATA) libmsocket.so $(DESTDIR)$(LIBDIR)
 
 test:
 	mosml testsocket.sml
diff -Nru mosml-2.01/src/dynlibs/msocket/msocket.c mosml-2.10.1/src/dynlibs/msocket/msocket.c
--- mosml-2.01/src/dynlibs/msocket/msocket.c	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/dynlibs/msocket/msocket.c	2014-08-28 08:47:22.000000000 +0000
@@ -21,6 +21,7 @@
 #include 
 #endif
 #include 
+#include 
 
 /* Moscow ML includes */
 
@@ -65,11 +66,8 @@
 */
 
 /* Decomposition of sock_ values: */
-#ifdef macintosh
 #define Sock_val(x) (Field(x,0))
-#else
-#define Sock_val(x) ((int) Field(x,0))
-#endif
+
 
 /* Decomposition of addr values: */
 #define Size_addrval(a)   Field(a, 0)
@@ -201,7 +199,11 @@
     /* The native representation of a sinaddrport is struct sockaddr_in */
     return newaddr(sizeof(struct sockaddr_in), AF_INET, sinaddrport);
   }
-  } 
+  default:
+    failwith("msocket: implemented sa_family");
+  }
+  /* NOTREACHED */
+  return Val_unit;
 }
 
 void failure()
@@ -443,7 +445,7 @@
   union saddr addr;
   value res;
 
-  int len = sizeof(addr);
+  socklen_t len = sizeof(addr);
   enter_blocking_section();
   ret = accept(Sock_val(sock), &addr.sockaddr_gen, &len);
   leave_blocking_section();
@@ -612,7 +614,7 @@
   value res;
   union saddr addr;
 
-  int len = sizeof(addr);
+  socklen_t len = sizeof(addr);
 
   enter_blocking_section();
   ret = recvfrom(Sock_val(sock), &Byte(buff, Long_val(offset)), 
@@ -630,7 +632,7 @@
     Push_roots(roots, 1);
     roots[0] = from_saddr(&addr, len);
     res = alloc_tuple(2);
-    modify(&Field(res, 0), Val_int(len));
+    modify(&Field(res, 0), Val_int(ret));
     modify(&Field(res, 1), roots[0]);
     Pop_roots();
   }
diff -Nru mosml-2.01/src/dynlibs/munix/.gitignore mosml-2.10.1/src/dynlibs/munix/.gitignore
--- mosml-2.01/src/dynlibs/munix/.gitignore	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/dynlibs/munix/.gitignore	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,2 @@
+/libmunix.so
+/munix.o
diff -Nru mosml-2.01/src/dynlibs/munix/Makefile mosml-2.10.1/src/dynlibs/munix/Makefile
--- mosml-2.01/src/dynlibs/munix/Makefile	2000-02-16 15:36:57.000000000 +0000
+++ mosml-2.10.1/src/dynlibs/munix/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -4,14 +4,10 @@
 
 include ../../Makefile.inc
 
-OPTS=-fno-defer-pop
-CFLAGS=-Dunix -O2 $(OPTS) $(ADDDYNLIBCFLAGS) -I$(INCDIR)
+#OPTS=-fno-defer-pop
+ROOTDIR:=../..
+CFLAGS=-Dunix -O3 $(OPTS) $(ADDDYNLIBCFLAGS) -I$(CAMLRT)
 
-MOSMLTOOLS=camlrunm $(MOSMLHOME)/tools
-MOSMLC=mosmlc -c
-MOSMLL=mosmlc
-MOSMLLEX=mosmllex
-MOSMLYACC=mosmlyac
 
 all: libmunix.so 
 
@@ -19,10 +15,10 @@
 	$(CC) $(CFLAGS) -c -o munix.o munix.c
 
 libmunix.so: munix.o
-	$(DYNLD) -o libmunix.so munix.o 
+	$(DYNLD) -o libmunix.so munix.o -lc
 
 install:
-	cp libmunix.so $(LIBDIR)
+	$(INSTALL_DATA) libmunix.so $(DESTDIR)$(LIBDIR)
 
 test:
 	gcc -O2 -o sieve sieve.c
diff -Nru mosml-2.01/src/dynlibs/munix/munix.c mosml-2.10.1/src/dynlibs/munix/munix.c
--- mosml-2.01/src/dynlibs/munix/munix.c	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/dynlibs/munix/munix.c	2014-08-28 08:47:22.000000000 +0000
@@ -9,6 +9,8 @@
 #include 
 #include 
 #include 
+#include 
+#include 
 
 /* Moscow ML includes */
 
@@ -59,8 +61,10 @@
     failwith("EINVAL"); break;
   case EISDIR:
     failwith("EISDIR"); break;
+#ifdef ELIBBAD
   case ELIBBAD:
     failwith("ELIBBAD"); break;
+#endif
   case ECHILD:
     failwith("ECHILD"); break;
   case EINTR:
@@ -124,9 +128,9 @@
     printf("Could not exec %s\n", String_val(cmd));
     exit(1);
     // Never gets here
+  }
     return Val_unit;
   }
-}
 
 /* ML type: int -> int */
 EXTERNML value unix_waitpid(value pid) {
diff -Nru mosml-2.01/src/.gitignore mosml-2.10.1/src/.gitignore
--- mosml-2.01/src/.gitignore	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/.gitignore	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,4 @@
+/Mosml.sml
+camlrunm
+config/m.h
+config/s.h
diff -Nru mosml-2.01/src/launch/camlexec.tpl mosml-2.10.1/src/launch/camlexec.tpl
--- mosml-2.01/src/launch/camlexec.tpl	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/launch/camlexec.tpl	2014-08-28 08:47:22.000000000 +0000
@@ -1,3 +1,4 @@
+#include 
 char * runtime_name = "BINDIR/camlrunm";
 char * errmsg = "Cannot exec camlrunm.\n";
 
diff -Nru mosml-2.01/src/launch/.gitignore mosml-2.10.1/src/launch/.gitignore
--- mosml-2.01/src/launch/.gitignore	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/launch/.gitignore	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,8 @@
+camlexec
+camlexec.c
+mosml
+mosmlc
+mosmllex
+testprog
+testprog.ui
+testprog.uo
diff -Nru mosml-2.01/src/launch/Makefile mosml-2.10.1/src/launch/Makefile
--- mosml-2.01/src/launch/Makefile	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/launch/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -8,20 +8,29 @@
 # header cannot be generated until camlrunm is installed in $(BINDIR)...
 
 install:
+	echo "#!$(BINDIR)/camlrunm" > $(DESTDIR)$(LIBDIR)/header;
+	for script in mosml mosmlc mosmllex; do \
+	  ${INSTALL_SCRIPT} $$script $(DESTDIR)$(BINDIR)/$$script; \
+	  chmod a+x $(DESTDIR)$(BINDIR)/$$script; \
+	done
+
+old_install:
 	(echo "#!$(BINDIR)/camlrunm"; \
-	 echo "exit 2"; \
-	 cat testprog) > /tmp/testscr
+	  echo "exit 2"; \
+	  cat testprog) > /tmp/testscr
 	chmod a+x /tmp/testscr
 	sh -c 'if sh -c /tmp/testscr 2>/dev/null; \
-               then echo "#!$(BINDIR)/camlrunm" > $(LIBDIR)/header; \
-               else ${INSTALL_PROGRAM} camlexec$(EXE) $(LIBDIR)/header; \
-               fi'
+                then echo "#!$(BINDIR)/camlrunm" > $(LIBDIR)/header; \
+                else ${INSTALL_PROGRAM} camlexec$(EXE) $(LIBDIR)/header; \
+                fi'
 	rm -f /tmp/testscr
+	echo "#!$(BINDIR)/camlrunm" > $(DESTDIR)$(LIBDIR)/header;
 	for script in mosml mosmlc mosmllex; do \
 	  ${INSTALL_SCRIPT} $$script $(BINDIR)/$$script; \
 	  chmod a+x $(BINDIR)/$$script; \
 	done
 
+
 mosml: mosml.tpl
 	sed -e "s|LIBDIR|$(LIBDIR)|" -e "s|BINDIR|$(BINDIR)|" mosml.tpl > mosml
 
diff -Nru mosml-2.01/src/launch.w32/.gitignore mosml-2.10.1/src/launch.w32/.gitignore
--- mosml-2.01/src/launch.w32/.gitignore	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/launch.w32/.gitignore	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,3 @@
+/*.exe
+/*.o
+*~
\ No newline at end of file
diff -Nru mosml-2.01/src/launch.w32/Makefile mosml-2.10.1/src/launch.w32/Makefile
--- mosml-2.01/src/launch.w32/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/launch.w32/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,44 @@
+# Makefile for cross compiling to WIN32
+
+CFLAGS=-O2
+
+HEADER_OBJS= mosmlexe.o
+CAMLRUNM_OBJS= camlrunm.o
+MOSMLC_OBJS= mosmlc.o driver.o
+MOSML_OBJS= mosml.o driver.o
+
+include ../Makefile.inc
+
+all: header.exe camlrunm.exe mosmlc.exe mosml.exe
+
+install:
+	$(INSTALL_PROGRAM) header.exe $(DESTDIR)$(LIBDIR)/header
+	$(INSTALL_PROGRAM) camlrunm.exe $(DESTDIR)$(BINDIR)/camlrunm.exe
+	$(INSTALL_PROGRAM) mosmlc.exe $(DESTDIR)$(BINDIR)/mosmlc.exe
+	$(INSTALL_PROGRAM) mosml.exe $(DESTDIR)$(BINDIR)/mosml.exe
+
+clean:
+	rm *.exe
+	rm *.o
+
+header.exe: $(HEADER_OBJS)
+	$(CC) $(CFLAGS) -o header.exe $(HEADER_OBJS) ../runtime/camlrt.dll
+
+camlrunm.exe: $(CAMLRUNM_OBJS)
+	$(CC) $(CFLAGS) -o camlrunm.exe $(CAMLRUNM_OBJS) ../runtime/camlrt.dll
+
+mosmlc.exe: $(MOSMLC_OBJS)
+	$(CC) $(CFLAGS) -o mosmlc.exe $(MOSMLC_OBJS)
+
+mosml.exe: $(MOSML_OBJS)
+	$(CC) $(CFLAGS) -o mosml.exe $(MOSML_OBJS) ../runtime/camlrt.dll
+
+#.c.o:
+#	$(CC) $(CFLAGS) -c $<
+
+mosmlexe.o: driver.h mosmlexe.c
+camlrunm.o: driver.h camlrunm.c
+mosmlc.o: driver.h mosmlc.c
+mosml.o: driver.h mosml.c
+driver.o: driver.h driver.c
+
diff -Nru mosml-2.01/src/launch.w32/mosmlc.c mosml-2.10.1/src/launch.w32/mosmlc.c
--- mosml-2.01/src/launch.w32/mosmlc.c	2000-08-02 12:06:16.000000000 +0000
+++ mosml-2.10.1/src/launch.w32/mosmlc.c	2014-08-28 08:47:22.000000000 +0000
@@ -4,7 +4,7 @@
 #include 
 #include 
 #include 
-#include 
+#include 
 #include "driver.h"
 
 // -----
diff -Nru mosml-2.01/src/lex/.gitignore mosml-2.10.1/src/lex/.gitignore
--- mosml-2.01/src/lex/.gitignore	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/lex/.gitignore	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,9 @@
+*.ui
+*.uo
+
+# Files derived from .lex and .grm files
+Grammar.sig
+Grammar.sml
+Scanner.sml
+
+mosmllex
diff -Nru mosml-2.01/src/lex/Makefile mosml-2.10.1/src/lex/Makefile
--- mosml-2.01/src/lex/Makefile	2000-01-24 21:59:00.000000000 +0000
+++ mosml-2.10.1/src/lex/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -37,7 +37,7 @@
 	cd test; make clean
 
 install:
-	${INSTALL_DATA} mosmllex $(LIBDIR)
+	${INSTALL_DATA} mosmllex $(DESTDIR)$(LIBDIR)
 
 Grammar.sml Grammar.sig: Grammar.grm
 	$(MOSMLYACC) Grammar.grm
diff -Nru mosml-2.01/src/lex/Scan_aux.sml mosml-2.10.1/src/lex/Scan_aux.sml
--- mosml-2.01/src/lex/Scan_aux.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/lex/Scan_aux.sml	2014-08-28 08:47:22.000000000 +0000
@@ -25,7 +25,7 @@
   in
     if !string_index >= len then
       let val new_buff = array(len * 2, #" ") in
-        copy { src= !string_buff, si=0, len = NONE, dst= new_buff, di=0 };
+        copy { src= !string_buff, dst= new_buff, di=0 };
         string_buff := new_buff
       end
     else ();
@@ -35,11 +35,12 @@
 ;
 
 fun get_stored_string () =
-  let val s = CharArray.extract(!string_buff, 0, SOME (!string_index)) in
-    string_buff := initial_string_buffer;
-    s
-  end
-;
+  let open CharArraySlice
+      val s = vector(slice(!string_buff, 0, SOME (!string_index))) 
+  in
+      string_buff := initial_string_buffer;
+      s
+  end;
 
 val char_for_backslash = fn
     #"n" => #"\010" (* #"\n" *)
diff -Nru mosml-2.01/src/Makedefs.bin mosml-2.10.1/src/Makedefs.bin
--- mosml-2.01/src/Makedefs.bin	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/Makedefs.bin	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,71 @@
+# Win32 configuration Makefile for Moscow ML
+
+# Where to install stuff
+
+MOSMLHOME=D:\mosml
+
+# To compile the runtime system camlrunm with support for
+# dynamically loadable libraries (DDLs), uncomment these:
+
+ADDPRIMS=dynlib.c
+ADDOBJS=dynlib.obj
+# ADDLIBS=
+# ADDCFLAGS=
+
+# For Visual C++ use:
+CC=cl
+CPP=cl -C -EP -Dwin32 -Umsdos -Uunix
+STRIP=rem
+EXE=.exe
+# ADDLIBS=
+# ADDCFLAGS=
+
+# For GNU-WIN32, use:
+#CC=gcc
+#CPP=cpp -P -traditional -Dwin32 -Umsdos -Uunix
+#STRIP=strip
+#AWK=gawk
+#EXE=.exe
+
+# ---------- You shouldn't need to edit below this line ------------
+
+# BINDIR contains true executable files, such as scripts
+# LIBDIR contains bytecode files (such as mosmlcmp and library units)
+
+BINDIR=$(MOSMLHOME)\bin
+LIBDIR=$(MOSMLHOME)\lib
+TOOLDIR=$(MOSMLHOME)\tools
+
+CAMLRT=..\runtime
+
+MOSMLTOOLS=..\tools
+
+MOSMLC=..\camlrunm.exe ..\mosmlcmp.w32 -stdlib ..\mosmllib -P none
+MOSMLL=..\camlrunm.exe ..\mosmllnk.w32 -stdlib ..\mosmllib -P none
+MOSMLLDOS=..\camlrunm.exe ..\mosmllnk.dos -stdlib ..\mosmllib -P none
+
+MOSMLLEX=..\camlrunm.exe ..\mosmllex.w32
+MOSMLYACC=..\mosmlyac\mosmlyac.exe
+MOSMLCUT=..\camlrunm.exe ..\cutdeps.w32
+MOSMLDEP=..\camlrunm.exe ..\mosmldep.w32
+
+# For cross-compiling to MS DOS (from Linux) (development only)
+# CPP=\lib\cpp -P -traditional -Uunix -Dmsdos -Uwin32
+
+.SUFFIXES :
+.SUFFIXES : .mlp .sml .sig .ui .uo .lex .c .obj
+
+.sig.ui:
+	$(MOSMLC) $(COMPFLAGS) $<
+
+.sml.uo:
+	$(MOSMLC) $(COMPFLAGS) $<
+
+.mlp.sml:
+	$(CPP) $< > $*.sml
+
+.lex.sml:
+	$(MOSMLLEX) $<
+
+.c.obj:
+	$(CC) -c $(CFLAGS) -Fo$@ $<
diff -Nru mosml-2.01/src/Makedefs.w32 mosml-2.10.1/src/Makedefs.w32
--- mosml-2.01/src/Makedefs.w32	2000-01-21 10:07:12.000000000 +0000
+++ mosml-2.10.1/src/Makedefs.w32	2014-08-28 08:47:22.000000000 +0000
@@ -2,7 +2,7 @@
 
 # Where to install stuff
 
-MOSMLHOME=D:\mosml
+MOSMLHOME=C:\mosml
 
 # To compile the runtime system camlrunm with support for
 # dynamically loadable libraries (DDLs), uncomment these:
diff -Nru mosml-2.01/src/Makefile mosml-2.10.1/src/Makefile
--- mosml-2.01/src/Makefile	2000-07-18 14:16:44.000000000 +0000
+++ mosml-2.10.1/src/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -1,90 +1,145 @@
 # Unix Makefile for Moscow ML
 
 # To build the Moscow ML system on a new machine for the first time, 
-#	(1) edit MOSMLHOME etc. in file Makefile.inc
+#	(1) edit PREFIX etc. in file Makefile.inc
 #	(2) execute `make world'
 
 # To install it
 
 #	(1) execute `make install'
-#	(2) edit MOSMLHOME in file mosml/tools/Makefile.stub
+#	(2) edit PREFIX in file mosml/tools/Makefile.stub
 
 # ------------------------------------------------------------
 
 include Makefile.inc
 
+# Basis dynlibs
+BASISDYNLIB=
+ifeq ($(DYNLIBSUPPORT),true)
+  BASISDYNLIB=intinf msocket munix
+endif
+
+
 # Build the entire system for the first time
 
 world:
-	cd config; sh autoconf $(CC)
-	cd runtime; make all
+	cd config; $(MAKE) all
+	cd runtime; $(MAKE) all
 	cp runtime/camlrunm$(EXE) .
-	cd mosmlyac; make all
-	cd mosmllib; make all
-	cd compiler; make all
-	cd toolssrc; make all
-	cd lex; make all
-	cd launch; make all
+	cd mosmlyac; $(MAKE) all
+	cd mosmllib; $(MAKE) all
+	cd compiler; $(MAKE) all
+	cd toolssrc; $(MAKE) all
+	cd lex; $(MAKE) all
+	cd launch; $(MAKE) all
+	$(MAKE) basisdynlib
+
+# Cross compilation to Win
+cross_w32:
+	cd config; $(MAKE) all
+	cd runtime; $(MAKE) all
+	cp runtime/camlrunm$(EXE) .
+	$(MAKE) -C mosmlyac all
+	$(MAKE) -C runtime clean
+	$(MAKE) -C mosmlyac clean_obj
+	$(MAKE) -C config UNAME_S=Cross_W32 w32
+	$(MAKE) -C runtime UNAME_S=Cross_W32 camlrt.dll
+	$(MAKE) -C mosmlyac UNAME_S=Cross_W32 all
+	$(MAKE) -C mosmllib UNAME_S=Cross_W32 all
+	$(MAKE) -C compiler UNAME_S=Cross_W32 w32
+	$(MAKE) -C toolssrc UNAME_S=Cross_W32 all
+	$(MAKE) -C lex UNAME_S=Cross_W32 all
+	$(MAKE) -C launch.w32 UNAME_S=Cross_W32 all
+
+	test -d $(DESTDIR)$(BINDIR) || mkdir -p $(DESTDIR)$(BINDIR)
+	test -d $(DESTDIR)$(LIBDIR) || mkdir -p $(DESTDIR)$(LIBDIR)
+	test -d $(DESTDIR)$(INCDIR) || mkdir -p $(DESTDIR)$(INCDIR)
+	test -d $(DESTDIR)$(DOCDIR) || mkdir -p $(DESTDIR)$(DOCDIR)
+	test -d $(DESTDIR)$(TOOLDIR) || mkdir -p $(DESTDIR)$(TOOLDIR)
+
+	$(MAKE) -C runtime UNAME_S=Cross_W32 install_w32
+	$(MAKE) -C mosmlyac UNAME_S=Cross_W32 install
+	$(MAKE) -C mosmllib UNAME_S=Cross_W32 install
+	$(MAKE) -C compiler UNAME_S=Cross_W32 install_w32
+	$(MAKE) -C toolssrc UNAME_S=Cross_W32 install
+	$(MAKE) -C lex UNAME_S=Cross_W32 install
+	$(MAKE) -C launch.w32 UNAME_S=Cross_W32 install
+	$(MAKE) -C doc install
+#	$(MAKE) basisdynlib
+
 
 uptodate:
-	cd runtime; make all
+	cd runtime; $(MAKE) all
 	cp runtime/camlrunm$(EXE) .
-	cd mosmlyac; make all
-	cd mosmllib; make all
-	cd compiler; make all
-	cd toolssrc; make all
-	cd lex; make all
-	cd launch; make all
+	cd mosmlyac; $(MAKE) all
+	cd mosmllib; $(MAKE) all
+	cd compiler; $(MAKE) all
+	cd toolssrc; $(MAKE) all
+	cd lex; $(MAKE) all
+	cd launch; $(MAKE) all
 
 # Recompile all Mosml code from scratch
 again:
-	cd mosmllib; make clean all
-	cd compiler; make clean all
-	cd toolssrc; make clean all
-	cd lex; make clean all
+	cd mosmllib; $(MAKE) clean all
+	cd compiler; $(MAKE) clean all
+	cd toolssrc; $(MAKE) clean all
+	cd lex; $(MAKE) clean all
+
+
+basisdynlib:
+	for i in $(BASISDYNLIB); do \
+	  (cd dynlibs/$$i; $(MAKE)) || exit $$?; \
+	done
+
 
 # Install the Mosml system
 install:
-	test -d $(BINDIR) || mkdir -p $(BINDIR)
-	test -d $(LIBDIR) || mkdir -p $(LIBDIR)
-	test -d $(INCDIR) || mkdir -p $(INCDIR)
-	test -d $(DOCDIR) || mkdir -p $(DOCDIR)
-	test -d $(TOOLDIR) || mkdir -p $(TOOLDIR)
-	cd runtime; make install
-	cd config; make install
-	cd launch; make all install
-	cd mosmlyac; make install
-	cd mosmllib; make install
-	cd compiler; make install
-	cd toolssrc; make install
-	cd lex; make install
-	(cd $(INCDIR)/..; rm -f config; ln -s include config)
-	cd doc; make install
+	test -d $(DESTDIR)$(BINDIR) || mkdir -p $(DESTDIR)$(BINDIR)
+	test -d $(DESTDIR)$(LIBDIR) || mkdir -p $(DESTDIR)$(LIBDIR)
+	test -d $(DESTDIR)$(INCDIR) || mkdir -p $(DESTDIR)$(INCDIR)
+	test -d $(DESTDIR)$(DOCDIR) || mkdir -p $(DESTDIR)$(DOCDIR)
+	test -d $(DESTDIR)$(TOOLDIR) || mkdir -p $(DESTDIR)$(TOOLDIR)
+	cd runtime; $(MAKE) install
+#	cd config; $(MAKE) install
+	cd launch; $(MAKE) all install
+	cd mosmlyac; $(MAKE) install
+	cd mosmllib; $(MAKE) install
+	cd compiler; $(MAKE) install
+	cd toolssrc; $(MAKE) install
+	cd lex; $(MAKE) install
+	cd doc; $(MAKE) install
+	$(MAKE) basisdynlib_install
+
+basisdynlib_install:
+	for i in $(BASISDYNLIB); do \
+	  (cd dynlibs/$$i; $(MAKE) install) || exit $$?; \
+	done
+
 
 # Remove all generated files
 clean:
-	cd config; make clean
-	cd runtime; make clean
-	cd launch; make clean
-	cd mosmlyac; make clean
-	cd mosmllib; make clean
-	cd compiler; make clean
-	cd toolssrc; make clean
-	cd lex; make clean
-	cd test; make clean
-	cd mosmllib/test; make clean
-	cd ../examples; make clean	
-	cd dynlibs; make clean
+	cd config; $(MAKE) clean
+	cd runtime; $(MAKE) clean
+	cd launch; $(MAKE) clean
+	cd mosmlyac; $(MAKE) clean
+	cd mosmllib; $(MAKE) clean
+	cd compiler; $(MAKE) clean
+	cd toolssrc; $(MAKE) clean
+	cd lex; $(MAKE) clean
+	cd test; $(MAKE) clean
+	cd mosmllib/test; $(MAKE) clean
+	cd ../examples; $(MAKE) clean	
+	cd dynlibs; $(MAKE) clean
 	rm -f camlrunm$(EXE)
-	cd doc; make clean
+	cd doc; $(MAKE) clean
 
 dynlibs:
-	cd dynlibs; make
+	cd dynlibs; $(MAKE)
 
 # Rebuild the dependencies in all Makefiles.
 # You can't do this unless you have a compiled runtime system.
 depend:
-	cd mosmllib; make depend
-	cd mosmlyac; make all
-	cd compiler; make depend
-	cd lex; make depend
+	cd mosmllib; $(MAKE) depend
+	cd mosmlyac; $(MAKE) all
+	cd compiler; $(MAKE) depend
+	cd lex; $(MAKE) depend
diff -Nru mosml-2.01/src/Makefile.inc mosml-2.10.1/src/Makefile.inc
--- mosml-2.01/src/Makefile.inc	2004-01-19 15:03:37.000000000 +0000
+++ mosml-2.10.1/src/Makefile.inc	2014-08-28 08:47:22.000000000 +0000
@@ -1,8 +1,28 @@
-# Unix configuration Makefile for Moscow ML
+# Unix configuration Makefile for Moscow ML          -*- mode: makefile -*-
 
 # Where to install stuff
+PREFIX=/usr/local
 
-MOSMLHOME=${HOME}/mosml
+# BINDIR contains true executable files, such as scripts
+# LIBDIR contains bytecode files (such as mosmlcmp and library units), and .dll/.so for dynlibs. 
+#        RPATH is set to include LIBDIR
+# INCDIR contains the runtime system header files (for compiling dynlibs)
+# DOCDIR contains documentation
+
+BINDIR=${PREFIX}/bin
+LIBDIR=${PREFIX}/lib/mosml
+INCDIR=${PREFIX}/include/mosml
+DOCDIR=${PREFIX}/share/doc/mosml
+TOOLDIR=${PREFIX}/share/mosml/tools
+
+### Where to install the man pages
+# Man pages for commands go in $(MANDIR)/man$(MANEXT)
+MANDIR=${PREFIX}/man
+MANEXT=1
+
+
+# The version
+VERSION=2.10
 
 # Various utility programs
 INSTALL_PROGRAM=cp
@@ -10,38 +30,89 @@
 INSTALL_DATA=cp
 PERL=perl
 
+BASELIBS=-lm
+
+# This works with most systems, including MacOS X with XCode installed:
+
+CC=gcc
+# CC=gcc -mmacosx-version-min=10.7 # for building OS X package
+# CC=/usr/sepp/bin/gcc		# Solaris at KVL
+
 # To compile the runtime system camlrunm with support for
-# dynamically loadable libraries (DDLs), uncomment these:
+# dynamically loadable libraries (DDLs), set DYNLIBSUPPORT to true
+DYNLIBSUPPORT=true
+
+ifeq ($(DYNLIBSUPPORT),true)
+  ADDPRIMS=dynlib.c
+  ADDOBJS=dynlib.o
+endif
 
-ADDPRIMS=dynlib.c
-ADDOBJS=dynlib.o
 ADDRUNLIBS=-ldl
-ADDRUNCFLAGS=
-ADDDYNLIBCFLAGS=
+ADDRUNCFLAGS=-fPIC
+ADDDYNLIBCFLAGS=-fPIC
 
-# To compile the runtime system camlrunm under Cygwin with support for
-# dynamically loadable libraries (DDLs), uncomment these:
 
-ADDPRIMS=dynlib.c
-ADDOBJS=dynlib.o
-ADDRUNCFLAGS=
-ADDDYNLIBCFLAGS=
+# Automatic detection of OS
+# If you need to override the detection, set UNAME_S to Custom and add your configuration there.
+# 
+UNAME_S := $(shell sh -c 'uname -s 2>/dev/null || echo not')
+
+
+# We choose to avoid "if .. else if .. else .. endif endif"
+# because maintaining the nesting to match is a pain.  If
+# we had "elif" things would have been much nicer...
+
+ifeq ($(UNAME_S),Linux)
+	CPP=cpp -P -traditional -Dunix -Umsdos
+	STRIP=strip -S
+	LD=gcc -rdynamic -Wl,-rpath,$(LIBDIR)
+	DYNLD=gcc -shared
+endif
+ifeq ($(UNAME_S),Darwin) 	# For MacOS X, use the same as Linux except DYNDL
+	CPP=cpp -P -traditional -Dunix -Umsdos
+	STRIP=strip -S
+	LD=$(CC) -rdynamic -Wl,-rpath,$(LIBDIR)
+	DYNLD=$(LD) -bundle -undefined dynamic_lookup
+endif
+ifeq ($(UNAME_S),Cross_W32)
+	CC=i586-mingw32msvc-gcc
+	CPP=cpp -P -traditional -Umsdos -Uunix -Dwin32
+	ADDRUNLIBS=
+	ADDRUNCFLAGS=
+	ADDDYNLIBCFLAGS=
+	STRIP=strip -S
+	EXE=.exe
+	LD=$(CC)
+	DYNLD=$(CC) -shared
+endif
+ifeq ($(UNAME_S),Custom) # Your configuration here
+error:
+	@echo "Unknow OS $(UNAME_S), please update Makefile.inc and send a patch to mosml.org"
+endif
+
+# Note for contributers, please check and convert the following to your platform of choice
+# For FreeBSD, use:
+# -----------------
+# CPP=/usr/bin/cpp -P -traditional -Dunix -Umsdos
+# STRIP=strip
+# LD=gcc -export-dynamic -Wl,-rpath,$(LIBDIR)
+# DYNLD=ld -shared
+# ADDRUNLIBS=
 
-# For Linux (x86 or Alpha), use:
-# ------------------------------
-CPP=/lib/cpp -P -traditional -Dunix -Umsdos
-STRIP=strip
-LD=gcc -rdynamic
-DYNLD=ld -shared
 
 # For Cygwin 20.1, use:
 # ---------------------
 # MOSMLHOME=/mosml
 # CPP=/lib/cpp -P -traditional -Dunix -Umsdos
 # STRIP=strip
-# LD=gcc -Wl,--export-dynamic
+# LD=gcc -Wl,--export-dynamic -Wl,-rpath,$(LIBDIR)
 # DYNLD=ld -shared
 # EXE=.exe
+# # For dynamically loadable libraries (DDLs) under Cygwin:
+# ADDPRIMS=dynlib.c
+# ADDOBJS=dynlib.o
+# ADDRUNCFLAGS=
+# ADDDYNLIBCFLAGS=
 
 # For NetBSD, use:
 # ------------------------
@@ -63,7 +134,7 @@
 # ADDDYNLIBCFLAGS=
 
 # If the above fails with dynlibs, try this:
-# LD=gcc -Wl,--export-dynamic
+# LD=gcc -Wl,--export-dynamic -Wl,-rpath,$(LIBDIR)
 
 
 # For HP-UX 9, use:
@@ -107,34 +178,22 @@
 SHELL=/bin/sh
 
 # ---------- You shouldn't need to edit below this line ------------
+ROOTDIR:=..
 
-# BINDIR contains true executable files, such as scripts
-# LIBDIR contains bytecode files (such as mosmlcmp and library units)
-# INCDIR contains the runtime system header files (for compiling dynlibs)
-# DOCDIR contains documentation
+CAMLRT=$(ROOTDIR)/runtime
 
-BINDIR=${MOSMLHOME}/bin
-LIBDIR=${MOSMLHOME}/lib
-INCDIR=${MOSMLHOME}/include
-DOCDIR=${MOSMLHOME}/doc
-TOOLDIR=${MOSMLHOME}/tools
-# LIBDIR=${MOSMLHOME}/lib/moscow_ml
-# TOOLDIR=${MOSMLHOME}/libexec/moscow_ml
-
-CAMLRT=../runtime
-
-MOSMLTOOLS=../tools
-
-MOSMLC=../camlrunm ../mosmlcmp -stdlib ../mosmllib -P none
-MOSMLL=../camlrunm ../mosmllnk -stdlib ../mosmllib -P none
-MOSMLLDOS=../camlrunm ../mosmllnk.dos -stdlib ../mosmllib -P none
-MOSMLLW32=../camlrunm ../mosmllnk.w32 -stdlib ../mosmllib -P none
-MOSMLLNEW=../camlrunm ../mosmllnk.new -stdlib ../mosmllib -P none
-
-MOSMLLEX=../camlrunm ../mosmllex
-MOSMLYACC=../mosmlyac/mosmlyac
-MOSMLCUT=../camlrunm ../cutdeps 
-MOSMLDEP=../camlrunm ../mosmldep
+MOSMLTOOLS=$(ROOTDIR)/tools
+
+MOSMLC=$(ROOTDIR)/camlrunm $(ROOTDIR)/mosmlcmp -stdlib $(ROOTDIR)/mosmllib -P none
+MOSMLL=$(ROOTDIR)/camlrunm $(ROOTDIR)/mosmllnk -stdlib $(ROOTDIR)/mosmllib -P none
+MOSMLLDOS=$(ROOTDIR)/camlrunm $(ROOTDIR)/mosmllnk.dos -stdlib $(ROOTDIR)/mosmllib -P none
+MOSMLLW32=$(ROOTDIR)/camlrunm $(ROOTDIR)/mosmllnk.w32 -stdlib $(ROOTDIR)/mosmllib -P none
+MOSMLLNEW=$(ROOTDIR)/camlrunm $(ROOTDIR)/mosmllnk.new -stdlib $(ROOTDIR)/mosmllib -P none
+
+MOSMLLEX=$(ROOTDIR)/camlrunm $(ROOTDIR)/mosmllex
+MOSMLYACC=$(ROOTDIR)/mosmlyac/mosmlyac
+MOSMLCUT=$(ROOTDIR)/camlrunm $(ROOTDIR)/cutdeps 
+MOSMLDEP=$(ROOTDIR)/camlrunm $(ROOTDIR)/mosmldep
 
 # For cross-compiling to MS DOS (from Linux) (development only)
 # CPP=/lib/cpp -P -traditional -Uunix -Dmsdos -Uwin32
@@ -142,8 +201,6 @@
 # For cross-compiling to Win 32 (from Linux) (development only)
 # CPP=/lib/cpp -P -traditional -Umsdos -Uunix -Dwin32
 
-CC=gcc
-
 .SUFFIXES :
 .SUFFIXES : .sml .sig .ui .uo .mlp .lex .c .o
 
diff -Nru mosml-2.01/src/mktounx.bat mosml-2.10.1/src/mktounx.bat
--- mosml-2.01/src/mktounx.bat	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mktounx.bat	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,16 @@
+REM On Win32, switch Makefiles from Win32 Makefiles to Unix Makefiles, 
+REM if not already done.
+
+if exist Makefile.w32 (
+  echo "Already in Unix mode"
+  exit /B 1
+)
+
+echo "Renaming all Makefile to Makefile.w32"
+
+FOR /F  %%f IN ('dir /S /B Makefile') DO move /Y %%f %%f.w32
+
+echo "Renaming all Makefile.unx to Makefile"
+
+FOR /F  %%f IN ('dir /S /B Makefile.unx') DO move /Y %%f %%~dpfMakefile
+
diff -Nru mosml-2.01/src/mktow32.bat mosml-2.10.1/src/mktow32.bat
--- mosml-2.01/src/mktow32.bat	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mktow32.bat	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,16 @@
+REM On Win32, switch Makefiles from Unix Makefiles to Win32 Makefiles, 
+REM if not already done.
+if exist Makefile.unx (
+  echo "Already in Win32 mode"
+  exit /B 1
+)
+
+echo "Renaming all Makefile to Makefile.unx"
+
+
+FOR /F  %%f IN ('dir /S /B Makefile') DO move /Y %%f %%f.unx
+
+echo "Renaming all Makefile.w32 to Makefile"
+
+FOR /F  %%f IN ('dir /S /B Makefile.w32') DO move /Y %%f %%~dpfMakefile
+
Binary files /tmp/HAzJFmIrvn/mosml-2.01/src/mosmlcmp and /tmp/A1vl5z0ZBv/mosml-2.10.1/src/mosmlcmp differ
Binary files /tmp/HAzJFmIrvn/mosml-2.01/src/mosmlcmp.w32 and /tmp/A1vl5z0ZBv/mosml-2.10.1/src/mosmlcmp.w32 differ
Binary files /tmp/HAzJFmIrvn/mosml-2.01/src/mosmldep and /tmp/A1vl5z0ZBv/mosml-2.10.1/src/mosmldep differ
Binary files /tmp/HAzJFmIrvn/mosml-2.01/src/mosmldep.w32 and /tmp/A1vl5z0ZBv/mosml-2.10.1/src/mosmldep.w32 differ
Binary files /tmp/HAzJFmIrvn/mosml-2.01/src/mosmllex and /tmp/A1vl5z0ZBv/mosml-2.10.1/src/mosmllex differ
Binary files /tmp/HAzJFmIrvn/mosml-2.01/src/mosmllex.w32 and /tmp/A1vl5z0ZBv/mosml-2.10.1/src/mosmllex.w32 differ
diff -Nru mosml-2.01/src/mosmllib/Array2.sml mosml-2.10.1/src/mosmllib/Array2.sml
--- mosml-2.01/src/mosmllib/Array2.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Array2.sml	2014-08-28 08:47:22.000000000 +0000
@@ -37,13 +37,13 @@
 	let val f00 = f(0, 0)
 	    val arr = Vector.tabulate(m, fn i => Array.array(n, f00))
 	    (* Column 0: do not apply f to (0,0) again: *)
-	    val _ = Vector.appi (fn (r, a) => Array.update(a, 0, f(r, 0))) 
-		                (arr, 1, NONE); 		
+	    val _ = VectorSlice.appi (fn (r, a) => Array.update(a, 0, f(r, 0))) 
+		                (VectorSlice.slice(arr, 1, NONE));
 	    (* Remaining columns: loop, updating all rows: *)
 	    fun loop c = 
 		if c < n then  
 		    (Vector.appi (fn (r, a) => Array.update(a, c, f(r, c))) 
-		                 (arr, 0, NONE); 
+		                 arr;
 		     loop (c+1))
 		else ()
 	in loop 1; ref (arr, m, n) end
@@ -61,7 +61,7 @@
 fun update(ref (a,m,n), i, j, x) = Array.update(Vector.sub(a, i), j, x);
 
 fun row (ref (a, _, _), i) = 
-    Array.extract(Vector.sub(a, i), 0, NONE);
+    Array.vector(Vector.sub(a, i));
 
 fun column (ref (a, m, n), j) = 
     if j<0 orelse j>=n then raise Subscript
@@ -86,10 +86,11 @@
     else i+n;
 
 fun foldi RowMajor f b { base = ref (a, m, n), row, col, nrows, ncols } = 
-    Vector.foldli 
+    VectorSlice.foldli 
            (fn (i, xs, res) => 
-	       Array.foldli (fn (j,x,res) => f(i,j,x,res)) res (xs,col,ncols))
-	   b (a, row, nrows)
+	       ArraySlice.foldli 
+	       (fn (j,x,res) => f(i,j,x,res)) res (ArraySlice.slice(xs,col,ncols)))
+	   b (VectorSlice.slice(a, row, nrows))
   | foldi ColMajor f b { base = ref (a, m, n), row, col, nrows, ncols } = 
     let val stoprow = stop m row nrows
 	val stopcol = stop n col ncols
@@ -107,9 +108,10 @@
     fold ColMajor (fn (a, _) => f a) () arr
 
 fun appi RowMajor f { base = ref (a, _, _), row, col, nrows, ncols } =
-    Vector.appi 
-          (fn (i, xs) => Array.appi (fn (j, x) => f(i, j, x)) (xs, col, ncols))
-	  (a, row, nrows)
+    VectorSlice.appi 
+          (fn (i, xs) => ArraySlice.appi 
+	   (fn (j, x) => f(i, j, x)) (ArraySlice.slice(xs, col, ncols)))
+	  (VectorSlice.slice(a, row, nrows))
   | appi ColMajor f reg =
     foldi ColMajor (fn (i, j, a, _) => f (i, j, a)) () reg
 
@@ -120,10 +122,10 @@
           {base=arr, row=0, col=0, nrows=NONE, ncols=NONE}
 
 fun modifyi RowMajor f { base = ref (a, _, _), row, col, nrows, ncols } =
-    Vector.appi 
-          (fn (i, xs) => Array.modifyi (fn (j, x) => f(i, j, x)) 
-	                               (xs, col, ncols))
-	  (a, row, nrows)
+    VectorSlice.appi 
+          (fn (i, xs) => ArraySlice.modifyi (fn (j, x) => f(i, j, x)) 
+	                               (ArraySlice.slice(xs, col, ncols)))
+	  (VectorSlice.slice(a, row, nrows))
   | modifyi ColMajor f (reg as {base, ...}) =
     foldi ColMajor (fn (i, j, a, _) => update(base, i, j, f (i, j, a))) () reg
 
@@ -134,18 +136,18 @@
 	fun bottomUp from_row to_row = 
 	    if from_row < src_row then ()
 	    else
-		(Array.copy { src = Vector.sub(sa, from_row), 
-			      si = src_col, len = ncols,
-			      dst = Vector.sub(da, to_row),
-			      di = dst_col };
+		(ArraySlice.copy { src = ArraySlice.slice
+				    (Vector.sub(sa, from_row), src_col, ncols),
+				   dst = Vector.sub(da, to_row),
+				   di = dst_col };
 		 bottomUp (from_row-1) (to_row-1))
 	fun topDown from_row to_row = 
 	    if from_row >= stoprow then ()
 	    else
-		(Array.copy { src = Vector.sub(sa, from_row), 
-			      si = src_col, len = ncols,
-			      dst = Vector.sub(da, to_row),
-			      di = dst_col };
+		(ArraySlice.copy { src = ArraySlice.slice
+				    (Vector.sub(sa, from_row), src_col, ncols),
+				   dst = Vector.sub(da, to_row),
+				   di = dst_col };
 		 topDown (from_row+1) (to_row+1))
     in
 	if src_row <= dst_row then (* top dst overlaps with bot src; 
diff -Nru mosml-2.01/src/mosmllib/Array.mlp mosml-2.10.1/src/mosmllib/Array.mlp
--- mosml-2.01/src/mosmllib/Array.mlp	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Array.mlp	2014-08-28 08:47:22.000000000 +0000
@@ -1,16 +1,15 @@
-(* Array -- new basis 1994-11-21, 1995-05-21 *)
+(* Array -- new basis 1994-11-21, 1995-05-21, 2000-10-18 *)
 
 structure Array :> Array = struct
 
 (* In fact, type 'a array = 'a array_ ref, but for the static equality
  * type to be right, we need to declare it a prim_EQtype:              *)
 prim_EQtype 'a array;
+type 'a vector = 'a Vector.vector;
 
 local 
     prim_type 'a array_;
 
-    type 'a vector = 'a Vector.vector;
-
     prim_val length_  : 'a array_ -> int               = 1 "vect_length";
     prim_val lengthv_ : 'a vector -> int               = 1 "vect_length";
 
@@ -80,57 +79,67 @@
 	else update_ a i v
     end
 
-fun extract (a : 'a array, i, slicelen) =
+fun vector (a : 'a array) =
     let val a = from_array a : 'a array_ 
-	val n = case slicelen of NONE => length_ a - i | SOME n => n
-	val newvec = if i<0 orelse n<0 orelse i+n > length_ a 
-			 then raise Subscript
-		     else vector_ n () : 'a vector
+	val n = length_ a
+	val newvec = vector_ n () : 'a vector
 	fun copy j = 
 	    if j length_ a1 - i1 | SOME k => k
+	val n = length_ a1
     in
-	if n<0 orelse i1<0 orelse i1+n > length_ a1
-	    orelse i2<0 orelse i2+n > length_ a2
-	then 
+	if i2<0 orelse i2+n > length_ a2 then 
 	    raise Subscript
-	else if i1 < i2 then		(* copy from high to low *)
-	         let fun hi2lo j = 
-		     if j >= 0 then
-			 (update_ a2 (i2+j) (sub_ a1 (i1+j)); hi2lo (j-1))
-		     else ()
-		 in hi2lo (n-1) end
-	     else                       (* i1 >= i2, copy from low to high *)
-		 let fun lo2hi j = 
-		     if j < n then
-			 (update_ a2 (i2+j) (sub_ a1 (i1+j)); lo2hi (j+1))
-		     else ()
-		 in lo2hi 0 end
+	else		(* copy from high to low *)
+	    let fun hi2lo j = 
+		    if j >= 0 then
+			(update_ a2 (i2+j) (sub_ a1 j); hi2lo (j-1))
+		    else ()
+	    in hi2lo (n-1) end
     end
 
-fun copyVec {src=a1: 'a vector, si=i1, len, dst=a2: 'a array, di=i2} =
+fun copyVec {src=a1: 'a vector, dst=a2: 'a array, di=i2} =
     let val a2 = from_array a2
-	val n = case len of NONE => lengthv_ a1 - i1 | SOME k => k
+	val n = lengthv_ a1
     in
-	if n<0 orelse i1<0 orelse i1+n > lengthv_ a1
-	       orelse i2<0 orelse i2+n > length_ a2
-	    then 
-		raise Subscript
+	if i2<0 orelse i2+n > length_ a2 then 
+	    raise Subscript
 	else 
-	    let fun lo2hi j = if j < n then
-		(update_ a2 (i2+j) (subv_ a1 (i1+j)); lo2hi (j+1))
-			      else ()
+	    let fun lo2hi j = 
+		    if j < n then
+			(update_ a2 (i2+j) (subv_ a1 j); lo2hi (j+1))
+		    else ()
 	    in lo2hi 0 end
     end;
 
+fun find (p : 'a -> bool) (a : 'a array) : 'a option = 
+    let val a = from_array a
+	val stop = length_ a
+	fun lr j = 
+	    if j < stop then 
+		if p (sub_ a j) then SOME (sub_ a j) else lr (j+1)
+	    else NONE
+    in lr 0 end
+
+fun exists (p : 'a -> bool) (a : 'a array) : bool = 
+    let val a = from_array a
+	val stop = length_ a
+	fun lr j = j < stop andalso (p (sub_ a j) orelse lr (j+1))
+    in lr 0 end
+
+fun all (p : 'a -> bool) (a : 'a array) : bool = 
+    let val a = from_array a
+	val stop = length_ a
+	fun lr j = j >= stop orelse (p (sub_ a j) andalso lr (j+1))
+    in lr 0 end
+
 fun foldl f e a = 
     let val a = from_array a
 	val stop = length_ a
@@ -158,48 +167,61 @@
 		   else ()
     in lr 0 end
 
-fun sliceend (a, i, NONE) = 
-        if i<0 orelse i>length a then raise Subscript
-	else length a
-  | sliceend (a, i, SOME n) = 
-	if i<0 orelse n<0 orelse i+n>length a then raise Subscript
-	else i+n;
-
-fun foldli f e (slice as (a, i, _)) = 
-    let val a = from_array a
-	fun loop stop =
-	    let fun lr j res = 
-		if j < stop then lr (j+1) (f(j, sub_ a j, res))
-		else res
-	    in lr i e end
-    in loop (sliceend slice) end;
-
-fun foldri f e (slice as (a, i, _)) = 
-    let val a = from_array a
-	fun loop start =
-	    let fun rl j res = 
-		    if j >= i then rl (j-1) (f(j, sub_ a j, res))
-		    else res
-	    in rl start e end;
-    in loop (sliceend slice - 1) end
-
-fun modifyi f (slice as (a, i, _)) = 
-    let val a = from_array a
-	fun loop stop =
-	    let fun lr j = 
-		if j < stop then (update_ a j (f(j, sub_ a j)); lr (j+1))
-		else ()
-	    in lr i end
-    in loop (sliceend slice) end;
-
-fun appi f (slice as (a, i, _)) = 
-    let val a = from_array a
-	fun loop stop = 
-	    let	fun lr j = 
-		    if j < stop then (f(j, sub_ a j); lr (j+1)) 
-		    else ()
-	    in lr i end
-    in loop (sliceend slice) end;
+fun findi (p : int * 'a -> bool) (a : 'a array) : (int * 'a) option = 
+    let val a = from_array a
+	val stop = length_ a
+	fun lr j = 
+	    if j < stop then 
+		if p (j, sub_ a j) then SOME (j, sub_ a j) else lr (j+1)
+	    else NONE
+    in lr 0 end
+
+fun foldli f e a = 
+    let val a = from_array a
+	val stop = length_ a
+	fun lr j res = 
+	    if j < stop then lr (j+1) (f(j, sub_ a j, res))
+	    else res
+    in lr 0 e end;
+
+fun foldri f e a = 
+    let val a = from_array a
+	fun rl j res = 
+	    if j >= 0 then rl (j-1) (f(j, sub_ a j, res))
+	    else res
+    in rl (length_ a - 1) e end;
+
+fun modifyi f a = 
+    let val a = from_array a
+	val stop = length_ a
+	fun lr j = 
+	    if j < stop then (update_ a j (f(j, sub_ a j)); lr (j+1))
+	    else ()
+    in lr 0 end;
+
+fun appi f a = 
+    let val a = from_array a
+	val stop = length_ a
+	fun lr j = 
+	    if j < stop then (f(j, sub_ a j); lr (j+1)) 
+	    else ()
+    in lr 0 end;
+
+fun collate cmp (a1, a2) =
+    let val a1 = from_array a1
+	and a2 = from_array a2
+	val n1 = length_ a1 
+	and n2 = length_ a2
+	val stop = if n1 < n2 then n1 else n2
+	fun h j = (* At this point a1[0..j-1] = a2[0..j-1] *)
+	    if j = stop then if      n1 < n2 then LESS
+                             else if n1 > n2 then GREATER
+                             else                 EQUAL
+	    else
+		case cmp(sub_ a1 j, sub_ a2 j) of
+		    EQUAL => h (j+1)
+		  | res   => res
+    in h 0 end;
 end
 
 end
diff -Nru mosml-2.01/src/mosmllib/Array.sig mosml-2.10.1/src/mosmllib/Array.sig
--- mosml-2.01/src/mosmllib/Array.sig	2000-06-01 19:57:44.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Array.sig	2014-08-28 08:47:22.000000000 +0000
@@ -1,6 +1,7 @@
 (* Array -- SML Basis Library *)
 
 prim_EQtype 'a array
+type 'a vector = 'a Vector.vector
 
 val maxLen   : int
 
@@ -11,22 +12,27 @@
 val length   : 'a array -> int
 val sub      : 'a array * int -> 'a
 val update   : 'a array * int * 'a  -> unit
-val extract  : 'a array * int * int option -> 'a Vector.vector
+val vector   : 'a array -> 'a vector
 
-val copy     : {src: 'a array,  si: int, len: int option,
-                dst: 'a array, di: int} -> unit
-val copyVec  : {src: 'a vector, si: int, len: int option, 
-                dst: 'a array, di: int} -> unit
+val copy     : {src: 'a array,  dst: 'a array, di: int} -> unit
+val copyVec  : {src: 'a vector, dst: 'a array, di: int} -> unit
+
+val find     : ('a -> bool) -> 'a array -> 'a option
+val exists   : ('a -> bool) -> 'a array -> bool
+val all      : ('a -> bool) -> 'a array -> bool
 
 val app      : ('a -> unit) -> 'a array -> unit
 val foldl    : ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
 val foldr    : ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
 val modify   : ('a -> 'a) -> 'a array -> unit
 
-val appi     : (int * 'a -> unit) -> 'a array * int * int option -> unit
-val foldli   : (int * 'a * 'b -> 'b) -> 'b -> 'a array * int * int option -> 'b
-val foldri   : (int * 'a * 'b -> 'b) -> 'b -> 'a array * int * int option -> 'b
-val modifyi  : (int * 'a -> 'a) -> 'a array * int * int option -> unit
+val findi    : (int * 'a -> bool) -> 'a array -> (int * 'a) option
+val appi     : (int * 'a -> unit) -> 'a array -> unit
+val foldli   : (int * 'a * 'b -> 'b) -> 'b -> 'a array -> 'b
+val foldri   : (int * 'a * 'b -> 'b) -> 'b -> 'a array -> 'b
+val modifyi  : (int * 'a -> 'a) -> 'a array -> unit
+
+val collate  : ('a * 'a -> order) -> 'a array * 'a array -> order
 
 (* 
    ['ty array] is the type of one-dimensional, mutable, zero-based
@@ -35,22 +41,8 @@
    are equal if both were created by the same call to a primitive
    (array, tabulate, fromList).
 
-   Some functions work on a *slice* of an array:
-
-   The slice (a, i, SOME n) denotes the subarray a[i..i+n-1].  That is,
-   a[i] is the first element of the slice, and n is the length of the
-   slice.  Valid only if 0 <= i <= i+n <= length a.
-
-   The slice (a, i, NONE) denotes the subarray a[i..length a-1].  That
-   is, the slice denotes the suffix of the array starting at i.  Valid
-   only if 0 <= i <= length a.  Equivalent to (a, i, SOME(length a - i)).
-
-       slice             meaning 
-       ----------------------------------------------------------
-       (a, 0, NONE)      the whole array              a[0..len-1]   
-       (a, 0, SOME n)    a left subarray (prefix)     a[0..n-1]
-       (a, i, NONE)      a right subarray (suffix)    a[i..len-1]
-       (a, i, SOME n)    a general slice              a[i..i+n-1] 
+   Functions working on a slices (contiguous subsequence) of an array
+   are found in the ArraySlice structure.
 
    [maxLen] is the maximal number of elements in an array.
 
@@ -74,30 +66,25 @@
    [update(a, i, x)] destructively replaces the i'th element of a by x.
    Raises Subscript if i<0 or i>=length a.
 
-   [extract(a, i, NONE)] returns a vector of the elements a[i..length a-1] 
-   of a.  Raises Subscript if i<0 or i>length a.
-
-   [extract(a, i, SOME len)] returns a vector of the elements a[i..i+len-1] 
-   of a.  Raises Subscript if i<0 or len<0 or i+len>length a or
-   len>Vector.maxLen.
-
-   [copy{src, si, len, dst, di}] destructively copies the slice
-   (src, si, len) to dst, starting at index di.  More precisely:
-   If len=NONE and n=length src, it copies src[si..n-1] to dst[di..di+n-si].
-   If len=SOME k, it copies src[si..si+k-1] to dst[di..di+k-1].  
-   Works also if src and dst are the same and the segments overlap.
-   Raises Subscript if si < 0 or di < 0, 
-   or if len=NONE and di + length src - si > length dst,
-   or if len=SOME k and k < 0 or si + k > length src or di + k > length dst.
-
-   [copyVec{src, si, len, dst, di}] destructively copies the slice
-   (src, si, len) to dst, starting at index di.  More precisely:
-   If len=NONE and n=length src, it copies src[si..n-1] to dst[di..di+n-si].
-   If len=SOME k, it copies src[si..si+k-1] to dst[di..di+k-1].  
-   Works also if src and dst are the same and the segments overlap.
-   Raises Subscript if si < 0 or di < 0, 
-   or if len=NONE and di + length src - si > length dst,
-   or if len=SOME k and k < 0 or si + k > length src or di + k > length dst.
+   [copy{src, dst, di}] destructively copies the array src to dst,
+   starting at index di.  
+   Raises Subscript if di<0, or if di + length src > length dst.
+
+   [copyVec{src, dst, di}] destructively copies the vector to dst,
+   starting at index di.  
+   Raises Subscript if di<0, or if di + Vector.length src > length dst.
+
+   [find p a] applies p to each element x of a, from left to right,
+   until p(x) evaluates to true; returns SOME x if such an x exists,
+   otherwise NONE.
+
+   [exists p a] applies p to each element x of a, from left to right,
+   until p(x) evaluates to true; returns true if such an x exists,
+   otherwise false.
+
+   [all p a] applies p to each element x of a, from left to right,
+   until p(x) evaluates to false; returns false if such an x exists,
+   otherwise true.
 
    [foldl f e a] folds function f over a from left to right.  That is,
    computes f(a[len-1], f(a[len-2], ..., f(a[1], f(a[0], e)) ...)),
@@ -112,43 +99,25 @@
    [modify f a] applies f to a[j] and updates a[j] with the result
    f(a[j]) for j=0,1,...,length a-1. 
 
-   The following iterators generalize the above ones in two ways:
+   The following iterators generalize the above ones by passing also
+   the index j to the function being iterated.
+
+   [findi p a] applies f to successive pairs (j, a[j]) for j=0,1,...,n-1, 
+   until p(j, a[j]) evaluates to true; returns SOME (j, a[j]) if such
+   a pair exists, otherwise NONE.
+
+   [foldli f e a] folds function f over the array from left to right.
+   That is, computes f(n-1, a[n-1], f(..., f(1, a[1], f(0, a[0], e)) ...)).  
+
+   [foldri f e a] folds function f over the array from right to left.  
+   That is, computes f(0, a[0], f(1, a[1], ..., f(n-1, a[n-1], e) ...)).
+
+   [appi f a] applies f to successive pairs (j, a[j]) for j=0,1,...,n-1.  
 
-    . the index j is also being passed to the function being iterated;
-    . the iterators work on a slice (subarray) of an array.
+   [modifyi f a] applies f to (j, a[j]) and updates a[j] with the
+   result f(j, a[j]) for j=0,1,...,n-1.
 
-   [foldli f e (a, i, SOME n)] folds function f over the subarray
-   a[i..i+n-1] from left to right.  That is, computes 
-   f(i+n-1, a[i+n-1], f(..., f(i+1, a[i+1], f(i, a[i], e)) ...)).  
-   Raises Subscript if i<0 or n<0 or i+n > length a.
-
-   [foldli f e (a, i, NONE)] folds function f over the subarray
-   a[i..len-1] from left to right, where len =  length a.  That is, 
-   computes f(len-1, a[len-1], f(..., f(i+1, a[i+1], f(i, a[i], e)) ...)).  
-   Raises Subscript if i<0 or i > length a.
-
-   [foldri f e (a, i, SOME n)] folds function f over the subarray
-   a[i..i+n-1] from right to left.  That is, computes 
-   f(i, a[i], f(i+1, a[i+1], ..., f(i+n-1, a[i+n-1], e) ...)).
-   Raises Subscript if i<0 or n<0 or i+n > length a.
-
-   [foldri f e (a, i, NONE)] folds function f over the subarray
-   a[i..len-1] from right to left, where len = length a.  That is, 
-   computes f(i, a[i], f(i+1, a[i+1], ..., f(len-1, a[len-1], e) ...)).
-   Raises Subscript if i<0 or i > length a.
-
-   [appi f (a, i, SOME n)] applies f to successive pairs (j, a[j]) for
-   j=i,i+1,...,i+n-1.  Raises Subscript if i<0 or n<0 or i+n > length a.
-
-   [appi f (a, i, NONE)] applies f to successive pairs (j, a[j]) for
-   j=i,i+1,...,len-1, where len = length a.  Raises Subscript if i<0
-   or i > length a.
-
-   [modifyi f (a, i, SOME n)] applies f to (j, a[j]) and updates a[j]
-   with the result f(j, a[j]) for j=i,i+1,...,i+n-1.  Raises Subscript
-   if i<0 or n<0 or i+n > length a.
-
-   [modifyi f (a, i, NONE)] applies f to (j, a[j]) and updates a[j]
-   with the result f(j, a[j]) for j=i,i+1,...,len-1.  Raises Subscript
-   if i<0 or i > length a.
+   [collate cmp (xs, ys)] returns LESS, EQUAL or GREATER according as
+   xs precedes, equals or follows ys in the lexicographic ordering on
+   arrays induced by the ordering cmp on elements.  
 *)
diff -Nru mosml-2.01/src/mosmllib/ArraySlice.sig mosml-2.10.1/src/mosmllib/ArraySlice.sig
--- mosml-2.01/src/mosmllib/ArraySlice.sig	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/ArraySlice.sig	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,156 @@
+(* ArraySlice -- SML Basis Library *)
+
+type 'a slice
+
+val length   : 'a slice -> int
+val sub      : 'a slice * int -> 'a
+val update   : 'a slice * int * 'a  -> unit
+val slice    : 'a Array.array * int * int option -> 'a slice
+val full     : 'a Array.array -> 'a slice
+val subslice : 'a slice * int * int option -> 'a slice
+val base     : 'a slice -> 'a Array.array * int * int
+val vector   : 'a slice -> 'a Vector.vector
+val copy     : {src: 'a slice, dst: 'a Array.array, di: int} -> unit
+val copyVec  : {src: 'a VectorSlice.slice, dst: 'a Array.array, di: int} 
+               -> unit 
+val isEmpty  : 'a slice -> bool
+val getItem  : 'a slice -> ('a * 'a slice) option
+
+val find     : ('a -> bool) -> 'a slice -> 'a option
+val exists   : ('a -> bool) -> 'a slice -> bool
+val all      : ('a -> bool) -> 'a slice -> bool
+
+val app      : ('a -> unit) -> 'a slice -> unit
+val foldl    : ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+val foldr    : ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+val modify   : ('a -> 'a) -> 'a slice -> unit
+
+val findi    : (int * 'a -> bool) -> 'a slice -> (int * 'a) option
+val appi     : (int * 'a -> unit) -> 'a slice -> unit
+val foldli   : (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+val foldri   : (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+val modifyi  : (int * 'a -> 'a) -> 'a slice -> unit
+
+val collate  : ('a * 'a -> order) -> 'a slice * 'a slice -> order
+
+(* 
+   ['ty slice] is the type of array slices, that is, sub-arrays.  
+   The slice (a,i,n) is valid if 0 <= i <= i+n <= size s, 
+                or equivalently, 0 <= i and 0 <= n and i+n <= size s.  
+   A valid slice sli = (a,i,n) represents the sub-array a[i...i+n-1],
+   so the elements of sli are a[i], a[i+1], ..., a[i+n-1], and n is
+   the length of the slice.  Only valid slices can be constructed by
+   the functions below.
+
+   [length sli] returns the number n of elements in sli = (s,i,n).
+
+   [sub (sli, k)] returns the k'th element of the slice, that is,
+   a(i+k) where sli = (a,i,n).  Raises Subscript if k<0 or k>=n.
+
+   [update (sli, k, x)] destructively replaces the k'th element of sli
+   by x.  That is, replaces a(k+i) by x, where sli = (a,i,n).  Raises
+   Subscript if i<0 or i>=n.
+
+   [slice (a, i, NONE)] creates the slice (a, i, length a-i),
+   consisting of the tail of a starting at i.  
+   Raises Subscript if i<0 or i > Array.length a.  
+   Equivalent to slice (a, i, SOME(Array.length a - i)).
+
+   [slice (a, i, SOME n)] creates the slice (a, i, n), consisting of
+   the sub-array of a with length n starting at i.  Raises Subscript
+   if i<0 or n<0 or i+n > Array.length a.  
+
+       slice             meaning 
+       ----------------------------------------------------------
+       (a, 0, NONE)      the whole array              a[0..len-1]   
+       (a, 0, SOME n)    a left sub-array (prefix)    a[0..n-1]
+       (a, i, NONE)      a right sub-array (suffix)   a[i..len-1]
+       (a, i, SOME n)    a general slice              a[i..i+n-1] 
+
+   [full a] creates the slice (a, 0, length a).  
+   Equivalent to slice(a,0,NONE)
+
+   [subslice (sli, i', NONE)] returns the slice (a, i+i', n-i') when
+   sli = (a,i,n).  Raises Subscript if i' < 0 or i' > n.
+
+   [subslice (sli, i', SOME n')] returns the slice (a, i+i', n') when
+   sli = (a,i,n).  Raises Subscript if i' < 0 or n' < 0 or i'+n' > n.
+
+   [base sli] is the concrete triple (a, i, n) when sli = (a, i, n).
+
+   [vector sli] creates and returns a vector consisting of the
+   elements of the slice, that is, a[i..i+n-1] when sli = (a,i,n).
+
+   [copy {src, dst, di}] copies the elements of slice src = (a,i,n),
+   that is, a[i..i+n-1], to the destination segment dst[di..di+n-1].
+   Raises Subscript if di<0 or if di+n > length dst.  Works also if
+   the array underlying sli is the same as dst, and the slice overlaps
+   with the destination segment.
+
+   [copyVec {src, dst, di}] copies the elements of the vector slice
+   src = (v,i,n), that is, v[i..i+n-1], to dst[di..di+n-1].  Raises
+   Subscript if di<0, or if len=NONE and di + n > length dst.  
+
+   [isEmpty sli] returns true if the slice sli = (a,i,n) is empty,
+   that is, if n=0.
+
+   [getItem sli] returns SOME(x, rst) where x is the first element and
+   rst the remainder of sli, if sli is non-empty; otherwise returns
+   NONE.  
+
+   [find p sli] applies p to each element x of sli, from left to
+   right, until p(x) evaluates to true; returns SOME x if such an x
+   exists, otherwise NONE.
+
+   [exists p sli] applies p to each element x of sli, from left to right,
+   until p(x) evaluates to true; returns true if such an x exists,
+   otherwise false.
+
+   [all p sli] applies p to each element x of sli, from left to right,
+   until p(x) evaluates to false; returns false if such an x exists,
+   otherwise true.
+
+   [app f sli] applies f to all elements of sli = (a,i,n), from
+   left to right.  That is, applies f to a[j+i] for j=0,1,...,n.
+
+   [foldl f e sli] folds function f over sli = (a,i,n) from left to right.  
+   That is, computes f(a[i+n-1], f(a[i+n-2],..., f(a[i+1], f(a[i], e))...)).
+
+   [foldr f e sli] folds function f over sli = (a,i,n) from right to left.  
+   That is, computes f(a[i], f(a[i+1],..., f(a[i+n-2], f(a[i+n-1], e))...)).
+
+   [modify f sli] modifies the elements of the slice sli = (a,i,n) by
+   function f.  That is, applies f to a[i+j] and updates a[i+j] with
+   the result f(a[i+j]) for j=0,1,...,n.
+
+   The following iterators generalize the above ones by also passing
+   the index into the array a underlying the slice to the function
+   being iterated.
+
+   [findi p sli] applies p to the elements of sli = (a,i,n) and the
+   underlying array indices, and returns the least (j, a[j]) for which
+   p(j, a[j]) evaluates to true, if any; otherwise returns NONE.  That
+   is, evaluates p(j, a[j]) for j=i,..i+n-1 until it evaluates to true
+   for some j, then returns SOME(j, a[j]); otherwise returns NONE.
+
+   [appi f sli] applies f to the slice sli = (a,i,n) and the
+   underlying array indices.  That is, applies f to successive pairs
+   (j, a[j]) for j=i,i+1,...,i+n-1.
+
+   [foldli f e sli] folds function f over the slice sli = (a,i,n) and
+   the underlying array indices from left to right.  That is, computes 
+   f(i+n-1, a[i+n-1], f(..., f(i+1, a[i+1], f(i, a[i], e)) ...)).  
+
+   [foldri f e sli] folds function f over the slice sli = (a,i,n) and
+   the underlying array indices from right to left.  That is, computes
+   f(i, a[i], f(i+1, a[i+1], ..., f(i+n-1, a[i+n-1], e) ...)).
+
+   [modifyi f sli] modifies the elements of the slice sli = (a,i,n) by
+   applying function f to the slice elements and the underlying array
+   indices.  That is, applies f to (j, a[j]) and updates a[j] with the
+   result f(j, a[j]) for j=i,i+1,...,i+n-1.  
+   
+   [collate cmp (sli1, sli2)] returns LESS, EQUAL or GREATER according
+   as sli1 precedes, equals or follows sli2 in the lexicographic
+   ordering on slices induced by the ordering cmp on elements.
+*)
diff -Nru mosml-2.01/src/mosmllib/ArraySlice.sml mosml-2.10.1/src/mosmllib/ArraySlice.sml
--- mosml-2.01/src/mosmllib/ArraySlice.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/ArraySlice.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,209 @@
+(* ArraySlice -- SML Basis Library 
+   sestoft@dina.kvl.dk 2000-10-18
+*)
+
+local
+    prim_val magic   : 'a -> 'b                        = 1 "identity";
+    type 'a array = 'a Array.array
+    type 'a vector = 'a Vector.vector;
+
+    prim_type 'a array_;
+
+    fun from_array (a : 'a  array)  = !(magic a)    : 'a array_;
+    fun make_array (a : '_a array_) = magic (ref a) : 'a array
+    prim_val sub_    : 'a array_ -> int -> 'a          = 2 "get_vect_item";
+    prim_val update_ : 'a array_ -> int -> 'a -> unit  = 3 "set_vect_item";
+    prim_val length_  : 'a array_ -> int               = 1 "vect_length";
+
+    prim_val vector_ : int -> 'x -> 'a vector          = 2 "make_vect";
+    prim_val subv_   : 'a vector -> int -> 'a          = 2 "get_vect_item";
+    prim_val updatev : 'a vector -> int -> 'a -> unit  = 3 "set_vect_item";
+in
+
+type 'a slice = 'a array * int * int
+
+(* Invariant on values (a, i, n) of type 'a slice:
+ *                  0 <= i <= i+n <= Array.length a, 
+ * or equivalently, 0 <= i and 0 <= n and i+n <= Array.length a.  
+ *)
+
+fun length (a, i, n) = n;
+
+fun sub((a', i', n'), i) = 
+    if i<0 orelse i >= n' then raise Subscript
+    else sub_ (from_array a') (i'+i);
+
+fun update ((a', i', n'), i, v)  =
+    if i<0 orelse i>=n' then raise Subscript 
+    else update_ (from_array a') (i'+i) v;
+
+fun slice (a, i, len) =
+    let val alen = Array.length a
+    in 
+	case len of 
+	    NONE   => if 0<=i andalso i<=alen then (a, i, alen - i)
+		      else raise Subscript
+	  | SOME n => if 0<=i andalso 0<=n andalso n<=alen-i then (a, i, n)
+		      else raise Subscript
+    end;
+
+fun full a = (a, 0, Array.length a);
+
+fun subslice ((a, i, n), i', NONE) =
+    if 0<=i' andalso i'<=n then (a, i+i', n-i')
+    else raise Subscript
+  | subslice ((a, i, n), i', SOME n') =
+    if 0<=i' andalso 0<=n' andalso n'<=n-i' then (a, i+i', n')
+    else raise Subscript;
+		      
+fun base sli = sli;
+
+fun vector (a : 'a array, i, n) = 
+    let val a = from_array a : 'a array_ 
+	val newvec = vector_ n () : 'a vector
+	fun copy j = 
+	    if j length_ a2 then raise Subscript
+	else if i1 < i2 then		(* copy from high to low *)
+	         let fun hi2lo j = 
+		     if j >= 0 then
+			 (update_ a2 (i2+j) (sub_ a1 (i1+j)); hi2lo (j-1))
+		     else ()
+		 in hi2lo (n-1) end
+	     else                       (* i1 >= i2, copy from low to high *)
+		 let fun lo2hi j = 
+		     if j < n then
+			 (update_ a2 (i2+j) (sub_ a1 (i1+j)); lo2hi (j+1))
+		     else ()
+		 in lo2hi 0 end
+    end;
+
+fun copyVec {src : 'a VectorSlice.slice, dst=a2: 'a array, di=i2} =
+    let val (a1, i1, n) = VectorSlice.base src
+	val a2 = from_array a2
+    in
+	if i2<0 orelse i2+n > length_ a2 then raise Subscript
+	else 
+	    let fun lo2hi j = if j < n then
+		(update_ a2 (i2+j) (subv_ a1 (i1+j)); lo2hi (j+1))
+			      else ()
+	    in lo2hi 0 end
+    end;
+
+fun isEmpty (_, _, n) = n=0;
+
+fun getItem (a, i, 0) = NONE
+  | getItem (a, i, n) = SOME(sub_ (from_array a) i, (a, i+1, n-1));
+
+fun find (p : 'a -> bool) ((a,i,n) : 'a slice) : 'a option = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j = 
+	    if j < stop then 
+		if p (sub_ a j) then SOME (sub_ a j) else lr (j+1)
+	    else NONE
+    in lr i end;
+
+fun exists (p : 'a -> bool) ((a,i,n) : 'a slice) : bool = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j = j < stop andalso (p (sub_ a j) orelse lr (j+1))
+    in lr i end;
+
+fun all (p : 'a -> bool) ((a,i,n) : 'a slice) : bool = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j = j >= stop orelse (p (sub_ a j) andalso lr (j+1))
+    in lr i end;
+
+fun app f (a, i, n) = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j = if j < stop then (f(sub_ a j); lr (j+1))
+		   else ()
+    in lr i end;
+
+fun foldl f e (a, i, n) = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j res = if j < stop then lr (j+1) (f(sub_ a j, res))
+		       else res
+    in lr i e end;
+
+fun foldr f e (a, i, n) =
+    let val a = from_array a
+	fun rl j res = if j >= i then rl (j-1) (f(sub_ a j, res))
+		       else res
+    in rl (i+n-1) e end;
+
+fun modify f (a, i, n) = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j = if j < stop then (update_ a j (f(sub_ a j)); lr (j+1))
+		   else ()
+    in lr i end;
+
+fun findi (p : int * 'a -> bool) ((a,i,n) : 'a slice) : (int * 'a) option = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j = 
+	    if j < stop then 
+		if p (j, sub_ a j) then SOME (j, sub_ a j) else lr (j+1)
+	    else NONE
+    in lr i end;
+
+fun appi f (a, i, n) = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j = 
+	    if j < stop then (f(j, sub_ a j); lr (j+1)) 
+	    else ()
+    in lr i end;
+
+fun foldli f e (a, i, n) = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j res = 
+	    if j < stop then lr (j+1) (f(j, sub_ a j, res))
+	    else res
+    in lr i e end;
+
+fun foldri f e (a, i, n) = 
+    let val a = from_array a
+	fun rl j res = 
+	    if j >= i then rl (j-1) (f(j, sub_ a j, res))
+	    else res
+    in rl (i+n-1) e end;
+
+fun modifyi f (a, i, n) = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j = 
+	    if j < stop then (update_ a j (f(j, sub_ a j)); lr (j+1))
+	    else ()
+    in lr i end;
+
+fun collate cmp ((a1,i1,n1), (a2,i2,n2)) =
+    let val a1 = from_array a1
+	and a2 = from_array a2
+	val stop = if n1 < n2 then n1 else n2
+	fun h j = (* At this point a1[i1..i1+j-1] = a2[i2..i2+j-1] *)
+	    if j = stop then if      n1 < n2 then LESS
+                             else if n1 > n2 then GREATER
+                             else                 EQUAL
+	    else
+		case cmp(sub_ a1 (i1+j), sub_ a2 (i2+j)) of
+		    EQUAL => h (j+1)
+		  | res   => res
+    in h 0 end;
+
+end
diff -Nru mosml-2.01/src/mosmllib/Binarymap.sig mosml-2.10.1/src/mosmllib/Binarymap.sig
--- mosml-2.01/src/mosmllib/Binarymap.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Binarymap.sig	2014-08-28 08:47:22.000000000 +0000
@@ -15,7 +15,7 @@
 val listItems : ('key, 'a) dict -> ('key * 'a) list
 val app       : ('key * 'a -> unit) -> ('key,'a) dict -> unit
 val revapp    : ('key * 'a -> unit) -> ('key,'a) dict -> unit
-val foldr     : ('key * 'a * 'b -> 'b)-> 'b -> ('key,'a) dict -> 'b
+val foldr     : ('key * 'a * 'b -> 'b) -> 'b -> ('key,'a) dict -> 'b
 val foldl     : ('key * 'a * 'b -> 'b) -> 'b -> ('key,'a) dict -> 'b
 val map       : ('key * 'a -> 'b) -> ('key,'a) dict -> ('key, 'b) dict
 val transform : ('a -> 'b) -> ('key,'a) dict -> ('key, 'b) dict
@@ -31,7 +31,7 @@
 
    [insert(m, i, v)] extends (or modifies) map m to map i to v.
 
-   [find (m, k)] returns v if m maps k to v; otherwise raises NotFound.
+   [find(m, k)] returns v if m maps k to v; otherwise raises NotFound.
    
    [peek(m, k)] returns SOME v if m maps k to v; otherwise returns NONE.
 
diff -Nru mosml-2.01/src/mosmllib/Buffer.sig mosml-2.10.1/src/mosmllib/Buffer.sig
--- mosml-2.01/src/mosmllib/Buffer.sig	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Buffer.sig	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,47 @@
+signature Buffer =
+sig
+    type buf
+    val new      : int -> buf
+    val contents : buf -> string
+    val size     : buf -> int
+    val clear    : buf -> unit
+    val reset    : buf -> unit
+
+    val addChar      : buf -> char -> unit
+    val addString    : buf -> string -> unit
+    val addSubString : buf -> substring -> unit
+end
+
+(* [buf] is the type of mutable string buffers that allows efficient
+   concatenation at the end and automatically expand as necessary.  It
+   provides accumulative concatenation of strings in quasi-linear time
+   (instead of quadratic time when strings are concatenated pairwise).
+
+   [new hint] creates a new empty buffer.  Raises Size if hint <= 0 or
+   hint > String.maxSize.
+   The argument hint is used as the initial size of the internal
+   string that holds the buffer contents.  The internal string is
+   automatically reallocated as contents is stored in the buffer.  For
+   best performance, hint should be of the same order of magnitude as
+   the number of characters that are expected to be stored in the
+   buffer (for instance, 80 for a buffer that holds one output line).
+   Nothing bad will happen if the buffer grows beyond that limit,
+   however.  In doubt, take hint = 16 for instance. 
+
+   [contents buf] returns the contents of buf.
+
+   [size buf] returns the size of the contents of buf.
+
+   [clear buf] emptys buf.
+
+   [reset buf] emptys buf and shrink the internal string to the
+   initial hint.
+
+   [addChar buf c] appends c at the end of buf.
+
+   [addString buf s] appends s at the end of buf.
+
+   [addSubString buf ss] appends ss at the end of buf.
+
+*)
+
diff -Nru mosml-2.01/src/mosmllib/Buffer.sml mosml-2.10.1/src/mosmllib/Buffer.sml
--- mosml-2.01/src/mosmllib/Buffer.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Buffer.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,135 @@
+(* String buffers heavily inspired by the Buffer module in OCaml *)
+(* Ken Friis Larsen  2001-07-31                      *)
+structure Buffer :> Buffer =
+struct
+
+datatype buf = BUF of {elts    : string ref,
+		       size    : int ref,
+                       initial : int}
+
+local 
+    prim_val create_ : int -> string                 = 1 "create_string";
+    prim_val update_ : string -> int -> char -> unit = 3 "set_nth_char";
+    prim_val blit_   : string -> int -> string -> int -> int -> unit 
+                                                     = 5 "blit_string";
+in 
+fun new bufSize =
+    if bufSize > 0 andalso bufSize <= String.maxSize
+    then BUF{elts    = ref (create_ bufSize),
+	     size    = ref 0,
+             initial = bufSize}
+    else raise Size
+
+fun clear (BUF{size, ...}) = size := 0
+
+fun size (BUF{size as ref s, ...}) = s
+
+fun reset (BUF{initial, elts, size, ...}) =
+    ( elts := create_ initial
+    ; size := 0 )
+
+fun contents (BUF{elts as ref arr, size as ref s, ...}) =
+    let val newstr = create_ s 
+    in blit_ arr 0 newstr 0 s; newstr end
+
+fun resize (BUF{elts as ref arr, size as ref s, ...}) more =
+    let val newSize = s + more
+        val ()      = if newSize > String.maxSize then raise Size else ()
+        fun roundUp new = if new < newSize then roundUp(2*new) 
+                          else if new > String.maxSize then String.maxSize
+                          else new
+        val len     = String.size arr
+        val newLen  = roundUp(2*len)
+                      handle Overflow => String.maxSize
+        val arr'    = create_ newLen
+    in  blit_ arr 0 arr' 0 s
+      ; elts := arr' end
+
+
+fun addChar (buf as BUF{elts as ref arr, size as ref s, ...}) c =
+    ( if s = String.size arr then resize buf 1 else ()
+    ; update_ (!elts) s c
+    ; size := s+1
+    )
+
+fun addSubString (buf as BUF{elts as ref arr, size as ref s, ...}) x =
+    let val (ss, off, len) = Substring.base x
+        val newSize = s+len
+    in  if newSize >= String.size arr then resize buf len else ()
+      ; blit_ ss off (!elts) s len
+      ; size := newSize end
+
+fun addString (buf as BUF{elts as ref arr, size as ref s, ...}) x = 
+    let val len = String.size x
+        val newSize = s+len  
+    in  if newSize >= String.size arr then resize buf len else ()
+      ; blit_ x 0 (!elts) s len
+      ; size := newSize end
+
+end (*end local*)
+end
+
+
+(* Implementation in pure SML (using slices) *)
+(*
+structure Buffer :> Buffer =
+struct
+   structure CA  = CharArray
+   structure CAS = CharArraySlice
+   structure CVS = CharVectorSlice
+
+   datatype buf = BUF of {elts    : CA.array ref,
+		          size    : int ref,
+                          initial : int}
+
+   fun contents (BUF{elts as ref arr, size as ref s, ...}) = 
+       CAS.vector(CAS.slice(arr, 0, SOME s))
+
+   fun clear (BUF{size, ...}) = size := 0
+
+   fun size (BUF{size as ref s, ...}) = s
+
+   fun new bufSize =
+       if bufSize > 0 then BUF{elts = ref (CA.array (bufSize, #"\000")),
+	                       size = ref 0,
+                               initial = bufSize}
+       else raise Size
+
+   fun reset (BUF{initial, elts, size, ...}) =
+       ( elts := CA.array (initial, #"\000")
+       ; size := 0 )
+
+
+   fun resize (BUF{elts as ref arr, size as ref s, ...}) more =
+       let val newSize = s + more
+           val ()      = if newSize > CA.maxLen then raise Size else ()
+           fun roundUp new = if new < newSize then roundUp(2*new) else new
+           val len     = CA.length arr
+           val newLen  = roundUp(2*len) 
+                         handle Overflow => CA.maxLen
+           val arr'    = CA.array (newLen, #"\000")
+                         handle Size => CA.array (CA.maxLen, #"\000")
+       in  CAS.copy{src=CAS.slice(arr, 0, SOME s), dst=arr', di=0}
+         ; elts := arr' end
+
+
+   fun addChar (buf as BUF{elts as ref arr, size as ref s, ...}) x =
+       ( if s = CA.length arr then resize buf 1 else ()
+       ; CA.update (!elts, s, x)
+       ; size := s+1)
+
+   fun addSubString (buf as BUF{elts as ref arr, size as ref s, ...}) x =
+       let val len = CVS.length x
+           val newSize = s+len  
+       in  if newSize >= CA.length arr then resize buf len else ()
+         ; CAS.copyVec{src = x, dst = !elts, di = s}
+         ; size := newSize end
+
+   fun addString (buf as BUF{elts as ref arr, size as ref s, ...}) x = 
+       let val len = String.size x
+           val newSize = s+len  
+       in  if newSize >= CA.length arr then resize buf len else ()
+         ; CA.copyVec{src = x, dst = !elts, di = s}
+         ; size := newSize end
+end
+*)
diff -Nru mosml-2.01/src/mosmllib/Byte.sig mosml-2.10.1/src/mosmllib/Byte.sig
--- mosml-2.01/src/mosmllib/Byte.sig	2000-06-01 19:57:44.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Byte.sig	2014-08-28 08:47:22.000000000 +0000
@@ -5,9 +5,9 @@
 val bytesToString   : Word8Vector.vector -> String.string
 val stringToBytes   : String.string -> Word8Vector.vector
 
-val unpackStringVec : Word8Vector.vector * int * int option -> string
-val unpackString    : Word8Array.array * int * int option -> string
-val packString      : Substring.substring * Word8Array.array * int -> unit
+val unpackStringVec : Word8VectorSlice.slice -> string
+val unpackString    : Word8ArraySlice.slice -> string
+val packString      : Word8Array.array * int * Substring.substring -> unit
 
 (* 
    Conversions between bytes and characters, and between byte vectors 
@@ -25,25 +25,13 @@
    In Moscow ML, all the above operations take constant time.  That
    is, no copying is done.
 
-   [unpackStringVec (v, i, NONE)] is the string whose character codes are
-   the bytes of v[i..length v-1].  Raises Subscript if i<0 or i>length v.
-   Equivalent to bytesToString(Word8Vector.extract (v, i, NONE)).
-   
-   [unpackStringVec (v, i, SOME n)] is the string whose character codes are
-   the bytes of v[i..i+n-1].  Raises Subscript if i<0 or n<0 or i+n>length v.
-   Equivalent to bytesToString(Word8Vector.extract (v, i, SOME n)).
-
-   [unpackString (a, i, NONE)] is the string whose character codes are
-   the bytes of a[i..length a-1].  Raises Subscript if i<0 or i>length a.
-   Equivalent to bytesToString(Word8Array.extract (v, i, NONE)).
-   
-   [unpackString (a, i, SOME n)] is the string whose character codes are
-   the bytes of a[i..i+n-1].  Raises Subscript if i<0 or n<0 or i+n>length a.
-   Equivalent to bytesToString(Word8Array.extract (a, i, SOME n)).
+   [unpackStringVec v] is the string whose character codes are the
+   bytes from the vector slice v.
 
-   [packString (ss, a, i)] copies the character codes of substring ss into
+   [unpackString a] is the string whose character codes are the bytes
+   from the array slice a.
+
+   [packString (a, i, ss)] copies the character codes of substring ss into
    the subarray a[i..i+n-1] where n = Substring.size ss.  Raises Subscript 
    if i<0 or i+n > length a.
-   Equivalent to Word8Array.copyVec{src=s, si=si, len=SOME n, dst=a, di=i} 
-   when (s, si, n) = Substring.base ss.
 *)
diff -Nru mosml-2.01/src/mosmllib/Byte.sml mosml-2.10.1/src/mosmllib/Byte.sml
--- mosml-2.01/src/mosmllib/Byte.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Byte.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,16 +1,19 @@
-(* Byte -- 1995-11-08, 1996-04-09 *)
+(* Byte -- 1995-11-08, 1996-04-09, 2000-10-26 *)
 
 prim_val byteToChar    : Word8.word -> Char.char = 1 "identity"
 prim_val charToByte    : Char.char -> Word8.word = 1 "identity"
 prim_val bytesToString : Word8Vector.vector -> String.string = 1 "identity"
 prim_val stringToBytes : String.string -> Word8Vector.vector = 1 "identity"
 
-fun unpackStringVec arg = bytesToString (Word8Vector.extract arg)
-fun unpackString arg = bytesToString (Word8Array.extract arg)
+fun unpackStringVec arg = 
+    bytesToString (Word8VectorSlice.vector arg)
 
-fun packString (ss, a, i) =
+fun unpackString arg = 
+    bytesToString (Word8ArraySlice.vector arg)
+
+fun packString (a, i, ss) =
     let val (s, si, n) = Substring.base ss
+	val src = Word8VectorSlice.slice(stringToBytes s, si, SOME n)
     in  
-        Word8Array.copyVec {src = stringToBytes s, si = si, 
-			    len = SOME n, dst = a, di = i} 
+        Word8ArraySlice.copyVec {src = src, dst = a, di = i} 
     end
diff -Nru mosml-2.01/src/mosmllib/Callback.sig mosml-2.10.1/src/mosmllib/Callback.sig
--- mosml-2.01/src/mosmllib/Callback.sig	2000-07-25 12:38:58.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Callback.sig	2014-08-28 08:47:22.000000000 +0000
@@ -96,7 +96,7 @@
 
    This example shows how to register the C function 
 
-      value silly_cfun(value v) 
+      value sillycfun(value v) 
       { return copy_double(42.42 * Double_val(v)); }
 
    so that it may be called from ML.
@@ -115,6 +115,7 @@
           val result = sillyfun(3.4)
 
    The C function (in mosml/src/runtime/callback.c)
+
         void registercptr(char* nam, void* cptr);
 
    is used to register C pointers for access from ML.  Only pointers
diff -Nru mosml-2.01/src/mosmllib/CharArray.sig mosml-2.10.1/src/mosmllib/CharArray.sig
--- mosml-2.01/src/mosmllib/CharArray.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/CharArray.sig	2014-08-28 08:47:22.000000000 +0000
@@ -13,22 +13,27 @@
 val length   : array -> int
 val sub      : array * int -> elem
 val update   : array * int * elem -> unit
-val extract  : array * int * int option -> vector
+val vector   : array -> vector
 
-val copy     : {src: array,  si: int, len: int option, 
-                dst: array, di: int} -> unit
-val copyVec  : {src: vector, si: int, len: int option, 
-                dst: array, di: int} -> unit
+val copy     : {src: array,  dst: array, di: int} -> unit
+val copyVec  : {src: vector, dst: array, di: int} -> unit
+
+val find     : (elem -> bool) -> array -> elem option
+val exists   : (elem -> bool) -> array -> bool
+val all      : (elem -> bool) -> array -> bool
 
 val app      : (elem -> unit) -> array -> unit
 val foldl    : (elem * 'b -> 'b) -> 'b -> array -> 'b
 val foldr    : (elem * 'b -> 'b) -> 'b -> array -> 'b
 val modify   : (elem -> elem) -> array -> unit
 
-val appi     : (int * elem -> unit) -> array * int * int option -> unit
-val foldli   : (int * elem * 'b -> 'b) -> 'b -> array * int * int option -> 'b
-val foldri   : (int * elem * 'b -> 'b) -> 'b -> array * int * int option -> 'b
-val modifyi  : (int * elem -> elem) -> array * int * int option -> unit
+val findi    : (int * elem -> bool) -> array -> (int * elem) option
+val appi     : (int * elem -> unit) -> array -> unit
+val foldli   : (int * elem * 'b -> 'b) -> 'b -> array -> 'b
+val foldri   : (int * elem * 'b -> 'b) -> 'b -> array -> 'b
+val modifyi  : (int * elem -> elem) -> array -> unit
+
+val collate  : (elem * elem -> order) -> array * array -> order
 
 (* 
    [array] is the type of one-dimensional, mutable, zero-based
diff -Nru mosml-2.01/src/mosmllib/CharArraySlice.sig mosml-2.10.1/src/mosmllib/CharArraySlice.sig
--- mosml-2.01/src/mosmllib/CharArraySlice.sig	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/CharArraySlice.sig	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,51 @@
+(* CharArraySlice -- SML Basis Library *)
+
+type elem = char
+type array = CharArray.array
+type vector = CharVector.vector
+type vector_slice = CharVectorSlice.slice
+
+type slice
+
+val length   : slice -> int
+val sub      : slice * int -> elem
+val update   : slice * int * elem  -> unit
+val slice    : array * int * int option -> slice
+val full     : array -> slice
+val subslice : slice * int * int option -> slice
+val base     : slice -> array * int * int
+val vector   : slice -> vector
+val copy     : {src: slice, dst: array, di: int} -> unit
+val copyVec  : {src: vector_slice, dst: array, di: int} -> unit 
+val isEmpty  : slice -> bool
+val getItem  : slice -> (elem * slice) option
+
+val find     : (elem -> bool) -> slice -> elem option
+val exists   : (elem -> bool) -> slice -> bool
+val all      : (elem -> bool) -> slice -> bool
+
+val app      : (elem -> unit) -> slice -> unit
+val foldl    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+val foldr    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+val modify   : (elem -> elem) -> slice -> unit
+
+val findi    : (int * elem -> bool) -> slice -> (int * elem) option
+val appi     : (int * elem -> unit) -> slice -> unit
+val foldli   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+val foldri   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+val modifyi  : (int * elem -> elem) -> slice -> unit
+
+val collate  : (elem * elem -> order) -> slice * slice -> order
+
+(* 
+   [slice] is the type of CharArray slices, that is, sub-arrays of
+   CharArray.array values.
+   The slice (a,i,n) is valid if 0 <= i <= i+n <= size s, 
+                or equivalently, 0 <= i and 0 <= n and i+n <= size s.  
+   A valid slice sli = (a,i,n) represents the sub-array a[i...i+n-1],
+   so the elements of sli are a[i], a[i+1], ..., a[i+n-1], and n is
+   the length of the slice.  Only valid slices can be constructed by
+   the functions below.
+
+   All operations are as for ArraySlice.slice.
+*)
diff -Nru mosml-2.01/src/mosmllib/CharArraySlice.sml mosml-2.10.1/src/mosmllib/CharArraySlice.sml
--- mosml-2.01/src/mosmllib/CharArraySlice.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/CharArraySlice.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,58 @@
+(* CharArraySlice -- SML Basis Library *)
+
+type elem = char
+type array = CharArray.array
+type vector = CharVector.vector
+type vector_slice = CharVectorSlice.slice
+
+local 
+    prim_val magic : 'a -> 'b = 1 "identity";
+in
+    type slice = array * int * int
+
+    val length   : slice -> int		= magic Word8ArraySlice.length;
+    val sub      : slice * int -> elem  = magic Word8ArraySlice.sub;
+    val update   : slice * int * elem -> unit 
+					= magic Word8ArraySlice.update;
+    val slice    : array * int * int option -> slice  
+					= magic Word8ArraySlice.slice;
+    val full     : array -> slice	= magic Word8ArraySlice.full;
+    val subslice : slice * int * int option -> slice  
+					= magic Word8ArraySlice.subslice;
+    val base     : slice -> array * int * int 
+					= magic Word8ArraySlice.base;
+    val vector   : slice -> vector	= magic Word8ArraySlice.vector;
+    val copy     : {src: slice, dst: array, di: int} -> unit 
+					= magic Word8ArraySlice.copy;
+    val copyVec  : {src: vector_slice, dst: array, di: int} -> unit  
+					= magic Word8ArraySlice.copyVec;
+    val isEmpty  : slice -> bool	= magic Word8ArraySlice.isEmpty;
+    val getItem  : slice -> (elem * slice) option 
+					= magic Word8ArraySlice.getItem;
+    val find     : (elem -> bool) -> slice -> elem option 
+					= magic Word8ArraySlice.find;
+    val exists   : (elem -> bool) -> slice -> bool 
+					= magic Word8ArraySlice.exists;
+    val all      : (elem -> bool) -> slice -> bool 
+					= magic Word8ArraySlice.all;
+    val app      : (elem -> unit) -> slice -> unit 
+					= magic Word8ArraySlice.app;
+    val foldl    : (elem * 'b -> 'b) -> 'b -> slice -> 'b 
+					= magic Word8ArraySlice.foldl;
+    val foldr    : (elem * 'b -> 'b) -> 'b -> slice -> 'b 
+					= magic Word8ArraySlice.foldr;
+    val modify   : (elem -> elem) -> slice -> unit 
+					= magic Word8ArraySlice.modify;
+    val findi    : (int * elem -> bool) -> slice -> (int * elem) option 
+					= magic Word8ArraySlice.findi;
+    val appi     : (int * elem -> unit) -> slice -> unit 
+					= magic Word8ArraySlice.appi;
+    val foldli   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b 
+					= magic Word8ArraySlice.foldli;
+    val foldri   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b 
+					= magic Word8ArraySlice.foldri;
+    val modifyi  : (int * elem -> elem) -> slice -> unit 
+					= magic Word8ArraySlice.modifyi;
+    val collate  : (elem * elem -> order) -> slice * slice -> order 
+					= magic Word8ArraySlice.collate;
+end
diff -Nru mosml-2.01/src/mosmllib/CharArray.sml mosml-2.10.1/src/mosmllib/CharArray.sml
--- mosml-2.01/src/mosmllib/CharArray.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/CharArray.sml	2014-08-28 08:47:22.000000000 +0000
@@ -14,15 +14,21 @@
     val length   : array -> int                 = magic Word8Array.length
     val sub      : array * int -> elem          = magic Word8Array.sub
     val update   : array * int * elem -> unit   = magic Word8Array.update
-    val extract  : array * int * int option -> vector  
-						= magic Word8Array.extract
-    val copy     : {src: array, si: int, len : int option, 
-		    dst: array, di: int} -> unit = magic Word8Array.copy
-    val copyVec  : {src: vector, si: int, len: int option, 
-		    dst: array, di: int} -> unit = magic Word8Array.copyVec
+    val vector   : array -> vector		= magic Word8Array.vector
+    val copy     : {src: array,  dst: array, di: int} -> unit 
+						= magic Word8Array.copy
+    val copyVec  : {src: vector, dst: array, di: int} -> unit 
+						= magic Word8Array.copyVec
     val app      : (elem -> unit) -> array -> unit
 						= magic Word8Array.app
 
+    val find     : (elem -> bool) -> array -> elem option
+						= magic Word8Array.find
+    val exists   : (elem -> bool) -> array -> bool
+						= magic Word8Array.exists
+    val all      : (elem -> bool) -> array -> bool
+						= magic Word8Array.all
+
     fun foldl (f : elem * 'b -> 'b) (e : 'b) (a : array) : 'b
 	= Word8Array.foldl (magic f) e (magic a)
 
@@ -32,35 +38,22 @@
     fun modify (f : elem -> elem) (a : array) : unit
 	= Word8Array.modify (magic f) (magic a)
 
-    fun appi (f : int * elem -> unit) (a : array*int*int option) : unit
+    val findi : (int * elem -> bool) -> array -> (int * elem) option
+	                                        = magic Word8Array.findi
+
+    fun appi (f : int * elem -> unit) (a : array) : unit
 	= Word8Array.appi (magic f) (magic a)
 
-    fun foldli (f : int * elem * 'b -> 'b) (e : 'b) 
-               (a : array*int*int option) : 'b
+    fun foldli (f : int * elem * 'b -> 'b) (e : 'b) (a : array) : 'b
 	= Word8Array.foldli (magic f) e (magic a)
 
-    fun foldri (f : int * elem * 'b -> 'b) (e : 'b) 
-	       (a : array*int*int option) : 'b 
+    fun foldri (f : int * elem * 'b -> 'b) (e : 'b) (a : array) : 'b 
 	= Word8Array.foldri (magic f) e (magic a)
 
-    fun modifyi (f : int * elem -> elem) (a : array*int*int option) : unit
+    fun modifyi (f : int * elem -> elem) (a : array) : unit
 	= Word8Array.modifyi (magic f) (magic a)
 
-(*
-    val foldl    : (elem * 'b -> 'b) -> 'b -> array -> 'b
-						= magic Word8Array.foldl
-    val foldr    : (elem * 'b -> 'b) -> 'b -> array -> 'b
-						= magic Word8Array.foldr
-    val modify   : (elem -> elem) -> array -> unit
-						= magic Word8Array.modify
-    val appi     : (int * elem -> unit) -> array*int*int option -> unit
-						= magic Word8Array.appi
-    val foldli   : (int * elem * 'b -> 'b) -> 'b -> array*int*int option -> 'b
-						= magic Word8Array.foldli
-    val foldri   : (int * elem * 'b -> 'b) -> 'b -> array*int*int option -> 'b
-						= magic Word8Array.foldri
-    val modifyi  : (int * elem -> elem) -> array*int*int option -> unit
-						= magic Word8Array.modifyi
-*)
+    val collate  : (elem * elem -> order) -> array * array -> order
+						= magic Word8Array.collate
 end
 
diff -Nru mosml-2.01/src/mosmllib/CharVector.sig mosml-2.10.1/src/mosmllib/CharVector.sig
--- mosml-2.01/src/mosmllib/CharVector.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/CharVector.sig	2014-08-28 08:47:22.000000000 +0000
@@ -10,18 +10,25 @@
 
 val length   : vector -> int
 val sub      : vector * int -> elem
-val extract  : vector * int * int option -> vector
+val update   : vector * int * elem -> vector
 val concat   : vector list -> vector
 
+val find     : (elem -> bool) -> vector -> elem option
+val exists   : (elem -> bool) -> vector -> bool
+val all      : (elem -> bool) -> vector -> bool
+
 val app      : (elem -> unit) -> vector -> unit
 val map      : (elem -> elem) -> vector -> vector
 val foldl    : (elem * 'b -> 'b) -> 'b -> vector -> 'b
 val foldr    : (elem * 'b -> 'b) -> 'b -> vector -> 'b
 
-val appi     : (int * elem -> unit) -> vector * int * int option -> unit
-val mapi     : (int * elem -> elem) -> vector * int * int option -> vector
-val foldli   : (int * elem * 'b -> 'b) -> 'b -> vector*int*int option -> 'b
-val foldri   : (int * elem * 'b -> 'b) -> 'b -> vector*int*int option -> 'b
+val findi    : (int * elem -> bool) -> vector -> (int * elem) option
+val appi     : (int * elem -> unit) -> vector -> unit
+val mapi     : (int * elem -> elem) -> vector -> vector
+val foldli   : (int * elem * 'b -> 'b) -> 'b -> vector -> 'b
+val foldri   : (int * elem * 'b -> 'b) -> 'b -> vector -> 'b
+
+val collate  : (elem * elem -> order) -> vector * vector -> order
 
 (* 
    [vector] is the type of one-dimensional, immutable, zero-based
diff -Nru mosml-2.01/src/mosmllib/CharVectorSlice.sig mosml-2.10.1/src/mosmllib/CharVectorSlice.sig
--- mosml-2.01/src/mosmllib/CharVectorSlice.sig	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/CharVectorSlice.sig	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,50 @@
+(* CharVectorSlice -- SML Basis Library *)
+
+type elem = Char.char
+type vector = CharVector.vector
+
+type slice = Substring.substring
+
+val length   : slice -> int
+val sub      : slice * int -> elem
+val slice    : vector * int * int option -> slice
+val full     : vector -> slice
+val subslice : slice * int * int option -> slice
+val base     : slice -> vector * int * int
+val vector   : slice -> vector
+val concat   : slice list -> vector
+val isEmpty  : slice -> bool
+val getItem  : slice -> (elem * slice) option
+
+val find     : (elem -> bool) -> slice -> elem option
+val exists   : (elem -> bool) -> slice -> bool
+val all      : (elem -> bool) -> slice -> bool
+
+val app      : (elem -> unit) -> slice -> unit
+val map      : (elem -> elem) -> slice -> vector
+val foldl    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+val foldr    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+
+val findi    : (int * elem -> bool) -> slice -> (int * elem) option
+val appi     : (int * elem -> unit) -> slice -> unit
+val mapi     : (int * elem -> elem) -> slice -> vector
+val foldli   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+val foldri   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+
+val collate  : (elem * elem -> order) -> slice * slice -> order
+
+(* 
+   [slice] is the type of CharVector slices, that is, sub-vectors of
+   CharVector.vector values.  Since a CharVector.vector is a string, a
+   slice is the same as a substring, and slices may be processed using
+   the functions defined as well as those in structure Substring.
+
+   The slice (a,i,n) is valid if 0 <= i <= i+n <= size s, 
+                or equivalently, 0 <= i and 0 <= n and i+n <= size s.  
+   A valid slice sli = (a,i,n) represents the sub-vector a[i...i+n-1],
+   so the elements of sli are a[i], a[i+1], ..., a[i+n-1], and n is
+   the length of the slice.  Only valid slices can be constructed by
+   these functions.
+
+   All operations are as for VectorSlice.slice.
+*)
diff -Nru mosml-2.01/src/mosmllib/CharVectorSlice.sml mosml-2.10.1/src/mosmllib/CharVectorSlice.sml
--- mosml-2.01/src/mosmllib/CharVectorSlice.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/CharVectorSlice.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,51 @@
+(* CharVectorSlice -- SML Basis Library *)
+
+type elem = Char.char
+type vector = CharVector.vector
+
+local 
+    prim_val magic : 'a -> 'b = 1 "identity";
+in
+    type slice = Substring.substring
+
+    val length   : slice -> int		= magic Word8VectorSlice.length;    
+    val sub      : slice * int -> elem	= magic Word8VectorSlice.sub;    
+    val slice    : vector * int * int option -> slice
+					= magic Word8VectorSlice.slice;    
+    val full     : vector -> slice	= magic Word8VectorSlice.full;    
+    val subslice : slice * int * int option -> slice
+					= magic Word8VectorSlice.subslice;    
+    val base     : slice -> vector * int * int
+					= magic Word8VectorSlice.base;    
+    val vector   : slice -> vector	= magic Word8VectorSlice.vector;    
+    val concat   : slice list -> vector = magic Word8VectorSlice.concat;    
+    val isEmpty  : slice -> bool	= magic Word8VectorSlice.isEmpty;    
+    val getItem  : slice -> (elem * slice) option
+					= magic Word8VectorSlice.getItem;    
+    val find     : (elem -> bool) -> slice -> elem option
+					= magic Word8VectorSlice.find;    
+    val exists   : (elem -> bool) -> slice -> bool
+					= magic Word8VectorSlice.exists;    
+    val all      : (elem -> bool) -> slice -> bool
+					= magic Word8VectorSlice.all;    
+    val app      : (elem -> unit) -> slice -> unit
+					= magic Word8VectorSlice.app;    
+    val map      : (elem -> elem) -> slice -> vector
+					= magic Word8VectorSlice.map;    
+    val foldl    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+					= magic Word8VectorSlice.foldl;    
+    val foldr    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+					= magic Word8VectorSlice.foldr;    
+    val findi    : (int * elem -> bool) -> slice -> (int * elem) option
+					= magic Word8VectorSlice.findi;    
+    val appi     : (int * elem -> unit) -> slice -> unit
+					= magic Word8VectorSlice.appi;    
+    val mapi     : (int * elem -> elem) -> slice -> vector
+					= magic Word8VectorSlice.mapi;    
+    val foldli   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+					= magic Word8VectorSlice.foldli;    
+    val foldri   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+					= magic Word8VectorSlice.foldri;    
+    val collate  : (elem * elem -> order) -> slice * slice -> order
+					= magic Word8VectorSlice.collate;
+end
diff -Nru mosml-2.01/src/mosmllib/CharVector.sml mosml-2.10.1/src/mosmllib/CharVector.sml
--- mosml-2.01/src/mosmllib/CharVector.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/CharVector.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,4 +1,4 @@
-(* CharVector *)
+(* CharVector -- SML Basis Library, 1995, 2000-10-26 *)
 
 type vector = string
 type elem = Char.char
@@ -13,33 +13,42 @@
 
     val length   : vector -> int  		= magic Word8Vector.length
     val sub      : vector * int -> elem         = magic Word8Vector.sub
-    val extract  : vector * int * int option -> vector 
-						= magic Word8Vector.extract
+    val update   : vector * int * elem -> vector 
+						= magic Word8Vector.update
     val concat   : vector list -> vector        = magic Word8Vector.concat
+    val find     : (elem -> bool) -> vector -> elem option 
+	                                        =  magic Word8Vector.find
+    val exists   : (elem -> bool) -> vector -> bool
+	                                        =  magic Word8Vector.exists
+    val all      : (elem -> bool) -> vector -> bool
+	                                        =  magic Word8Vector.all
 
+    val collate  : (elem * elem -> order) -> vector * vector -> order 
+                                                = magic String.collate
 
     val app      : (elem -> unit) -> vector -> unit
 						= magic Word8Vector.app
     val map      : (elem -> elem) -> vector -> vector
 						= magic Word8Vector.map
-    fun foldl (f : elem * 'b -> 'b) (e : 'b) v : 'b
+    val findi    : (int * elem -> bool) -> vector -> (int * elem) option
+	                                        =  magic Word8Vector.findi
+
+    fun foldl (f : elem * 'b -> 'b) (e : 'b) (v : vector) : 'b
 	= Word8Vector.foldl (magic f) e (magic v)
 
     fun foldr (f : elem * 'b -> 'b) (e : 'b) (v : vector) : 'b
 	= Word8Vector.foldr (magic f) e (magic v)
 	
-    fun appi (f : int * elem -> unit) (v : vector * int * int option) : unit
+    fun appi (f : int * elem -> unit) (v : vector) : unit
 	= Word8Vector.appi (magic f) (magic v)
 
-    fun mapi (f : int * elem -> elem) (v : vector * int * int option) : vector
+    fun mapi (f : int * elem -> elem) (v : vector) : vector
 	= magic(Word8Vector.mapi (magic f) (magic v))
 
-    fun foldli (f : int * elem * 'b -> 'b) (e : 'b) 
-	       (v : vector*int*int option) : 'b
+    fun foldli (f : int * elem * 'b -> 'b) (e : 'b) (v : vector) : 'b
         = Word8Vector.foldli (magic f) e (magic v)
 
-    fun foldri (f : int * elem * 'b -> 'b) (e : 'b) 
-	       (v : vector*int*int option) : 'b
+    fun foldri (f : int * elem * 'b -> 'b) (e : 'b) (v : vector) : 'b
 	= Word8Vector.foldri (magic f) e (magic v)
 
 (*
@@ -56,3 +65,4 @@
 						= magic Word8Vector.foldri
 *)
 end
+
diff -Nru mosml-2.01/src/mosmllib/Dynlib.sml mosml-2.10.1/src/mosmllib/Dynlib.sml
--- mosml-2.01/src/mosmllib/Dynlib.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Dynlib.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,7 +1,7 @@
 structure Dynlib :> Dynlib =
 struct
 
-(* Ken Larsen (kla@it.dtu.dk) and sestoft@dina.kvl.dk 1998-01-12 1999-01-07 *)
+(* Ken Friis Larsen (ken@friislarsen.net) and sestoft@dina.kvl.dk 1998-01-12 1999-01-07 *)
 	
 prim_type dlHandle_			(* A pointer outside the ML heap *)
 prim_type symHandle_			(* A pointer outside the ML heap *)
diff -Nru mosml-2.01/src/mosmllib/FileSys.mlp mosml-2.10.1/src/mosmllib/FileSys.mlp
--- mosml-2.01/src/mosmllib/FileSys.mlp	2000-04-11 19:37:01.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/FileSys.mlp	2014-08-28 08:47:22.000000000 +0000
@@ -50,7 +50,7 @@
 in
 
     type dirstream  = dirstruct_ option ref;
-    datatype access = A_READ | A_WRITE | A_EXEC;
+    datatype access_mode = A_READ | A_WRITE | A_EXEC;
 
     fun access (path, perm) =
 	let fun mem p = if List.exists (fn q => p=q) perm then 1 else 0
@@ -92,12 +92,12 @@
 		in
 		    if islink_ file then 
 			(incrlink(); 
-			 expand(mkAbsolute(readlink_ file, p)))
+			 expand(mkAbsolute{path=readlink_ file, relativeTo=p}))
 		    else
 			file
 		end
 	in 
-	    (expand(mkAbsolute(p, getDir())))
+	    (expand(mkAbsolute{path=p, relativeTo=getDir()}))
 	    handle Fail s => raiseSys "fullPath" (SOME p) s
 	end;
 
@@ -150,7 +150,7 @@
 
     fun fullPath p =
 	let open Path 
-	    val realp = mkCanonical(mkAbsolute(p, getDir()))
+	    val realp = mkCanonical(mkAbsolute{path=p, relativeTo=getDir()})
 	in 
 	    if access (realp, []) then realp 
 	    else raise raiseSys "fullPath" (SOME realp) 
@@ -221,7 +221,7 @@
 
     fun realPath p =
 	if Path.isAbsolute p then fullPath p
-	else Path.mkRelative(fullPath p, getDir());
+	else Path.mkRelative{path=fullPath p, relativeTo=getDir()};
 
     fun rmDir p = 
 	(rmdir_ p) handle Fail s => raiseSys "rmDir" (SOME p) s;
diff -Nru mosml-2.01/src/mosmllib/FileSys.sig mosml-2.10.1/src/mosmllib/FileSys.sig
--- mosml-2.01/src/mosmllib/FileSys.sig	2000-06-01 19:57:44.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/FileSys.sig	2014-08-28 08:47:22.000000000 +0000
@@ -23,8 +23,8 @@
 val remove    : string -> unit
 val rename    : {old: string, new: string} -> unit
 
-datatype access = A_READ | A_WRITE | A_EXEC
-val access    : string * access list -> bool
+datatype access_mode = A_READ | A_WRITE | A_EXEC
+val access    : string * access_mode list -> bool
 
 val fileSize  : string -> int
 
@@ -108,7 +108,7 @@
 
    [rename {old, new}] changes the name of file `old' to `new'.
 
-   [access] is the type of access permissions:
+   [access_mode] is the type of access permissions:
 
    [A_READ] specifies read access.
 
diff -Nru mosml-2.01/src/mosmllib/General.fke mosml-2.10.1/src/mosmllib/General.fke
--- mosml-2.01/src/mosmllib/General.fke	2000-06-01 19:57:44.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/General.fke	2014-08-28 08:47:22.000000000 +0000
@@ -33,8 +33,10 @@
 exception Fail of string
 exception Match
 exception Overflow
+exception Option
 exception Subscript
 exception Size
+exception Span
 
 (* Additional Moscow ML top-level exceptions *)
 
@@ -52,7 +54,7 @@
 
 val o          : ('b -> 'c) * ('a -> 'b) -> ('a -> 'c)
 val ignore     : 'a -> unit
-val before     : 'a * 'b -> 'a
+val before     : 'a * unit -> 'a
 
 val exnName    : exn -> string
 val exnMessage : exn -> string
@@ -159,6 +161,8 @@
    [Match] signals the failure to match a value against the patterns
    in a case, handle, or function application.
 
+   [Option] is raised by Option.valOf when applied to NONE.
+
    [Overflow] signals the attempt to compute an unrepresentable number.
 
    [Subscript] signals the attempt to use an illegal index in an
diff -Nru mosml-2.01/src/mosmllib/.gitignore mosml-2.10.1/src/mosmllib/.gitignore
--- mosml-2.01/src/mosmllib/.gitignore	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/.gitignore	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,17 @@
+*.ui
+*.uo
+
+# Files derived from .mlp versions
+Array.sml
+FileSys.sml
+Help.sml
+Int.sml
+Mosml.sml
+Path.sml
+Process.sml
+Strbase.sml
+Weak.sml
+Vector.sml
+Word.sml
+Word8Array.sml
+Word8Vector.sml
diff -Nru mosml-2.01/src/mosmllib/Hashset.sig mosml-2.10.1/src/mosmllib/Hashset.sig
--- mosml-2.01/src/mosmllib/Hashset.sig	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Hashset.sig	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,90 @@
+(* Hashset -- sets implemented by hashtables *)
+
+signature Hashset = sig
+type 'item set
+
+exception NotFound
+
+val empty        : ('_item -> word) * ('_item * '_item -> bool) -> '_item set
+val singleton    : ('_item -> word) * ('_item * '_item -> bool) -> '_item 
+                   -> '_item set
+
+val member       : '_item set * '_item -> bool
+val retrieve     : '_item set * '_item -> '_item
+val peek         : '_item set * '_item -> '_item option
+
+val add          : '_item set * '_item -> unit
+val addList      : '_item set * '_item list -> unit
+val delete       : '_item set * '_item -> unit
+
+val isEmpty      : '_item set -> bool
+val isSubset     : '_item set * '_item set -> bool
+val equal        : '_item set * '_item set -> bool
+val numItems     : '_item set ->  int
+val listItems    : '_item set -> '_item list
+
+val app          : ('_item -> unit) -> '_item set -> unit
+val fold         : ('_item * 'b -> 'b) -> 'b -> '_item set -> 'b
+val all          : ('_item -> bool) -> '_item set -> bool
+val exists       : ('_item -> bool) -> '_item set -> bool
+val find         : ('_item -> bool) -> '_item set -> '_item option
+val copy         : '_item set -> '_item set
+
+val hash         : '_item set -> word
+val polyHash     : 'a -> word
+
+end
+
+(* 
+   ['item set] is the type of sets of elements of type 'item, with a
+   given hash function and equality predicate.
+
+   [empty (hash, equal)] creates a new empty set with the given hash
+   function and equality predicate.  It must hold that equal(x, y)
+   implies hash x = hash y.
+
+   [singleton (hash, equal) i] creates the singleton set containing i,
+   with the given hash function and equality predicate.
+
+   [member(s, i)] returns true if and only if i is in s.
+
+   [retrieve(s, i)] returns i if it is in s; raises NotFound otherwise.
+
+   [peek(s, i)] returns SOME i if i is in s; returns NONE otherwise.
+
+   [add(s, i)] adds item i to set s.  
+
+   [addList(s, xs)] adds all items from the list xs to the set s.
+
+   [delete(s, i)] removes item i from s.  Raises NotFound if i is not in s.
+
+   [isEmpty s] returns true if the set is empty; false otherwise.
+
+   [equal(s1, s2)] returns true if and only if the two sets have the
+   same elements.  
+
+   [isSubset(s1, s2)] returns true if and only if s1 is a subset of s2.
+   
+   [numItems s] returns the number of items in set s.
+
+   [listItems s] returns a list of the items in set s, in some order.
+
+   [app f s] applies function f to the elements of s, in some order.
+
+   [fold f e s] applies the folding function f to the entries of the
+   set in some order.
+
+   [find p s] returns SOME i, where i is an item in s which satisfies
+   p, if one exists; otherwise returns NONE.  
+
+   [hash s] returns the hashcode of the set, which is the sum of the
+   hashcodes of its elements, as computed by the hash function given
+   when the set was created.  
+
+   [polyHash v] returns a system-defined hashcode for the value v.
+   This pseudo-polymorphic hash function can be used together with the
+   standard equality function (=) to create a Hashset for any type that 
+   admits equality, as follows:
+
+       val set = Hashset.empty (Hashset.hash, op =);
+*)
diff -Nru mosml-2.01/src/mosmllib/Hashset.sml mosml-2.10.1/src/mosmllib/Hashset.sml
--- mosml-2.01/src/mosmllib/Hashset.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Hashset.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,279 @@
+(* Hashset -- sets implemented using a hash function and equality predicate.
+ * Note: in contrast to Rbset this representation is imperative.  
+ * 
+ * 80 % complete * 2001-10-28
+
+   A functional (persistent) hashset or hashmap does not seem to make
+   much sense.  The point of a hashset or hashmap is to provide
+   near-constant-time access, so should use an array or vector.  But
+   copying the array on every update or insertion is too unpleasant,
+   as its size will be proportional to the number of elements in the
+   set or entries in the map.  
+
+   We miss hashcode functions for string, int, real, ... or must use
+   the general pseudo-polymorphic function hash : 'a -> word.
+
+   Sigh.  The SML/NJ ord-set-sig and hash-table-sig use the name find
+   with entirely different meanings.
+
+ * Considerably modified for Moscow ML from SML/NJ Library version 0.2
+ *
+ * COPYRIGHT (c) 1992 by AT&T Bell Laboratories.
+ * See file mosml/copyrght/copyrght.att for details.
+ *
+ * Original author: John Reppy, AT&T Bell Laboratories, Murray Hill, NJ 07974
+ *)
+
+exception NotFound
+
+datatype 'key bucket_t
+  = NIL
+  | B of word * 'key * 'key bucket_t   (* hashcode, item, rest *)
+
+datatype 'key set = 
+    HT of { hashVal : 'key -> word,
+	    sameKey : 'key * 'key -> bool,
+	    table   : 'key bucket_t Array.array ref,
+	    n_items : int ref}
+
+local 
+    prim_val andb_      : word -> int -> int = 2 "and";
+    prim_val lshift_    : int -> int -> int = 2 "shift_left";
+in 
+    fun index (i, sz) = andb_ i (sz-1)
+
+    (* find smallest power of 2 (>= 32) that is >= n *)
+    fun roundUp n = 
+	let fun f i = if (i >= n) then i else f (lshift_ i 1)
+	in f 32 end
+end;
+
+(* Conditionally grow the table *)
+
+fun growTable (HT{table, n_items, ...}) = 
+    let val arr = !table
+	val sz = Array.length arr
+    in
+	if (!n_items >= sz) then 
+	    let val newSz = sz+sz
+		val newArr = Array.array (newSz, NIL)
+		fun copy NIL = ()
+		  | copy (B(h, key, rest)) = 
+		    let val indx = index (h, newSz)
+		    in
+			Array.update (newArr, indx,
+				      B(h, key, Array.sub(newArr, indx)));
+			copy rest
+		    end
+	    in
+		Array.app copy arr;
+		table := newArr
+	    end
+	else ()
+    end (* growTable *);
+
+(* Create a new empty table  *)
+
+fun empty (hashVal, sameKey) = 
+    HT{
+       hashVal=hashVal,
+       sameKey=sameKey,
+       table = ref (Array.array(roundUp 13, NIL)),
+       n_items = ref 0
+       };
+
+(* Add an item.  If the key already has an item associated with it, *
+   then the old item is discarded. *)
+
+fun add (tbl as HT{hashVal, sameKey, table, n_items}, key) =
+    let val arr = !table
+	val sz = Array.length arr
+	val hash = hashVal key
+	val indx = index (hash, sz)
+	fun look NIL = 
+	    (Array.update(arr, indx, B(hash, key, Array.sub(arr, indx)));
+	     n_items := !n_items + 1;
+	     growTable tbl;
+	     NIL)
+	  | look (B(h, k, r)) = 
+	    if ((hash = h) andalso sameKey(key, k)) then 
+		B(hash, key, r)
+	    else (case (look r) of 
+		      NIL => NIL
+		    | rest => B(h, k, rest)
+                  (* end case *))
+    in
+	case (look (Array.sub (arr, indx))) of 
+	    NIL => ()
+	  | b   => Array.update(arr, indx, b)
+    end;
+
+(* Add a list of elements to the set  *)
+
+fun addList (set, xs) = 
+    List.app (fn x => add(set, x)) xs
+
+(* Create a new singleton set *)
+
+fun singleton (hashVal, sameKey) item = 
+    let val set = HT{hashVal=hashVal,
+		     sameKey=sameKey,
+		     table = ref (Array.array(roundUp 13, NIL)),
+		     n_items = ref 0
+		     }
+    in add (set, item); set end
+
+(* Being empty, subset of, or equal *)
+
+fun isEmpty (HT{n_items=ref n, ...}) = (n = 0)
+
+fun all p (HT{table, ...}) = 
+    let fun allF NIL               = true
+	  | allF (B(_, key, rest)) = p key andalso allF rest
+    in
+	Array.all allF (!table)
+    end
+
+fun exists p (HT{table, ...}) = 
+    let fun existsF NIL               = false
+	  | existsF (B(_, key, rest)) = p key orelse existsF rest
+    in
+	Array.exists existsF (!table)
+    end
+
+fun member (set as HT{sameKey, ...}, x) = 
+    exists (fn y => sameKey(x, y)) set
+
+fun isSubset (set1 as HT{sameKey, n_items=ref n1, ...}, 
+	      set2 as HT{n_items=ref n2, ...}) = 
+    n1<=n2 andalso 
+    all (fn x1 => exists (fn x2 => sameKey(x1, x2)) set2) set1
+
+fun equal (set1 as HT{n_items=ref n1, ...}, set2 as HT{n_items=ref n2, ...}) = 
+    n1=n2 andalso isSubset (set1, set2) andalso isSubset(set2, set1)    
+
+(* Retrieve an item, or raise NotFound *)
+
+fun retrieve (HT{hashVal, sameKey, table, ...}, key) = 
+    let val arr = !table
+	val sz = Array.length arr
+	val hash = hashVal key
+	val indx = index (hash, sz)
+	fun look NIL = raise NotFound
+	  | look (B(h, k, r)) = 
+	    if ((hash = h) andalso sameKey(key, k)) then k
+	    else look r
+    in
+	look (Array.sub (arr, indx))
+    end;
+
+(* Find an item, return NONE if the item doesn't exist *)
+
+fun peek (HT{hashVal, sameKey, table=ref arr, ...}, key) = 
+    let val sz = Array.length arr
+	val hash = hashVal key
+	val indx = index (hash, sz)
+	fun look NIL = NONE
+	  | look (B(h, k, r)) = 
+	    if (hash = h) andalso sameKey(key, k) then SOME k
+	    else look r
+    in
+	look (Array.sub (arr, indx))
+    end;
+    
+(* Delete an item *)
+
+fun delete (HT{hashVal, sameKey, table, n_items}, key) = 
+    let val arr = !table
+	val sz = Array.length arr
+	val hash = hashVal key
+	val indx = index (hash, sz)
+	fun look NIL          = raise NotFound
+	  | look (B(h, k, r)) = 
+	    if (hash = h) andalso sameKey(key, k) then
+		(k, r)
+	    else 
+		let val (item, r') = look r 
+		in (item, B(h, k, r')) end
+	val (item, bucket) = look (Array.sub (arr, indx))
+    in
+	Array.update (arr, indx, bucket);
+	n_items := !n_items - 1
+    end (* remove *);
+
+(* Return the number of items in the table *)
+
+fun numItems (HT{n_items, ...}) = !n_items
+
+(* Return a list of the members of the set *)
+
+fun listItems (HT{table = ref arr, n_items, ...}) = 
+    let fun loop NIL             res = res
+	  | loop (B(_, k, rest)) res = loop rest (k :: res)
+	fun coll (bucket, res) = loop bucket res
+    in
+	Array.foldr coll [] arr
+    end;
+
+(* Apply a function to the members of the set *)
+
+fun app f (HT{table, ...}) = 
+    let fun appF NIL               = ()
+	  | appF (B(_, key, rest)) = (f key; appF rest)
+    in
+	Array.app appF (!table)
+    end
+
+(* Fold over the members of the set *)
+
+fun fold f e (HT{table, ...}) = 
+    let fun loop NIL             res = res
+	  | loop (B(_, k, rest)) res = loop rest (f (k, res))
+	fun foldF (bucket, res) = loop bucket res
+    in
+	Array.foldr foldF e (!table)
+    end
+
+(* Find a member that satisfies the predicate *)
+
+fun find p (HT{table=ref arr, ...}) = 
+    let fun loopb NIL             = NONE
+	  | loopb (B(_, k, rest)) = if p k then SOME k else loopb rest 
+	fun loopf i = 
+	    if i<0 then 
+		NONE
+	    else 
+		case loopb (Array.sub(arr, i)) of
+		    NONE => loopf (i-1)
+		  | res  => res
+    in
+	loopf (Array.length arr - 1)
+    end
+    
+(* Create a copy of the hashset *)
+
+fun copy (HT{hashVal, sameKey, table=ref arr, n_items}) = 
+    let val newArr = Array.array (Array.length arr, NIL)
+    in
+	Array.copy { src=arr, dst=newArr, di=0 };
+	HT{hashVal=hashVal, 
+	   sameKey=sameKey,
+	   table = ref newArr, 
+	   n_items = ref(!n_items)}
+    end;
+
+(* The hash code of a hashset -- use the stored hash codes *)
+
+fun hash (HT{table, ...}) = 
+    let fun loop NIL             res = res
+	  | loop (B(h, _, rest)) res = loop rest (h + res)
+	fun addHash (bucket, res) = loop bucket res
+    in
+	Array.foldr addHash 0w0 (!table)
+    end
+
+(* The built-in pseudo-polymorphic hash function *)
+
+prim_val hash_param : int -> int -> 'a -> word = 3 "hash_univ_param";
+
+fun polyHash x = hash_param 50 500 x;
diff -Nru mosml-2.01/src/mosmllib/Int.mlp mosml-2.10.1/src/mosmllib/Int.mlp
--- mosml-2.01/src/mosmllib/Int.mlp	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Int.mlp	2014-08-28 08:47:22.000000000 +0000
@@ -1,4 +1,4 @@
-(* Int -- new basis 1995-03-19, 1996-04-01 *)
+(* Int -- new basis 1995-03-19, 1996-04-01, 2004-05-02 *)
 
 type int = int
 
@@ -36,7 +36,16 @@
 	let fun h 0 res = res
 	      | h n res = h (n div radix) (prhex (n mod radix) :: res)
 	    fun tostr n = h (n div radix) [prhex (n mod radix)]
-	in String.implode (if i < 0 then #"~" :: tostr (~i) else tostr i) end
+	in 
+	    if i < 0 then
+		let val last  = ~(i mod (~radix))
+		    val first = i div (~radix)
+		in 
+		    String.implode(#"~" :: h first [prhex last])
+		end
+	    else
+		String.implode (tostr i) 
+	end
 in
     fun scan radix getc source =
 	let open StringCvt
@@ -48,15 +57,18 @@
 		  | HEX => (Char.isHexDigit,                       16)
 	    fun dig1 sgn NONE             = NONE
 	      | dig1 sgn (SOME (c, rest)) = 
-		let fun digr res src = 
-		    case getc src of
-			NONE           => SOME (sgn * res, src)
-		      | SOME (c, rest) => 
-			    if isDigit c then 
-				digr (factor * res + hexval c) rest
-			    else 
-				SOME (sgn * res, src)
-		in if isDigit c then digr (hexval c) rest else NONE end	    
+		let val next_val =
+		        if sgn = 1 then fn (res, hv) => factor * res + hv
+		        else            fn (res, hv) => factor * res - hv
+		    fun digr res src = 
+		        case getc src of
+			    NONE           => SOME (res, src)
+			  | SOME (c, rest) => 
+				if isDigit c then 
+				    digr (next_val(res, hexval c)) rest
+				else 
+				    SOME (res, src)
+		in if isDigit c then digr (sgn * hexval c) rest else NONE end
 	    fun getdigs sgn after0 inp = 
 		case dig1 sgn inp of
 		    NONE => SOME(0, after0)
diff -Nru mosml-2.01/src/mosmllib/ListPair.sig mosml-2.10.1/src/mosmllib/ListPair.sig
--- mosml-2.01/src/mosmllib/ListPair.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/ListPair.sig	2014-08-28 08:47:22.000000000 +0000
@@ -9,10 +9,30 @@
 val foldr  : ('a * 'b * 'c -> 'c) -> 'c -> 'a list * 'b list -> 'c
 val foldl  : ('a * 'b * 'c -> 'c) -> 'c -> 'a list * 'b list -> 'c
 
+val allEq    : ('a * 'b -> bool) -> 'a list * 'b list -> bool
+
+exception UnequalLengths
+
+val zipEq    : ('a list * 'b list) -> ('a * 'b) list
+val mapEq    : ('a * 'b -> 'c) -> 'a list * 'b list -> 'c list
+val appEq    : ('a * 'b -> 'c) -> 'a list * 'b list -> unit
+val foldrEq  : ('a * 'b * 'c -> 'c) -> 'c -> 'a list * 'b list -> 'c
+val foldlEq  : ('a * 'b * 'c -> 'c) -> 'c -> 'a list * 'b list -> 'c
+
 (* 
-   These functions process pairs of lists.  No exception is raised
-   when the lists are found to be of unequal length.  Instead the
-   excess elements from the longer list are disregarded.
+   These functions process pairs (xs, ys) of lists.  
+   There are three groups of functions:
+
+     * zip, map, app, all, exists, foldr and foldl raise no exception
+       when the argument lists are found to be of unequal length; the
+       excess elements from the longer list are simply disregarded.
+
+     * zipEq, mapEq, appEq, foldrEq and foldlEq raise exception
+       UnequalLengths when the argument lists are found to be of
+       unequal length.
+
+     * allEq raises no exception but returns false if the lists are
+       found to have unequal lengths (after traversing the lists).
 
    [zip (xs, ys)] returns the list of pairs of corresponding elements
    from xs and ys.  
@@ -22,24 +42,28 @@
    xys.  Hence zip (unzip xys) has the same result and effect as xys.
 
    [map f (xs, ys)] applies function f to the pairs of corresponding
-   elements of xs and ys and returns the list of results.  Hence 
-   map f (xs, ys) has the same result and effect as List.map f (zip (xs, ys)).
+   elements of xs and ys from left to right and returns the list of
+   results.  Hence map f (xs, ys) has the same result and effect as
+   List.map f (zip (xs, ys)).
 
    [app f (xs, ys)] applies function f to the pairs of corresponding
-   elements of xs and ys and returns ().  Hence app f (xs, ys) has the
-   same result and effect as List.app f (zip (xs, ys)).
+   elements of xs and ys from left to right and returns ().  Hence 
+   app f (xs, ys) has the same result and effect as 
+   List.app f (zip (xs, ys)).
 
    [all p (xs, ys)] applies predicate p to the pairs of corresponding
-   elements of xs and ys until p evaluates to false or one or both
-   lists is exhausted; returns true if p is true of all such pairs;
-   otherwise false.  Hence all p (xs, ys) has the same result and
-   effect as Lisp.all p (zip (xs, ys)).
-
-   [exists p (xs, ys)] applies predicate p to the pairs of corresponding
-   elements of xs and ys until p evaluates to true or one or both
-   lists is exhausted; returns true if p is true of any such pair;
-   otherwise false.  Hence exists p (xs, ys) has the same result and
-   effect as Lisp.exists p (zip (xs, ys)).
+   elements of xs and ys from left to right until p evaluates to false
+   or one or both lists is exhausted; returns true if p is true of all
+   such pairs; otherwise false.  Hence all p (xs, ys) has the same
+   result and effect as List.all p (zip (xs, ys)).
+
+   [exists p (xs, ys)] applies predicate p to the pairs of
+   corresponding elements of xs and ys from left to right until p
+   evaluates to true or one or both lists is exhausted; returns true
+   if p is true of any such pair; otherwise false.  
+   Hence exists p (xs, ys) has the same result and effect as 
+   List.exists p (zip (xs, ys)).  Also, exists p (xs, ys) is equivalent 
+   to not(all (not o p) (xs, ys)).
 
    [foldr f e (xs, ys)] evaluates f(x1, y1, f(x2, y2, f(..., f(xn, yn, e))))
    where xs = [x1, x2, ..., x(n-1), xn, ...],
@@ -52,4 +76,39 @@
          ys = [y1, y2, ..., y(n-1), yn, ...], 
    and    n = min(length xs, length ys).
    Equivalent to List.foldl (fn ((x, y), r) => f(x, y, r)) e (zip(xs, ys)).
+
+   [zipEq (xs, ys)] returns the list of pairs of corresponding
+   elements from xs and ys.  Raises UnequalLengths if xs and ys do not
+   have the same length.
+
+   [mapEq f (xs, ys)] applies function f to pairs of corresponding
+   elements of xs and ys from left to right, and then returns the list
+   of results if xs and ys have the same length, otherwise raises
+   UnequalLengths.  If f has no side effects and terminates, then
+   it is equivalent to List.map f (zipEq (xs, ys)).
+
+   [appEq f (xs, ys)] applies function f to pairs of corresponding
+   elements of xs and ys from left to right, and then raises
+   UnequalLengths if xs and ys have the same length. 
+
+   [foldrEq f e (xs, ys)] raises UnequalLengths if xs and ys do not
+   have the same length.  Otherwise evaluates 
+         f(x1, y1, f(x2, y2, f(..., f(xn, yn, e))))
+   where xs = [x1, x2, ..., x(n-1), xn],
+         ys = [y1, y2, ..., y(n-1), yn], 
+   and n = length xs = length ys.
+   Equivalent to List.foldr (fn ((x,y),r) => f(x,y,r)) e (zipEq(xs, ys)).
+
+   [foldlEq f e (xs, ys)] evaluates 
+   f(xn, yn, f( ..., f(x2, y2, f(x1, y1, e))))
+   where xs = [x1, x2, ..., x(n-1), xn, ...], 
+         ys = [y1, y2, ..., y(n-1), yn, ...], 
+   and    n = min(length xs, length ys).
+   Then raises UnequalLengths if xs and ys do not have the same
+   length.  If f has no side effects and terminates normally, then it is
+   equivalent to List.foldl (fn ((x,y),r) => f(x,y,r)) e (zipEq(xs, ys)).
+
+   [allEq p (xs, ys)] works as all p (xs, ys) but returns false if xs
+   and ys do not have the same length.  Equivalent to 
+       all p (xs, ys) andalso length xs = length ys.
 *)
diff -Nru mosml-2.01/src/mosmllib/ListPair.sml mosml-2.10.1/src/mosmllib/ListPair.sml
--- mosml-2.01/src/mosmllib/ListPair.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/ListPair.sml	2014-08-28 08:47:22.000000000 +0000
@@ -40,6 +40,44 @@
 	  | h e _       _       = e
     in h e xs ys end;
 
+exception UnequalLengths;
+
+fun zipEq (xs, ys) = 
+    let fun h (x::xr) (y::yr) res = h xr yr ((x, y) :: res)
+	  | h []      []      res = List.rev res
+	  | h _       _       res = raise UnequalLengths
+    in h xs ys [] end;
+
+fun mapEq f (xs, ys) = 
+    let fun h (x::xr) (y::yr) res = h xr yr (f(x, y) :: res)
+	  | h []      []      res = List.rev res
+	  | h _       _       res = raise UnequalLengths
+    in h xs ys [] end;
+
+fun appEq f (xs, ys) = 
+    let fun h (x::xr) (y::yr) = (f (x, y); h xr yr)
+	  | h []      []      = ()
+	  | h _       _       = raise UnequalLengths
+    in h xs ys end;
+
+fun allEq p (xs, ys) = 
+    let fun h (x::xr) (y::yr) = p(x, y) andalso h xr yr
+	  | h []      []      = true
+	  | h _       _       = false
+    in h xs ys end;
+
+fun foldrEq f e (xs, ys) = 
+    let fun h (x::xr) (y::yr) = f(x, y, h xr yr) 
+	  | h []      []      = e
+	  | h _       _       = raise UnequalLengths
+    in h xs ys end;
+
+fun foldlEq f e (xs, ys) = 
+    let fun h e (x::xr) (y::yr) = h (f(x, y, e)) xr yr
+	  | h e []      []      = e
+	  | h e _       _       = raise UnequalLengths
+    in h e xs ys end;
+
 (* The following is not a member of the Basis Library:
 
 fun find p (xs, ys) = 
diff -Nru mosml-2.01/src/mosmllib/List.sig mosml-2.10.1/src/mosmllib/List.sig
--- mosml-2.01/src/mosmllib/List.sig	2000-06-01 19:57:44.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/List.sig	2014-08-28 08:47:22.000000000 +0000
@@ -35,6 +35,8 @@
 val exists     : ('a -> bool) -> 'a list -> bool
 val all        : ('a -> bool) -> 'a list -> bool
 
+val collate    : ('a * 'a -> order) -> 'a list * 'a list -> order
+
 val tabulate   : int * (int -> 'a) -> 'a list           (* Size      *)
 
 val getItem    : 'a list -> ('a * 'a list) option
@@ -81,9 +83,9 @@
    to right, and returns the list of those y's for which f(x)
    evaluated to SOME y.
 
-   [find p xs] applies f to each element x of xs, from left to
-   right until p(x) evaluates to true; returns SOME x if such an x
-   exists otherwise NONE.
+   [find p xs] applies p to each element x of xs, from left to right,
+   until p(x) evaluates to true; returns SOME x if such an x exists,
+   otherwise NONE.
 
    [filter p xs] applies p to each element x of xs, from left to
    right, and returns the sublist of those x for which p(x) evaluated
@@ -108,6 +110,10 @@
    right until p(x) evaluates to false; returns false if such an x
    exists, otherwise true.
 
+   [collate cmp (xs, ys)] returns LESS, EQUAL or GREATER according as
+   xs precedes, equals or follows ys in the lexicographic ordering on
+   lists induced by the ordering cmp on elements.
+
    [tabulate(n, f)] returns a list of length n whose elements are
    f(0), f(1), ..., f(n-1), created from left to right.  Raises Size
    if n<0.
diff -Nru mosml-2.01/src/mosmllib/List.sml mosml-2.10.1/src/mosmllib/List.sml
--- mosml-2.01/src/mosmllib/List.sml	2000-05-16 16:13:08.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/List.sml	2014-08-28 08:47:22.000000000 +0000
@@ -93,6 +93,16 @@
 fun all p []      = true
   | all p (x::xr) = p x andalso all p xr;
 
+fun collate cmp (xs, ys) =
+    let fun h []       []       = EQUAL
+	  | h []       (y1::yr) = LESS
+	  | h (x1::xr) []       = GREATER
+	  | h (x1::xr) (y1::yr) = 
+	    case cmp(x1, y1) of
+		EQUAL => h xr yr
+	      | res   => res
+    in h xs ys end
+
 fun tabulate (n, f) =
     let fun h i = if i order) -> 'a list -> 'a list
-val sorted : ('a * 'a -> order) -> 'a list -> bool
+val sort      : ('a * 'a -> order) -> 'a list -> 'a list
+val sorted    : ('a * 'a -> order) -> 'a list -> bool
+val merge     : ('a * 'a -> order) -> 'a list * 'a list -> 'a list
+val mergeUniq : ('a * 'a -> order) -> 'a list * 'a list -> 'a list
+val eqclasses : ('a * 'a -> order) -> 'a list -> 'a list list
 
 (* 
    [sort ordr xs] sorts the list xs in nondecreasing order, using the
@@ -10,4 +13,28 @@
 
    [sorted ordr xs] checks that the list xs is sorted in nondecreasing
    order, in the given ordering.
+
+   [merge ordr (xs, ys)] returns a sorted list of the elements of the
+   sorted lists xs and ys, preserving duplicates.  Both xs and ys must
+   be already sorted by ordr, that is, must satisfy
+      sorted ordr xs andalso sorted ordr ys
+   Then the result satisfies 
+      sorted ordr (merge ordr (xs, ys))
+
+   [mergeUniq ordr (xs, ys)] returns a sorted list of the elements of
+   the sorted lists xs and ys, without duplicates: no elements in the
+   result are EQUAL by ordr.  Both xs and ys must be already sorted by
+   ordr.
+
+   [eqclasses ordr xs] returns a list [xs1, xs2, ..., xsn] of
+   non-empty equivalence classes of xs, obtained by sorting the list 
+   and then grouping consecutive runs of elements that are EQUAL by ordr.
+   If ordr is a total order, then it holds for xi in xsi and xj in xsj:
+      ordr(xi, xj) = EQUAL   iff i=j and 
+      ordr(xi, xj) = LESS    iff ij 
+   Thus ordr(xi, xj) = Int.compare(i, j).  A list of representatives
+   for the equivalence classes of xs under ordering ordr can be
+   obtained by
+      List.map List.hd (eqclasses ordr xs) 
 *)
diff -Nru mosml-2.01/src/mosmllib/Listsort.sml mosml-2.10.1/src/mosmllib/Listsort.sml
--- mosml-2.01/src/mosmllib/Listsort.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Listsort.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,8 +1,13 @@
 (* Listsort *)
 
-(** Smooth Applicative Merge Sort, Richard O'Keefe 1982        **)
-(** From L.C. Paulson: ML for the Working Programmer, CUP 1991 **)
-(** Optimized for Moscow ML **)
+(* Smooth Applicative Merge Sort, Richard O'Keefe 1982        *)
+(* From L.C. Paulson: ML for the Working Programmer, CUP 1991 *)
+(* Optimized for Moscow ML *)
+
+(* Should be made stable; this requires more than a change to nextrun;
+   for inspiration, see 
+   http://www.dcs.gla.ac.uk/mail-www/haskell/msg00207.html
+ *)
 
 fun sort ordr []          = []
   | sort ordr (xs as [_]) = xs
@@ -11,11 +16,14 @@
 	 GREATER => [x2, x1]
        | _       => xs)
   | sort ordr xs =
-    let fun merge []      ys = ys 
-          | merge xs      [] = xs
-          | merge (x::xs) (y::ys) =
-            if ordr(x, y) <> GREATER then x :: merge xs (y::ys)
-            else y :: merge (x::xs) ys
+    let fun merge []       ys = ys
+	  | merge (x1::xr) ys = 
+	    let fun take x1 xr []       = x1 :: xr
+		  | take x1 xr (y1::yr) = 
+	            (case ordr(x1, y1) of 
+			 LESS    => x1 :: take y1 yr xr
+		       | _       => y1 :: take x1 xr yr)
+	    in take x1 xr ys end
         fun mergepairs l1  []              k = [l1]
           | mergepairs l1 (ls as (l2::lr)) k =
             if k mod 2 = 1 then l1::ls
@@ -30,8 +38,51 @@
 	    in sorting tail (mergepairs (List.rev revrun) ls (r+1)) (r+1) end
     in sorting xs [] 0 end;
 
+(* Check sortedness *)
+
 fun sorted ordr []         = true
   | sorted ordr (y1 :: yr) = 
     let fun h x0 []       = true
 	  | h x0 (x1::xr) = ordr(x0, x1) <> GREATER andalso h x1 xr
     in h y1 yr end;
+
+(* Merge without duplicates *)
+
+fun mergeUniq ordr ([],     ys) = ys
+  | mergeUniq ordr (x1::xr, ys) = 
+    let fun take x1 xr []       = x1 :: xr
+	  | take x1 xr (y1::yr) = 
+	    (case ordr(x1, y1) of 
+		 LESS    => x1 :: take y1 yr xr
+	       | GREATER => y1 :: take x1 xr yr
+	       | EQUAL   => take x1 xr yr)
+    in take x1 xr ys end
+
+(* Merge with duplicates *)
+
+fun merge ordr ([],     ys) = ys
+  | merge ordr (x1::xr, ys) = 
+    let fun take x1 xr []       = x1 :: xr
+	  | take x1 xr (y1::yr) = 
+	    (case ordr(x1, y1) of 
+		 LESS    => x1 :: take y1 yr xr
+	       | _       => y1 :: take x1 xr yr)
+    in take x1 xr ys end
+
+(* Find the equivalence classes of a sorted list *)
+
+fun eqclasses ordr xs =
+    let val xs = List.rev (sort ordr xs)
+	fun group last rest cs1 css =
+	    case rest of 
+		[]     => cs1 :: css
+	      | r1::rr => 
+		    if ordr(r1, last) = EQUAL then 
+			group r1 rr (r1 :: cs1) css
+		    else
+			group r1 rr [r1] (cs1 :: css)
+    in 
+	case xs of 
+	    []     => []
+	  | x1::xr => group x1 xr [x1] []
+    end
diff -Nru mosml-2.01/src/mosmllib/Makefile mosml-2.10.1/src/mosmllib/Makefile
--- mosml-2.01/src/mosmllib/Makefile	2000-06-27 16:38:25.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -7,23 +7,25 @@
 
 # Make with the supplied compiler
 
-all: Array.uo Array2.uo Arraysort.uo \
-     BasicIO.uo Binaryset.uo Binarymap.uo BinIO.uo Bool.uo Byte.uo \
-     Callback.uo Char.uo CharArray.uo CharVector.uo CommandLine.uo \
+all: Array.uo Array2.uo ArraySlice.uo Arraysort.uo \
+     BasicIO.uo Binaryset.uo Binarymap.uo BinIO.uo Bool.uo Buffer.uo Byte.uo \
+     Callback.uo Char.uo CharArray.uo CharArraySlice.uo \
+     CharVector.uo CharVectorSlice.uo CommandLine.uo \
      Date.uo Dynarray.uo Dynlib.uo \
-     FileSys.uo Gdbm.uo Gdimage.uo Help.uo \
+     FileSys.uo Gdbm.uo Gdimage.uo Hashset.uo Help.uo \
      Int.uo Intmap.uo Intset.uo IO.uo \
      Lexing.uo List.uo ListPair.uo Listsort.uo Location.uo \
      Math.uo Misc.uo Mosml.uo Mosmlcgi.uo Mosmlcookie.uo Msp.uo Mysql.uo \
      NJ93.uo Nonstdio.uo \
      Obj.uo Option.uo OS.uo \
      Parsing.uo Path.uo Polygdbm.uo Polyhash.uo Postgres.uo PP.uo Process.uo \
-     Random.uo Real.uo Regex.uo \
+     Random.uo Rbset.uo Real.uo Redblackmap.uo Regex.uo \
      Signal.uo SML90.uo Socket.uo Splaymap.uo Splayset.uo Splaytree.uo \
      Strbase.uo String.uo StringCvt.uo Substring.uo Susp.uo \
      TextIO.uo Time.uo Timer.uo \
-     Unix.uo Vector.uo \
-     Weak.uo Word.uo Word8.uo Word8Array.uo Word8Vector.uo
+     Unix.uo Vector.uo VectorSlice.uo \
+     Weak.uo Word.uo Word8.uo Word8Array.uo Word8ArraySlice.uo \
+     Word8Vector.uo Word8VectorSlice.uo
 
 # Make with the current compiler
 current:
@@ -39,14 +41,14 @@
 	rm -f Vector.sml Word.sml Word8Array.sml Word8Vector.sml Weak.sml
 
 install:
-	${INSTALL_DATA} README $(LIBDIR)
-	${INSTALL_DATA} *.ui $(LIBDIR)
-	${INSTALL_DATA} *.uo $(LIBDIR)
-	${INSTALL_DATA} *.sig $(LIBDIR)
-	${INSTALL_DATA} General.fke $(LIBDIR)/General.sig
-	${INSTALL_DATA} Meta.fke $(LIBDIR)/Meta.sig
-	rm -f $(LIBDIR)/camlrunm
-	ln -s $(BINDIR)/camlrunm $(LIBDIR)/camlrunm
+	${INSTALL_DATA} README $(DESTDIR)$(LIBDIR)
+	${INSTALL_DATA} *.ui $(DESTDIR)$(LIBDIR)
+	${INSTALL_DATA} *.uo $(DESTDIR)$(LIBDIR)
+	${INSTALL_DATA} *.sig $(DESTDIR)$(LIBDIR)
+	${INSTALL_DATA} General.fke $(DESTDIR)$(LIBDIR)/General.sig
+	${INSTALL_DATA} Meta.fke $(DESTDIR)$(LIBDIR)/Meta.sig
+#	rm -f $(DESTDIR)$(LIBDIR)/camlrunm
+#	ln -s $(BINDIR)/camlrunm $(LIBDIR)/camlrunm
 
 depend: Array.sml FileSys.sml Help.sml Int.sml Mosml.sml Path.sml \
     Process.sml Strbase.sml Vector.sml Word.sml Word8Array.sml \
@@ -61,123 +63,146 @@
 OS.ui: FileSys.ui Path.ui Process.ui
 
 ### DO NOT DELETE THIS LINE
-Word8Vector.uo: Word8Vector.ui List.ui Word8.ui 
-Word8Array.uo: Word8Array.ui List.ui Word8.ui Word8Vector.ui 
-Word.uo: Word.ui String.ui StringCvt.ui Char.ui 
-Weak.uo: Weak.ui 
-Vector.uo: Vector.ui List.ui 
-Strbase.uo: Strbase.ui List.ui 
-Process.uo: Process.ui List.ui BasicIO.ui 
-Path.uo: Path.ui String.ui List.ui Substring.ui 
-Mosml.uo: Mosml.ui Timer.ui FileSys.ui BinIO.ui String.ui List.ui Vector.ui \
-    Word8.ui Process.ui Byte.ui TextIO.ui Word8Vector.ui Time.ui 
-Int.uo: Int.ui String.ui StringCvt.ui Char.ui 
-Help.uo: Help.ui String.ui StringCvt.ui List.ui BasicIO.ui Vector.ui \
-    TextIO.ui Char.ui 
-OS.uo: OS.ui 
-FileSys.uo: FileSys.ui Path.ui List.ui OS.ui Time.ui 
-Array.uo: Array.ui List.ui Vector.ui 
-Gdimage.uo: Gdimage.ui Dynlib.ui Vector.ui 
-Signal.uo: Signal.ui Word.ui 
-Signal.ui: Word.ui 
-Unix.uo: Unix.ui Signal.ui Word.ui Dynlib.ui Option.ui Vector.ui Process.ui \
-    TextIO.ui Obj.uo 
-Unix.ui: Signal.ui Process.ui TextIO.ui 
-Socket.uo: Socket.ui Word.ui Dynlib.ui Word8Array.ui Vector.ui \
-    Word8Vector.ui Time.ui 
-Socket.ui: Word8Array.ui Word8Vector.ui Time.ui 
-Regex.uo: Regex.ui Word.ui Dynlib.ui List.ui Vector.ui Substring.ui 
-Mysql.uo: Mysql.ui String.ui Real.ui Dynlib.ui StringCvt.ui Msp.ui List.ui \
-    Date.ui Option.ui Vector.ui Substring.ui Int.ui 
-Mysql.ui: Msp.ui Date.ui Vector.ui 
-Postgres.uo: Postgres.ui String.ui Real.ui Dynlib.ui StringCvt.ui Msp.ui \
-    List.ui Date.ui Option.ui Word8Array.ui Vector.ui Substring.ui Int.ui \
-    Bool.ui 
+CharArray.uo: CharArray.ui CharVector.ui Word8Array.ui Char.ui 
+Redblackset.uo: Redblackset.ui List.ui 
+NJ93.uo: NJ93.ui String.ui List.ui BasicIO.ui TextIO.ui 
+Char.uo: Char.ui Strbase.ui 
+Binarymap.uo: Binarymap.ui 
+Splayset.uo: Splayset.ui List.ui Splaytree.ui 
+ArraySlice.ui: Vector.ui Array.ui VectorSlice.ui 
+Word.ui: StringCvt.ui 
 Postgres.ui: Msp.ui Date.ui Word8Array.ui Vector.ui 
-Mosmlcookie.uo: Mosmlcookie.ui String.ui List.ui Date.ui Option.ui \
-    Process.ui Substring.ui Bool.ui 
-Mosmlcookie.ui: Date.ui 
 Msp.uo: Msp.ui String.ui StringCvt.ui List.ui Option.ui Vector.ui TextIO.ui \
     Int.ui Mosmlcgi.ui Char.ui 
-Word8Vector.ui: Word8.ui 
-Word8Array.ui: Word8.ui Word8Vector.ui 
-Word8.uo: Word8.ui Word.ui String.ui StringCvt.ui Char.ui 
-Word8.ui: Word.ui StringCvt.ui 
-Word.ui: StringCvt.ui 
-Timer.uo: Timer.ui Time.ui 
-Timer.ui: Time.ui 
-Time.uo: Time.ui String.ui StringCvt.ui Char.ui 
-Time.ui: StringCvt.ui 
-TextIO.uo: TextIO.ui String.ui Char.ui 
-TextIO.ui: StringCvt.ui Char.ui 
-Susp.uo: Susp.ui 
 Substring.uo: Substring.ui String.ui Strbase.ui 
-StringCvt.uo: StringCvt.ui 
-String.uo: String.ui List.ui Strbase.ui Char.ui 
-String.ui: Char.ui 
-Splaytree.uo: Splaytree.ui 
-Splayset.uo: Splayset.ui List.ui Splaytree.ui 
+Timer.ui: Time.ui 
+Mosml.uo: Mosml.ui Timer.ui FileSys.ui BinIO.ui String.ui List.ui Vector.ui \
+    Word8.ui Process.ui Byte.ui TextIO.ui Word8Vector.ui Time.ui 
+Parsing.uo: Parsing.ui Lexing.ui Vector.ui Obj.uo 
+Array.uo: Array.ui List.ui Vector.ui 
+Word8Vector.ui: Word8.ui 
+Math.uo: Math.ui 
+OS.uo: OS.ui 
 Splaymap.uo: Splaymap.ui Splaytree.ui 
-SML90.uo: SML90.ui String.ui BasicIO.ui 
-Real.uo: Real.ui StringCvt.ui Char.ui 
-Real.ui: StringCvt.ui 
-Random.uo: Random.ui 
+CharVector.uo: CharVector.ui String.ui Word8Vector.ui Char.ui 
+CharArraySlice.uo: CharArraySlice.ui CharVector.ui CharArray.ui \
+    Word8ArraySlice.ui CharVectorSlice.ui 
+Time.ui: StringCvt.ui 
+Path.uo: Path.ui String.ui CharVector.ui List.ui Substring.ui 
+Word.uo: Word.ui String.ui StringCvt.ui Char.ui 
+Intmap.uo: Intmap.ui 
+Array.ui: Vector.ui 
+Arraysort.ui: Array.ui 
+Word8ArraySlice.ui: Word8Array.ui Word8.ui Word8Vector.ui \
+    Word8VectorSlice.ui 
+Word8Vector.uo: Word8Vector.ui String.ui List.ui Word8.ui 
+List.uo: List.ui 
 Polyhash.uo: Polyhash.ui Array.ui 
-Polygdbm.uo: Polygdbm.ui List.ui Gdbm.ui 
-Polygdbm.ui: Gdbm.ui 
-Parsing.uo: Parsing.ui Lexing.ui Vector.ui Obj.uo 
-Parsing.ui: Lexing.ui Vector.ui Obj.uo 
 PP.uo: PP.ui String.ui List.ui Vector.ui Array.ui TextIO.ui 
-Option.uo: Option.ui 
+CharArraySlice.ui: CharVector.ui CharArray.ui CharVectorSlice.ui 
+Redblackmap.uo: Redblackmap.ui 
+Random.uo: Random.ui 
 Nonstdio.uo: Nonstdio.ui BasicIO.ui CharArray.ui 
+CharVectorSlice.ui: CharVector.ui Substring.ui Char.ui 
+BasicIO.uo: BasicIO.ui 
+VectorSlice.ui: Vector.ui 
+Unix.uo: Unix.ui BinIO.ui Signal.ui Word.ui Dynlib.ui Option.ui Vector.ui \
+    OS.ui TextIO.ui Obj.uo 
+Byte.uo: Byte.ui String.ui Word8.ui Word8ArraySlice.ui Substring.ui \
+    Word8Vector.ui Char.ui Word8VectorSlice.ui 
+Byte.ui: String.ui Word8Array.ui Word8.ui Word8ArraySlice.ui Substring.ui \
+    Word8Vector.ui Char.ui Word8VectorSlice.ui 
+Signal.ui: Word.ui 
+Socket.uo: Socket.ui Word.ui Dynlib.ui Word8Array.ui Vector.ui \
+    Word8Vector.ui Time.ui Word8VectorSlice.ui 
+Parsing.ui: Lexing.ui Vector.ui Obj.uo 
 Nonstdio.ui: BasicIO.ui CharArray.ui Char.ui 
-NJ93.uo: NJ93.ui String.ui List.ui BasicIO.ui TextIO.ui 
-Mosmlcgi.uo: Mosmlcgi.ui String.ui StringCvt.ui List.ui Option.ui \
-    Process.ui Substring.ui Splaymap.ui TextIO.ui Int.ui Char.ui 
-Mosml.ui: Word8Vector.ui 
+Polygdbm.uo: Polygdbm.ui List.ui Gdbm.ui 
+Process.uo: Process.ui List.ui BasicIO.ui Time.ui 
+TextIO.ui: StringCvt.ui Char.ui 
+Word8Array.ui: Word8.ui Word8Vector.ui 
+Time.uo: Time.ui Real.ui StringCvt.ui Char.ui 
+Gdbm.uo: Gdbm.ui Dynlib.ui List.ui 
+Signal.uo: Signal.ui Word.ui 
+Lexing.uo: Lexing.ui CharArray.ui Obj.uo 
 Misc.uo: Misc.ui String.ui List.ui Option.ui Vector.ui Array.ui TextIO.ui \
     Char.ui 
-Misc.ui: Array.ui 
-Math.uo: Math.ui 
-Location.uo: Location.ui CharVector.ui Parsing.ui BasicIO.ui Nonstdio.ui \
-    Lexing.ui 
-Location.ui: BasicIO.ui Lexing.ui 
-Listsort.uo: Listsort.ui List.ui 
-ListPair.uo: ListPair.ui List.ui 
-List.uo: List.ui 
-Lexing.uo: Lexing.ui CharArray.ui Obj.uo 
+Polygdbm.ui: Gdbm.ui 
+Mysql.uo: Mysql.ui String.ui Real.ui Dynlib.ui StringCvt.ui Msp.ui List.ui \
+    Date.ui Option.ui Word8Array.ui Vector.ui Substring.ui Int.ui 
+Date.ui: StringCvt.ui Time.ui 
 Lexing.ui: CharArray.ui Obj.uo 
-Intset.uo: Intset.ui List.ui 
-Intmap.uo: Intmap.ui 
-Int.ui: StringCvt.ui 
-Gdbm.uo: Gdbm.ui Dynlib.ui List.ui 
-FileSys.ui: Time.ui 
-Dynlib.uo: Dynlib.ui 
+Word8Array.uo: Word8Array.ui List.ui Word8.ui Word8Vector.ui 
+Unix.ui: BinIO.ui Signal.ui OS.ui TextIO.ui 
 Dynarray.uo: Dynarray.ui Array.ui 
+Word8.ui: Word.ui StringCvt.ui 
 Date.uo: Date.ui String.ui Real.ui StringCvt.ui Option.ui Vector.ui Int.ui \
     Time.ui Char.ui 
-Date.ui: StringCvt.ui Time.ui 
-CommandLine.uo: CommandLine.ui Vector.ui 
-CharVector.uo: CharVector.ui Word8Vector.ui Char.ui 
-CharVector.ui: Char.ui 
-CharArray.uo: CharArray.ui CharVector.ui Word8Array.ui Char.ui 
-CharArray.ui: CharVector.ui Char.ui 
-Char.uo: Char.ui Strbase.ui 
-Callback.uo: Callback.ui Polyhash.ui 
-Byte.uo: Byte.ui String.ui Word8Array.ui Word8.ui Substring.ui \
-    Word8Vector.ui Char.ui 
-Byte.ui: String.ui Word8Array.ui Word8.ui Substring.ui Word8Vector.ui \
-    Char.ui 
+Word8VectorSlice.ui: Word8.ui Word8Vector.ui 
+CharVectorSlice.uo: CharVectorSlice.ui CharVector.ui Substring.ui Char.ui \
+    Word8VectorSlice.ui 
+BinIO.ui: Word8.ui Word8Vector.ui 
 Bool.uo: Bool.ui StringCvt.ui Char.ui 
-Bool.ui: StringCvt.ui 
+Susp.uo: Susp.ui 
+Mosmlcookie.uo: Mosmlcookie.ui String.ui List.ui Date.ui Option.ui \
+    Process.ui Substring.ui Bool.ui 
+Postgres.uo: Postgres.ui String.ui Real.ui Dynlib.ui StringCvt.ui Msp.ui \
+    List.ui Date.ui Option.ui Word8Array.ui Vector.ui Substring.ui Int.ui \
+    Bool.ui 
 Binaryset.uo: Binaryset.ui List.ui 
-Binarymap.uo: Binarymap.ui 
-BinIO.uo: BinIO.ui Word8.ui TextIO.ui Word8Vector.ui 
-BinIO.ui: Word8.ui Word8Vector.ui 
-BasicIO.uo: BasicIO.ui 
+Hashset.uo: Hashset.ui List.ui Array.ui 
+Rbset.uo: Rbset.ui List.ui Int.ui 
+CommandLine.uo: CommandLine.ui Vector.ui 
+TextIO.uo: TextIO.ui String.ui Char.ui 
+Location.ui: BasicIO.ui Lexing.ui 
+AppleScript.uo: AppleScript.ui 
+Timer.uo: Timer.ui Time.ui 
+VectorSlice.uo: VectorSlice.ui Vector.ui 
+Int.uo: Int.ui String.ui StringCvt.ui Char.ui 
+CharArray.ui: CharVector.ui Char.ui 
+Word8VectorSlice.uo: Word8VectorSlice.ui Word8.ui Word8Vector.ui 
+Array2.uo: Array2.ui List.ui Vector.ui Array.ui VectorSlice.ui \
+    ArraySlice.ui 
+StringCvt.uo: StringCvt.ui 
 Arraysort.uo: Arraysort.ui Array.ui 
-Arraysort.ui: Array.ui 
-Array2.uo: Array2.ui List.ui Vector.ui Array.ui 
+Misc.ui: Array.ui 
+String.uo: String.ui List.ui Strbase.ui Char.ui 
+Weak.uo: Weak.ui 
+Location.uo: Location.ui CharVector.ui Parsing.ui BasicIO.ui Nonstdio.ui \
+    Lexing.ui 
+ListPair.uo: ListPair.ui List.ui 
+Mosml.ui: Word8Vector.ui 
+String.ui: Char.ui 
+ArraySlice.uo: ArraySlice.ui Vector.ui Array.ui VectorSlice.ui 
 Array2.ui: Vector.ui 
-Array.ui: Vector.ui 
-AppleScript.uo: AppleScript.ui 
+Callback.uo: Callback.ui Polyhash.ui 
+Regex.uo: Regex.ui Word.ui Dynlib.ui List.ui Vector.ui Substring.ui 
+Mysql.ui: Msp.ui Date.ui Word8Array.ui Vector.ui 
+CharVector.ui: Char.ui 
+BinIO.uo: BinIO.ui Word8.ui TextIO.ui Word8Vector.ui 
+Real.ui: StringCvt.ui 
+Int.ui: StringCvt.ui 
+Word8ArraySlice.uo: Word8ArraySlice.ui Word8Array.ui Word8.ui \
+    Word8Vector.ui Word8VectorSlice.ui 
+Intset.uo: Intset.ui List.ui 
+SML90.uo: SML90.ui String.ui BasicIO.ui 
+Dynlib.uo: Dynlib.ui 
+Bool.ui: StringCvt.ui 
+Listsort.uo: Listsort.ui List.ui 
+Strbase.uo: Strbase.ui List.ui 
+Vector.uo: Vector.ui List.ui 
+FileSys.ui: Time.ui 
+Splaytree.uo: Splaytree.ui 
+Real.uo: Real.ui StringCvt.ui Char.ui 
+Buffer.uo: Buffer.ui String.ui Substring.ui 
+Word8.uo: Word8.ui Word.ui String.ui StringCvt.ui Char.ui 
+Option.uo: Option.ui 
+Mosmlcgi.uo: Mosmlcgi.ui String.ui StringCvt.ui List.ui Option.ui \
+    Process.ui Substring.ui Splaymap.ui TextIO.ui Int.ui Char.ui 
+FileSys.uo: FileSys.ui Path.ui List.ui Time.ui 
+Help.uo: Help.ui String.ui StringCvt.ui List.ui BasicIO.ui Vector.ui \
+    TextIO.ui Char.ui 
+Process.ui: Time.ui 
+Mosmlcookie.ui: Date.ui 
+Socket.ui: Word8Array.ui Word8Vector.ui Time.ui 
+Gdimage.uo: Gdimage.ui Dynlib.ui Vector.ui 
diff -Nru mosml-2.01/src/mosmllib/Makefile.w32 mosml-2.10.1/src/mosmllib/Makefile.w32
--- mosml-2.01/src/mosmllib/Makefile.w32	2000-08-02 12:06:16.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Makefile.w32	2014-08-28 08:47:22.000000000 +0000
@@ -5,9 +5,10 @@
 
 !include ..\Makedefs.w32
 
-all: Array.uo Array2.uo Arraysort.uo \
-     BasicIO.uo Binaryset.uo Binarymap.uo BinIO.uo Bool.uo Byte.uo \
-     Callback.uo Char.uo CharArray.uo CharVector.uo CommandLine.uo \
+all: Array.uo Array2.uo ArraySlice.uo Arraysort.uo \
+     BasicIO.uo Binaryset.uo Binarymap.uo BinIO.uo Bool.uo Buffer.uo Byte.uo \
+     Callback.uo Char.uo CharArray.uo CharArraySlice.uo \
+     CharVector.uo CharVectorSlice.uo CommandLine.uo \
      Date.uo Dynarray.uo Dynlib.uo \
      FileSys.uo Gdbm.uo Gdimage.uo Help.uo \
      Int.uo Intmap.uo Intset.uo IO.uo \
@@ -16,12 +17,13 @@
      NJ93.uo Nonstdio.uo \
      Obj.uo Option.uo OS.uo \
      Parsing.uo Path.uo Polygdbm.uo Polyhash.uo Postgres.uo PP.uo Process.uo \
-     Random.uo Real.uo Regex.uo \
+     Random.uo Real.uo Redblackmap.uo Redblackset.uo Regex.uo \
      Signal.uo SML90.uo Socket.uo Splaymap.uo Splayset.uo Splaytree.uo \
      Strbase.uo String.uo StringCvt.uo Substring.uo Susp.uo \
      TextIO.uo Time.uo Timer.uo \
-     Unix.uo Vector.uo \
-     Weak.uo Word.uo Word8.uo Word8Array.uo Word8Vector.uo
+     Unix.uo Vector.uo VectorSlice.uo \
+     Weak.uo Word.uo Word8.uo Word8Array.uo Word8ArraySlice.uo \
+     Word8Vector.uo Word8VectorSlice.uo
 
 Array.sml: Array.mlp
 FileSys.sml: FileSys.mlp
@@ -85,52 +87,30 @@
 
 
 ### DO NOT DELETE THIS LINE
-Word8Vector.uo: Word8Vector.ui List.ui Word8.ui 
+Word8VectorSlice.uo: Word8VectorSlice.ui Word8.ui Word8Vector.ui 
+Word8VectorSlice.ui: Word8.ui Word8Vector.ui 
+Word8Vector.uo: Word8Vector.ui String.ui List.ui Word8.ui 
+Word8Vector.ui: Word8.ui 
+Word8ArraySlice.uo: Word8ArraySlice.ui Word8Array.ui Word8.ui \
+    Word8Vector.ui Word8VectorSlice.ui 
+Word8ArraySlice.ui: Word8Array.ui Word8.ui Word8Vector.ui \
+    Word8VectorSlice.ui 
 Word8Array.uo: Word8Array.ui List.ui Word8.ui Word8Vector.ui 
+Word8Array.ui: Word8.ui Word8Vector.ui 
+Word8.uo: Word8.ui Word.ui String.ui StringCvt.ui Char.ui 
+Word8.ui: Word.ui StringCvt.ui 
 Word.uo: Word.ui String.ui StringCvt.ui Char.ui 
+Word.ui: StringCvt.ui 
 Weak.uo: Weak.ui 
+VectorSlice.uo: VectorSlice.ui Vector.ui 
+VectorSlice.ui: Vector.ui 
 Vector.uo: Vector.ui List.ui 
-Strbase.uo: Strbase.ui List.ui 
-Process.uo: Process.ui List.ui BasicIO.ui 
-Path.uo: Path.ui String.ui List.ui Substring.ui 
-Mosml.uo: Mosml.ui Timer.ui FileSys.ui BinIO.ui String.ui List.ui Vector.ui \
-    Word8.ui Process.ui Byte.ui TextIO.ui Word8Vector.ui Time.ui 
-Int.uo: Int.ui String.ui StringCvt.ui Char.ui 
-Help.uo: Help.ui String.ui StringCvt.ui List.ui BasicIO.ui Vector.ui \
-    TextIO.ui Char.ui 
-OS.uo: OS.ui 
-FileSys.uo: FileSys.ui Path.ui List.ui OS.ui Time.ui 
-Array.uo: Array.ui List.ui Vector.ui 
-Gdimage.uo: Gdimage.ui Dynlib.ui Vector.ui 
-Signal.uo: Signal.ui Word.ui 
-Signal.ui: Word.ui 
 Unix.uo: Unix.ui Signal.ui Word.ui Dynlib.ui Option.ui Vector.ui Process.ui \
     TextIO.ui Obj.uo 
 Unix.ui: Signal.ui Process.ui TextIO.ui 
-Socket.uo: Socket.ui Word.ui Dynlib.ui Word8Array.ui Vector.ui \
-    Word8Vector.ui Time.ui 
-Socket.ui: Word8Array.ui Word8Vector.ui Time.ui 
-Regex.uo: Regex.ui Word.ui Dynlib.ui List.ui Vector.ui Substring.ui 
-Mysql.uo: Mysql.ui String.ui Real.ui Dynlib.ui StringCvt.ui Msp.ui List.ui \
-    Date.ui Option.ui Vector.ui Substring.ui Int.ui 
-Mysql.ui: Msp.ui Date.ui Vector.ui 
-Postgres.uo: Postgres.ui String.ui Real.ui Dynlib.ui StringCvt.ui Msp.ui \
-    List.ui Date.ui Option.ui Word8Array.ui Vector.ui Substring.ui Int.ui \
-    Bool.ui 
-Postgres.ui: Msp.ui Date.ui Word8Array.ui Vector.ui 
-Mosmlcookie.uo: Mosmlcookie.ui String.ui List.ui Date.ui Option.ui \
-    Process.ui Substring.ui Bool.ui 
-Mosmlcookie.ui: Date.ui 
-Msp.uo: Msp.ui String.ui StringCvt.ui List.ui Option.ui Vector.ui TextIO.ui \
-    Int.ui Mosmlcgi.ui Char.ui 
-Word8Vector.ui: Word8.ui 
-Word8Array.ui: Word8.ui Word8Vector.ui 
-Word8.uo: Word8.ui Word.ui String.ui StringCvt.ui Char.ui 
-Word8.ui: Word.ui StringCvt.ui 
-Word.ui: StringCvt.ui 
 Timer.uo: Timer.ui Time.ui 
 Timer.ui: Time.ui 
-Time.uo: Time.ui String.ui StringCvt.ui Char.ui 
+Time.uo: Time.ui Real.ui StringCvt.ui Char.ui 
 Time.ui: StringCvt.ui 
 TextIO.uo: TextIO.ui String.ui Char.ui 
 TextIO.ui: StringCvt.ui Char.ui 
@@ -139,25 +119,53 @@
 StringCvt.uo: StringCvt.ui 
 String.uo: String.ui List.ui Strbase.ui Char.ui 
 String.ui: Char.ui 
+Strbase.uo: Strbase.ui List.ui 
 Splaytree.uo: Splaytree.ui 
 Splayset.uo: Splayset.ui List.ui Splaytree.ui 
 Splaymap.uo: Splaymap.ui Splaytree.ui 
+Socket.uo: Socket.ui Word.ui Dynlib.ui Word8Array.ui Vector.ui \
+    Word8Vector.ui Time.ui Word8VectorSlice.ui 
+Socket.ui: Word8Array.ui Word8Vector.ui Time.ui 
 SML90.uo: SML90.ui String.ui BasicIO.ui 
+Signal.uo: Signal.ui Word.ui 
+Signal.ui: Word.ui 
+Regex.uo: Regex.ui Word.ui Dynlib.ui List.ui Vector.ui Substring.ui 
+Redblackset.uo: Redblackset.ui List.ui 
+Redblackmap.uo: Redblackmap.ui 
 Real.uo: Real.ui StringCvt.ui Char.ui 
 Real.ui: StringCvt.ui 
+Rbset.uo: Rbset.ui List.ui Int.ui 
 Random.uo: Random.ui 
+Process.uo: Process.ui List.ui BasicIO.ui Time.ui 
+Process.ui: Time.ui 
+PP.uo: PP.ui String.ui List.ui Vector.ui Array.ui TextIO.ui 
+Postgres.uo: Postgres.ui String.ui Real.ui Dynlib.ui StringCvt.ui Msp.ui \
+    List.ui Date.ui Option.ui Word8Array.ui Vector.ui Substring.ui Int.ui \
+    Bool.ui 
+Postgres.ui: Msp.ui Date.ui Word8Array.ui Vector.ui 
 Polyhash.uo: Polyhash.ui Array.ui 
 Polygdbm.uo: Polygdbm.ui List.ui Gdbm.ui 
 Polygdbm.ui: Gdbm.ui 
+Path.uo: Path.ui String.ui List.ui Substring.ui Char.ui 
 Parsing.uo: Parsing.ui Lexing.ui Vector.ui Obj.uo 
 Parsing.ui: Lexing.ui Vector.ui Obj.uo 
-PP.uo: PP.ui String.ui List.ui Vector.ui Array.ui TextIO.ui 
+OS.uo: OS.ui 
 Option.uo: Option.ui 
 Nonstdio.uo: Nonstdio.ui BasicIO.ui CharArray.ui 
 Nonstdio.ui: BasicIO.ui CharArray.ui Char.ui 
 NJ93.uo: NJ93.ui String.ui List.ui BasicIO.ui TextIO.ui 
+Mysql.uo: Mysql.ui String.ui Real.ui Dynlib.ui StringCvt.ui Msp.ui List.ui \
+    Date.ui Option.ui Word8Array.ui Vector.ui Substring.ui Int.ui 
+Mysql.ui: Msp.ui Date.ui Word8Array.ui Vector.ui 
+Msp.uo: Msp.ui String.ui StringCvt.ui List.ui Option.ui Vector.ui TextIO.ui \
+    Int.ui Mosmlcgi.ui Char.ui 
+Mosmlcookie.uo: Mosmlcookie.ui String.ui List.ui Date.ui Option.ui \
+    Process.ui Substring.ui Bool.ui 
+Mosmlcookie.ui: Date.ui 
 Mosmlcgi.uo: Mosmlcgi.ui String.ui StringCvt.ui List.ui Option.ui \
     Process.ui Substring.ui Splaymap.ui TextIO.ui Int.ui Char.ui 
+Mosml.uo: Mosml.ui Timer.ui FileSys.ui BinIO.ui String.ui List.ui Vector.ui \
+    Word8.ui Process.ui Byte.ui TextIO.ui Word8Vector.ui Time.ui 
 Mosml.ui: Word8Vector.ui 
 Misc.uo: Misc.ui String.ui List.ui Option.ui Vector.ui Array.ui TextIO.ui \
     Char.ui 
@@ -173,8 +181,15 @@
 Lexing.ui: CharArray.ui Obj.uo 
 Intset.uo: Intset.ui List.ui 
 Intmap.uo: Intmap.ui 
+Int.uo: Int.ui String.ui StringCvt.ui Char.ui 
 Int.ui: StringCvt.ui 
+Help.uo: Help.ui String.ui StringCvt.ui List.ui BasicIO.ui Vector.ui \
+    TextIO.ui Char.ui 
+Hashset.uo: Hashset.ui List.ui Array.ui 
+Gdimage.uo: Gdimage.ui Dynlib.ui Vector.ui 
 Gdbm.uo: Gdbm.ui Dynlib.ui List.ui 
+FileSys.uo: FileSys.ui Path.ui String.ui CharVector.ui List.ui Char.ui \
+    Time.ui 
 FileSys.ui: Time.ui 
 Dynlib.uo: Dynlib.ui 
 Dynarray.uo: Dynarray.ui Array.ui 
@@ -182,26 +197,37 @@
     Time.ui Char.ui 
 Date.ui: StringCvt.ui Time.ui 
 CommandLine.uo: CommandLine.ui Vector.ui 
-CharVector.uo: CharVector.ui Word8Vector.ui Char.ui 
+CharVectorSlice.uo: CharVectorSlice.ui CharVector.ui Substring.ui Char.ui \
+    Word8VectorSlice.ui 
+CharVectorSlice.ui: CharVector.ui Substring.ui Char.ui 
+CharVector.uo: CharVector.ui String.ui Word8Vector.ui Char.ui 
 CharVector.ui: Char.ui 
+CharArraySlice.uo: CharArraySlice.ui CharVector.ui CharArray.ui \
+    Word8ArraySlice.ui CharVectorSlice.ui 
+CharArraySlice.ui: CharVector.ui CharArray.ui CharVectorSlice.ui 
 CharArray.uo: CharArray.ui CharVector.ui Word8Array.ui Char.ui 
 CharArray.ui: CharVector.ui Char.ui 
 Char.uo: Char.ui Strbase.ui 
 Callback.uo: Callback.ui Polyhash.ui 
-Byte.uo: Byte.ui String.ui Word8Array.ui Word8.ui Substring.ui \
-    Word8Vector.ui Char.ui 
+Byte.uo: Byte.ui String.ui Word8.ui Word8ArraySlice.ui Substring.ui \
+    Word8Vector.ui Char.ui Word8VectorSlice.ui 
 Byte.ui: String.ui Word8Array.ui Word8.ui Substring.ui Word8Vector.ui \
     Char.ui 
+Buffer.uo: Buffer.ui String.ui Substring.ui 
 Bool.uo: Bool.ui StringCvt.ui Char.ui 
 Bool.ui: StringCvt.ui 
-Binaryset.uo: Binaryset.ui List.ui 
-Binarymap.uo: Binarymap.ui 
 BinIO.uo: BinIO.ui Word8.ui TextIO.ui Word8Vector.ui 
 BinIO.ui: Word8.ui Word8Vector.ui 
+Binaryset.uo: Binaryset.ui List.ui 
+Binarymap.uo: Binarymap.ui 
 BasicIO.uo: BasicIO.ui 
 Arraysort.uo: Arraysort.ui Array.ui 
 Arraysort.ui: Array.ui 
-Array2.uo: Array2.ui List.ui Vector.ui Array.ui 
+ArraySlice.uo: ArraySlice.ui Vector.ui Array.ui VectorSlice.ui 
+ArraySlice.ui: Vector.ui Array.ui VectorSlice.ui 
+Array2.uo: Array2.ui List.ui Vector.ui Array.ui VectorSlice.ui \
+    ArraySlice.ui 
 Array2.ui: Vector.ui 
+Array.uo: Array.ui List.ui Vector.ui 
 Array.ui: Vector.ui 
 AppleScript.uo: AppleScript.ui 
diff -Nru mosml-2.01/src/mosmllib/Math.sig mosml-2.10.1/src/mosmllib/Math.sig
--- mosml-2.01/src/mosmllib/Math.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Math.sig	2014-08-28 08:47:22.000000000 +0000
@@ -34,18 +34,18 @@
    [cos r] is the cosine of r, where r is in radians.
 
    [tan r] is the tangent of r, where r is in radians.  Raises Domain if 
-   r is a multiple of pi/2.
+   r is a multiple of pi/2.0.
 
-   [atan t] is the arc tangent of t, in the open interval ] ~pi/2, pi/2 [.
+   [atan t] is the arc tangent of t, in the open interval ] ~pi/2.0, pi/2.0 [.
 
-   [asin t] is the arc sine of t, in the closed interval [ ~pi/2, pi/2 ].  
+   [asin t] is the arc sine of t, in the closed interval [ ~pi/2.0, pi/2.0 ].  
    Raises Domain if abs x > 1.
 
    [acos t] is the arc cosine of t, in the closed interval [ 0, pi ].
    Raises Domain if abs x > 1.
 
    [atan2(y, x)] is the arc tangent of y/x, in the interval ] ~pi, pi ],
-   except that atan2(y, 0) = sign y * pi/2.  The quadrant of the result
+   except that atan2(y, 0) = sign y * pi/2.0.  The quadrant of the result
    is the same as the quadrant of the point (x, y).
    Hence sign(cos(atan2(y, x))) = sign x 
    and   sign(sin(atan2(y, x))) = sign y. 
@@ -64,10 +64,10 @@
    [log10 x] is the base-10 logarithm of x.  Raises Domain if x <= 0.0.
 
    [sinh x] returns the hyperbolic sine of x, mathematically defined as
-   (exp x - exp (~x)) / 2.  Raises Overflow if x is too large.
+   (exp x - exp (~x)) / 2.0.  Raises Overflow if x is too large.
 
    [cosh x] returns the hyperbolic cosine of x, mathematically defined as
-   (exp x + exp (~x)) / 2.  Raises Overflow if x is too large.
+   (exp x + exp (~x)) / 2.0.  Raises Overflow if x is too large.
 
    [tanh x] returns the hyperbolic tangent of x, mathematically defined 
    as (sinh x) / (cosh x).  Raises Domain if x is too large.
diff -Nru mosml-2.01/src/mosmllib/Misc.sig mosml-2.10.1/src/mosmllib/Misc.sig
--- mosml-2.01/src/mosmllib/Misc.sig	2000-05-05 14:42:38.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Misc.sig	2014-08-28 08:47:22.000000000 +0000
@@ -3,7 +3,7 @@
 type 'a array  = 'a Array.array
 
 val o         : ('b -> 'c) * ('a -> 'b) -> 'a -> 'c
-val before    : 'a * 'b -> 'a
+val before    : 'a * unit -> 'a
 
 val chr       : int -> char
 val ord       : char -> int
diff -Nru mosml-2.01/src/mosmllib/Misc.sml mosml-2.10.1/src/mosmllib/Misc.sml
--- mosml-2.01/src/mosmllib/Misc.sml	2000-05-05 14:42:38.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Misc.sml	2014-08-28 08:47:22.000000000 +0000
@@ -3,7 +3,7 @@
 type 'a array  = 'a Array.array
 
 fun (g o f) x = g (f x);
-fun a before b = a;
+fun a before () = a;
 
 fun getOpt (SOME v, _) = v
   | getOpt (NONE,   a) = a;
diff -Nru mosml-2.01/src/mosmllib/Mosmlcgi.sig mosml-2.10.1/src/mosmllib/Mosmlcgi.sig
--- mosml-2.01/src/mosmllib/Mosmlcgi.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Mosmlcgi.sig	2014-08-28 08:47:22.000000000 +0000
@@ -110,7 +110,7 @@
    [part_type prt] is SOME(typ) if the part prt contains a specification
    `Context-Type: typ'; otherwise NONE.
 
-   [part_data prt] is the data contain in part prt; for instance, the
+   [part_data prt] is the data contained in part prt; for instance, the
    contents of a file uploaded via form-based file upload.
 
    [part_field_strings prt fnm] is a (possibly empty) list of the
diff -Nru mosml-2.01/src/mosmllib/Mosmlcookie.sml mosml-2.10.1/src/mosmllib/Mosmlcookie.sml
--- mosml-2.01/src/mosmllib/Mosmlcookie.sml	2000-02-03 20:58:33.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Mosmlcookie.sml	2014-08-28 08:47:22.000000000 +0000
@@ -76,7 +76,7 @@
 		concatOpt "; expires=" (Option.map datefmt expiry),
 		concatOpt "; domain=" domain,
 		concatOpt "; path=" path,
-		"; secure", Bool.toString secure]
+		"; secure=", Bool.toString secure, "\n"]
     end
 
 (* To set multiple cookies *)
@@ -96,4 +96,4 @@
 fun deleteCookie { name : string, path : string option } : string =
     String.concat["Set-cookie: ", name, "=deleted;",
 		  "expires=Friday, 11-Feb-77 12:00:00 GMT",
-		  concatOpt "; path=" path]
+		  concatOpt "; path=" path, "\n"]
diff -Nru mosml-2.01/src/mosmllib/Mosml.mlp mosml-2.10.1/src/mosmllib/Mosml.mlp
--- mosml-2.01/src/mosmllib/Mosml.mlp	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Mosml.mlp	2014-08-28 08:47:22.000000000 +0000
@@ -6,13 +6,6 @@
     prim_val setbyte_ : real -> int -> Word8.word -> unit  = 3 "set_nth_char";
 in
 
-#if defined(msdos)
-#include "../config.dos/m.h"
-#elif defined(win32)
-#include "../config.w32/m.h"
-#else
-#include "../config/m.h"
-#endif
 
 prim_val doubleVec : real -> Word8Vector.vector = 1 "doubletow8vec"
 prim_val vecDouble_ : Word8Vector.vector -> real = 1 "w8vectodouble"
@@ -79,7 +72,8 @@
 	val cputimer  = startCPUTimer ()
 	val realtimer = startRealTimer ()
 	fun report () = 
-	    let val {usr, sys, gc} = checkCPUTimer cputimer;
+	    let val {usr, sys} = checkCPUTimer cputimer;
+		val gc = checkGCTime cputimer;
 		val rea = checkRealTimer realtimer;
 		fun format t = Time.toString t
 	    in TextIO.print("User: "     ^ format usr ^
@@ -127,7 +121,7 @@
 	    (* This works for bash, csh and tcsh: *)
 	    (* catenate (cmd :: List.@(args, ["<", infile, "&>", outfile])) *)
 	val status = Process.system cmdline
-	val result = if status = Process.success then 
+	val result = if Process.isSuccess status then 
 			 Success (Byte.bytesToString (read outfile))
 		     else 
 			 ((Failure (Byte.bytesToString (read outfile)))
@@ -138,4 +132,16 @@
 	result
     end
 
+#include "../config/defs.h"
+val systemProperties = [ 
+    ("version", VERSION_S)
+  , ("dynlib support", DYNLIBSUPPORT_S)
+]
+fun systemInfo [] = systemProperties
+  | systemInfo ps = 
+    let fun lookup [] _ = NONE
+          | lookup ((res as (p,_))::rest) prop = if p = prop then SOME res
+                                                 else lookup rest prop
+    in  List.mapPartial (lookup systemProperties) ps end   
+
 end (* local *)
diff -Nru mosml-2.01/src/mosmllib/Mosml.sig mosml-2.10.1/src/mosmllib/Mosml.sig
--- mosml-2.01/src/mosmllib/Mosml.sig	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Mosml.sig	2014-08-28 08:47:22.000000000 +0000
@@ -15,6 +15,8 @@
 
 val run : string -> string list -> string -> runresult
 
+val systemInfo: string list -> (string * string) list
+
 (* 
    [argv ()] returns the command line strings of the current process.
    Hence List.nth(argv (), 0) is the command used to invoke the SML
@@ -56,4 +58,12 @@
    is the program's (standard and error) output as a string, if it
    executed successfully; otherwise returns Failure s where s is its
    (standard and error) output as a string.
+       Extreme care should be taken when calling this function in web
+   scripts and similar, since the cmd is executed by the shell, so
+   even the args can be abused for attacks.
+
+   [systemInfo query] returns a pair (p, v) for each property p in
+   query, where v is the value associated with p. If query is the
+   empty list, then all properties and values are returned.  The
+   property "version" is always guaranteed to have a value associated.
 *)
diff -Nru mosml-2.01/src/mosmllib/Msp.sig mosml-2.10.1/src/mosmllib/Msp.sig
--- mosml-2.01/src/mosmllib/Msp.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Msp.sig	2014-08-28 08:47:22.000000000 +0000
@@ -407,9 +407,10 @@
    HTML encoding functions:
 
    [urlencode s] returns the url-encoding of s.  That is, space (ASCII 32) 
-   is replaced by `+' and every non-alphanumeric character c except 
-   the characters - _ . is replaced by %hh, where hh is the hexadecimal 
-   representation of the ASCII code of c.
+   is replaced by `+' and every non-alphanumeric character c except
+   the three characters hyphen (-), underscore (_) and full stop (.)
+   is replaced by %hh, where hh is the hexadecimal representation of
+   the ASCII code of c.
 
    [htmlencode s] returns the html-encoding of s.  That is, < and >
    are replaced by < and > respectively, and & is replaced by 
diff -Nru mosml-2.01/src/mosmllib/Msp.sml mosml-2.10.1/src/mosmllib/Msp.sml
--- mosml-2.01/src/mosmllib/Msp.sml	2004-01-12 22:23:47.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Msp.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,5 +1,5 @@
 (* Msp.sml -- prelude for ML Server Pages
-   sestoft@dina.kvl.dk 2000-02-24 version 0.7
+   sestoft@dina.kvl.dk 2000-11-06 version 0.8
  *)
 
 (* Efficiently concatenable word sequences *)
diff -Nru mosml-2.01/src/mosmllib/Mysql.sig mosml-2.10.1/src/mosmllib/Mysql.sig
--- mosml-2.01/src/mosmllib/Mysql.sig	2000-04-28 14:53:32.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Mysql.sig	2014-08-28 08:47:22.000000000 +0000
@@ -2,6 +2,7 @@
 
 type dbconn                                   (* Connection to server *)
 type dbresult                                 (* Result of a query    *)
+eqtype oid                                    (* (not used by Mysql)  *)
 
 exception Closed                              (* Connection is closed *)
 exception Null                                (* Field value is NULL  *)
@@ -10,10 +11,10 @@
 
 val openbase : { dbhost    : string option,   (* database server host *)
                  dbname    : string option,   (* database name        *)
-                 dboptions : string option,   (* (not used by MySQL)  *)
+                 dboptions : string option,   (* (not used by Mysql)  *)
                  dbport    : string option,   (* database server port *)
                  dbpwd     : string option,   (* user passwd          *)
-                 dbtty     : string option,   (* (not used by MySQL)  *)
+                 dbtty     : string option,   (* (not used by Mysql)  *)
                  dbuser    : string option    (* database user        *)
                } -> dbconn
 
@@ -31,12 +32,12 @@
 (* Query execution and result set information *)
 
 datatype dbresultstatus =
-    Bad_response            (* (not used by mysql)                    *)
+    Bad_response            (* (not used by Mysql)                    *)
   | Command_ok              (* The query was a command                *)
-  | Copy_in                 (* (not used by mysql)                    *)
-  | Copy_out                (* (not used by mysql)                    *)
+  | Copy_in                 (* (not used by Mysql)                    *)
+  | Copy_out                (* (not used by Mysql)                    *)
   | Empty_query
-  | Fatal_error             (* (not used by mysql)                    *)
+  | Fatal_error             (* (not used by Mysql)                    *)
   | Nonfatal_error
   | Tuples_ok               (* The query successfully returned tuples *)
 
@@ -61,13 +62,16 @@
 val isnull       : dbresult -> int -> int -> bool
 
 datatype dynval =
-    Int of int                          (* MySQL int4            *)
-  | Real of real                        (* MySQL float8 (float4) *)
-  | String of string                    (* MySQL text (varchar)  *)
-  | Date of int * int * int             (* MySQL date yyyy-mm-dd *)
-  | Time of int * int * int             (* MySQL time hh:mm:ss   *)
-  | DateTime of Date.date               (* MySQL datetime        *)
-  | NullVal                             (* MySQL NULL value      *)
+    Bool of bool                        (* (not used by Mysql)   *)
+  | Int of int                          (* Mysql int4            *)
+  | Real of real                        (* Mysql float8 (float4) *)
+  | String of string                    (* Mysql text (varchar)  *)
+  | Date of int * int * int             (* Mysql date yyyy-mm-dd *)
+  | Time of int * int * int             (* Mysql time hh:mm:ss   *)
+  | DateTime of Date.date               (* Mysql datetime        *)
+  | Oid of oid                          (* (not used by Mysql)   *)
+  | Bytea of Word8Array.array           (* (not used by Mysql)   *)
+  | NullVal                             (* Mysql NULL value      *)
 
 val getdynfield  : dbresult -> int -> int -> dynval
 val getdyntup    : dbresult -> int -> dynval vector
@@ -82,13 +86,16 @@
 (* Some standard ML and MySQL types: *)
 
 datatype dyntype = 
-    IntTy               (* ML int               MySQL int4              *)
-  | RealTy              (* ML real              MySQL float8, float4    *)
-  | StringTy            (* ML string            MySQL text, varchar     *) 
-  | DateTy              (* ML (yyyy, mth, day)  MySQL date              *)
-  | TimeTy              (* ML (hh, mm, ss)      MySQL time              *)
-  | DateTimeTy          (* ML Date.date         MySQL datetime, abstime *)
-  | UnknownTy
+    BoolTy              (* ML bool              (not used by Mysql)     *)
+  | IntTy               (* ML int               Mysql int4              *)
+  | RealTy              (* ML real              Mysql float8, float4    *)
+  | StringTy            (* ML string            Mysql text, varchar     *) 
+  | DateTy              (* ML (yyyy, mth, day)  Mysql date              *)
+  | TimeTy              (* ML (hh, mm, ss)      Mysql time              *)
+  | DateTimeTy          (* ML Date.date         Mysql datetime, abstime *)
+  | OidTy               (* ML oid               (not used by Mysql)     *)
+  | ByteArrTy           (* ML Word8Array.array  (not used by Mysql)     *)
+  | UnknownTy of oid
 
 val fromtag : dyntype -> string
 val ftype   : dbresult -> int -> dyntype
diff -Nru mosml-2.01/src/mosmllib/Mysql.sml mosml-2.10.1/src/mosmllib/Mysql.sml
--- mosml-2.01/src/mosmllib/Mysql.sml	2000-04-28 14:53:32.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Mysql.sml	2014-08-28 08:47:22.000000000 +0000
@@ -17,6 +17,8 @@
 
 prim_type dbresult_	(* a finalized object containing a MYSQL_RES pointer *)
 
+type oid = unit		(* not used by Mysql *)
+
 (* One mysql function requires a dbconn where Postgres requires a
    dbresult.  Hence we include the dbconn_ in the Mysql.dbresult *)
 
@@ -316,66 +318,75 @@
 	raise Fail "Mysql.isnull': negative tuple number"
 
 datatype dynval =
-    Int of int				(* mysql int4            *)
-  | Real of real			(* mysql float8 (float4) *)
-  | String of string			(* mysql text (varchar)  *)
-  | Date of int * int * int             (* mysql date yyyy-mm-dd *)
-  | Time of int * int * int             (* mysql time hh:mm:ss   *)
-  | DateTime of Date.date               (* mysql datetime        *)
-  | NullVal				(* mysql NULL            *)
+    Bool of bool                        (* (not used by Mysql)   *)
+  | Int of int                          (* Mysql int4            *)
+  | Real of real                        (* Mysql float8 (float4) *)
+  | String of string                    (* Mysql text (varchar)  *)
+  | Date of int * int * int             (* Mysql date yyyy-mm-dd *)
+  | Time of int * int * int             (* Mysql time hh:mm:ss   *)
+  | DateTime of Date.date               (* Mysql datetime        *)
+  | Oid of oid                          (* (not used by Mysql)   *)
+  | Bytea of Word8Array.array           (* (not used by Mysql)   *)
+  | NullVal                             (* Mysql NULL value      *)
 
 datatype dyntype = 
-    IntTy               (* ML int               mysql int4              *)
-  | RealTy              (* ML real              mysql float8, float4    *)
-  | StringTy            (* ML string            mysql text, varchar     *) 
-  | DateTy              (* ML (yyyy, mth, day)  mysql date              *)
-  | TimeTy              (* ML (hh, mm, ss)      mysql time              *)
-  | DateTimeTy          (* ML Date.date         mysql datetime, abstime *)
-  | UnknownTy
+    BoolTy              (* ML bool              (not used by Mysql)     *)
+  | IntTy               (* ML int               Mysql int4              *)
+  | RealTy              (* ML real              Mysql float8, float4    *)
+  | StringTy            (* ML string            Mysql text, varchar     *) 
+  | DateTy              (* ML (yyyy, mth, day)  Mysql date              *)
+  | TimeTy              (* ML (hh, mm, ss)      Mysql time              *)
+  | DateTimeTy          (* ML Date.date         Mysql datetime, abstime *)
+  | OidTy               (* ML oid               (not used by Mysql)     *)
+  | ByteArrTy           (* ML Word8Array.array  (not used by Mysql)     *)
+  | UnknownTy of oid
 
 (* A translation from Mysql types to Moscow ML types.
    
    NB!: The numbers below need to correspond to the
         numbers in mmysql.c *)
 
-fun totag 0      = SOME IntTy      (* FIELD_TYPE_DECIMAL *)
-  | totag 1      = SOME IntTy      (* FIELD_TYPE_TINY *)
-  | totag 2      = SOME IntTy      (* FIELD_TYPE_SHORT *)
-  | totag 3      = SOME IntTy      (* FIELD_TYPE_LONG *)
-  | totag 4      = SOME RealTy     (* FIELD_TYPE_FLOAT *)
-  | totag 5      = SOME RealTy     (* FIELD_TYPE_DOUBLE *)
-  | totag 6      = SOME UnknownTy  (* FIELD_TYPE_NULL *)
-  | totag 7      = SOME DateTimeTy (* FIELD_TYPE_TIMESTAMP *)
-  | totag 8      = SOME IntTy      (* FIELD_TYPE_LONGLONG *)  
-  | totag 9      = SOME IntTy 	   (* FIELD_TYPE_INT24 *)     
-  | totag 10     = SOME DateTy     (* FIELD_TYPE_DATE *)      
-  | totag 11     = SOME TimeTy     (* FIELD_TYPE_TIME *)      
-  | totag 12     = SOME DateTimeTy (* FIELD_TYPE_DATETIME *)  
-  | totag 13     = SOME DateTy     (* FIELD_TYPE_YEAR *)      
-  | totag 14     = SOME DateTy     (* FIELD_TYPE_NEWDATE *)   
-  | totag 15     = SOME UnknownTy  (* FIELD_TYPE_ENUM *)      
-  | totag 16     = SOME UnknownTy  (* FIELD_TYPE_SET *)       
-  | totag 17     = SOME StringTy   (* FIELD_TYPE_TINY_BLOB *) 
-  | totag 18     = SOME StringTy   (* FIELD_TYPE_MEDIUM_BLOB *)
-  | totag 19     = SOME StringTy   (* FIELD_TYPE_LONG_BLOB *) 
-  | totag 20     = SOME StringTy   (* FIELD_TYPE_BLOB *)      
-  | totag 21     = SOME StringTy   (* FIELD_TYPE_VAR_STRING *)
-  | totag 22     = SOME StringTy   (* FIELD_TYPE_STRING *)    
-  | totag _      = NONE            (* NB. Unknown Type *)    
+fun totag 0      = SOME IntTy		(* FIELD_TYPE_DECIMAL *)
+  | totag 1      = SOME IntTy		(* FIELD_TYPE_TINY *)
+  | totag 2      = SOME IntTy		(* FIELD_TYPE_SHORT *)
+  | totag 3      = SOME IntTy		(* FIELD_TYPE_LONG *)
+  | totag 4      = SOME RealTy		(* FIELD_TYPE_FLOAT *)
+  | totag 5      = SOME RealTy		(* FIELD_TYPE_DOUBLE *)
+  | totag 6      = SOME (UnknownTy ())  (* FIELD_TYPE_NULL *)
+  | totag 7      = SOME DateTimeTy	(* FIELD_TYPE_TIMESTAMP *)
+  | totag 8      = SOME IntTy		(* FIELD_TYPE_LONGLONG *)  
+  | totag 9      = SOME IntTy		(* FIELD_TYPE_INT24 *)     
+  | totag 10     = SOME DateTy		(* FIELD_TYPE_DATE *)      
+  | totag 11     = SOME TimeTy		(* FIELD_TYPE_TIME *)      
+  | totag 12     = SOME DateTimeTy	(* FIELD_TYPE_DATETIME *)  
+  | totag 13     = SOME DateTy		(* FIELD_TYPE_YEAR *)      
+  | totag 14     = SOME DateTy		(* FIELD_TYPE_NEWDATE *)   
+  | totag 15     = SOME (UnknownTy ())	(* FIELD_TYPE_ENUM *)      
+  | totag 16     = SOME (UnknownTy ())  (* FIELD_TYPE_SET *)       
+  | totag 17     = SOME StringTy	(* FIELD_TYPE_TINY_BLOB *) 
+  | totag 18     = SOME StringTy	(* FIELD_TYPE_MEDIUM_BLOB *)
+  | totag 19     = SOME StringTy	(* FIELD_TYPE_LONG_BLOB *) 
+  | totag 20     = SOME StringTy	(* FIELD_TYPE_BLOB *)      
+  | totag 21     = SOME StringTy	(* FIELD_TYPE_VAR_STRING *)
+  | totag 22     = SOME StringTy	(* FIELD_TYPE_STRING *)    
+  | totag _      = NONE			(* NB. Unknown Type *)    
 
 (* Translation from Moscow ML types to Mysql types: *)
 
-fun fromtag IntTy      = "long"
-  | fromtag RealTy     = "double"
-  | fromtag StringTy   = "text"
-  | fromtag DateTy     = "date"
-  | fromtag TimeTy     = "time"
-  | fromtag DateTimeTy = "datetime"
-  | fromtag UnknownTy  = raise Fail "Mysql.fromtag"
+fun fromtag BoolTy        = raise Fail "fromtag: no Mysql type for BoolTy"
+  | fromtag IntTy         = "long"
+  | fromtag RealTy        = "double"
+  | fromtag StringTy      = "text"
+  | fromtag DateTy        = "date"
+  | fromtag TimeTy        = "time"
+  | fromtag DateTimeTy    = "datetime"
+  | fromtag OidTy         = raise Fail "fromtag: no Mysql type for OidTy"
+  | fromtag ByteArrTy     = raise Fail "fromtag: no Mysql type for ByteArrTy"
+  | fromtag (UnknownTy _) = raise Fail "Mysql.fromtag";
 
 fun typeof tyname = 
     case totag tyname of
-	NONE     => UnknownTy
+	NONE     => UnknownTy ()
       | SOME tag => tag
 		
 fun ftype (_, dbres) fno = 
@@ -407,9 +418,8 @@
       | DateTimeTy => (fn tupno => 
 		       if db_isnull dbres_ tupno fno then NullVal
 		       else DateTime (db_getdatetime dbres_ tupno fno))
-      | UnknownTy => 
-	raise Fail ("Mysql.getdynfield: unknown type") 
-(*      | _ => raise Fail "Mysql.getdynfield: unknown type" *)
+      | UnknownTy () => raise Fail ("Mysql.getdynfield: unknown type") 
+      | _ => raise Fail "Mysql.getdynfield: unknown type";
 
 fun applyto x f = f x
 
@@ -431,7 +441,8 @@
       | dynval2s (Time hms)     = fmttrip ":" hms
       | dynval2s (DateTime dt)  = Date.toString dt
       | dynval2s NullVal        = "NULL"
-end
+      | dynval2s _              = raise Fail "Mysql.dynval2s: unknown dynval"
+end;
 
 
 (* Implements "copy  to stdout" : *)
@@ -458,8 +469,8 @@
   | dynvaltostring (Time time)      = totime time
   | dynvaltostring (DateTime dt)    = Date.fmt "%Y-%m-%d %H:%M:%S" dt
   | dynvaltostring (NullVal)        = "\\N"
-(*  | dynvaltostring _              = raise Fail ("dynvaltostring: unknown dynval")
-*)
+  | dynvaltostring _ = raise Fail "Mysql.dynvaltostring: unknown dynval";
+
 fun copytableto (dconn as { conn, closed } : dbconn,
 		 tablename : string,
 		 put : string -> unit) : unit =
diff -Nru mosml-2.01/src/mosmllib/Option.sml mosml-2.10.1/src/mosmllib/Option.sml
--- mosml-2.01/src/mosmllib/Option.sml	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Option.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,6 +1,6 @@
 (* Option *)
 
-exception Option
+exception Option = Option
 
 datatype option = datatype option
 
diff -Nru mosml-2.01/src/mosmllib/Path.mlp mosml-2.10.1/src/mosmllib/Path.mlp
--- mosml-2.01/src/mosmllib/Path.mlp	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Path.mlp	2014-08-28 08:47:22.000000000 +0000
@@ -17,21 +17,29 @@
     val op sub = String.sub
     val substring = String.extract
 
+    val unixslash = "/"
+    val unixvolslash = "/"
+
+    fun isunixslash c = c = #"/"
+
+    fun splitabsvolrest_unix s =
+        if size s >= 1 andalso isunixslash (s sub 0) then 
+            (true, "", substring(s, 1, NONE))
+        else 
+            (false, "", s);    
+
+
 #ifdef unix
-val slash = "/"
-val volslash = "/"
-fun isslash c = c = #"/"
+val slash = unixslash
+val volslash = unixvolslash
+val isslash = isunixslash
 fun validVol s = s = ""
 
 fun getVol s = 
     if size s >= 1 andalso isslash (s sub 0) then SOME ""
     else NONE
 
-fun splitabsvolrest s =
-    if size s >= 1 andalso isslash (s sub 0) then 
-        (true, "", substring(s, 1, NONE))
-    else 
-        (false, "", s);    
+val splitabsvolrest = splitabsvolrest_unix 
 #endif
 
 #if defined(msdos) || defined(win32)
@@ -300,7 +308,7 @@
 
 fun parentize' ar = "" :: parentize ar;
 
-fun mkRelative (p1, p2) =
+fun mkRelative { path=p1, relativeTo=p2 } =
     case (fromString p1, canonize p2) of
         (_ ,                {isAbs=false,...}) => raise Path
       | ({isAbs=false,...}, _                ) => p1
@@ -321,7 +329,7 @@
 fun parentize []      = []
   | parentize (_::ar) = parentArc :: parentize ar;
 
-fun mkRelative (p1, p2) =
+fun mkRelative { path=p1, relativeTo=p2 } =
     case (fromString p1, fromString (mkCanonical p2)) of
         (_ ,                {isAbs=false,...}) => raise Path
       | ({isAbs=false,...}, _                ) => p1
@@ -338,7 +346,7 @@
             end;
 #endif
 
-fun mkAbsolute (p1, p2) =
+fun mkAbsolute { path=p1, relativeTo=p2 } =
     if isRelative p2 then raise Path
     else if isAbsolute p1 then p1
     else mkCanonical(concat(p2, p1));
@@ -394,4 +402,47 @@
 fun ext s  = #ext  (splitBaseExt s);
 fun base s = #base (splitBaseExt s);
 
+exception InvalidArc
+
+fun fromUnixString p = 
+    case splitabsvolrest_unix p of
+        (false, v,   "") => {isAbs=false, vol = v, arcs = []}
+      | (isAbs, v, rest) => {isAbs=isAbs, vol = v, 
+                             arcs = String.fields isunixslash rest}
+
+fun toUnixString (path as {isAbs, vol, arcs}) =
+    let fun h []        res = res 
+          | h (a :: ar) res = h ar (a :: unixslash :: res)
+    in  
+        if validVolume{isAbs=isAbs, vol=vol} then 
+            case (isAbs, arcs) of
+                (false, []         ) => vol
+              | (false, "" :: _    ) => raise Path
+              | (false, a1 :: arest) => 
+                    String.concat (vol :: List.rev (h arest [a1]))
+              | (true,  []         ) => vol ^ unixvolslash
+              | (true, a1 :: arest ) => 
+                    String.concat (List.rev (h arest [a1, unixvolslash, vol])) 
+        else
+            raise Path
+    end
+
+val isInvalidArc = CharVector.exists isslash
+val isInvalidUnixArc = CharVector.exists isunixslash
+fun invalidArc isInvalid arc = 
+    if isInvalid arc then () 
+    else raise InvalidArc 
+
+fun fromUnixPath s = 
+    let val p as {arcs, ...} = fromUnixString s
+    in  List.app (invalidArc isInvalidArc) arcs
+      ; toString p
+    end
+
+fun toUnixPath s = 
+    let val p as {arcs, ...} = fromString s
+    in  List.app (invalidArc isInvalidUnixArc) arcs
+      ; toUnixString p
+    end
+
 end
diff -Nru mosml-2.01/src/mosmllib/Path.sig mosml-2.10.1/src/mosmllib/Path.sig
--- mosml-2.01/src/mosmllib/Path.sig	2000-05-16 07:19:58.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Path.sig	2014-08-28 08:47:22.000000000 +0000
@@ -14,8 +14,9 @@
 
 val isAbsolute   : string -> bool
 val isRelative   : string -> bool
-val mkAbsolute   : string * string -> string
-val mkRelative   : string * string -> string
+val isRoot       : string -> bool
+val mkAbsolute   : { path : string, relativeTo : string } -> string
+val mkRelative   : { path : string, relativeTo : string } -> string
 
 val concat       : string * string -> string
 
@@ -32,6 +33,10 @@
 val base         : string -> string    
 val ext          : string -> string option
 
+exception InvalidArc
+val fromUnixPath : string -> string
+val toUnixPath   : string -> string
+
 (* 
    This module provides OS-independent functions for manipulating
    strings that represent file names and paths in a directory
@@ -66,7 +71,7 @@
    to look at paths, exemplified by the following paths:
 
         Unix:    d/e/f/a.b.c       and     /d/e/f/a.b.c 
-        DOS:     A:d\e\f\a.b.c     and     A:d\e\f\a.b.c     
+        DOS:     A:d\e\f\a.b.c     and     A:\d\e\f\a.b.c     
 
    (1) A path consists of a sequence of arcs, possibly preceded by a
        volume and a root:
@@ -104,6 +109,9 @@
    [isAbsolute p] returns true if p is an absolute path.  
    Equals not (isRelative p).
 
+   [isRoot p] returns true if p is a canonical specification of a root
+   directory. That is, if p is an absolute path with no arcs.
+
    [validVolume {isAbs, vol}] returns true if vol is a valid volume
    name for an absolute path (if isAbs=true) resp. for a relative path
    (if isAbs=false).  Under Unix, the only valid volume name is "";
@@ -119,16 +127,17 @@
    equivalent in the presence of symbolic links.  Raises Path if p2 is
    not a relative path.
 
-   [mkAbsolute(p1, p2)] returns the absolute path made by taking path
-   p2, then p1.  That is, returns p1 if p1 is absolute; otherwise
-   returns the canonicalized concatenation of p2 and p1.  Raises Path
-   if p2 is not absolute (even if p1 is absolute).
-
-   [mkRelative(p1, p2)] returns p1 relative to p2.  That is, returns
-   p1 if p1 is already relative; otherwise returns the relative path
-   leading from p2 to p1.  Raises Path if p2 is not absolute (and even
-   if p1 is relative), or if p1 and p2 are both absolute but have
-   different roots.
+   [mkAbsolute { path=p1, relativeTo=p2 }] returns the absolute path
+   made by taking path p2, then p1.  That is, returns p1 if p1 is
+   absolute; otherwise returns the canonicalized concatenation of p2
+   and p1.  Raises Path if p2 is not absolute (even if p1 is
+   absolute).
+
+   [mkRelative { path=p1, relativeTo=p2 }] returns p1 relative to p2.
+   That is, returns p1 if p1 is already relative; otherwise returns
+   the relative path leading from p2 to p1.  Raises Path if p2 is not
+   absolute (and even if p1 is relative), or if p1 and p2 are both
+   absolute but have different roots.
 
    [mkCanonical p] returns a canonical path which is equivalent to p.
    Redundant occurrences of the parent arc, the current arc, and the
@@ -195,4 +204,18 @@
    [ext s] equals #ext (splitBaseExt s).
 
    [base s] equals #base (splitBaseExt s).
+
+   
+   GROUP 4: Convenience functions for manipulating Unix-style paths.
+
+   [fromUnixPath s] returns a path in the style of the host OS from
+   the Unix-style path s. Slash characters are translated to the
+   directory separators of the local system, as are parent arcs and
+   current arcs.  Raises InvalidArc if any arc in s is invalid in the
+   host OS's path syntax.
+
+   [toUnixPath s] returns a Unix-style path from the path s in the
+   style of the host OS. If the path s has a non-empty volume name,
+   then the Path exception is raised. Raises InvalidArc if any arc
+   contains a slash character.
 *)
diff -Nru mosml-2.01/src/mosmllib/Polyhash.sml mosml-2.10.1/src/mosmllib/Polyhash.sml
--- mosml-2.01/src/mosmllib/Polyhash.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Polyhash.sml	2014-08-28 08:47:22.000000000 +0000
@@ -220,7 +220,7 @@
 	  fun filterP NIL = NIL
 	    | filterP (B(hash, key, item, rest)) = if (pred(key, item))
 		then B(hash, key, item, filterP rest)
-		else filterP rest
+		else (n_items := !n_items - 1; filterP rest)
 	  val arr = !table
 	  val sz = Array.length arr
 	  fun filterTbl i = if (i < sz)
diff -Nru mosml-2.01/src/mosmllib/Postgres.sig mosml-2.10.1/src/mosmllib/Postgres.sig
--- mosml-2.01/src/mosmllib/Postgres.sig	2000-04-28 14:53:32.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Postgres.sig	2014-08-28 08:47:22.000000000 +0000
@@ -2,7 +2,7 @@
 
 type dbconn                                   (* Connection to server *)
 type dbresult                                 (* Result of a query    *)
-type oid                                      (* Internal object id   *)
+eqtype oid                                    (* Internal object id   *)
 
 exception Closed                              (* Connection is closed *)
 exception Null                                (* Field value is NULL  *)
@@ -55,8 +55,8 @@
 val getint       : dbresult -> int -> int -> int
 val getreal      : dbresult -> int -> int -> real
 val getstring    : dbresult -> int -> int -> string
-val getdate      : dbresult -> int -> int -> int * int * int (* Y M D *)
-val gettime      : dbresult -> int -> int -> int * int * int (* H M S *)
+val getdate      : dbresult -> int -> int -> int * int * int   (* Y M D *)
+val gettime      : dbresult -> int -> int -> int * int * int   (* H M S *)
 val getdatetime  : dbresult -> int -> int -> Date.date
 val getbool      : dbresult -> int -> int -> bool
 val isnull       : dbresult -> int -> int -> bool
@@ -108,7 +108,16 @@
 val formattable : dbresult -> Msp.wseq
 val showquery   : dbconn -> string -> Msp.wseq
 
-(*
+(* 
+
+   (Technical warning: This expects the PostgreSQL server to use ISO
+   date format, such as 2002-07-25.  Also, if the PostgreSQL server
+   was compiled with support for multibyte-encodings (Unicode), the
+   database must be created with
+     createdb -E LATIN1 
+   or you should set the environment variable PGCLIENTENCODING to
+   LATIN1 in the SML program's environment.)
+ 
    [dbconn] is the type of connections to a PostgreSQL database.
 
    [dbresult] is the type of result sets from SQL queries.
diff -Nru mosml-2.01/src/mosmllib/Postgres.sml mosml-2.10.1/src/mosmllib/Postgres.sml
--- mosml-2.01/src/mosmllib/Postgres.sml	2000-04-28 14:53:32.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Postgres.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,5 +1,5 @@
 (* mosml/src/dynlibs/mpq/Postgres.sml.  
-   sestoft@dina.kvl.dk -- 1998 -- version 0.05 of 2000-04-28 *)
+   sestoft@dina.kvl.dk -- 1998 -- version 0.07 of 2004-01-12 *)
 
 open Dynlib;
 
@@ -194,10 +194,57 @@
     else
 	pq_getstring dbres tupno fno 
 
+(* Scanning dates and times in ISO format (Postgres 7) *)
+
+local					
+    open Substring (* for getc, all *)
+    fun getint src = Option.valOf (Int.scan StringCvt.DEC getc src)
+    fun drop p     = StringCvt.dropl p getc
+in
+    fun scandate (src : Substring.substring)  =
+	let fun isSep c  = (c = #"-")
+	    val (year,  src1) = getint src
+	    val (month, src2) = getint (drop isSep src1)
+	    val (day,   src3) = getint (drop isSep src2)
+	in ((year, month, day), src3) end
+
+    fun scantime (src : Substring.substring) =
+	let fun isSep c  = (c = #":")
+	    val (hour, src1) = getint src
+	    val (min,  src2) = getint (drop isSep src1)
+	    val (sec,  src3) = getint (drop isSep src2)
+	in ((hour, min, sec), src3) end
+
+    fun pq_getdatetime dbres fno tupno : Date.date =
+	let val src = Substring.all (pq_getstring dbres fno tupno) 
+	    val ((yr,mo,da), src1) = scandate src
+	    val src2 = drop (fn c => c = #" ") src1
+	    val ((hr,mi,se), _   ) = scantime src2
+	    open Date
+	    val tomonth = 
+		fn 1 => Jan | 2 => Feb |  3 => Mar |  4 => Apr
+		 | 5 => May | 6 => Jun |  7 => Jul |  8 => Aug
+		 | 9 => Sep | 10 => Oct | 11 => Nov | 12 => Dec
+		 | _ => raise Fail "Postgres.db_getdatetime 1";
+	in date {year=yr, month=tomonth mo, day=da, 
+		 hour=hr, minute=mi, second=se, offset=NONE} end
+        handle Option.Option => raise Fail "Postgres.db_getdatetime 2"
+
+    fun pq_gettime dbres fno tupno : int * int * int =
+	#1(scantime(Substring.all(pq_getstring dbres fno tupno)))
+	handle Option.Option => raise Fail "Postgres.db_gettime"
+
+    fun pq_getdate dbres fno tupno : int * int * int =
+	#1(scandate (Substring.all (pq_getstring dbres fno tupno)))
+	handle Option.Option => raise Fail "Postgres.db_getdate"
+end
+
+(*
 fun pq_getdatetime dbres fno tupno : Date.date =
     case Date.fromString (pq_getstring dbres fno tupno) of
 	NONE    => raise Fail "Postgres.pq_getdatetime"
       | SOME dt => dt
+*)
 
 fun getdatetime dbres fno tupno =
     if pq_isnull dbres tupno fno then
@@ -205,6 +252,7 @@
     else
 	pq_getdatetime dbres tupno fno
 
+(*
 fun pq_gettime dbres fno tupno : int * int * int =
     let val s = pq_getstring dbres fno tupno 
 	open Substring (* for getc, all *)
@@ -218,6 +266,7 @@
 	(hour, min, sec)
     end
     handle Option.Option => raise Fail "Postgres.pq_gettime"
+*)
 
 fun gettime dbres fno tupno =
     if pq_isnull dbres tupno fno then
@@ -225,19 +274,21 @@
     else
 	pq_gettime dbres tupno fno
 
+(*
 fun pq_getdate dbres fno tupno : int * int * int =
     let val s = pq_getstring dbres fno tupno 
 	open Substring (* for getc, all *)
 	fun getint src = Option.valOf (Int.scan StringCvt.DEC getc src)
 	fun drop p     = StringCvt.dropl p getc
 	fun isSep c  = (c = #"-")
-	val (month, src1) = getint (all s)
-	val (day,   src2) = getint (drop isSep src1)
-	val (year,  src3) = getint (drop isSep src2)
+	val (year,  src1) = getint (all s)
+	val (month, src2) = getint (drop isSep src1)
+	val (day,   src3) = getint (drop isSep src2)
     in 
 	(year, month, day)
     end
     handle Option.Option => raise Fail "Postgres.pq_getdate"
+*)
 
 fun getdate dbres fno tupno =
     if pq_isnull dbres tupno fno then
@@ -258,12 +309,12 @@
 
 datatype dynval =
     Bool of bool			(* psql bool            *)
-  | Int of int				(* psql int4            *)
+  | Int of int				(* psql int4, int8      *)
   | Real of real			(* psql float8, float4  *)
   | String of string			(* psql text, varchar   *)
   | Date of int * int * int		(* psql date yyyy-mm-dd *)
   | Time of int * int * int             (* psql time hh:mm:ss   *)
-  | DateTime of Date.date		(* psql datetime        *)
+  | DateTime of Date.date		(* psql timestamp        *)
   | Oid of oid				(* psql oid             *)
   | Bytea of Word8Array.array		(* psql bytea           *)
   | NullVal				(* psql NULL            *)
@@ -274,19 +325,21 @@
 
 (* A translation from Postgres types to Moscow ML types: *)
 
-fun totag "bool"     = SOME BoolTy
-  | totag "int4"     = SOME IntTy
-  | totag "float8"   = SOME RealTy
-  | totag "float4"   = SOME RealTy
-  | totag "text"     = SOME StringTy
-  | totag "varchar"  = SOME StringTy
-  | totag "date"     = SOME DateTy
-  | totag "datetime" = SOME DateTimeTy
-  | totag "abstime"  = SOME DateTimeTy
-  | totag "time"     = SOME TimeTy
-  | totag "oid"      = SOME OidTy
-  | totag "bytea"    = SOME ByteArrTy
-  | totag _          = NONE
+fun totag "bool"      = SOME BoolTy
+  | totag "int4"      = SOME IntTy
+  | totag "int8"      = SOME IntTy
+  | totag "float8"    = SOME RealTy
+  | totag "float4"    = SOME RealTy
+  | totag "text"      = SOME StringTy
+  | totag "varchar"   = SOME StringTy
+  | totag "date"      = SOME DateTy
+  | totag "timestamp" = SOME DateTimeTy
+  | totag "abstime"   = SOME DateTimeTy
+  | totag "datetime"  = SOME DateTimeTy (* obsoleted in Postgres 7.3 *)
+  | totag "time"      = SOME TimeTy
+  | totag "oid"       = SOME OidTy
+  | totag "bytea"     = SOME ByteArrTy
+  | totag _           = NONE
     
 (* Translation from Moscow ML types to Postgres types: *)
 
@@ -296,7 +349,7 @@
   | fromtag StringTy   = "text"
   | fromtag TimeTy     = "time"
   | fromtag DateTy     = "date"
-  | fromtag DateTimeTy = "datetime"
+  | fromtag DateTimeTy = "timestamp"
   | fromtag OidTy      = "oid"
   | fromtag ByteArrTy  = "bytea"
   | fromtag (UnknownTy _) = raise Fail "Postgres.fromtag"
diff -Nru mosml-2.01/src/mosmllib/PP.sig mosml-2.10.1/src/mosmllib/PP.sig
--- mosml-2.01/src/mosmllib/PP.sig	2000-06-01 19:57:44.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/PP.sig	2014-08-28 08:47:22.000000000 +0000
@@ -95,11 +95,11 @@
 
    [with_pp consumer f] makes a new ppstream from the consumer and
    applies f (which can be thought of as a producer) to that
-   ppstream, then flushed the ppstream and returns the value of f.
+   ppstream, then flushes the ppstream and returns the value of f.
 
    [pp_to_string linewidth printit x] constructs a new ppstream
    ppstrm whose consumer accumulates the output in a string s.  Then
-   evaluates (printit ppstrm x) and finally returns the string s.
+   it evaluates (printit ppstrm x) and finally returns the string s.
 
    
    Example 1: A simple prettyprinter for Booleans:
diff -Nru mosml-2.01/src/mosmllib/Process.mlp mosml-2.10.1/src/mosmllib/Process.mlp
--- mosml-2.01/src/mosmllib/Process.mlp	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Process.mlp	2014-08-28 08:47:22.000000000 +0000
@@ -15,10 +15,12 @@
 local
     prim_val getenv_ : string -> string = 1 "sys_getenv";
 in
-    fun getEnv s = 
-	(SOME (getenv_ s)) handle _ => NONE
+    fun getEnv s = (SOME (getenv_ s)) handle _ => NONE
+    prim_val sleep  : Time.time -> unit = 1 "sml_sleep";
 end
 
+fun isSuccess sv = (sv = success);
+
 val terminate = BasicIO.exit;
 
 local 
diff -Nru mosml-2.01/src/mosmllib/Process.sig mosml-2.10.1/src/mosmllib/Process.sig
--- mosml-2.01/src/mosmllib/Process.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Process.sig	2014-08-28 08:47:22.000000000 +0000
@@ -1,15 +1,18 @@
 (* OS.Process -- SML Basis Library *)
 
-eqtype status
+type status
 
 val success   : status
 val failure   : status
 
+val isSuccess : status -> bool
+
 val system    : string -> status
 
 val atExit    : (unit -> unit) -> unit
 val exit      : status -> 'a
 val terminate : status -> 'a
+val sleep     : Time.time -> unit 
 
 val getEnv    : string -> string option
 
@@ -22,7 +25,12 @@
 
    [failure] is a status value that signifies an error during
    execution of a process.  Note that in contrast to the success
-   value, there may be several distinct failure values.
+   value, there may be several distinct failure values.  Use function
+   isSuccess to reliably test for success.
+
+   [isSuccess sv] returns true if the status value sv represents a
+   successful execution, false otherwise.  It holds that 
+   isSuccess success = true and isSuccess failure = false.
 
    [system cmd] asks the operating system to execute command cmd, and
    returns a status value.
@@ -37,6 +45,11 @@
    [terminate i] terminates the SML process with completion code i 
    (but without executing the registered actions).
 
+   [sleep t] suspends this process for approximately the time
+   indicated by t.  The actual time slept depends on the capabilities
+   of the underlying system and the system load.  Does not sleep at
+   all if t <= Time.zeroTime.
+
    [getEnv evar] returns SOME s if the environment variable evar is
    defined and is associated with the string s; otherwise NONE.
 *)
diff -Nru mosml-2.01/src/mosmllib/Random.sig mosml-2.10.1/src/mosmllib/Random.sig
--- mosml-2.01/src/mosmllib/Random.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Random.sig	2014-08-28 08:47:22.000000000 +0000
@@ -13,7 +13,9 @@
    [generator] is the type of random number generators, here the
    linear congruential generators from Paulson 1991, 1996.
 
-   [newgenseed seed] returns a random number generator with the given seed.
+   [newgenseed seed] returns a random number generator with the given
+   seed.  Throws exception Fail on seed 0.0 (which would give rise to
+   a degenerate sequence of random numbers).
 
    [newgen ()] returns a random number generator, taking the seed from
    the system clock.
@@ -24,8 +26,8 @@
    interval [0,1).
 
    [range (min, max) gen] returns an integral random number in the
-   range [min, max).  Raises Fail if min > max.
+   range [min, max).  Raises Fail if min >= max.
 
    [rangelist (min, max) (n, gen)] returns a list of n integral random
-   numbers in the range [min, max).  Raises Fail if min > max.  
+   numbers in the range [min, max).  Raises Fail if min >= max.  
 *)
diff -Nru mosml-2.01/src/mosmllib/Random.sml mosml-2.10.1/src/mosmllib/Random.sml
--- mosml-2.01/src/mosmllib/Random.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Random.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,4 +1,8 @@
-(* Random -- Moscow ML library 1995-04-23, 1999-02-24 *)
+(* Random -- Moscow ML library 1995-04-23, 1999-02-24, 2000-10-24, 
+   2004-01-12 *)
+
+(* Perhaps replace with one of Marsaglia's multi-seed generators; see
+   CACM 46, 5 (May 2003) 90-93 or http://home.attbi.com/~glynnec1/random.c *)
 
 type generator = {seedref : real ref}
 
@@ -6,18 +10,24 @@
 
 val a = 16807.0 
 val m = 2147483647.0 
+
+(* The seed must be integral but is represented in a real to get a
+   wider range *)
+
 fun nextrand seed = 
     let val t = a*seed 
     in t - m * real(floor(t/m)) end
 
-fun newgenseed seed =
-    {seedref = ref (nextrand seed)};
+fun newgenseed 0.0  = raise Fail "Random.newgenseed: bad seed 0.0"
+  | newgenseed seed = {seedref = ref (nextrand seed)};
 
 fun newgen () =
-    let prim_val getrealtime_ : unit -> {sec : int, usec : int} 
-                                = 1 "sml_getrealtime"
-        val {sec, usec} = getrealtime_ ()
-    in newgenseed (real sec + real usec) end
+    let prim_val getrealtime_ : unit -> real = 1 "sml_getrealtime"
+	val r    = getrealtime_ ()
+        (* Changed divisor from 10^6 to 10^7 to avoid trunc Overflow *)
+	val sec  = real (trunc(r/10000000.0))
+	val usec = trunc(r - 10000000.0 * sec);
+    in newgenseed (sec + real usec) end;
 
 fun random {seedref as ref seed} = 
     (seedref := nextrand seed; seed / m);
@@ -28,16 +38,22 @@
     in h n seed0 [] end;
 
 fun range (min, max) = 
-    if min > max then raise Fail "Random.range: empty range" 
+    if min >= max then raise Fail "Random.range: empty range" 
     else 
-	fn {seedref as ref seed} =>
-	(seedref := nextrand seed; min + (floor(real(max-min) * seed / m)));
+	let val scale = (real max - real min) / m
+	in
+	    fn {seedref as ref seed} =>
+	    (seedref := nextrand seed; floor(real min + scale * seed))
+	end;
 
 fun rangelist (min, max) =
-    if min > max then raise Fail "Random.rangelist: empty range" 
+    if min >= max then raise Fail "Random.rangelist: empty range" 
     else 
-	fn (n, {seedref as ref seed0}) => 
-	let fun h 0 seed res = (seedref := seed; res)
-	      | h i seed res = h (i-1) (nextrand seed) 
-		               (min + floor(real(max-min) * seed / m) :: res)
-	in h n seed0 [] end
+	let val scale = (real max - real min) / m
+	in
+	    fn (n, {seedref as ref seed0}) => 
+	    let fun h 0 seed res = (seedref := seed; res)
+		  | h i seed res = 
+		h (i-1) (nextrand seed) (floor(real min + scale * seed) :: res)
+	    in h n seed0 [] end
+	end;
diff -Nru mosml-2.01/src/mosmllib/Rbset.sig mosml-2.10.1/src/mosmllib/Rbset.sig
--- mosml-2.01/src/mosmllib/Rbset.sig	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Rbset.sig	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,151 @@
+(* Rbset -- ordered sets implemented by red-black trees *)
+(* Intention: should resemble SML/NJs ORD_SET signature *)
+
+signature Rbset = sig
+type 'item set
+
+exception NotFound
+exception NonMonotonic
+
+val empty        : ('item * 'item -> order) -> 'item set
+val singleton    : ('item * 'item -> order) -> 'item -> 'item set
+val add          : 'item set * 'item -> 'item set
+val add'         : 'item * 'item set -> 'item set
+val addList      : 'item set * 'item list -> 'item set
+val isEmpty      : 'item set -> bool
+val isSubset     : 'item set * 'item set -> bool
+val member       : 'item set * 'item -> bool
+val delete       : 'item set * 'item -> 'item set
+val numItems     : 'item set ->  int
+val getOrder     : 'item set -> ('item * 'item -> order)
+val union        : 'item set * 'item set -> 'item set
+val intersection : 'item set * 'item set -> 'item set
+val difference   : 'item set * 'item set -> 'item set
+val listItems    : 'item set -> 'item list
+val app          : ('item -> unit) -> 'item set -> unit
+val revapp       : ('item -> unit) -> 'item set -> unit
+val foldr        : ('item * 'b -> 'b) -> 'b -> 'item set -> 'b
+val foldl        : ('item * 'b -> 'b) -> 'b -> 'item set -> 'b
+val map          : ('item -> 'newitem) * ('newitem * 'newitem -> order) 
+                   -> 'item set -> 'newitem set
+val mapMono      : ('item -> 'newitem) * ('newitem * 'newitem -> order) 
+                   -> 'item set -> 'newitem set
+val find         : ('item -> bool) -> 'item set -> 'item option
+val min          : 'item set -> 'item option
+val max          : 'item set -> 'item option
+val hash         : ('item -> word) -> 'item set -> word
+val equal        : 'item set * 'item set -> bool
+val compare      : 'item set * 'item set -> order 
+
+val depth        : 'item set -> int
+
+datatype 'item intv = 
+    All
+  | From of 'item
+  | To   of 'item
+  | FromTo of 'item * 'item
+
+val subset  : 'item set * 'item intv -> 'item set
+val sublist : 'item set * 'item intv -> 'item list
+
+end
+
+(* 
+
+   ['item set] is the type of sets of ordered elements of type 'item.
+   The ordering relation on the elements is used in the representation
+   of the set.  The result of combining or comparing two sets with
+   different underlying ordering relations is undefined.  The
+   implementation uses Okasaki-style red-black trees.
+
+   [empty ordr] creates a new empty set with the given ordering
+   relation.  
+
+   [singleton ordr i] creates the singleton set containing i, with the
+   given ordering relation.
+
+   [add(s, i)] adds item i to set s.  
+
+   [addList(s, xs)] adds all items from the list xs to the set s.
+
+   [isEmpty s] returns true if and only if the set is empty.
+
+   [equal(s1, s2)] returns true if and only if the two sets have the
+   same elements, as determined by the ordering relation given when
+   the sets were created.  
+
+   [isSubset(s1, s2)] returns true if and only if s1 is a subset of s2.
+
+   [member(s, i)] returns true if and only if i is in s.
+
+   [delete(s, i)] removes item i from s.  Raises NotFound if i is not in s.
+   
+   [numItems s] returns the number of items in set s.
+
+   [union(s1, s2)] returns the union of s1 and s2.  
+
+   [intersection(s1, s2)] returns the intersection of s1 and s2.
+
+   [difference(s1, s2)] returns the difference between s1 and s2 (that
+   is, the set of elements in s1 but not in s2).
+
+   [listItems s] returns a list of the items in set s, in increasing
+   order.
+
+   [app f s] applies function f to the elements of s, in increasing
+   order.
+
+   [revapp f s] applies function f to the elements of s, in decreasing
+   order. 
+
+   [foldl f e s] applies the folding function f to the entries of the
+   set in increasing order.
+
+   [foldr f e s] applies the folding function f to the entries of the
+   set in decreasing order. 
+
+   [map (f, ordr) s] creates a new set with underlying ordering ordr
+   by applying function f to all elements of the set s.
+
+   [mapMono (f, ordr) s] creates a new set by applying the strictly
+   monotonically increasing function f to all elements of s.  The new
+   set will have ordering ordr.  This is faster than map (f, ordr) s by 
+   a logarithmic factor, but the function must satisfy 
+      ordr(f x, f y) = ordr'(x, y) 
+   for all elements x, y in s, where ordr' is the ordering relation 
+   on s; otherwise exception NonMonotonic is thrown.
+
+   [find p s] returns SOME i, where i is an item in s which satisfies
+   p, if one exists; otherwise returns NONE.  Traverses the entries of
+   the set in increasing order.
+
+   [min s] returns SOME i, where i is the least item in the set s, if s is 
+   non-empty; returns NONE if s is empty.
+
+   [max s] returns SOME i, where i is the greatest item in the set s,
+   if s is non-empty; returns NONE if s is empty.
+
+   [hashCode h s] returns the hashcode of the set, which is the sum of
+   the hashcodes of its elements, as computed by the function h.
+
+   [compare (s1, s2)] returns LESS, EQUAL or GREATER according as s1
+   precedes, equals or follows s2 in the lexicographic ordering that
+   would be obtained by comparing the sorted lists of elements of the
+   two sets.  It holds that 
+      equal(s1, s2)    if and only if compare(s1, s2) = EQUAL
+      isSubset(s1, s2) implies compare(s1, s2) = LESS
+      isSubset(s2, s1) implies compare(s1, s2) = GREATER
+
+   [subset(s, intv)] returns a set of those elements of s that belong
+   to the interval intv.  The intervals have the following meaning:
+
+       All             denotes  all elements
+       From e1         denotes  elements e for which cmp(e1, e) <> GREATER
+       To e2           denotes  elements e for which cmp(e, e2) = LESS
+       FromTo(e1, e2)  denotes  elements e for which cmp(e1, e) <> GREATER
+                                                 and cmp(e, e2) = LESS
+
+   [sublist(s, intv)] returns a list, in order, of those elements of s
+   that belong to the interval intv.  Thus sublist(s, All) is equivalent 
+   to listItems s.
+*)
diff -Nru mosml-2.01/src/mosmllib/Rbset.sml mosml-2.10.1/src/mosmllib/Rbset.sml
--- mosml-2.01/src/mosmllib/Rbset.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Rbset.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,536 @@
+(* Rbset -- functional sets using Okasaki-style red-black trees *)
+(* Ken Friis Larsen                                 *)
+(* Various extensions, and test: sestoft@dina.kvl.dk * 2001-10-21 *)
+
+structure Rbset :>  Rbset =
+struct
+
+  datatype 'item tree = LEAF
+                      | RED   of 'item * 'item tree * 'item tree
+                      | BLACK of 'item * 'item tree * 'item tree
+                           
+  type 'item set  = ('item * 'item -> order) * 'item tree * int
+
+  datatype 'item intv = 
+      All
+    | From of 'item
+    | To   of 'item
+    | FromTo of 'item * 'item
+
+  exception NotFound
+
+  fun empty compare = (compare, LEAF, 0)
+
+  fun getOrder (compare, _, _) = compare
+
+  fun numItems (_, _, n) = n
+
+  fun singleton compare x = (compare, BLACK(x, LEAF, LEAF), 1)
+
+  fun isEmpty (_, LEAF, _) = true
+    | isEmpty _            = false
+
+  fun member ((compare, tree, n), elm) =
+      let fun memShared x left right =
+              case compare(elm,x) of
+                  EQUAL   => true
+                | LESS    => mem left
+                | GREATER => mem right
+          and mem LEAF                    = false
+            | mem (RED(x, left, right))   = memShared x left right
+            | mem (BLACK(x, left, right)) = memShared x left right
+      in  mem tree end
+
+  fun retrieve (set, x) = if member(set, x) then x else raise NotFound
+
+  fun peek (set, x) = if member(set, x) then SOME x else NONE
+
+  fun lbalance z (RED(y,RED(x,a,b),c)) d =
+      RED(y,BLACK(x,a,b),BLACK(z,c,d))
+    | lbalance z (RED(x,a,RED(y,b,c))) d =
+      RED(y,BLACK(x,a,b),BLACK(z,c,d))
+    | lbalance x left right = BLACK(x, left, right)
+                              
+  fun rbalance x a (RED(y,b,RED(z,c,d))) =
+      RED(y,BLACK(x,a,b),BLACK(z,c,d))
+    | rbalance x a (RED(z,RED(y,b,c),d)) =
+      RED(y,BLACK(x,a,b),BLACK(z,c,d))
+    | rbalance x left right = BLACK(x, left, right)
+                        
+  exception GETOUT  
+    
+  local 
+      fun insert compare elm =
+          let fun ins LEAF = RED(elm,LEAF,LEAF)
+	        | ins (BLACK(x,left,right)) =
+                  (case compare(elm, x) of
+                       LESS    => lbalance x (ins left) right
+                     | GREATER => rbalance x left (ins right)
+                     | EQUAL   => raise GETOUT)
+	        | ins (RED(x,left,right)) =
+                  (case compare(elm, x) of
+                       LESS    => RED(x, (ins left), right)
+                     | GREATER => RED(x, left, (ins right))
+                     | EQUAL   => raise GETOUT)
+          in  ins end
+  in
+
+  fun add (set as (compare, tree, n), elm) =
+      ( compare
+      , case insert compare elm tree of
+            RED(e, l, r) => BLACK(e, l, r)
+          | tree         => tree          
+      , n+1)
+      handle GETOUT => set
+
+  fun add' (elm, set) = add(set, elm)
+
+  fun addList (set, xs) = List.foldl add' set xs
+  end
+
+  fun push LEAF stack = stack
+    | push tree stack = tree :: stack
+
+  fun pushNode x right stack = BLACK(x, LEAF, LEAF) :: push right stack
+
+  fun getMin []             some none = none
+    | getMin (tree :: rest) some none = 
+      let fun descend tree stack =
+	  case tree of
+	      LEAF                  => getMin stack some none
+	    | RED  (x, LEAF, right) => some x (push right stack)
+	    | BLACK(x, LEAF, right) => some x (push right stack)
+	    | RED  (x, left, right) => descend left (pushNode x right stack) 
+	    | BLACK(x, left, right) => descend left (pushNode x right stack) 
+      in descend tree rest end
+
+(*   fun getMin []             some none = none
+    | getMin (tree :: rest) some none = 
+      case tree of
+          LEAF                  => getMin rest some none
+        | RED  (x, LEAF, right) => some x (push right rest)
+        | BLACK(x, LEAF, right) => some x (push right rest)
+        | RED  (x, left, right) => getMin(pushNode left x right rest) some none
+        | BLACK(x, left, right) => getMin(pushNode left x right rest) some none
+ *)
+
+  fun getMax []             some none = none
+    | getMax (tree :: rest) some none = 
+      let fun descend tree stack =
+	  case tree of
+	      LEAF                  => getMax stack some none
+	    | RED  (x, left, LEAF)  => some x (push left stack)
+	    | BLACK(x, left, LEAF)  => some x (push left stack)
+	    | RED  (x, left, right) => descend right (pushNode x left stack) 
+	    | BLACK(x, left, right) => descend right (pushNode x left stack) 
+      in descend tree rest end
+
+(*   fun getMax []             some none = none
+    | getMax (tree :: rest) some none = 
+      case tree of
+          LEAF                  => getMax rest some none
+        | RED  (x, left, LEAF)  => some x (push left rest)
+        | BLACK(x, left, LEAF)  => some x (push left rest)
+        | RED  (x, left, right) => getMax(pushNode right x left rest) some none
+        | BLACK(x, left, right) => getMax(pushNode right x left rest) some none
+ *)
+  fun fold get f e (compare, tree, n) =
+      let fun loop stack acc =
+              get stack (fn x => fn stack => loop stack (f(x, acc))) acc
+      in  loop (push tree []) e end
+
+  fun foldl f = fold getMin f
+
+  fun foldr f = fold getMax f
+
+  fun listItems set = foldr op:: [] set
+
+  fun appAll get f (compare, tree, n) =
+      let fun loop stack = get stack (fn x => (f x; loop)) ()
+      in  loop [tree] end
+
+  fun app f = appAll getMin f
+
+  fun revapp f = appAll getMax f
+
+  fun find p (compare, tree, n) =
+      let fun loop stack = 
+              getMin stack (fn x => fn stack => 
+                                       if p x then SOME x else loop stack) NONE
+      in  loop (push tree []) end
+
+  fun map (f, compare) s =
+      foldl (fn (k, res) => add(res, f k)) (empty compare) s 
+
+  (*  Ralf Hinze's convert a sorted list to RB tree *)
+  local 
+      datatype 'item digits = 
+               ZERO
+             | ONE of 'item * 'item tree * 'item digits
+             | TWO of 'item * 'item tree * 'item * 'item tree * 'item digits
+                      
+      fun incr x a ZERO                  = ONE(x, a, ZERO)
+        | incr x a (ONE(y, b, ds))       = TWO(x, a, y, b, ds)
+        | incr z c (TWO(y, b, x, a, ds)) =
+          ONE(z, c, incr y (BLACK(x, a, b)) ds)
+          
+      fun insertMax(a, digits) = incr a LEAF digits
+                        
+      fun build ZERO                  a = a
+        | build (ONE(x, a, ds))       b = build ds (BLACK(x, a, b))
+        | build (TWO(y, b, x, a, ds)) c = build ds (BLACK(x, a, RED(y, b, c)))
+  
+      fun buildAll digits = build digits LEAF
+
+      fun toInt digits =
+          let fun loop ZERO power acc            = acc
+                | loop (ONE(_,_,rest)) power acc = 
+                  loop rest (2*power) (power + acc)
+                | loop (TWO(_,_,_,_,rest)) power acc =
+                  loop rest (2*power) (2*power + acc)
+          in  loop digits 1 0 end 
+
+      fun get stack = getMin stack (fn x => fn stack => SOME(x,stack)) NONE
+  
+      fun insRest stack acc =
+          getMin stack (fn x => fn stack => insRest stack (insertMax(x,acc))) 
+                 acc
+ 
+  in  
+  fun fromSortedList (compare, ls) = 
+      let val digits = List.foldl insertMax ZERO ls 
+      in  (compare, buildAll digits, toInt digits) end
+          
+
+  (* FIXME: it *must* be possible to write union, equal, isSubset,
+            intersection, and difference more elegantly. 
+  *)
+  fun union (s1 as (compare, t1, n1), s2 as (_, t2, n2)) =
+      let fun loop x y stack1 stack2 res =
+              case compare(x, y) of
+                  EQUAL => 
+                  let val res = insertMax(x, res)
+                  in  case (get stack1, get stack2) of
+                          (SOME(x, s1), SOME(y, s2)) => loop x y s1 s2 res
+                        | (NONE, NONE)               => res
+                        | (SOME _, _)                => insRest stack1 res
+                        | (_, SOME _)                => insRest stack2 res 
+                  end
+                | LESS => 
+                  let val res = insertMax(x, res)
+                  in  case get stack1 of
+                          NONE => insRest stack2 (insertMax(y, res))
+                        | SOME(x, stack1) => loop x y stack1 stack2 res
+                  end
+                | GREATER => 
+                  let val res = insertMax(y, res)
+                  in  case get stack2 of
+                          NONE => insRest stack1 (insertMax(x, res))
+                        | SOME(y, stack2) => loop x y stack1 stack2 res
+                  end
+      in  (* FIXME: here is lots of room for optimizations *)
+          case (get [t1], get [t2]) of
+              (SOME(x, stack1), SOME(y, stack2)) => 
+              let val digits = loop x y stack1 stack2 ZERO
+              in  (compare, buildAll digits, toInt digits) end
+            | (_, SOME _) => s2
+            | _           => s1 end  
+
+
+  fun intersection (s1 as (compare, t1, n1), s2 as (_, t2, n2)) =
+      let fun loop x y stack1 stack2 res =
+              case compare(x, y) of
+                  EQUAL => 
+                  let val res = insertMax(x, res)
+                  in  case (get stack1, get stack2) of
+                          (SOME(x, s1), SOME(y, s2)) => loop x y s1 s2 res
+                        | _                          => res
+                  end
+                | LESS => 
+                  (case get stack1 of
+                       NONE            => res
+                     | SOME(x, stack1) => loop x y stack1 stack2 res)
+                | GREATER => 
+                  (case get stack2 of
+                       NONE            => res
+                     | SOME(y, stack2) => loop x y stack1 stack2 res)
+      in  (* FIXME: here is lots of room for optimizations *)
+          case (get [t1], get [t2]) of
+              (SOME(x, stack1), SOME(y, stack2)) => 
+              let val digits = loop x y stack1 stack2 ZERO
+              in  (compare, buildAll digits, toInt digits) end
+            | _           => empty compare end  
+
+
+  fun difference (s1 as (compare, t1, n1), s2 as (_, t2, n2)) =
+      let fun loop x y stack1 stack2 res =
+              case compare(x, y) of
+                  EQUAL => 
+                  (case (get stack1, get stack2) of
+                       (SOME(x, s1), SOME(y, s2)) => loop x y s1 s2 res
+                     | (SOME _, _)                => insRest stack1 res
+                     | _                          => res)
+                | LESS => 
+                  let val res = insertMax(x, res)
+                  in  case get stack1 of
+                          NONE            => res
+                        | SOME(x, stack1) => loop x y stack1 stack2 res
+                  end
+                | GREATER => 
+                  (case get stack2 of
+                       NONE => insRest stack1 (insertMax(x, res))
+                     | SOME(y, stack2) => loop x y stack1 stack2 res)
+      in  (* FIXME: here is lots of room for optimizations *)
+          case (get [t1], get [t2]) of
+              (SOME(x, stack1), SOME(y, stack2)) => 
+              let val digits = loop x y stack1 stack2 ZERO
+              in  (compare, buildAll digits, toInt digits) end
+            | (_, SOME _) => empty compare
+            | _           => s1 end  
+	
+  fun equal ((compare, t1, _), (_, t2, _)) =
+      let fun loop x y stack1 stack2 =
+              case compare(x, y) of
+                  EQUAL => 
+                  (case (get stack1, get stack2) of
+                       (SOME(x, s1), SOME(y, s2)) => loop x y s1 s2
+                     | (NONE, NONE)               => true
+                     | _                          => false)
+                | _ => false
+      in  (* FIXME: here is lots of room for optimizations *)
+          case (get [t1], get [t2]) of
+              (SOME(x, stack1), SOME(y, stack2)) => loop x y stack1 stack2 
+            | (NONE, NONE)                       => true
+            | _                                  => false end
+
+  fun compare ((cmp, t1, _), (_, t2, _)) =
+      let fun loop x y stack1 stack2 =
+	  case cmp(x, y) of
+	      EQUAL =>
+                  (case (get stack1, get stack2) of
+                       (SOME(x, s1), SOME(y, s2)) => loop x y s1 s2
+                     | (NONE, NONE)               => EQUAL
+                     | (NONE, _)                  => LESS
+                     | (_, NONE)                  => GREATER)
+	    | order => order
+      in
+          case (get [t1], get [t2]) of
+              (SOME(x, stack1), SOME(y, stack2)) => loop x y stack1 stack2 
+            | (NONE, NONE)                       => EQUAL
+	    | (NONE, _)                          => LESS
+	    | (_, NONE)                          => GREATER
+      end
+  
+  fun isSubset ((compare, t1, _), (_, t2, _)) =
+      let fun loop x y stack1 stack2 =
+              case compare(x, y) of
+                  EQUAL => 
+                  (case (get stack1, get stack2) of
+                       (SOME(x, s1), SOME(y, s2)) => loop x y s1 s2
+                     | (NONE, _)                  => true
+                     | _                          => false)
+                | LESS => false
+                | GREATER => 
+                  (case get stack2 of
+                       SOME(y, stack2) => loop x y stack1 stack2
+                     | NONE            => false)  
+      in  (* FIXME: here is lots of room for optimizations *)
+          case (get [t1], get [t2]) of
+              (SOME(x, stack1), SOME(y, stack2)) => loop x y stack1 stack2
+            | (NONE, _)                          => true
+            | _                                  => false end
+
+  end
+
+  (* Function f must be strictly monotonically increasing on the
+     elements of s; we check this requirement: *)
+
+  exception NonMonotonic
+
+  fun mapMono (f, compare) s =
+      let val fxs = foldl (fn (x, res) => f x :: res) [] s
+	  fun sorted []         = true
+	    | sorted (y1 :: yr) = 
+	      let fun h x0 []       = true
+		    | h x0 (x1::xr) = compare(x0, x1) = LESS andalso h x1 xr
+	      in h y1 yr end
+      in 
+	  if sorted fxs then
+	      fromSortedList (compare, fxs)
+	  else
+	      raise NonMonotonic
+      end
+     
+  (* Peter Sestoft's convert a sorted list to RB tree *)
+  (* Did I write this?  I'm impressed, but let's ignore it for now. 
+
+  fun fromSortedList' (compare, ls) = 
+      let val len = List.length ls
+	  fun log2 n = 
+	      let fun loop k p = if p >= n then k else loop (k+1) (2*p)
+	      in loop 0 1 end
+	  fun h 0 _ xs = (LEAF, xs)
+	    | h n d xs =
+	      let val m = n div 2
+	          val (t1, y :: yr) = h m       (d-1) xs
+	          val (t2, zs)      = h (n-m-1) (d-1) yr
+	      in (if d=0 then RED(y, t1, t2) else BLACK(y, t1, t2), zs) end
+      in  (compare, 
+	   case #1 (h len (log2 (len + 1) - 1) ls) of
+                RED(x, left, right) => BLACK(x, left, right)
+              | tree                => tree
+          , len) 
+      end
+  *)
+      
+  (* delete a la Stefan M. Kahrs *)
+ 
+  fun sub1 (BLACK arg) = RED arg
+    | sub1 _ = raise Fail "Rbset.sub1: impossible"
+
+  fun balleft y (RED(x,a,b)) c             = RED(y, BLACK(x, a, b), c)
+    | balleft x bl (BLACK(y, a, b))        = rbalance x bl (RED(y, a, b))
+    | balleft x bl (RED(z,BLACK(y,a,b),c)) = 
+      RED(y, BLACK(x, bl, a), rbalance z b (sub1 c))
+    | balleft _ _ _ = raise Fail "Rbset.balleft: impossible"
+
+  fun balright x a             (RED(y,b,c)) = RED(x, a, BLACK(y, b, c))
+    | balright y (BLACK(x,a,b))          br = lbalance y (RED(x,a,b)) br
+    | balright z (RED(x,a,BLACK(y,b,c))) br = 
+      RED(y, lbalance x (sub1 a) b, BLACK(z, c, br))
+    | balright _ _ _ = raise Fail "Rbset.balright: impossible"
+
+  (* [append left right] constructs a new tree t.
+  PRECONDITIONS: RB left /\ RB right 
+              /\ !e in left => !x in right e < x
+  POSTCONDITION: not (RB t)
+  *)
+  fun append LEAF right                    = right
+    | append left LEAF                     = left
+    | append (RED(x,a,b)) (RED(y,c,d))     = 
+      (case append b c of
+	   RED(z, b, c) => RED(z, RED(x, a, b), RED(y, c, d))
+         | bc           => RED(x, a, RED(y, bc, d)))
+    | append a (RED(x,b,c))                = RED(x, append a b, c)
+    | append (RED(x,a,b)) c                = RED(x, a, append b c) 
+    | append (BLACK(x,a,b)) (BLACK(y,c,d)) = 
+      (case append b c of
+	   RED(z, b, c) => RED(z, BLACK(x, a, b), BLACK(y, c, d))
+         | bc           => balleft x a (BLACK(y, bc, d)))
+   
+  fun delete (set as (compare, tree, n), x) =
+      let fun delShared y a b =
+              case compare(x,y) of
+                  EQUAL   => append a b
+                | LESS    => (case a of
+                                  BLACK _ => balleft y (del a) b
+                                | _       => RED(y, del a, b))
+                | GREATER => (case b of
+                                  BLACK _ => balright y a (del b)
+                                | _       => RED(y, a, del b))  
+          and del LEAF             = raise NotFound
+            | del (RED(y, a, b))   = delShared y a b
+            | del (BLACK(y, a, b)) = delShared y a b
+      in  ( compare
+          , case del tree of
+                RED arg => BLACK arg
+              | tree    => tree          
+          , n-1) end
+
+  fun min (_, t, _) = 
+      let fun h LEAF = NONE
+	    | h (RED  (k, LEAF, t2)) = SOME k
+	    | h (RED  (k, t1,   t2)) = h t1
+	    | h (BLACK(k, LEAF, t2)) = SOME k
+	    | h (BLACK(k, t1,   t2)) = h t1
+      in h t end
+
+  fun max (_, t, _) = 
+      let fun h LEAF = NONE
+	    | h (RED  (k, t1, LEAF)) = SOME k
+	    | h (RED  (k, t1, t2  )) = h t2
+	    | h (BLACK(k, t1, LEAF)) = SOME k
+	    | h (BLACK(k, t1, t2  )) = h t2
+      in h t end
+
+  fun hash (h : 'item -> word) (s : 'item set) = 
+      foldl (fn (k, res) => h k + res) 0w0 s
+
+  (* Extract sublist containing the elements that are in the given interval *)
+
+  fun sublist((cmp, t, _), intv) =
+      let fun collectall LEAF res = res
+	    | collectall (RED(k, t1, t2)) res = 
+	      collectall t1 (k :: collectall t2 res)
+	    | collectall (BLACK(k, t1, t2)) res = 
+	      collectall t1 (k :: collectall t2 res)
+	  (* Collect from `from' till end *) 
+	  fun collectfrom LEAF res = res
+	    | collectfrom (tree as RED  (k, t1, t2)) res =
+	      collnode tree k t1 t2 res
+	    | collectfrom (tree as BLACK(k, t1, t2)) res =
+	      collnode tree k t1 t2 res
+	  and collnode tree k t1 t2 res = 
+	      case intv of 
+		  From from => 
+		      if cmp(from, k) = GREATER then (* ignore left *)
+			  collectfrom t2 res
+		      else (* from <= k *)
+			  collectfrom t1 (k :: collectall t2 res)
+		| FromTo (from, _) => 
+		      if cmp(from, k) = GREATER then (* ignore left *)
+			  collectfrom t2 res
+		      else (* from <= k *)
+			  collectfrom t1 (k :: collectfrom t2 res)
+		| _ => collectall tree res
+	  (* Collect from beginning to `to', exclusive *)
+	  fun collectto LEAF res = res
+	    | collectto (tree as RED  (k, t1, t2)) res = 
+	      collnode tree k t1 t2 res
+	    | collectto (tree as BLACK(k, t1, t2)) res =
+	      collnode tree k t1 t2 res
+	  and collnode tree k t1 t2 res =
+	      case intv of 
+		  To to => 
+		      if cmp(k, to) = LESS then
+			  collectall t1 (k :: collectto t2 res)
+		      else (* ignore right, k >= to *)
+			  collectto t1 res
+		| FromTo (_, to) => 
+		      if cmp(k, to) = LESS then
+			  collectall t1 (k :: collectto t2 res)
+		      else (* ignore right, k >= to *)
+			  collectto t1 res
+		| _ => collectall tree res
+	  (* Collect from `from' to `to' *)
+	  fun collectfromto LEAF res = res
+	    | collectfromto (tree as RED  (k, t1, t2)) res =
+	      collnode tree k t1 t2 res 
+	    | collectfromto (tree as BLACK(k, t1, t2)) res =
+	      collnode tree k t1 t2 res 
+	  and collnode tree k t1 t2 res = 
+	      case intv of 
+		  From from => collectfrom tree res
+		| To to     => collectto tree res
+		| FromTo (from, to) => 
+		      if cmp(from, k) = GREATER then (* ignore left *)
+			  collectfromto t2 res
+		      else if cmp(k, to) = LESS then  (* from <= k < to *)
+			  collectfrom t1 (k :: collectto t2 res)
+		      else (* ignore right *)
+			  collectfromto t1 res
+		| All => collectall tree res
+      in collectfromto t [] end
+
+    (* Note: builds an intermediate list of elements *)
+    fun subset (s as (cmp, t, _), intv) = 
+	fromSortedList(cmp, sublist(s, intv))
+
+    (* For debugging only *)
+
+    fun depth LEAF = 0
+      | depth (RED  (_, t1, t2)) = 1 + Int.max(depth t1, depth t2)
+      | depth (BLACK(_, t1, t2)) = 1 + Int.max(depth t1, depth t2)
+
+    val depth = fn (_, t, _) => depth t
+end
diff -Nru mosml-2.01/src/mosmllib/README mosml-2.10.1/src/mosmllib/README
--- mosml-2.01/src/mosmllib/README	2000-06-15 10:08:45.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/README	2014-08-28 08:47:22.000000000 +0000
@@ -1,74 +1,90 @@
-Library units, Moscow ML version 2.00 (June 2000)
+Library units, Moscow ML version 2.10 (August 2013)
 
-      Name        Purpose                                     Notes
-    -----------------------------------------------------------------
-    | Array       mutable constant-time-access arrays        |SDF NO|
-    | Array2      two-dimensional arrays                     |S     |
-    | Arraysort   array sorting (quicksort)                  |   L  |
-    | BasicIO     input-output, see Definition (temporary)   | DF   |
-    | Binarymap   binary tree implementation of finite maps  |   L  |
-    | Binaryset   binary tree implementation of finite sets  |   L  |
-    | BinIO       binary input-output streams (imperative)   |S F   |
-    | Bool        Booleans                                   |S F   |
-    | Byte        character-byte conversion                  |S F   |
-    | Callback    registering ML values for access from C    |      |
-    | Char        characters                                 |SDF NO|
-    | CharArray   arrays of characters                       |S F   |
-    | CharVector  vectors of characters (= strings)          |S F   |
-    | CommandLine program name and arguments                 |S F   |
-    | Date        manipulation of calendar dates             |S F   |
-    | Dynarray    dynamic arrays                             |   L  |
-    | Dynlib      dynamic linking with C                     |      |
-    | FileSys     interaction with the file system           |S F   |
-    | Gdbm        persistent hash tables of strings (gdbm)   |      |
-    | Gdimage     generation of PNG images (Boutell's GD)    |      |
-    | General     various top-level primitives               |SD    |
-    | Graphics    graphics primitives (DOS version only)     |      |   
-    | Help        on-line help                               | DF NO|
-    | Int         operations on integers                     |S F   |
-    | Intmap      finite maps from integers                  |   L  |
-    | Intset      finite sets of integers                    |   L  |
-    | List        classic list manipulation functions        |SDF NO|
-    | ListPair    operations on pairs of lists               |S F   |
-    | Listsort    list sorting (mergesort)                   |      |
-    | Location    error reporting for lexers and parsers     |      |
-    | Math        trigonometric functions etc.               |S F   |
-    | Misc        various for initial top-level environment  | DF NO|
-    | Mosml       various non-standard utilities             |  F   |
-    | Mosmlcgi    utilities for writing CGI programs         |      |
-    | Msp         utilities for generating HTML code         |      |
-    | NJ93        top-level compatibility with SML/NJ 0.93   |    N |
-    | Option      partial functions                          |SDF NO|
-    | OS          operating system information               |S F   |
-    | Path        file-system independent path manipulation  |S F   |
-    | Polygdbm    polymorphic persistent hash tables (gdbm)  |      |
-    | Polyhash    polymorphic hash tables                    |      |
-    | Postgres    interface to PostgreSQL database server    |      |
-    | PP          general prettyprinters                     |   L  |
-    | Process     manipulating processes                     |S F   |
-    | Random      generation of pseudo-random numbers        |      |
-    | Real        arithmetic on floating-point numbers       |S F   |
-    | Regex       regular expressions as in POSIX 1003.2     |      |
-    | Real        arithmetic on floating-point numbers       |S F   |
-    | Signal      Unix signals                               |S     |
-    | Socket      interface to sockets                       |      |
-    | Splaymap    splay-tree implementation of finite maps   |   L  |
-    | Splayset    splay-tree implementation of finite sets   |   L  |
-    | String      string manipulation                        |SDF NO|
-    | StringCvt   conversion to and from strings             |S F   |
-    | Substring   manipulation of constant-time substrings   |S F   |
-    | Susp        support for lazy evaluation                |      |
-    | TextIO      text input-output streams (imperative)     |SDF   |
-    | Time        time points and durations                  |S F   |
-    | Timer       measuring real time and cpu time           |S F   |
-    | Unix        starting concurrent subprocesses           |S     |
-    | Vector      immutable constant-time-access vectors     |SDF NO|
-    | Weak        arrays of weak pointers                    |      |
-    | Word        words (31-bit unsigned integers)           |S F   |
-    | Word8       bytes (8-bit unsigned integers)            |S F   |
-    | Word8Array  arrays of bytes                            |S F   |
-    | Word8Vector vectors of bytes                           |S F   |
-    -----------------------------------------------------------------
+      Name             Purpose                                       Notes
+    --------------------------------------------------------------------------
+    | Array            mutable constant-time-access arrays          |SDF NO  |
+    | Array2           two-dimensional arrays                       |S       |
+    | ArraySlice       mutable sub-arrays                           |S F     |
+    | Arraysort        array sorting (quicksort)                    |   L    |
+    | BasicIO          input-output, see Definition (temporary)     | DF     |
+    | Binarymap        binary tree implementation of finite maps    |   L    |
+    | Binaryset        binary tree implementation of finite sets    |   L    |
+    | BinIO            binary input-output streams (imperative)     |S F     |
+    | Bool             Booleans                                     |S F     |
+    | Buffer           mutable string buffer                        |        |
+    | Byte             character-byte conversion                    |S F     |
+    | Callback         registering ML values for access from C      |        |
+    | Char             characters                                   |SDF NO  |
+    | CharArray        arrays of characters                         |S F     |
+    | CharArraySlice   sub-arrays of characters                     |S F     |
+    | CharVector       vectors of characters (= strings)            |S F     |
+    | CharVectorSlice  sub-vectors of characters (= substrings)     |S F     |
+    | CommandLine      program name and arguments                   |S F     |
+    | Date             manipulation of calendar dates               |S F     |
+    | Dynarray         dynamic arrays                               |   L    |
+    | Dynlib           dynamic linking with C                       |        |
+    | FileSys          interaction with the file system             |S F     | 
+    | Gdbm             persistent hash tables of strings (gdbm)     |      C |
+    | Gdimage          generation of PNG images (Boutell's GD)      |      C |
+    | General          various top-level primitives                 |SD      |
+    | Graphics         graphics primitives (DOS version only)       |        |
+    | Hashset          sets implemented by hashtables               |   L    |
+    | Help             on-line help                                 | DF NO  |
+    | Int              operations on integers                       |S F     |
+    | Intmap           finite maps from integers                    |   L    |
+    | Intset           finite sets of integers                      |   L    |
+    | Lexing           support for lexers generated by mosmllex     |        |
+    | List             classic list manipulation functions          |SDF NO  |
+    | ListPair         operations on pairs of lists                 |S F     |
+    | Listsort         list sorting (mergesort)                     |        |
+    | Location         error reporting for lexers and parsers       |        |
+    | Math             trigonometric functions etc.                 |S F     |
+    | Meta             functions specific to the interactive system |        |
+    | Misc             various for initial top-level environment    | DF NO  |
+    | Mosml            various non-standard utilities               |  F     |
+    | Mosmlcgi         utilities for writing CGI programs           |        |
+    | Mosmlcookie      manipulating cookies in CGI programs         |        |
+    | Msp              utilities for generating HTML code           |        | 
+    | MySQL            interface to the Mysql database server       |      C |
+    | NJ93             top-level compatibility with SML/NJ 0.93     |    N   |
+    | Nonstdio         non-standard I/O, used by lexers             |        |
+    | Option           partial functions                            |SDF NO  |
+    | OS               operating system information                 |S F     |
+    | Parsing          support for parsers generated by mosmlyac    |        |
+    | Path             file-system independent path manipulation    |S F     |
+    | Polygdbm         polymorphic persistent hash tables (gdbm)    |      C |
+    | Polyhash         polymorphic hash tables                      |        |
+    | Postgres         interface to PostgreSQL database server      |        |
+    | PP               general prettyprinters                       |   L    |
+    | Process          manipulating processes                       |S F     |
+    | Random           generation of pseudo-random numbers          |        |
+    | Rbset            sets implemented by red-black trees          |        |
+    | Real             arithmetic on floating-point numbers         |S F     |
+    | Redblackmap      maps implemented by red-black trees          |        |
+    | Regex            regular expressions as in POSIX 1003.2       |      C |
+    | Real             arithmetic on floating-point numbers         |S F     |
+    | Signal           Unix signals                                 |S       |
+    | Socket           interface to sockets                         |      C |
+    | Splaymap         splay-tree implementation of finite maps     |   L    |
+    | Splayset         splay-tree implementation of finite sets     |   L    |
+    | String           string manipulation                          |SDF NO  |
+    | StringCvt        conversion to and from strings               |S F     |
+    | Substring        manipulation of constant-time substrings     |S F     |
+    | Susp             support for lazy evaluation                  |        |
+    | TextIO           text input-output streams (imperative)       |SDF     |
+    | Time             time points and durations                    |S F     |
+    | Timer            measuring real time and cpu time             |S F     |
+    | Unix             starting concurrent subprocesses             |S       |
+    | Vector           immutable constant-time-access vectors       |SDF NO  |
+    | VectorSlice      immutable sub-vectors                        |S F     |
+    | Weak             arrays of weak pointers                      |        |
+    | Word             words (31-bit unsigned integers)             |S F     |
+    | Word8            bytes (8-bit unsigned integers)              |S F     |
+    | Word8Array       arrays of bytes                              |S F     |
+    | Word8ArraySlice  sub-arrays of byte arrays                    |S F     |
+    | Word8Vector      vectors of bytes                             |S F     |
+    | Word8VectorSlice sub-vectors of byte vectors                  |S F     |
+    --------------------------------------------------------------------------
 
 Only the libraries marked S belong to the SML Basis Library; the
 remaining ones are non-standard.
@@ -79,6 +95,8 @@
   N  means that the unit is loaded if option `-P nj93' is specified.
   O  means that the unit is loaded if option `-P sml90' is specified.
   L  means that the unit is from the SML/NJ Library (version 0.2).
+  C  means that the unit requires the Dynlib foreign (C) function
+     interface and other foreign libraries
 
 A unit U can be loaded into a Moscow ML interactive session by
 evaluating
diff -Nru mosml-2.01/src/mosmllib/Redblackmap.sig mosml-2.10.1/src/mosmllib/Redblackmap.sig
--- mosml-2.01/src/mosmllib/Redblackmap.sig	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Redblackmap.sig	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,66 @@
+(* Redblackmap -- applicative maps as Red-black trees *)
+signature Redblackmap =
+sig
+type ('key, 'a) dict
+
+exception NotFound
+
+val mkDict    : ('key * 'key -> order) -> ('key, 'a) dict
+val insert    : ('key, 'a) dict * 'key * 'a -> ('key, 'a) dict
+val find      : ('key, 'a) dict * 'key -> 'a
+val peek      : ('key, 'a) dict * 'key -> 'a option
+val remove    : ('key, 'a) dict * 'key -> ('key, 'a) dict * 'a
+val numItems  : ('key, 'a) dict -> int
+val listItems : ('key, 'a) dict -> ('key * 'a) list
+val app       : ('key * 'a -> unit) -> ('key,'a) dict -> unit
+val revapp    : ('key * 'a -> unit) -> ('key,'a) dict -> unit
+val foldr     : ('key * 'a * 'b -> 'b)-> 'b -> ('key,'a) dict -> 'b
+val foldl     : ('key * 'a * 'b -> 'b) -> 'b -> ('key,'a) dict -> 'b
+val map       : ('key * 'a -> 'b) -> ('key,'a) dict -> ('key, 'b) dict
+val transform : ('a -> 'b) -> ('key,'a) dict -> ('key, 'b) dict
+end
+
+(* 
+   [('key, 'a) dict] is the type of applicative maps from domain type
+   'key to range type 'a, or equivalently, applicative dictionaries
+   with keys of type 'key and values of type 'a.  They are implemented
+   as Okasaki-style red-black trees.
+
+   [mkDict ordr] returns a new, empty map whose keys have ordering
+   ordr.
+
+   [insert(m, i, v)] extends (or modifies) map m to map i to v.
+
+   [find (m, k)] returns v if m maps k to v; otherwise raises NotFound.
+   
+   [peek(m, k)] returns SOME v if m maps k to v; otherwise returns NONE.
+
+   [remove(m, k)] removes k from the domain of m and returns the
+   modified map and the element v corresponding to k.  Raises NotFound
+   if k is not in the domain of m.
+
+   [numItems m] returns the number of entries in m (that is, the size
+   of the domain of m).
+
+   [listItems m] returns a list of the entries (k, v) of keys k and
+   the corresponding values v in m, in order of increasing key values.
+
+   [app f m] applies function f to the entries (k, v) in m, in
+   increasing order of k (according to the ordering ordr used to
+   create the map or dictionary).
+
+   [revapp f m] applies function f to the entries (k, v) in m, in
+   decreasing order of k.
+
+   [foldl f e m] applies the folding function f to the entries (k, v)
+   in m, in increasing order of k.
+
+   [foldr f e m] applies the folding function f to the entries (k, v)
+   in m, in decreasing order of k.
+
+   [map f m] returns a new map whose entries have form (k, f(k,v)),
+   where (k, v) is an entry in m.
+
+   [transform f m] returns a new map whose entries have form (k, f v),
+   where (k, v) is an entry in m.
+*)
diff -Nru mosml-2.01/src/mosmllib/Redblackmap.sml mosml-2.10.1/src/mosmllib/Redblackmap.sml
--- mosml-2.01/src/mosmllib/Redblackmap.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Redblackmap.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,199 @@
+(* Redblackmap --                                                   *) 
+(*    applicative maps implemented by Okasaki-style Red-Black trees *)
+(* Ken Friis Larsen                                     *)
+structure Redblackmap :>  Redblackmap =
+struct
+
+  datatype ('key, 'a) tree = 
+           LEAF
+         | RED   of 'key * 'a * ('key, 'a) tree * ('key, 'a) tree
+         | BLACK of 'key * 'a * ('key, 'a) tree * ('key, 'a) tree
+                           
+  type ('key, 'a) dict  = ('key * 'key -> order) * ('key, 'a) tree * int
+
+  exception NotFound
+
+  fun mkDict compare = (compare, LEAF, 0)
+
+  fun numItems (_, _, n) = n
+
+  fun find ((compare, tree, n), key) =
+      let fun loopShared k x left right =
+              case compare(key, k) of
+                  EQUAL   => x
+                | LESS    => loop left
+                | GREATER => loop right
+          and loop LEAF                       = raise NotFound
+            | loop (RED(k, x, left, right))   = loopShared k x left right
+            | loop (BLACK(k, x, left, right)) = loopShared k x left right
+      in  loop tree end
+
+  fun peek (set, key) = SOME(find(set, key)) 
+                        handle NotFound => NONE
+
+  fun lbalance z zd (RED(y,yd,RED(x,xd,a,b),c)) d =
+      RED(y,yd,BLACK(x,xd,a,b),BLACK(z,zd,c,d))
+    | lbalance z zd (RED(x,xd,a,RED(y,yd,b,c))) d =
+      RED(y,yd,BLACK(x,xd,a,b),BLACK(z,zd,c,d))
+    | lbalance k x left right = BLACK(k, x, left, right)
+                              
+  fun rbalance x xd a (RED(y,yd,b,RED(z,zd,c,d))) =
+      RED(y,yd,BLACK(x,xd,a,b),BLACK(z,zd,c,d))
+    | rbalance x xd a (RED(z,zd,RED(y,yd,b,c),d)) =
+      RED(y,yd,BLACK(x,xd,a,b),BLACK(z,zd,c,d))
+    | rbalance k x left right = BLACK(k, x, left, right)
+                        
+  exception GETOUT  
+
+  fun insert (set as (compare, tree, n), key, data) =
+      let val addone = ref true
+          fun ins LEAF = RED(key,data,LEAF,LEAF)
+	    | ins (BLACK(k,x,left,right)) =
+              (case compare(key, k) of
+                   LESS    => lbalance k x (ins left) right
+                 | GREATER => rbalance k x left (ins right)
+                 | EQUAL   => (addone := false; BLACK(key, data, left, right)))
+	    | ins (RED(k, x,left,right)) =
+              (case compare(key, k) of
+                   LESS    => RED(k, x, (ins left), right)
+                 | GREATER => RED(k, x, left, (ins right))
+                 | EQUAL   => (addone := false; RED(key, data, left, right)))
+      in  ( compare
+          , case ins tree of
+                RED x => BLACK x
+              | tree  => tree          
+          , if !addone then n+1 else n) end
+
+  fun push LEAF stack = stack
+    | push tree stack = tree :: stack
+
+  fun pushNode left k x right stack = 
+      left :: (BLACK(k, x, LEAF, LEAF) :: (push right stack))
+
+  fun getMin []             some none = none
+    | getMin (tree :: rest) some none = 
+      case tree of
+          LEAF                 => getMin rest some none
+        | RED  (k, x, LEAF, b) => some k x (push b rest)
+        | BLACK(k, x, LEAF, b) => some k x (push b rest)
+        | RED  (k, x, a, b)    => getMin(pushNode a k x b rest) some none
+        | BLACK(k, x, a, b)    => getMin(pushNode a k x b rest) some none
+
+  fun getMax []             some none = none
+    | getMax (tree :: rest) some none = 
+      case tree of
+          LEAF                 => getMax rest some none
+        | RED  (k, x, a, LEAF) => some k x (push a rest)
+        | BLACK(k, x, a, LEAF) => some k x (push a rest)
+        | RED  (k, x, a, b)    => getMax(pushNode b k x a rest) some none
+        | BLACK(k, x, a, b)    => getMax(pushNode b k x a rest) some none
+
+  fun fold get f e (compare, tree, n) =
+      let fun loop stack acc =
+              get stack (fn k =>fn x =>fn stack => loop stack (f(k,x,acc))) acc
+      in  loop [tree] e end
+
+  fun foldl f = fold getMin f
+
+  fun foldr f = fold getMax f
+
+  fun listItems set = foldr (fn(k,x,res) => (k,x)::res) [] set
+
+  fun appAll get f (compare, tree, n) =
+      let fun loop stack = get stack (fn k => fn x => (f(k,x); loop)) ()
+      in  loop [tree] end
+
+  fun app f = appAll getMin f
+
+  fun revapp f = appAll getMax f
+
+
+  (* remove a la Stefan M. Kahrs *)
+  fun redden (BLACK arg) = RED arg
+    | redden _ = raise Fail "Redblackmap.redden: impossible" 
+
+  fun balleft y yd (RED(x,xd,a,b)) c                = 
+      RED(y, yd, BLACK(x, xd, a, b), c)
+    | balleft x xd bl (BLACK(y, yd, a, b))          = 
+      rbalance x xd bl (RED(y, yd, a, b))
+    | balleft x xd bl (RED(z,zd,BLACK(y,yd,a,b),c)) = 
+      RED(y, yd, BLACK(x, xd, bl, a), rbalance z zd b (redden c))
+    | balleft _ _ _ _ = raise Fail "Redblackmap.balleft: impossible"  
+
+  fun balright x xd a             (RED(y, yd ,b,c)) = 
+      RED(x, xd, a, BLACK(y, yd, b, c))
+    | balright y yd (BLACK(x,xd,a,b))          br = 
+      lbalance y yd (RED(x,xd,a,b)) br
+    | balright z zd (RED(x,xd,a,BLACK(y,yd,b,c))) br = 
+      RED(y, yd, lbalance x xd (redden a) b, BLACK(z, zd, c, br))
+    | balright _ _ _ _ = raise Fail "Redblackmap.balright: impossible" 
+
+
+  (* [append left right] constructs a new tree t.
+  PRECONDITIONS: RB left /\ RB right 
+              /\ !e in left => !x in right e < x
+  POSTCONDITION: not (RB t)
+  *)
+  fun append LEAF right                    = right
+    | append left LEAF                     = left
+    | append (RED(x,xd,a,b)) (RED(y,yd,c,d))     = 
+      (case append b c of
+	   RED(z, zd, b, c) => RED(z, zd, RED(x, xd, a, b), RED(y, yd, c, d))
+         | bc           => RED(x, xd, a, RED(y, yd, bc, d)))
+    | append a (RED(x,xd,b,c))                = RED(x, xd, append a b, c)
+    | append (RED(x,xd,a,b)) c                = RED(x, xd, a, append b c) 
+    | append (BLACK(x,xd,a,b)) (BLACK(y,yd,c,d)) = 
+      (case append b c of
+	   RED(z, zd, b, c) => RED(z, zd, BLACK(x,xd,a,b), BLACK(y,yd,c,d))
+         | bc           => balleft x xd a (BLACK(y, yd, bc, d)))
+   
+  fun remove ((compare, tree, n), key) =
+      let fun delShared k x a b =
+              case compare(key, k) of
+                  EQUAL   => (x, append a b)
+                | LESS    => 
+                  let val (res, a') = del a
+                  in  (res, case a of
+                                BLACK _ => balleft k x a' b
+                              | _       => RED(k, x, a', b)) end
+                | GREATER => 
+                  let val (res, b') = del b
+                  in  (res, case b of
+                                BLACK _ => balright k x a b'
+                              | _       => RED(k, x, a, b')) end  
+          and del LEAF                = raise NotFound
+            | del (RED(k, x, a, b))   = delShared k x a b
+            | del (BLACK(k, x, a, b)) = delShared k x a b
+
+          val (res, tree) = case del tree of
+                                (res, RED arg) => (res, BLACK arg)
+                              | x              => x
+      in  ((compare, tree, n-1), res) end
+
+  fun map f (compare, tree, n) = 
+      let fun loop LEAF = LEAF
+            | loop (RED(k,x,a,b)) = 
+              let val a = loop a
+                  val x = f(k,x)
+              in  RED(k,x,a, loop b) end
+            | loop (BLACK(k,x,a,b)) = 
+              let val a = loop a
+                  val x = f(k,x)
+              in  BLACK(k,x,a, loop b) end
+      in  (compare, loop tree, n) end
+
+  fun transform f (compare, tree, n) = 
+      let fun loop LEAF = LEAF
+            | loop (RED(k,x,a,b)) = 
+              let val a = loop a
+              in  RED(k, f x, a, loop b) end
+            | loop (BLACK(k,x,a,b)) = 
+              let val a = loop a
+              in  BLACK(k, f x, a, loop b) end
+      in  (compare, loop tree, n) end
+end
+(*
+val t1 = Redblackset.addList(Redblackset.empty Int.compare, [43,25,13,14]);
+val t2 = Redblackset.addList(Redblackset.empty Int.compare, [43,1,2,3]);
+val t3 = Redblackset.addList(Redblackset.empty Int.compare, [1,3]);
+*)
diff -Nru mosml-2.01/src/mosmllib/Socket.sig mosml-2.10.1/src/mosmllib/Socket.sig
--- mosml-2.01/src/mosmllib/Socket.sig	2000-06-01 19:57:44.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Socket.sig	2014-08-28 08:47:22.000000000 +0000
@@ -152,7 +152,7 @@
    [listen (sock, queuelen)] enables the passive stream socket sock to
    accept incoming connections.  The parameter queuelen specifies the
    maximal number of pending connections.  Further connections from
-   clients may be refised when this limit is reached.
+   clients may be refused when this limit is reached.
 
    [close sock] closes the socket.
 
diff -Nru mosml-2.01/src/mosmllib/Socket.sml mosml-2.10.1/src/mosmllib/Socket.sml
--- mosml-2.01/src/mosmllib/Socket.sml	2000-05-16 16:13:08.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Socket.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,9 +1,9 @@
-(* Ken Larsen kla@it.dtu.dk 1998-10-26 *)
+(* Ken Friis Larsen (ken@friislarsen.net) 1998-10-26 *)
 
 (* The initial implementation was financed by the PROSPER project. *)
 
 (* Beautification and documentation by sestoft@dina.kvl.dk 
-   1999-02-01, 2000-05-16 *)
+   1999-02-01, 2000-05-16, 2000-10-24 *)
 
 structure Socket :> Socket =
 struct
@@ -93,7 +93,8 @@
 
 	prim_val vector_ : int -> Word8Vector.vector = 1 "create_string"
 
-	fun extract vec len = Word8Vector.extract(vec, 0, SOME len)
+	fun extract vec len = 
+	    Word8VectorSlice.vector(Word8VectorSlice.slice(vec, 0, SOME len))
     in
 	fun getinetaddr (ADDR a : pf_inet sock_addr) = getinetaddr_ a
 
@@ -265,15 +266,17 @@
 	(* Note: This must agree with the particular representation of
 	   Time.time found in mosml/src/mosmllib/Time.sml: *)
 
-        prim_val fromtime : Time.time -> {sec : int, usec : int} = 1 "identity"
-	val time_timebase = ~1073741824; 
+        prim_val fromtime : Time.time -> real = 1 "identity"
 
 	fun select { rds, wrs, exs, timeout } =
 	    let val (tsec, tusec) = 
 		    case timeout of
 			NONE   => (~1,0)
-		      | SOME t => let val {sec, usec} = fromtime t 
-				  in (sec - time_timebase, usec) end
+		      | SOME t => 
+			    let val r    = fromtime t 
+				val sec  = trunc(r/1000000.0)
+				val usec = trunc(r - 1000000.0 * real sec)
+			    in (sec, usec) end
 		val rvec = Vector.fromList rds
 		val wvec = Vector.fromList wrs
 		val evec = Vector.fromList exs
diff -Nru mosml-2.01/src/mosmllib/String.sig mosml-2.10.1/src/mosmllib/String.sig
--- mosml-2.01/src/mosmllib/String.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/String.sig	2014-08-28 08:47:22.000000000 +0000
@@ -4,25 +4,29 @@
     type char = Char.char
 in
     type string = string
-    val maxSize   : int
-    val size      : string -> int
-    val sub       : string * int -> char
-    val substring : string * int * int -> string
-    val extract   : string * int * int option -> string
-    val concat    : string list -> string
-    val ^         : string * string -> string
-    val str       : char -> string
-    val implode   : char list -> string 
-    val explode   : string -> char list
-
-    val map       : (char -> char) -> string -> string 
-    val translate : (char -> string) -> string -> string
-    val tokens    : (char -> bool) -> string -> string list
-    val fields    : (char -> bool) -> string -> string list
-    val isPrefix  : string -> string -> bool
-
-    val compare   : string * string -> order
-    val collate   : (char * char -> order) -> string * string -> order
+    val maxSize     : int
+    val size        : string -> int
+    val sub         : string * int -> char
+    val substring   : string * int * int -> string
+    val extract     : string * int * int option -> string
+    val ^           : string * string -> string
+    val concat      : string list -> string
+    val concatWith  : string -> string list -> string
+    val str         : char -> string
+    val implode     : char list -> string 
+    val explode     : string -> char list
+
+    val map         : (char -> char) -> string -> string 
+    val translate   : (char -> string) -> string -> string
+    val tokens      : (char -> bool) -> string -> string list
+    val fields      : (char -> bool) -> string -> string list
+
+    val compare     : string * string -> order
+    val collate     : (char * char -> order) -> string * string -> order
+
+    val isPrefix    : string -> string -> bool
+    val isSuffix    : string -> string -> bool
+    val isSubstring : string -> string -> bool
 
     val fromString  : string -> string option     (* ML escape sequences *)
     val toString    : string -> string            (* ML escape sequences *)
@@ -55,10 +59,18 @@
    [extract (s, i, SOME n)] is the string s[i..i+n-1].
    Raises Subscript if i<0 or n<0 or i+n>size s. 
 
+   [s1 ^ s2] is the concatenation of strings s1 and s2.
+
    [concat ss] is the concatenation of all the strings in ss.
    Raises Size if the sum of their sizes is greater than maxSize.
 
-   [s1 ^ s2] is the concatenation of strings s1 and s2.
+   [concatWith sep ss] is the concatenation of all the strings in ss,
+   using sep as a separator.  Thus 
+      concatWith sep ss             is  the empty string ""
+      concatWith sep [s]            is  s
+      concatWith sep [s1, ..., sn]  is  concat[s1, sep, ..., sep, sn].
+   Raises Size if the resulting string would have more than maxSize 
+   characters.
 
    [str c] is the string of size one which contains the character c.
 
@@ -92,7 +104,13 @@
         "abc||def" contains three fields: "abc" and "" and "def"
 
    [isPrefix s1 s2] is true if s1 is a prefix of s2.  
-   That is, if there exists a string t such that s1 ^ t = s2.
+   That is, if there exists a string u such that s1 ^ u = s2.
+
+   [isSuffix s1 s2] is true if s1 is a suffix of s2.  
+   That is, if there exists a string t such that t ^ s1 = s2.
+
+   [isSubstring s1 s2] is true if s1 is a substring of s2.  
+   That is, if there exist strings t and u such that t ^ s1 ^ u = s2.
 
    [fromString s] scans the string s as an ML source program string,
    converting escape sequences into the appropriate characters.  Does
diff -Nru mosml-2.01/src/mosmllib/String.sml mosml-2.10.1/src/mosmllib/String.sml
--- mosml-2.01/src/mosmllib/String.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/String.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,4 +1,4 @@
-(* String -- 1994-12-10, 1995-11-07, 1999-04-22 *)
+(* String -- 1994-12-10, 1995-11-07, 1999-04-22, 2000-10-18 *)
 
 local 
     type char = Char.char;
@@ -31,6 +31,28 @@
             in blit_ v1 0 newstr to len1; copyall (to+len1) vr end
     in copyall 0 strs; newstr end;
 
+fun concatWith sep []       = ""
+  | concatWith sep (s1::sr) =
+    let val seplen = size sep
+	val s1len  = size s1
+	fun acc []       len = len
+          | acc (v1::vr) len = acc vr (size v1 + seplen + len)
+        val len = acc sr s1len
+        val newstr = if len > maxSize then raise Size else mkstring_ len 
+        fun copyall to []       = ()
+          | copyall to (v1::vr) = 
+            let val len1 = size v1
+            in 
+		blit_ sep 0 newstr to seplen; 
+		blit_ v1 0 newstr (to+seplen) len1; 
+		copyall (to+seplen+len1) vr
+	    end
+    in 
+	blit_ s1 0 newstr 0 s1len;
+	copyall s1len sr; 
+	newstr 
+    end;
+
 val op ^ = op ^;
 
 fun str c = 
@@ -106,6 +128,34 @@
 	    j = stop orelse sub_ s1 j = sub_ s2 j andalso h (j+1)
     in n1 <= n2 andalso h 0 end;
 
+fun isSuffix s1 s2 = 
+    let val n1 = size s1 
+	and n2 = size s2
+	val offset = n2-n1
+	fun h j = 
+	    (* At this point s1[0..j-1] = s2[offset..offset+j-1] *)
+	    j = n1 orelse sub_ s1 j = sub_ s2 (j+offset) andalso h (j+1)
+    in n1 <= n2 andalso h 0 end;
+
+fun isSubstring "" s2 = true
+  | isSubstring s1 s2 =
+    let val n1 = size s1 
+	and n2 = size s2
+	val stop1 = n1-1
+	val stop2 = n2-n1
+	fun cmp offset =
+	    let fun h j = 
+		(* At this point s1[0..j-1] = s2[offset..j+offset-1] *)
+		j >= stop1 
+		orelse sub_ s1 j = sub_ s2 (j+offset) andalso h (j+1)
+	    in h 0 end
+	(* Comparison at end of s1 good if s1 begins with identical chars: *)
+	fun issub offset = 
+	    offset <= stop2 andalso 
+	    (sub_ s1 stop1 = sub_ s2 (stop1+offset) andalso cmp offset 
+	     orelse issub (offset+1))
+    in issub 0 end;
+
 fun foldl f e s = 
     let val stop = size s
 	fun h j res = if j>=stop then res 
diff -Nru mosml-2.01/src/mosmllib/Substring.sig mosml-2.10.1/src/mosmllib/Substring.sig
--- mosml-2.01/src/mosmllib/Substring.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Substring.sig	2014-08-28 08:47:22.000000000 +0000
@@ -2,47 +2,51 @@
 
 type substring
 
-val substring : string * int * int -> substring
-val extract   : string * int * int option -> substring
-val all       : string -> substring
-val string    : substring -> string
-val base      : substring -> (string * int * int)
-
-val isEmpty   : substring -> bool
-val getc      : substring -> (char * substring) option
-val first     : substring -> char option
-val triml     : int -> substring -> substring
-val trimr     : int -> substring -> substring
-val sub       : substring * int -> char
-val size      : substring -> int
-val slice     : substring * int * int option -> substring
-val concat    : substring list -> string
-val explode   : substring -> char list
-val isPrefix  : string -> substring -> bool
-val compare   : substring * substring -> order
-val collate   : (char * char -> order) -> substring * substring -> order
-
-val dropl     : (char -> bool) -> substring -> substring
-val dropr     : (char -> bool) -> substring -> substring
-val takel     : (char -> bool) -> substring -> substring
-val taker     : (char -> bool) -> substring -> substring
-val splitl    : (char -> bool) -> substring -> substring * substring
-val splitr    : (char -> bool) -> substring -> substring * substring
-val splitAt   : substring * int -> substring * substring
-
-val position  : string -> substring -> substring * substring
+val substring   : string * int * int -> substring
+val extract     : string * int * int option -> substring
+val full        : string -> substring
+val all         : string -> substring
+val string      : substring -> string
+val base        : substring -> (string * int * int)
+
+val isEmpty     : substring -> bool
+val getc        : substring -> (char * substring) option
+val first       : substring -> char option
+val triml       : int -> substring -> substring
+val trimr       : int -> substring -> substring
+val sub         : substring * int -> char
+val size        : substring -> int
+val slice       : substring * int * int option -> substring
+val concat      : substring list -> string
+val concatWith  : string -> substring list -> string
+val explode     : substring -> char list
+val compare     : substring * substring -> order
+val collate     : (char * char -> order) -> substring * substring -> order
+
+val dropl       : (char -> bool) -> substring -> substring
+val dropr       : (char -> bool) -> substring -> substring
+val takel       : (char -> bool) -> substring -> substring
+val taker       : (char -> bool) -> substring -> substring
+val splitl      : (char -> bool) -> substring -> substring * substring
+val splitr      : (char -> bool) -> substring -> substring * substring
+val splitAt     : substring * int -> substring * substring
+
+val position    : string -> substring -> substring * substring
+val isPrefix    : string -> substring -> bool
+val isSuffix    : string -> substring -> bool
+val isSubstring : string -> substring -> bool
 
 exception Span
-val span      : substring * substring -> substring
+val span        : substring * substring -> substring
 
-val translate : (char -> string) -> substring -> string
+val translate   : (char -> string) -> substring -> string
 
-val tokens    : (char -> bool) -> substring -> substring list
-val fields    : (char -> bool) -> substring -> substring list
+val tokens      : (char -> bool) -> substring -> substring list
+val fields      : (char -> bool) -> substring -> substring list
 
-val foldl     : (char * 'a -> 'a) -> 'a -> substring -> 'a
-val foldr     : (char * 'a -> 'a) -> 'a -> substring -> 'a
-val app       : (char -> unit) -> substring -> unit
+val foldl       : (char * 'a -> 'a) -> 'a -> substring -> 'a
+val foldr       : (char * 'a -> 'a) -> 'a -> substring -> 'a
+val app         : (char -> unit) -> substring -> unit
 
 (* 
    [substring] is the type of substrings of a basestring, an efficient 
@@ -52,6 +56,9 @@
    A valid substring (s, i, n) represents the string s[i...i+n-1].  
    Invariant in the implementation: Any value of type substring is valid.
 
+   A substring is the same as a CharVectorSlice.slice, so substrings
+   may be processed using the functions declared in CharVectorSlice.
+
    [substring(s, i, n)] creates the substring (s, i, n), consisting of
    the substring of s with length n starting at i.  Raises Subscript
    if i<0 or n<0 or i+n > size s.  Equivalent to extract(s, i, SOME n).
@@ -64,7 +71,9 @@
    consisting of the substring of s with length n starting at i.
    Raises Subscript if i<0 or n<0 or i+n > size s.
 
-   [all s] is the substring (s, 0, size s).
+   [full s] is the substring (s, 0, size s).
+
+   [all s] is the same as full(s).  Its use is deprecated.
 
    [string sus] is the string s[i..i+n-1] represented by sus = (s, i, n).
 
@@ -93,24 +102,27 @@
    [sub (sus, k)] returns the k'th character of the substring; that is,
    s(i+k) where sus = (s, i, n).  Raises Subscript if k<0 or k>=n.
 
-   [size (s, i, n)] returns the size of the substring, that is, n.
+   [size sus] returns the size n of the substring sus = (s, i, n).
 
    [slice (sus, i', NONE)] returns the substring (s, i+i', n-i'), where
    sus = (s, i, n).  Raises Subscript if i' < 0 or i' > n.
 
    [slice (sus, i', SOME n')] returns the substring (s, i+i', n'), where
-   sus = (s, i, n).  Raises Subscript if i' < 0 or n' < 0 or i'+n' >= n.
+   sus = (s, i, n).  Raises Subscript if i' < 0 or n' < 0 or i'+n' > n.
 
    [concat suss] returns a string consisting of the concatenation of
-   the substrings.  Equivalent to String.concat (List.map string suss).
+   the substrings.  Equivalent to String.concat (List.map string suss).  
+   Raises Size if the resulting string would be longer than String.maxSize.
+
+   [concatWith sep suss] returns a string consisting of the
+   concatenation of the substrings in suss, using sep as a separator.
+   Equivalent to String.concatWith sep (List.map string suss).  Raises
+   Size if the resulting string would be longer than String.maxSize.
 
    [explode sus] returns the list of characters of sus, that is,
         [s(i), s(i+1), ..., s(i+n-1)]
    where sus = (s, i, n).  Equivalent to String.explode(string ss).
 
-   [isPrefix s1 s2] is true if s1 is a prefix of s2. That is, if there 
-   exists a string t such that string s1 ^ t = string s2.
-
    [compare (sus1, sus2)] performs lexicographic comparison, using the
    standard ordering Char.compare on the characters.  Returns LESS,
    EQUAL, or GREATER, according as sus1 is less than, equal to, or
@@ -172,6 +184,15 @@
    where sus1 contains the first k characters of sus, and sus2
    contains the rest.  Raises Subscript if k < 0 or k > size sus.
 
+   [isPrefix s1 s2] is true if s1 is a prefix of s2. That is, if there 
+   exists a string u such that  s1 ^ u = string s2.
+
+   [isSuffix s1 s2] is true if s1 is a suffix of s2. That is, if there
+   exists a string t such that  t ^ s1 = string s2.
+
+   [isSubstring s1 s2] is true if s1 is a substring of s2. That is, if
+   there exist strings t and u such that  t ^ s1 ^ u = string s2.
+
    [position s (s',i,n)] splits the substring into a pair (pref, suff)
    of substrings, where suff is the longest suffix of (s', i, n) which
    has s as a prefix.  More precisely, let m = size s.  If there is a
@@ -219,5 +240,4 @@
 
    [app f sus] applies f to all characters of sus, from left to right.
    Equivalent to List.app f (explode sus).
-
 *)
diff -Nru mosml-2.01/src/mosmllib/Substring.sml mosml-2.10.1/src/mosmllib/Substring.sml
--- mosml-2.01/src/mosmllib/Substring.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Substring.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,4 +1,4 @@
-(* Substring -- 1995-06-15, 1997-06-03 *)
+(* Substring -- 1995-06-15, 1997-06-03, 2000-10-18 *)
 
 local 
     prim_val sub_      : string -> int -> char         = 2 "get_nth_char";
@@ -28,7 +28,9 @@
 
 fun substring (s, i, n) = extract(s, i, SOME n);
 
-fun all s = (s, 0, size s)
+fun full s = (s, 0, size s)
+
+fun all s = (s, 0, size s)		(* deprecated *)
 
 fun getc (s, i, 0) = NONE
   | getc (s, i, n) = SOME(sub_ s i, (s, i+1, n-1))
@@ -80,6 +82,25 @@
 	    (blit_ s1 i1 newstr to len1; copyall (to+len1) vr)
     in copyall 0 strs; newstr end;
 
+fun concatWith sep []       = ""
+  | concatWith sep ((s1s, s1i, s1len)::sr) =
+    let val seplen = String.size sep
+	fun acc []       len = len
+          | acc (v1::vr) len = acc vr (size v1 + seplen + len)
+        val len = acc sr s1len
+        val newstr = if len > String.maxSize then raise Size 
+		     else mkstring_ len 
+        fun copyall to []       = ()
+          | copyall to ((v1, i1, len1)::vr) = 
+	    (blit_ sep 0 newstr to seplen; 
+	     blit_ v1 i1 newstr (to+seplen) len1; 
+	     copyall (to+seplen+len1) vr)
+    in 
+	blit_ s1s s1i newstr 0 s1len;
+	copyall s1len sr; 
+	newstr 
+    end;
+
 fun compare ((s1, i1, n1), (s2, i2, n2)) =
     let val stop = if n1 < n2 then n1 else n2
 	fun h j = (* At this point (s1, i1, j) = (s2, i2, j) *)
@@ -96,10 +117,37 @@
     in h 0 end;
 
 fun isPrefix s1 (s2, i2, n2) =
-    let val stop = if n2 < String.size s1 then n2 else String.size s1
-	fun h j = (* At this point (s1, 0, j) = (s2, i2, j) *)
+    let val n1 = String.size s1
+	val stop = if n1 < n2 then n1 else n2
+	fun h j = (* At this point string (s1, 0, j) = string (s2, i2, j) *)
 	    j = stop orelse sub_ s1 j = sub_ s2 (i2+j) andalso h (j+1)
-    in String.size s1 <= n2 andalso h 0 end;
+    in n1 <= n2 andalso h 0 end;
+
+fun isSuffix s1 (s2, i2, n2) = 
+    let val n1 = String.size s1 
+	val offset = i2+n2-n1
+	fun h j = 
+	    (* At this point string (s1, 0, j) = string (s2, offset, j) *)
+	    j = n1 orelse sub_ s1 j = sub_ s2 (j+offset) andalso h (j+1)
+    in n1 <= n2 andalso h 0 end;
+
+fun isSubstring "" (ss as (s2, i2, n2)) = true
+  | isSubstring s1 (ss as (s2, i2, n2)) =             
+    let val n1 = String.size s1 
+	val stop1 = n1-1
+	val stop2 = i2+n2-n1
+	fun cmp offset =
+	    let fun h j = 
+		(* At this point string (s1, 0, j) = string(s2, offset, j) *)
+		j >= stop1 
+		orelse sub_ s1 j = sub_ s2 (j+offset) andalso h (j+1)
+	    in h 0 end
+	(* Comparison at end of s1 good if s1 begins with identical chars: *)
+	fun issub offset = 
+	    offset <= stop2 andalso 
+	    (sub_ s1 stop1 = sub_ s2 (stop1+offset) andalso cmp offset 
+	     orelse issub (offset+1))
+    in issub i2 end;
 
 fun collate cmp ((s1, i1, n1), (s2, i2, n2)) =
     let val stop = if n1 < n2 then n1 else n2
@@ -126,9 +174,15 @@
 		      else h (j-1) (sub_ s j :: res)
     in h (i+n-1) [] end;
 
-fun app f ss = foldl (fn (x, _) => f x) () ss
+(* fun app f ss = foldl (fn (x, _) => f x) () ss *)
+
+fun app f (s,i,n) = 
+    let val stop = i+n
+        fun h j = if j>=stop then ()
+                      else (f (sub_ s j); h (j+1))
+    in h i end;
 
-exception Span
+exception Span = Span
 
 fun span ((s, i, n), (s', i', n')) = 
     if i > i'+n' orelse s<>s' then 
diff -Nru mosml-2.01/src/mosmllib/test/array2.sml mosml-2.10.1/src/mosmllib/test/array2.sml
--- mosml-2.01/src/mosmllib/test/array2.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/array2.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,4 +1,4 @@
-(* File "test/array2.sml" 1995-09-12, 1997-03-12, 1998-04-07 *)
+(* File "test/array2.sml" 1995-09-12, 1997-03-12, 1998-04-07, 2001-05-29 *)
 
 val _ = load "Array2";			(* MOSML *)
 
@@ -122,30 +122,33 @@
     testcopy {row=1,  col=1,  nrows=SOME 0, ncols=SOME 2 } 0 0 same
 val test6g = 
     testcopy {row=1,  col=1,  nrows=SOME 2, ncols=SOME 0 } 0 0 same
+
+val ### = Vector.fromList
+
 val test6h = 
     testcopy {row=0,  col=0,  nrows=NONE, ncols=SOME 3 } 0 1
-    (elts [ #[0, 0, 1, 2], #[10, 10, 11, 12], #[20, 20, 21, 22]])
+    (elts [ ###[0, 0, 1, 2], ###[10, 10, 11, 12], ###[20, 20, 21, 22]])
 val test6i = 
     testcopy {row=0,  col=0,  nrows=SOME 2, ncols=NONE } 1 0
-    (elts [ #[0, 1, 2, 3], #[0, 1, 2, 3], #[10, 11, 12, 13]])
+    (elts [ ###[0, 1, 2, 3], ###[0, 1, 2, 3], ###[10, 11, 12, 13]])
 val test6j = 
     testcopy {row=0,  col=0,  nrows=SOME 2, ncols=SOME 3 } 1 1
-    (elts [ #[0, 1, 2, 3], #[10, 0, 1, 2], #[20, 10, 11, 12]])
+    (elts [ ###[0, 1, 2, 3], ###[10, 0, 1, 2], ###[20, 10, 11, 12]])
 val test6k = 
     testcopy {row=1,  col=1,  nrows=SOME 2, ncols=SOME 3 } 0 0
-    (elts [ #[11, 12, 13, 3], #[21, 22, 23, 13], #[20, 21, 22, 23]])
+    (elts [ ###[11, 12, 13, 3], ###[21, 22, 23, 13], ###[20, 21, 22, 23]])
 val test6l = 
     testcopy {row=0,  col=1,  nrows=SOME 2, ncols=SOME 3 } 1 0
-    (elts [ #[0, 1, 2, 3], #[1, 2, 3, 13], #[11, 12, 13, 23]])
+    (elts [ ###[0, 1, 2, 3], ###[1, 2, 3, 13], ###[11, 12, 13, 23]])
 val test6m = 
     testcopy {row=0,  col=1,  nrows=SOME 2, ncols=SOME 3 } 1 1
-    (elts [ #[0, 1, 2, 3], #[10, 1, 2, 3], #[20, 11, 12, 13]])
+    (elts [ ###[0, 1, 2, 3], ###[10, 1, 2, 3], ###[20, 11, 12, 13]])
 val test6n = 
     testcopy {row=0,  col=1,  nrows=NONE, ncols=SOME 1 } 0 3
-    (elts [ #[0, 1, 2, 1], #[10, 11, 12, 11], #[20, 21, 22, 21]])
+    (elts [ ###[0, 1, 2, 1], ###[10, 11, 12, 11], ###[20, 21, 22, 21]])
 val test6o = 
     testcopy {row=1,  col=0,  nrows=SOME 1, ncols=NONE } 2 0
-    (elts [ #[0, 1, 2, 3], #[10, 11, 12, 13], #[10, 11, 12, 13]])
+    (elts [ ###[0, 1, 2, 3], ###[10, 11, 12, 13], ###[10, 11, 12, 13]])
 
 fun failcopy { row, col, nrows, ncols } dst_row dst_col = 
     (copy { src={ base=a1, row=row, col=col, nrows=nrows, ncols=ncols}, 
@@ -264,51 +267,51 @@
 val test9a = 
     chkmodify 
       [23, 22, 21, 20, 13, 12, 11, 10, 3, 2, 1, 0]
-      (elts [#[0, 10, 20, 30], #[100, 110, 120, 130], #[200, 210, 220, 230]]);
+      (elts [###[0, 10, 20, 30], ###[100, 110, 120, 130], ###[200, 210, 220, 230]]);
 val test9b = 
     chkmodifyi { row=0, col=0, nrows=NONE, ncols=NONE }
       [23, 22, 21, 20, 13, 12, 11, 10, 3, 2, 1, 0]
-      (elts [#[0, 10, 20, 30], #[100, 110, 120, 130], #[200, 210, 220, 230]]);
+      (elts [###[0, 10, 20, 30], ###[100, 110, 120, 130], ###[200, 210, 220, 230]]);
 val test9c = 
     chkmodifyi { row=0, col=1, nrows=NONE, ncols=NONE }
       [23, 22, 21, 13, 12, 11, 3, 2, 1]
-      (elts [#[0, 10, 20, 30], #[10, 110, 120, 130], #[20, 210, 220, 230]]);
+      (elts [###[0, 10, 20, 30], ###[10, 110, 120, 130], ###[20, 210, 220, 230]]);
 val test9d = 
     chkmodifyi { row=1, col=0, nrows=NONE, ncols=NONE }
       [23, 22, 21, 20, 13, 12, 11, 10]
-      (elts [#[0, 1, 2, 3], #[100, 110, 120, 130], #[200, 210, 220, 230]]);
+      (elts [###[0, 1, 2, 3], ###[100, 110, 120, 130], ###[200, 210, 220, 230]]);
 val test9e = 
     chkmodifyi { row=1, col=1, nrows=NONE, ncols=NONE }
       [23, 22, 21, 13, 12, 11]
-      (elts [#[0, 1, 2, 3], #[10, 110, 120, 130], #[20, 210, 220, 230]]);
+      (elts [###[0, 1, 2, 3], ###[10, 110, 120, 130], ###[20, 210, 220, 230]]);
 val test9f =  
     chkmodifyi { row=3, col=0, nrows=NONE, ncols=NONE }
       []
-      (elts [#[0, 1, 2, 3], #[10, 11, 12, 13], #[20, 21, 22, 23]]);
+      (elts [###[0, 1, 2, 3], ###[10, 11, 12, 13], ###[20, 21, 22, 23]]);
 val test9g =  
     chkmodifyi { row=0, col=4, nrows=NONE, ncols=NONE }
       []
-      (elts [#[0, 1, 2, 3], #[10, 11, 12, 13], #[20, 21, 22, 23]]);
+      (elts [###[0, 1, 2, 3], ###[10, 11, 12, 13], ###[20, 21, 22, 23]]);
 val test9h =  
     chkmodifyi { row=1, col=1, nrows=SOME 0, ncols=NONE }
       []
-      (elts [#[0, 1, 2, 3], #[10, 11, 12, 13], #[20, 21, 22, 23]]);
+      (elts [###[0, 1, 2, 3], ###[10, 11, 12, 13], ###[20, 21, 22, 23]]);
 val test9i =  
     chkmodifyi { row=1, col=1, nrows=NONE, ncols=SOME 0 }
       []
-      (elts [#[0, 1, 2, 3], #[10, 11, 12, 13], #[20, 21, 22, 23]]);
+      (elts [###[0, 1, 2, 3], ###[10, 11, 12, 13], ###[20, 21, 22, 23]]);
 val test9j =  
     chkmodifyi { row=1, col=1, nrows=SOME 1, ncols=NONE }
       [13, 12, 11]
-      (elts [#[0, 1, 2, 3], #[10, 110, 120, 130], #[20, 21, 22, 23]]);
+      (elts [###[0, 1, 2, 3], ###[10, 110, 120, 130], ###[20, 21, 22, 23]]);
 val test9k =  
     chkmodifyi { row=1, col=1, nrows=NONE, ncols=SOME 1 }
       [21, 11]
-      (elts [#[0, 1, 2, 3], #[10, 110, 12, 13], #[20, 210, 22, 23]]);
+      (elts [###[0, 1, 2, 3], ###[10, 110, 12, 13], ###[20, 210, 22, 23]]);
 val test9l =  
     chkmodifyi { row=0, col=1, nrows=SOME 2, ncols=SOME 2 }
       [12, 11, 2, 1]
-      (elts [#[0, 10, 20, 3], #[10, 110, 120, 13], #[20, 21, 22, 23]]);
+      (elts [###[0, 10, 20, 3], ###[10, 110, 120, 13], ###[20, 21, 22, 23]]);
 
 fun chkfold traversal resseq =
     check'(fn _ =>
diff -Nru mosml-2.01/src/mosmllib/test/arrayslice.sml mosml-2.10.1/src/mosmllib/test/arrayslice.sml
--- mosml-2.01/src/mosmllib/test/arrayslice.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/arrayslice.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,346 @@
+(* test/arrayslice.sml -- some test cases for ArraySlice 
+   sestoft@dina.kvl.dk 2000-10-18 *)
+
+use "auxil.sml";
+
+local 
+    open Array ArraySlice 
+    infix 9 sub
+    val array0 = fromList []
+    fun cons (x,r) = x ::  r
+    fun consi (i,x,r) = (i,x) ::  r
+
+in
+
+val a = fromList [1,11,21,31,41,51,61];
+val b = fromList [441,551,661];
+val c = fromList [1,11,21,31,41,51,61];
+
+val slice00 = slice(array0, 0, NONE)
+val slice01 = slice(array0, 0, SOME 0)
+val slice02 = slice(a, 0, SOME 0)
+val slice03 = slice(a, 7, NONE)
+val slice04 = slice(a, 7, SOME 0)
+val slice05 = slice(a, 4, SOME 0)
+
+val slicea07 = full a
+val slicea02 = slice(a, 0, SOME 2); 
+val slicea23 = slice(a, 2, SOME 3); 
+val slicea25 = slice(a, 2, SOME 5); 
+
+val slice06 = subslice(slicea23, 0, SOME 0)
+val slice07 = subslice(slicea23, 1, SOME 0)
+val slice08 = subslice(slicea23, 3, NONE)
+val slice09 = subslice(slicea23, 3, SOME 0)
+
+val slice0s = [slice00, slice01, slice02, slice03, slice04, slice05,
+	       slice06, slice07, slice08, slice09];
+
+val sliceas = [slicea07, slicea02, slicea23, slicea25];
+
+val test1a = 
+    check'(fn _ => List.all 
+	   (fn sli => vector sli = #[] 
+	    andalso length sli = 0
+	    andalso isEmpty sli
+	    andalso vector (subslice(sli, 0, NONE)) = #[]
+	    andalso vector (subslice(sli, 0, SOME 0)) = #[]
+	    andalso all (fn _ => false) sli
+	    andalso not (exists (fn _ => true) sli)
+	    andalso NONE = find (fn _ => true) sli
+	    andalso NONE = findi (fn _ => true) sli
+	    andalso not (Option.isSome (getItem sli))
+	    andalso (copy{src=sli, dst=array0, di=0}; true)
+	    andalso (app (fn _ => raise Fail "1a app") sli; true)
+	    andalso (appi (fn _ => raise Fail "1a appi") sli; true)
+	    andalso foldl cons [1,2] sli = [1,2]
+	    andalso foldli consi [] sli = []
+	    andalso foldr cons [1,2] sli = [1,2]
+	    andalso foldri consi [] sli = []
+	    andalso (modify ~ sli; vector sli = #[])
+	    andalso (modifyi (fn (_, x) => ~x) sli; vector sli = #[])
+	    andalso collate Int.compare (sli, slice00) = EQUAL)
+	   slice0s);
+
+val test1b = 
+    check'(fn _ => 
+	   vector slicea02 = #[1, 11]
+	   andalso vector slicea23 = #[21,31,41]
+	   andalso vector slicea25 = #[21,31,41,51,61]
+	   andalso vector slicea07 = #[1,11,21,31,41,51,61]
+	   andalso base slicea02 = (a, 0, 2)
+	   andalso base slicea23 = (a, 2, 3)
+	   andalso base slicea25 = (a, 2, 5)
+	   andalso base slicea07 = (a, 0, 7)
+	   andalso length slicea02 = 2
+	   andalso length slicea23 = 3
+	   andalso length slicea25 = 5
+	   andalso length slicea07 = 7);
+
+val test2a = 
+    check'(fn _ => 
+	   slicea07 sub 0 = 1 
+	   andalso slicea07 sub 6 = 61 
+	   andalso slicea23 sub 0 = 21 
+	   andalso slicea23 sub 2 = 41);
+
+val test2b = 
+    (slicea07 sub ~1; "WRONG") handle Subscript => "OK" | _ => "WRONG";
+
+val test2c = 
+    (slicea07 sub 7; "WRONG") handle Subscript => "OK" | _ => "WRONG";
+
+val test2c = 
+    (slicea23 sub ~1; "WRONG") handle Subscript => "OK" | _ => "WRONG";
+
+val test2d = 
+    (slicea23 sub 3; "WRONG") handle Subscript => "OK" | _ => "WRONG";
+
+val test2e = 
+    check'(fn _ =>
+	   List.all (fn sli => ((sli sub 0; false) 
+				handle Subscript => true)) slice0s);
+
+val test3a = 
+    check'(fn _ => List.all (not o isEmpty) sliceas)
+
+val test4a =
+    check'(fn _ => vector (subslice(slicea23, 0, SOME 0)) = #[]
+	   andalso vector (subslice(slicea23, 0, NONE)) = #[21,31,41]
+	   andalso vector (subslice(slicea23, 0, SOME 1)) = #[21]
+	   andalso vector (subslice(slicea23, 0, SOME 2)) = #[21,31]
+	   andalso vector (subslice(slicea23, 1, SOME 2)) = #[31,41]
+	   andalso vector (subslice(slicea23, 3, SOME 0)) = #[]);
+
+val test4b =
+    (subslice(slicea23, 3, SOME 1); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4c =
+    (subslice(slicea23, ~1, NONE); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4d =
+    (subslice(slicea23, ~1, SOME 2); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4e =
+    (subslice(slicea23, 4, NONE); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4f =
+    (subslice(slicea23, 4, SOME ~2); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4g =
+    (subslice(slicea23, 2, SOME 2); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test5 = 
+    check'(fn _ => let val (i1, r1) = Option.valOf (getItem slicea23)
+		       val (i2, r2) = Option.valOf (getItem r1)
+		       val (i3, r3) = Option.valOf (getItem r2)
+		   in 
+		       i1 = 21 andalso i2 = 31 andalso i3 = 41 
+		       andalso not (Option.isSome (getItem r3))
+		   end);
+
+val test6a = (update(slicea23, ~1, 99) seq "WRONG")
+             handle Subscript => "OK" | _ => "WRONG";
+val test6b = (update(slicea23, 3, 99) seq "WRONG")
+             handle Subscript => "OK" | _ => "WRONG";
+
+val test6c = 
+    check'(fn _ => 
+	   (update(slicea23, 0, 99); Array.sub(a, 2) = 99)
+	   andalso (update(slicea23, 2, 199); Array.sub(a, 4) = 199)
+	   andalso (update(slicea23, 0, 21);  Array.sub(a, 2) = 21)
+	   andalso (update(slicea23, 2, 41);  Array.sub(a, 4) = 41));
+
+val sliced = full (tabulate(100, fn i => i mod 7 * 10 + 1));
+val sliceb = full b;
+
+val e = array(203, 0);
+val _ = (copy{src=sliced, dst=e, di=0}; 
+	 copy{src=sliceb, dst=e, di=length sliced};
+	 copy{src=sliced, dst=e, di=length sliced + length sliceb});
+
+val ev = Vector.concat [vector sliced, vector sliceb, vector sliced]; 
+(* length e = 203 *)
+
+val slicee = full e
+
+val test9a = 
+    check'(fn () => vector(subslice(slicee, 100, SOME 3)) = vector sliceb);
+val test9b = 
+    check'(fn () => 
+	   ev = vector (subslice(slicee, 0, SOME (length slicee)))
+	   andalso ev = vector (subslice(slicee, 0, NONE)));
+
+val _ = copy{src=slicee, dst=e, di=0};
+val g = array(203, 9999999);
+val _ = copy{src=slicee, dst=g, di=0};
+
+val sliceg = full g;
+
+val test10a = 
+	   check'(fn () => ev = Array.vector e
+		  andalso ev = Array.vector g);
+
+val sliceg0 = slice(g, 0, SOME (Array.length g - 1));
+val _ = copy{src=sliceg0, dst=g, di=1};
+val test10b = check'(fn () => vector sliceb = vector (slice(g, 101, SOME 3)));
+
+val sliceg1 = slice(g, 1, SOME (Array.length g - 1));
+val _ = copy{src=sliceg1, dst=g, di=0};
+val test10c = check'(fn () => vector sliceb = vector (slice(g, 100, SOME 3)));
+
+val sliceg202 = slice(g, 202, SOME 1);
+val _ = copy{src=sliceg202, dst=g, di=202};
+val test10d = 
+    check'(fn () => sliceg sub 202 = 10 * (202-1-103) mod 7 + 1);
+
+val test11a = (copy{src=sliceg, dst=g, di= ~1}; "WRONG") 
+              handle Subscript => "OK" | _ => "WRONG"
+val test11b = (copy{src=sliceg1, dst=g, di=0}; "OK") 
+              handle _ => "WRONG"
+val test11c = (copy{src=sliceg, dst=g, di=1}; "WRONG") 
+              handle Subscript => "OK" | _ => "WRONG"
+
+local 
+    val v = ref 0
+    fun setv c = v := c;
+    fun addv c = v := c + !v;
+    fun setvi (i, c) = v := c + i;
+    fun setvif (i, c, _) = v := c + i;
+    fun addvi (i, c) = v := c + i + !v;
+    fun cons (x,r) = x ::  r
+    fun consi (i,x,r) = (i,x) ::  r
+    val inplist = [1,2,3,4,7,9,13,4,5,6,8,0];
+    val inpa = Array.fromList inplist
+    val inp = slice(inpa, 4, SOME 3)
+    val pnia = Array.fromList (rev inplist)
+    val pni = slice(pnia, 5, SOME 3)
+    fun resetinp () = copy{src=full(fromList inplist), dst=inpa, di=0}
+in 
+
+val test12a =
+    check'(fn _ =>
+	           foldl cons [1,2] inp = [13,9,7,1,2]
+	   andalso (foldl (fn (x, _) => setv x) () inp; !v = 13));
+
+val test12b =
+    check'(fn _ =>
+	           foldr cons [1,2] inp = [7,9,13,1,2]
+	   andalso (foldr (fn (x, _) => setv x) () inp; !v = 7));
+
+val test12c =
+    check'(fn _ =>
+	   find (fn _ => false) inp = NONE
+	   andalso find (fn x => x=7) inp = SOME 7
+	   andalso find (fn x => x=9) inp = SOME 9
+	   andalso (setv 0; find (fn x => (addv x; x=9)) inp; !v = 7+9));
+
+val test12d = 
+    check'(fn _ =>
+           ((setv 0; app addv inp; !v = 7+9+13)
+	    andalso (app setv inp; !v = 13)));
+
+val test12e = 
+    check'(fn _ =>
+	   (resetinp(); modify ~ inp; foldr (op::) [] inp = [~7,~9,~13])
+	   andalso (resetinp(); setv 117; modify (fn x => (setv x; 37)) inp; 
+		    !v = 13))
+
+val _ = resetinp(); 
+
+val test12f = 
+    check'(fn _ => 
+	   not (exists (fn i => i>13) inp)
+	   andalso exists (fn i => i>12) inp);
+val test12g = 
+    check'(fn _ => 
+	   (setv 117; exists (fn x => (setv x; false)) slice05; !v = 117)
+	   andalso (setv 0; exists (fn x => (addv x; false)) inp; !v = 7+9+13)
+	   andalso (exists (fn x => (setv x; false)) inp; !v = 13));
+val test12h = 
+    check'(fn _ => 
+	   not (all (fn i => i<13) inp)
+	   andalso all (fn i => i<14) inp);
+val test12i = 
+    check'(fn _ => 
+	   (setv 117; all (fn x => (setv x; true)) slice05; !v = 117)
+	   andalso (setv 0; all (fn x => (addv x; true)) inp; !v = 7+9+13)
+	   andalso (all (fn x => (setv x; true)) inp; !v = 13));
+
+val _ = resetinp();
+
+val test13 =
+    check'(fn _ =>
+	   foldli consi [] inp = [(6,13),(5,9),(4,7)]
+	   andalso foldri consi [] inp = [(4,7),(5,9),(6,13)]
+	   andalso (resetinp(); setv 117; foldli setvif () inp; !v = 6+13)
+	   andalso (resetinp(); setv 117; foldri setvif () inp; !v = 4+7));
+
+val _ = resetinp();
+
+val test14a =
+    check'(fn _ =>
+	   findi (fn _ => false) inp = NONE
+	   andalso findi (fn (i,x) => x=9) inp = SOME (5,9)
+	   andalso findi (fn (i,x) => i=6) inp = SOME (6,13));
+
+val test14b =
+    check'(fn _ =>	   
+	   List.all (fn sli => NONE=findi (fn (j, x) => j*10+1<>x) sli)
+	            sliceas)
+
+val test15 = 
+    check'(fn _ =>
+           ((setvi (0,0); appi addvi inp; !v = 4+7+5+9+6+13)
+	   andalso (appi setvi inp; !v = 6+13)));
+
+val test16 = 
+    check'(fn _ =>
+           (resetinp(); modifyi (op -) inp; vector inp = #[~3,~4,~7])
+	   andalso (resetinp(); setv 117; 
+		    modifyi (fn x => (setvi x; 37)) inp; !v = 6+13));
+end
+
+val test17a = 
+    check'(fn _ =>
+	   let fun invcompare (c1, c2) = Char.compare (c2, c1) 
+	       fun coll s1 s2 = 
+		   collate invcompare (full (fromList (explode s1)), 
+				       full (fromList (explode s2)))
+	   in 
+	       coll "" "" = EQUAL
+	       andalso coll "" " " = LESS
+	       andalso coll " " "" = GREATER
+	       andalso coll "ABCD" "ABCD" = EQUAL
+	       andalso coll "ABCD" "ABCD " = LESS
+	       andalso coll "ABCD " "ABCD" = GREATER
+	       andalso coll "B" "ABCD" = LESS
+	       andalso coll "ABCD" "B" = GREATER
+	       andalso coll "CCCB" "CCCABCD" = LESS
+	       andalso coll "CCCABCD" "CCCB" = GREATER
+	       andalso coll "CCCB" "CCCA" = LESS
+	       andalso coll "CCCA" "CCCB" = GREATER
+	   end)
+
+val test17b = 
+    check'(fn _ =>
+  let val sa = fromList(explode "AAAAaAbAABBBB");
+                              (* 0123456789012 *)
+      fun invcompare (c1, c2) = Char.compare (c2, c1) 
+      fun coll s1 s2 = collate invcompare (s1, s2)
+  in 
+      coll (full sa) (slice(sa, 0, SOME 13)) = EQUAL
+      andalso coll (slice(sa, 0, SOME 0)) (slice(sa, 13, SOME 0)) = EQUAL
+      andalso coll (slice(sa, 0, SOME 0)) (slice(sa, 0, SOME 13)) = LESS
+      andalso coll (slice(sa, 0, SOME 13)) (slice(sa, 0, SOME 0)) = GREATER
+      andalso coll (slice(sa, 0, SOME 3)) (slice(sa, 1, SOME 3)) = EQUAL
+      andalso coll (slice(sa, 0, SOME 4)) (slice(sa, 1, SOME 4)) = GREATER
+      andalso coll (slice(sa, 1, SOME 4)) (slice(sa, 0, SOME 4)) = LESS
+  end)
+end
diff -Nru mosml-2.01/src/mosmllib/test/array.sml mosml-2.10.1/src/mosmllib/test/array.sml
--- mosml-2.01/src/mosmllib/test/array.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/array.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,8 +1,10 @@
 (* test/array.sml -- some test cases for Array 
-   PS 1994-12-10, 1995-06-14, 1995-11-07 *)
+   PS 1994-12-10, 1995-06-14, 1995-11-07, 2000-10-19 *)
 
 use "auxil.sml";
 
+load "ArraySlice";
+
 local 
     open Array 
     infix 9 sub
@@ -47,11 +49,11 @@
 val test6c = check'(fn () => c sub 0 = 1);
 
 val e = array(203, 0);
-val _ = (copy{src=d, si=0, dst=e, di=0,        len=NONE}; 
-	 copy{src=b, si=0, dst=e, di=length d, len=NONE};
-	 copy{src=d, si=0, dst=e, di=length d + length b, len=NONE});
+val _ = (copy{src=d, dst=e, di=0}; 
+	 copy{src=b, dst=e, di=length d};
+	 copy{src=d, dst=e, di=length d + length b});
 	 
-fun a2v a = extract(a, 0, NONE);
+fun a2v a = vector a
 val ev = Vector.concat [a2v d, a2v b, a2v d]; (* length e = 203 *)
 
 val test7 = check'(fn () => length e = 203);
@@ -61,87 +63,43 @@
 val test8b = (update(e, length e, 99) seq "WRONG")
              handle Subscript => "OK" | _ => "WRONG";
 
-val f = extract (e, 100, SOME 3);
+val f = ArraySlice.vector(ArraySlice.slice (e, 100, SOME 3));
 
 val test9 = check'(fn () => f = a2v b);
 
 val test9a = 
-    check'(fn () => ev = extract(e, 0, SOME (length e))
-	   andalso ev = extract(e, 0, NONE));
+    check'(fn () => ev = vector e);
 val test9b = 
-    check'(fn () => Vector.fromList [] = extract(e, 100, SOME 0));
-val test9c = (extract(e, ~1, SOME (length e))  seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9d = (extract(e, length e+1, SOME 0) seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9e = (extract(e, 0, SOME (length e+1)) seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9f = (extract(e, 20, SOME ~1)        seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9g = (extract(e, ~1, NONE)  seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9h = (extract(e, length e+1, NONE) seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9i = 
-    check'(fn () => a2v (fromList []) = extract(e, length e, SOME 0)
-	    andalso a2v (fromList []) = extract(e, length e, NONE));
-val test9j =
-    check'(fn () => extract(e, 3, SOME(length e - 3)) = extract(e, 3, NONE));
+    check'(fn () => a2v (fromList []) = vector array0);
 
-val _ = copy{src=e, si=0, dst=e, di=0, len=NONE};
+val _ = copy{src=e, dst=e, di=0};
 val g = array(203, 9999999);
-val _ = copy{src=e, si=0, dst=g, di=0, len=NONE};
+val _ = copy{src=e, dst=g, di=0};
 
-val test10a = check'(fn () => ev = extract(e, 0, SOME (length e)) 
- 		      andalso ev = extract(e, 0, NONE));
-val test10b = check'(fn () => ev = extract(g, 0, SOME (length g))
-		      andalso ev = extract(g, 0, NONE));
-
-val _ = copy{src=g, si=203, dst=g, di=0, len=SOME 0};
-val test10c = check'(fn () => ev = extract(g, 0, SOME (length g)));
-
-val _ = copy{src=g, si=0, dst=g, di=203, len=SOME 0};
-val test10d = check'(fn () => ev = extract(g, 0, SOME (length g)));
-
-val _ = copy{src=g, si=0, dst=g, di=1, len=SOME (length g-1)};
-val test10e = check'(fn () => a2v b = extract(g, 101, SOME 3));
-
-val _ = copy{src=g, si=1, dst=g, di=0, len=SOME (length g-1)};
-val test10f = check'(fn () => a2v b = extract(g, 100, SOME 3));
-
-val _ = copy{src=g, si=202, dst=g, di=202, len=SOME 1};
-val test10g = 
-    check'(fn () => g sub 202 = 10 * (202-1-103) mod 7 + 1);
-val test10h = 
-    check'(fn () => (copy{src=array0, si=0, dst=array0, di=0, len=SOME 0}; 
-		     array0 <> array(0, 999999)));
-val test10i = 
-    check'(fn () => (copy{src=array0, si=0, dst=array0, di=0, len=NONE}; 
-		     array0 <> array(0, 999999)));
+val test10a = check'(fn () => ev = vector g);
 
-val test11a = (copy{src=g, si= ~1, dst=g, di=0, len=NONE}; "WRONG") 
-              handle Subscript => "OK" | _ => "WRONG"
-val test11b = (copy{src=g, si=0, dst=g, di= ~1, len=NONE}; "WRONG") 
-              handle Subscript => "OK" | _ => "WRONG"
-val test11c = (copy{src=g, si=1, dst=g, di=0, len=NONE}; "OK") 
-              handle _ => "WRONG"
-val test11d = (copy{src=g, si=0, dst=g, di=1, len=NONE}; "WRONG") 
-              handle Subscript => "OK" | _ => "WRONG"
-val test11e = (copy{src=g, si=203, dst=g, di=0, len=NONE}; "OK") 
-              handle _ => "WRONG"
+val test10b = 
+    check'(fn () => (copy{src=array0, dst=array0, di=0}; 
+		     array0 <> array(0, 999999)));
+val test10c = 
+    check'(fn () => (copy{src=array0, dst=g, di=0}; 
+		     ev = vector g));
+val test10d = 
+    check'(fn () => (copy{src=array0, dst=g, di=203}; 
+		     ev = vector g));
+val test10e = 
+    check'(fn () => (copy{src=array0, dst=g, di=1}; 
+		     ev = vector g));
 
-val test11f = (copy{src=g, si= ~1, dst=g, di=0, len=SOME (length g)}; "WRONG") 
+val test11a = (copy{src=g, dst=g, di=1}; "WRONG") 
               handle Subscript => "OK" | _ => "WRONG"
-val test11g = (copy{src=g, si=0, dst=g, di= ~1, len=SOME (length g)}; "WRONG") 
+val test11b = (copy{src=g, dst=g, di=202}; "WRONG") 
               handle Subscript => "OK" | _ => "WRONG"
-val test11h = (copy{src=g, si=1, dst=g, di=0, len=SOME (length g)}; "WRONG") 
+val test11c = (copy{src=b, dst=g, di = ~1}; "WRONG") 
               handle Subscript => "OK" | _ => "WRONG"
-val test11i = (copy{src=g, si=0, dst=g, di=1, len=SOME (length g)}; "WRONG") 
-              handle Subscript => "OK" | _ => "WRONG"
-val test11j = (copy{src=g, si=0, dst=g, di=0, len=SOME (length g+1)}; "WRONG") 
-              handle Subscript => "OK" | _ => "WRONG"
-val test11k = (copy{src=g, si=203, dst=g, di=0, len=SOME 1}; "WRONG") 
+val test11d = (copy{src=b, dst=g, di=203}; "WRONG") 
               handle Subscript => "OK" | _ => "WRONG"
+val test11e = check'(fn () => ev = vector g);
 
 local 
     val v = ref 0
@@ -154,8 +112,7 @@
     val inplist = [7,9,13];
     val inp = fromList inplist
     val pni = fromList (rev inplist)
-    fun copyinp a = 
-	copy{src=inp, si=0, dst=a, di=0, len=NONE}
+    fun copyinp a = copy{src=inp, dst=a, di=0}
 in 
 
 val array0 = fromList [] : int array;
@@ -172,7 +129,6 @@
 	   andalso foldr cons [1,2] inp = [7,9,13,1,2]
 	   andalso (foldr (fn (x, _) => setv x) () inp; !v = 7));
 
-(*
 val test12c =
     check'(fn _ =>
 	           find (fn _ => true) array0 = NONE
@@ -180,13 +136,12 @@
 	   andalso find (fn x => x=7) inp = SOME 7
 	   andalso find (fn x => x=9) inp = SOME 9
 	   andalso (setv 0; find (fn x => (addv x; x=9)) inp; !v = 7+9));
-*)
+
 val test12d = 
     check'(fn _ =>
            (setv 117; app setv array0; !v = 117)
 	   andalso (setv 0; app addv inp; !v = 7+9+13)
 	   andalso (app setv inp; !v = 13));
-
 val test12e = 
     let val a = array(length inp, inp sub 0)
     in 
@@ -195,158 +150,96 @@
 	   andalso (copyinp a; modify ~ a; foldr (op::) [] a = map ~ inplist)
 	   andalso (setv 117; modify (fn x => (setv x; 37)) a; !v = ~13))
     end
+val test12f = 
+    check'(fn _ => 
+	   not (exists (fn i => i>61) a)
+	   andalso exists (fn i => i>41) a
+	   andalso not (exists (fn _ => true) array0));
+val test12g = 
+    check'(fn _ => 
+	   (setv 117; exists (fn x => (setv x; false)) array0; !v = 117)
+	   andalso (setv 0; exists (fn x => (addv x; false)) inp; !v = 7+9+13)
+	   andalso (exists (fn x => (setv x; false)) inp; !v = 13));
+val test12h = 
+    check'(fn _ => 
+	   not (all (fn i => i<61) a)
+	   andalso all (fn i => i<62) a
+	   andalso all (fn _ => false) array0);
+val test12i = 
+    check'(fn _ => 
+	   (setv 117; all (fn x => (setv x; true)) array0; !v = 117)
+	   andalso (setv 0; all (fn x => (addv x; true)) inp; !v = 7+9+13)
+	   andalso (all (fn x => (setv x; true)) inp; !v = 13));
 
 val test13a =
     check'(fn _ =>
-	           foldli consi [] (array0, 0, NONE) = []
-	   andalso foldri consi [] (array0, 0, NONE) = []
-	   andalso foldli consi [] (inp, 0, NONE) = [(2,13),(1,9),(0,7)]
-	   andalso foldri consi [] (inp, 0, NONE) = [(0,7),(1,9),(2,13)])
+	           foldli consi [] array0 = []
+	   andalso foldri consi [] array0 = []
+	   andalso (setv 117; foldli (fn (_, x, _) => setv x) () array0; 
+		    !v = 117)
+	   andalso (setv 117; foldri (fn (_, x, _) => setv x) () array0; 
+		    !v = 117));
 val test13b =
     check'(fn _ =>
-	           foldli consi [] (array0, 0, SOME 0) = []
-	   andalso foldri consi [] (array0, 0, SOME 0) = []
-	   andalso foldli consi [] (inp, 0, SOME 0) = []
-	   andalso foldri consi [] (inp, 0, SOME 0) = []
-	   andalso foldli consi [] (inp, 3, SOME 0) = []
-	   andalso foldri consi [] (inp, 3, SOME 0) = []
-	   andalso foldli consi [] (inp, 0, SOME 3) = [(2,13),(1,9),(0,7)]
-	   andalso foldri consi [] (inp, 0, SOME 3) = [(0,7),(1,9),(2,13)]
-	   andalso foldli consi [] (inp, 0, SOME 2) = [(1,9),(0,7)]
-	   andalso foldri consi [] (inp, 0, SOME 2) = [(0,7),(1,9)]
-	   andalso foldli consi [] (inp, 1, SOME 2) = [(2,13),(1,9)]
-	   andalso foldri consi [] (inp, 1, SOME 2) = [(1,9),(2,13)]
-	   andalso foldli consi [] (inp, 2, SOME 1) = [(2,13)]
-	   andalso foldri consi [] (inp, 2, SOME 1) = [(2,13)]);
-
-val test13c = (foldli consi [] (inp, ~1, NONE) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test13d = (foldli consi [] (inp, 4, NONE) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test13e = (foldli consi [] (inp, ~1, SOME 2) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test13f = (foldli consi [] (inp, 4, SOME 0) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test13g = (foldli consi [] (inp, 0, SOME 4) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test13h = (foldli consi [] (inp, 2, SOME ~1) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-
-val test13i = (foldri consi [] (inp, ~1, NONE) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test13j = (foldri consi [] (inp, 4, NONE) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test13k = (foldri consi [] (inp, ~1, SOME 2) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test13l = (foldri consi [] (inp, 4, SOME 0) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test13m = (foldri consi [] (inp, 0, SOME 4) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test13n = (foldri consi [] (inp, 2, SOME ~1) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-(*
+	           foldli consi [] array0 = []
+	   andalso foldri consi [] array0 = []
+	   andalso foldli consi [] inp = [(2,13),(1,9),(0,7)]
+	   andalso foldri consi [] inp = [(0,7),(1,9),(2,13)]
+	   andalso (foldli (fn (_, x, _) => setv x) () inp; !v = 13)
+	   andalso (foldri (fn (_, x, _) => setv x) () inp; !v = 7));
+
 val test14a =
     check'(fn _ =>
-	   findi (fn _ => true) (array0, 0, NONE) = NONE
-   andalso findi (fn _ => false) (inp, 0, NONE) = NONE
-   andalso findi (fn (i, x) => x=9 orelse 117 div (2-i) = 0) (inp, 0, NONE)
-	   = SOME (1,9));
+	   findi (fn _ => true) array0 = NONE
+   andalso findi (fn _ => false) inp = NONE
+   andalso findi (fn (i, x) => x=9 orelse 117 div (2-i) = 0) inp = SOME (1,9));
 
 val test14b =
     check'(fn _ =>
-	   findi (fn _ => true) (array0, 0, SOME 0) = NONE
-   andalso findi (fn _ => false) (inp, 0, NONE) = NONE
-   andalso findi (fn (i, x) => x=9 orelse 117 div (2-i) = 0) (inp, 0, NONE)
-	   = SOME (1,9));
-
-val test14c = (findi (fn _ => true) (inp, ~1, NONE) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test14d = (findi (fn _ => true) (inp, 4, NONE) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test14e = (findi (fn _ => true) (inp, ~1, SOME 2) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test14f = (findi (fn _ => true) (inp, 4, SOME 0) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test14g = (findi (fn _ => true) (inp, 0, SOME 4) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test14h = (findi (fn _ => true) (inp, 2, SOME ~1) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-*)
+	   (setvi (0,117); 
+	    findi (fn arg => (setvi arg; false)) array0;
+	    !v = 117));
+val test14c =
+    check'(fn _ =>
+	   (setvi (0,0); 
+	    findi (fn arg => (addvi arg; false)) inp;
+	    !v = 0+7+1+9+2+13));
+
 val test15a = 
     check'(fn _ =>
-           (setvi (0,117); appi setvi (array0, 0, NONE); !v = 117)
-	   andalso (setvi (0,0); appi addvi (inp, 0, NONE); !v = 0+7+1+9+2+13)
-	   andalso (appi setvi (inp, 0, NONE); !v = 2+13));
-val test15b = 
-    check'(fn _ =>
-           (setvi (0,117); appi setvi (array0, 0, SOME 0); !v = 117)
-	   andalso (setvi (0,0); appi addvi (inp, 0, SOME 0); !v = 0)
-	   andalso (setvi (0,0); appi addvi (inp, 3, SOME 0); !v = 0)
-	   andalso (setvi (0,0); appi addvi (inp, 0, SOME 2); !v = 0+7+1+9)
-	   andalso (setvi (0,0); appi addvi (inp, 1, SOME 2); !v = 1+9+2+13)
-	   andalso (setvi (0,0); appi addvi (inp, 0, SOME 3); !v = 0+7+1+9+2+13)
-	   andalso (appi setvi (inp, 1, SOME 2); !v = 2+13)
-	   andalso (appi setvi (inp, 0, SOME 2); !v = 1+9)
-	   andalso (appi setvi (inp, 0, SOME 1); !v = 0+7)
-	   andalso (appi setvi (inp, 0, SOME 3); !v = 2+13));
-
-val test15c = (appi setvi (inp, ~1, NONE) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test15d = (appi setvi (inp, 4, NONE) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test15e = (appi setvi (inp, ~1, SOME 2) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test15f = (appi setvi (inp, 4, SOME 0) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test15g = (appi setvi (inp, 0, SOME 4) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test15h = (appi setvi (inp, 2, SOME ~1) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
+           (setvi (0,117); appi setvi array0; !v = 117)
+	   andalso (setvi (0,0); appi addvi inp; !v = 0+7+1+9+2+13)
+	   andalso (appi setvi inp; !v = 2+13));
 
 val test16a = 
     let val a = array(length inp, inp sub 0)
     in 
 	check'(fn _ =>
-           (modifyi (op +) (array0, 0, NONE); true)
-	   andalso (modifyi (op +) (array0, 0, SOME 0); true)
-	   andalso (copyinp a; modifyi (op -) (a, 0, SOME 0); 
-		    foldr (op::) [] a = [7,9,13])
-	   andalso (copyinp a; modifyi (op -) (a, 3, SOME 0); 
-		    foldr (op::) [] a = [7,9,13])
-	   andalso (copyinp a; modifyi (op -) (a, 0, NONE); 
-		    foldr (op::) [] a = [~7,~8,~11])
-	   andalso (copyinp a; modifyi (op -) (a, 0, SOME 3); 
-		    foldr (op::) [] a = [~7,~8,~11])
-	   andalso (copyinp a; modifyi (op -) (a, 0, SOME 2); 
-		    foldr (op::) [] a = [~7,~8,13])
-	   andalso (copyinp a; modifyi (op -) (a, 1, SOME 2); 
-		    foldr (op::) [] a = [7,~8,~11])
-	   andalso (copyinp a; setv 117; 
-		    modifyi (fn x => (setvi x; 37)) (a, 0, NONE); !v = 2+13)
-	   andalso (copyinp a; setv 117; 
-		    modifyi (fn x => (setvi x; 37)) (a, 0, SOME 3); !v = 2+13)
-	   andalso (copyinp a; setv 117; 
-		    modifyi (fn x => (setvi x; 37)) (a, 1, SOME 2); !v = 2+13)
-	   andalso (copyinp a; setv 117; 
-		    modifyi (fn x => (setvi x; 37)) (a, 0, SOME 2); !v = 1+9)
-	   andalso (copyinp a; setv 117; 
-		    modifyi (fn x => (setvi x; 37)) (a, 0, SOME 0); !v = 117)
-	   andalso (copyinp a; setv 117; 
-		    modifyi (fn x => (setvi x; 37)) (a, 3, SOME 0); !v = 117))
+           (modifyi (op +) array0; true)
+	   andalso (copyinp a; modifyi (op -) a; 
+		    foldr (op::) [] a = [~7,~8,~11]))
     end
 
-val test16b = (modifyi (op+) (inp, ~1, NONE) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test16c = (modifyi (op+) (inp, 4, NONE) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test16d = (modifyi (op+) (inp, ~1, SOME 2) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test16e = (modifyi (op+) (inp, 4, SOME 0) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test16f = (modifyi (op+) (inp, 0, SOME 4) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
-val test16g = (modifyi (op+) (inp, 2, SOME ~1) seq "WRONG")
-           handle Subscript => "OK" | _ => "WRONG";
 end
 
+val test17 = 
+    check'(fn _ =>
+	   let fun invcompare (c1, c2) = Char.compare (c2, c1) 
+	       fun coll s1 s2 = 
+		   collate invcompare (fromList (explode s1), 
+				       fromList (explode s2))
+	   in 
+	       coll "" "" = EQUAL
+	       andalso coll "" " " = LESS
+	       andalso coll " " "" = GREATER
+	       andalso coll "ABCD" "ABCD" = EQUAL
+	       andalso coll "ABCD" "ABCD " = LESS
+	       andalso coll "ABCD " "ABCD" = GREATER
+	       andalso coll "B" "ABCD" = LESS
+	       andalso coll "ABCD" "B" = GREATER
+	       andalso coll "CCCB" "CCCABCD" = LESS
+	       andalso coll "CCCABCD" "CCCB" = GREATER
+	       andalso coll "CCCB" "CCCA" = LESS
+	       andalso coll "CCCA" "CCCB" = GREATER
+	   end)
 end
diff -Nru mosml-2.01/src/mosmllib/test/callback/testcallback.sml mosml-2.10.1/src/mosmllib/test/callback/testcallback.sml
--- mosml-2.01/src/mosmllib/test/callback/testcallback.sml	2000-06-16 11:26:45.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/callback/testcallback.sml	2014-08-28 08:47:22.000000000 +0000
@@ -128,7 +128,7 @@
 	      app1 (getcptr "using_unreg") ()) : bool;
 
 fun mkfun extra = 
-    let fun f r = r + extra
+    let fun f (r : real) = r + extra
     in f end
 
 (* On a 266 MHz Pentium II notebook this does 1.25 million callbacks/sec: *)
diff -Nru mosml-2.01/src/mosmllib/test/filesys.sml mosml-2.10.1/src/mosmllib/test/filesys.sml
--- mosml-2.01/src/mosmllib/test/filesys.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/filesys.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,5 +1,5 @@
 (* test/filesys.sml
-   PS 1995-03-23, 1996-05-01, 1998-04-06, 1999-03-02
+   PS 1995-03-23, 1996-05-01, 1998-04-06, 1999-03-02, 2002-04-08
 *)
 
 (* DOS: Plain WRONG: test6a, test9a (and test9b);
@@ -54,10 +54,14 @@
              handle OS.SysErr _ => "OK" | _ => "WRONG";
 val test6d = (chDir "exists.not" seq "WRONG")
              handle OS.SysErr _ => "OK" | _ => "WRONG";
-val test6e = (fullPath "exists.not" seq "WRONG")
+val test6e = (fullPath "exists.not"; "OK")
              handle OS.SysErr _ => "OK" | _ => "WRONG";
-val test6f = (realPath "exists.not" seq "WRONG")
+      (* WAS (fullPath "exists.not" seq "WRONG")
+	      handle OS.SysErr _ => "OK" | _ => "WRONG"; *)
+val test6f = (realPath "exists.not"; "OK")
              handle OS.SysErr _ => "OK" | _ => "WRONG";
+      (* WAS (realPath "exists.not" seq "WRONG")
+             handle OS.SysErr _ => "OK" | _ => "WRONG"; *)
 val test6g = (modTime "exists.not" seq "WRONG")
              handle OS.SysErr _ => "OK" | _ => "WRONG";
 val test6h = (setTime("exists.not", NONE) seq "WRONG")
@@ -95,16 +99,20 @@
     check'(fn _ => fullPath "testlink" = getDir() ^ "/README");
 val test8c = (fullPath "testcycl" seq "WRONG")
  	     handle OS.SysErr _ => "OK" | _ => "WRONG";
-val test8d = (fullPath "testbadl" seq "WRONG")
+val test8d = (fullPath "testbadl"; "OK")
  	     handle OS.SysErr _ => "OK" | _ => "WRONG";
+      (* WAS (fullPath "testbadl" seq "WRONG")
+ 	     handle OS.SysErr _ => "OK" | _ => "WRONG"; *)
 val test8e = 
     check'(fn _ => realPath "." = ".");
 val test8f = 
     check'(fn _ => realPath "testlink" = "README");
 val test8g = (realPath "testcycl" seq "WRONG")
  	     handle OS.SysErr _ => "OK" | _ => "WRONG";
-val test8h = (realPath "testbadl" seq "WRONG")
+val test8h = (realPath "testbadl"; "OK")
  	     handle OS.SysErr _ => "OK" | _ => "WRONG";
+     (* WAS  (realPath "testbadl" seq "WRONG")
+ 	     handle OS.SysErr _ => "OK" | _ => "WRONG"; *)
 
 val test9a = 
     check'(fn _ => 
diff -Nru mosml-2.01/src/mosmllib/test/listpair.sml mosml-2.10.1/src/mosmllib/test/listpair.sml
--- mosml-2.01/src/mosmllib/test/listpair.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/listpair.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,18 +1,20 @@
 (* test/listpair.sml
-   PS 1995-02-25, 1997-03-07
+   PS 1995-02-25, 1997-03-07, 2000-10-19
 *)
 
 use "auxil.sml";
 
-local 
+local
     open ListPair
     val a = [1, 2, 3, 4, 5, 6]
     val b = [10, 40, 50, 50]
+    val b6 = [10, 40, 50, 50, 60, 70]
     val ab = [(1, 10), (2, 40), (3, 50), (4, 50)]
+    val ab6 = [(1, 10), (2, 40), (3, 50), (4, 50), (5, 60), (6, 70)]
     fun take 0 xs        = []
       | take n []        = []
       | take n (x :: xr) = x :: take (n-1) xr
-in 
+in
 
 val test1 = check(zip([], []) = [] 
 		  andalso zip ([], a) = [] 
@@ -26,19 +28,22 @@
 		   andalso (b, take (length b) a) = unzip(zip(b, a)));
 val test2b = check(ab = zip(unzip ab));
 
-val test3a = check(map (fn (x, y) => x + y) (a, b) = 
-		  List.map (fn (x,y) => x + y) (zip(a, b)));
-
 local 
     val v = ref 0
     fun h [] r = r | h (x::xr) r = h xr (r+r+x): int;
     val isum = h (take (length b) a) 0
+    val isum6 = h (take (length b6) a) 0
 in 
     fun reset () = v := 0;
     fun incrv i = v := 2 * !v + i;
     fun checkv () = check(!v = isum);
+    fun checkv6 () = check(!v = isum6);
+    fun checkv0 () = check(!v = 0);
 end;
 
+val test3a = check(map (fn (x, y) => x + y) (a, b) = 
+		  List.map (fn (x,y) => x + y) (zip(a, b)));
+
 val test3b = (reset (); map (incrv o #1) (a, b) seq (); checkv());
 
 val test4 = (reset (); app (incrv o #1) (a, b); checkv());
@@ -80,5 +85,94 @@
     andalso foldlchk (fn (x, y, (r1, r2)) => (x div r1, y div r2)) (0, 0) [] []);
 end
 
+val test8a = (zipEq (a, b); "WRONG")
+             handle UnequalLengths => "OK" | _ => "WRONG";
+val test8b = (zipEq (b, a); "WRONG")
+             handle UnequalLengths => "OK" | _ => "WRONG";
+
+val test8b = 
+    check'(fn _ => zipEq (a, b6) = ab6
+	   andalso zipEq (b6, a) = List.map (fn (x,y) => (y,x)) ab6);
+
+val test9a = (mapEq op- (a, b); "WRONG")
+             handle UnequalLengths => "OK" | _ => "WRONG";
+val test9b = (mapEq op- (b, a); "WRONG")
+             handle UnequalLengths => "OK" | _ => "WRONG";
+val test9c = 
+    check'(fn _ => 
+	   mapEq op- (a, b6) = List.map op- (zipEq(a, b6))
+	   andalso mapEq op- (b6, a) = List.map op- (zipEq(b6, a))
+	   andalso mapEq op- (a, b6) = List.map op- (zip(a, b6))
+	   andalso mapEq op- (b6, a) = List.map op- (zip(b6, a)))
+val test9d = (reset (); mapEq (incrv o #1) (a, b6) seq (); checkv6());
+val test9e = (reset (); 
+	      (mapEq (incrv o #1) (a, b); "WRONG")
+	      handle UnequalLengths => checkv() | _ => "WRONG");
+
+val test10a = (appEq ignore (a, b); "WRONG")
+              handle UnequalLengths => "OK" | _ => "WRONG";
+val test10b = (appEq ignore (b, a); "WRONG")
+              handle UnequalLengths => "OK" | _ => "WRONG";
+val test10c =
+    (reset (); 
+     (appEq (incrv o #1) (a, b); "WRONG")
+     handle UnequalLengths => checkv() | _ => "WRONG");	 
+val test10d =
+    (reset (); appEq (incrv o #1) (a, b6); checkv6());
+
+val test11a = 
+    check'(fn _ =>
+	   allEq (fn _ => false) ([], [])
+	   andalso not (allEq (fn _ => true) (a, []))
+	   andalso not (allEq (fn _ => true) ([], a))
+	   andalso allEq (fn _ => true) (a, b6)
+	   andalso allEq (fn _ => true) (b6, a)
+	   andalso not (allEq (fn (x, y) => x <> 77) (a, b))
+	   andalso allEq (fn (x, y) => x <> 77) (a, b6)
+	   andalso allEq (fn (x, y) => x <> 77) (b6, a));
+val test11b = 
+    (reset(); 
+     allEq (fn (x,y) => (incrv x; true)) (a, b);
+     checkv());
+val test11c = 
+    (reset(); 
+     allEq (fn (x,y) => (incrv x; true)) (a, b6); 
+     checkv6());
+
+local 
+    fun foldrEqchk f e xs ys = 
+	foldrEq f e (xs, ys) = 
+	List.foldr (fn ((x, y), r) => f(x, y, r)) e (zipEq(xs, ys))
+    fun foldlEqchk f e xs ys = 
+	foldlEq f e (xs, ys) = 
+	List.foldl (fn ((x, y), r) => f(x, y, r)) e (zipEq(xs, ys))
+in
+val test12a = check'(fn _ => 
+    foldrEqchk (fn (x, y, (r1, r2)) => (x-r1, y div r2)) (0, 10) a b6
+    andalso 
+    foldrEqchk (fn (x, y, (r1, r2)) => (x div r1, y div r2)) (2, 3) b6 a
+    andalso 
+    foldrEqchk (fn (x, y, (r1, r2)) => (x div r1, y div r2)) (0, 0) [] []);
+val test12b = 
+    (reset();
+     foldrEq (fn (x, _, _) => incrv x) () (rev a, b6); 
+     checkv6());
+
+val test13a = check'(fn _ => 
+    foldlEqchk (fn (x, y, (r1, r2)) => (x-r1, y div r2)) (0, 10) a b6
+    andalso 
+    foldlEqchk (fn (x, y, (r1, r2)) => (x div r1, y-r2)) (10, 0) b6 a
+    andalso 
+    foldlEqchk (fn (x, y, (r1, r2)) => (x div r1, y div r2)) (0, 0) [] []);
+val test13b = 
+    (reset();
+     (foldlEq (fn (x, _, _) => incrv x) () (a, b); "WRONG") 
+     handle UnequalLengths => "OK" | _ => "WRONG";
+     checkv());
+val test13c = 
+    (reset();
+     foldlEq (fn (x, _, _) => incrv x) () (a, b6); 
+     checkv6());
+end
 end;
 
diff -Nru mosml-2.01/src/mosmllib/test/list.sml mosml-2.10.1/src/mosmllib/test/list.sml
--- mosml-2.01/src/mosmllib/test/list.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/list.sml	2014-08-28 08:47:22.000000000 +0000
@@ -47,7 +47,9 @@
 
 val test14 = (reset (); app incrv v16; checkv);
 
-val test15 = check([2,4,6,8,10,12] = map (fn i=>i*2) v16);
+val test15a = check([2,4,6,8,10,12] = map (fn i=>i*2) v16);
+
+val test15b = (reset (); map incrv v16; checkv);
 
 val test16 = 
     check([3,9,15] = 
@@ -110,4 +112,23 @@
     check'(fn _ => getItem [] = NONE
 	   andalso getItem [#"A"] = SOME(#"A", [])
 	   andalso getItem [#"B", #"C"] = SOME(#"B", [#"C"]));
+
+val test38 = 
+    check'(fn _ =>
+	   let fun invcompare (c1, c2) = Char.compare (c2, c1) 
+	       fun coll s1 s2 = collate invcompare (explode s1, explode s2)
+	   in 
+	       coll "" "" = EQUAL
+	       andalso coll "" " " = LESS
+	       andalso coll " " "" = GREATER
+	       andalso coll "ABCD" "ABCD" = EQUAL
+	       andalso coll "ABCD" "ABCD " = LESS
+	       andalso coll "ABCD " "ABCD" = GREATER
+	       andalso coll "B" "ABCD" = LESS
+	       andalso coll "ABCD" "B" = GREATER
+	       andalso coll "CCCB" "CCCABCD" = LESS
+	       andalso coll "CCCABCD" "CCCB" = GREATER
+	       andalso coll "CCCB" "CCCA" = LESS
+	       andalso coll "CCCA" "CCCB" = GREATER
+	   end)
 end;
diff -Nru mosml-2.01/src/mosmllib/test/listsort.sml mosml-2.10.1/src/mosmllib/test/listsort.sml
--- mosml-2.01/src/mosmllib/test/listsort.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/listsort.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,29 +1,113 @@
-(* File "test/listsort.sml"  *)
+(* File "test/listsort.sml" * 1995, 2001-10-21  *)
 
-load "Listsort";
-load "Random";
-load "Real";
+app load ["Listsort", "Random", "Real"];
+use "auxil.sml";
 
 local
-    val a_unsort = Random.randomlist (10000, Random.newgen ());
-    val a_sort = Listsort.sort Real.compare a_unsort;
-    val sortedsort = 
+    open Listsort
+    val r_unsort = Random.randomlist (10000, Random.newgen ());
+    val r_sort = Listsort.sort Real.compare r_unsort;
+    val r_sortedsort = 
 	Listsort.sorted Real.compare o Listsort.sort Real.compare
+    val i_unsort = Random.rangelist (0, 10000) (10000, Random.newgen ());
+    val i_sort = Listsort.sort Int.compare i_unsort;
+    val i_sortedsort = 
+	Listsort.sorted Int.compare o Listsort.sort Int.compare
 in
-    val test1 = 
-	not (Listsort.sorted Real.compare a_unsort
-	     orelse Listsort.sorted Real.compare [2.1, 1.0]);
+    val test1r = 
+	check'(fn _ =>
+	       not (Listsort.sorted Real.compare r_unsort
+		    orelse Listsort.sorted Real.compare [2.1, 1.0]));
+
+    val test1i = 
+	check'(fn _ =>
+	       not (Listsort.sorted Int.compare i_unsort
+		    orelse Listsort.sorted Int.compare [2, 1]));
 	
-    val test2 = Listsort.sorted Real.compare a_sort
-	andalso Listsort.sorted Real.compare []
-	andalso Listsort.sorted Real.compare [1.0, 2.1];
-
-    val test3 = sortedsort []
-	andalso sortedsort [1.0]
-	andalso sortedsort [1.0, 1.0]
-	andalso sortedsort [1.0, 2.0]
-	andalso sortedsort [2.0, 1.0]
-	andalso sortedsort [3.0, 2.0, 1.0]
-	andalso sortedsort [2.0, 3.0, 1.0]
-	andalso sortedsort [2.0, 1.0, 3.0]
+    val test2r = 
+	check'(fn _ =>
+	       Listsort.sorted Real.compare r_sort
+	       andalso Listsort.sorted Real.compare []
+	       andalso Listsort.sorted Real.compare [1.0, 2.1]);
+
+    val test2i = 
+	check'(fn _ =>
+	       Listsort.sorted Int.compare i_sort
+	       andalso Listsort.sorted Int.compare []
+	       andalso Listsort.sorted Int.compare [1, 2]);
+
+    val test3r = 
+	check'(fn _ =>
+	       r_sortedsort []
+	       andalso r_sortedsort [1.0]
+	       andalso r_sortedsort [1.0, 1.0]
+	       andalso r_sortedsort [1.0, 2.0]
+	       andalso r_sortedsort [2.0, 1.0]
+	       andalso r_sortedsort [3.0, 2.0, 1.0]
+	       andalso r_sortedsort [2.0, 3.0, 1.0]
+	       andalso r_sortedsort [2.0, 1.0, 3.0]);
+
+    val test3i = 
+	check'(fn _ =>
+	       i_sortedsort []
+	       andalso i_sortedsort [1]
+	       andalso i_sortedsort [1, 1]
+	       andalso i_sortedsort [1, 2]
+	       andalso i_sortedsort [2, 1]
+	       andalso i_sortedsort [3, 2, 1]
+	       andalso i_sortedsort [2, 3, 1]
+	       andalso i_sortedsort [2, 1, 3]);
+
+    (* merge *)
+
+    fun double []       = []
+      | double (x1::xr) = x1 :: x1 :: double xr
+
+    val test4 = 
+	check'(fn _ =>
+	       merge Int.compare (i_sort, i_sort) = double i_sort 
+	       andalso merge Int.compare ([], i_sort) = i_sort
+	       andalso merge Int.compare (i_sort, []) = i_sort
+	       andalso merge Int.compare ([1,3,5], [2,4,6]) = [1,2,3,4,5,6]
+	       andalso merge Int.compare ([2,4,6], [1,3,5]) = [1,2,3,4,5,6]
+	       andalso merge Int.compare ([1,4,5], [2,4,6]) = [1,2,4,4,5,6]
+	       andalso merge Int.compare ([2,3,6], [1,3,5]) = [1,2,3,3,5,6]
+	       andalso merge Int.compare ([4,6], [1,3]) = [1,3,4,6]
+	       andalso merge Int.compare ([1,3], [4,6]) = [1,3,4,6]
+	       andalso merge Int.compare ([4,6], [1,3,4]) = [1,3,4,4,6]
+	       andalso merge Int.compare ([1,3,4], [4,6]) = [1,3,4,4,6])
+
+    (* mergeUniq *)
+
+    val test5 = 
+	check'(fn _ =>
+	       mergeUniq Int.compare (i_sort, i_sort) = i_sort
+	       andalso mergeUniq Int.compare ([], i_sort) = i_sort
+	       andalso mergeUniq Int.compare (i_sort, []) = i_sort
+	       andalso mergeUniq Int.compare ([1,3,5], [2,4,6]) = [1,2,3,4,5,6]
+	       andalso mergeUniq Int.compare ([2,4,6], [1,3,5]) = [1,2,3,4,5,6]
+	       andalso mergeUniq Int.compare ([1,4,5], [2,4,6]) = [1,2,4,5,6]
+	       andalso mergeUniq Int.compare ([2,3,6], [1,3,5]) = [1,2,3,5,6]
+	       andalso mergeUniq Int.compare ([4,6], [1,3]) = [1,3,4,6]
+	       andalso mergeUniq Int.compare ([1,3], [4,6]) = [1,3,4,6]
+	       andalso mergeUniq Int.compare ([4,6], [1,3,4]) = [1,3,4,6]
+	       andalso mergeUniq Int.compare ([1,3,4], [4,6]) = [1,3,4,6])
+
+    (* eqclasses *)
+
+    fun inteqccheck ordr arg res = 
+	List.map (Listsort.sort Int.compare) (Listsort.eqclasses ordr arg)
+	= List.map (Listsort.sort Int.compare) res;
+
+    fun f (arg, res) = 
+	inteqccheck (fn (x, y) => Int.compare(Int.abs x, Int.abs y)) arg res;
+
+    val test6 = 
+	check'(fn _ =>
+	       f([], [])
+	       andalso f([1], [[1]])
+	       andalso f([1, ~1], [[1,~1]])
+	       andalso f([1, 2, ~1], [[1,~1],[2]])
+	       andalso f([5, 1, 2, ~1, ~1, 3, ~0, 7, 1, 5, 5, ~2,0],
+			 [[~0,0],[1,~1,~1,1],[2,~2],[3],[5,5,5],[7]]));
 end
diff -Nru mosml-2.01/src/mosmllib/test/polyhash.sml mosml-2.10.1/src/mosmllib/test/polyhash.sml
--- mosml-2.01/src/mosmllib/test/polyhash.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/polyhash.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,5 +1,5 @@
 (* test/polyhash.sml
-   PS 1998-04-03
+   PS 1998-04-03, 2003-05-24
 *)
 
 load "Polyhash";
@@ -15,4 +15,57 @@
 
     val test2 = 
 	check'(fn _ => hash ("abc" ^ "def") = hash "abcdef")
+
+    local 
+	datatype reflist = 
+	    Empty
+	  | Node of int * reflist ref 
+	    
+	val tail = ref Empty
+	val cyclic = Node(117, tail)
+	val _ = tail := cyclic
+    in
+	val test3 = 
+	    check'(fn _ => hash cyclic = hash cyclic)
+    end
+
+    fun mkstr 0 s = ""
+      | mkstr 1 s = s
+      | mkstr n s = let val r = mkstr (n-1) s in r ^ r end	
+
+    fun equal pref i = (hash (pref ^ mkstr i "abc") 
+			= hash (pref ^ mkstr i "abc"));
+
+    fun unequal pref i = (hash (pref ^ mkstr i "abc") 
+			  <> hash (pref ^ mkstr i "def"));
+
+    val blank128 = mkstr 8 " "
+
+    val test4 = 
+	check'(fn _ => List.all (equal "") [0,1,2,3,4,5,6,7,8,9]);
+
+    val test5 = 
+	check'(fn _ => List.all (unequal "") [1,2,3,4,5,6,7,8,9]);
+
+    val test6 = 
+	check'(fn _ => List.all (equal blank128) [0,1,2,3,4,5,6,7,8,9]);
+
+    val test7 = 
+	check'(fn _ => List.all (unequal blank128) [1,2,3,4,5,6,7]); 
+
+    val t = mkPolyTable (10, Fail "hash") : (int, string) hash_table
+	
+    val test8 = 
+	check'(fn _ => (insert t (7, "foo"); 
+			insert t (5, "goo");
+			numItems t = 2));
+
+    val test9 = 
+	check'(fn _ => (filter (fn _ => true) t;
+			numItems t = 2));
+
+    val test10 = 
+	check'(fn _ => (filter (fn (i, s) => i > 6) t;
+			numItems t = 1
+			andalso listItems t = [(7, "foo")]));
 end
diff -Nru mosml-2.01/src/mosmllib/test/process.sml mosml-2.10.1/src/mosmllib/test/process.sml
--- mosml-2.01/src/mosmllib/test/process.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/process.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,46 @@
+(* test/process.sml
+   PS 2000-11-01
+*)
+
+use "auxil.sml";
+
+local 
+    open Process
+in
+
+val test1 = 
+    check'(fn _ => isSuccess success andalso not (isSuccess failure));
+
+val test2 = 
+    check'(fn _ => 
+	   isSuccess (system "mosmlc")
+	   andalso not (isSuccess (system "nonsuchprogramexists")));
+
+val test3a = 
+    check'(fn _ =>
+	   let open Time 
+	       val ms = fromMilliseconds 1
+	       val t1 = now()
+	   in sleep zeroTime; t1 + ms > now() end);
+
+val test3b = 
+    check'(fn _ =>
+	   let open Time 
+	       val ms = fromMilliseconds 1
+	       val t1 = now()
+	   in sleep (zeroTime - now()); t1 + ms > now() end);
+
+val test3c = 
+    check'(fn _ =>
+	   let open Time 
+	       val ms500  = fromMilliseconds 500
+	       val ms1500 = fromMilliseconds 1500
+	       val t1 = now()
+	       val _ = sleep (fromSeconds 1)
+	       val t2 = now()
+	   in t1 + ms500 < t2 andalso t2 < t1 + ms1500 end);
+
+val test4 = 
+    check'(fn _ => Option.isSome(getEnv "HOME")
+	   andalso not (Option.isSome (getEnv "nonsuchvariableexists")));
+end
diff -Nru mosml-2.01/src/mosmllib/test/random.sml mosml-2.10.1/src/mosmllib/test/random.sml
--- mosml-2.01/src/mosmllib/test/random.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/random.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,49 @@
+(* test/random.sml -- PS 2007-05-04 *)
+
+use "auxil.sml";
+load "Random";
+
+local 
+    open Random
+in	
+val r42 =  range (42, 43);
+val rmax = range (valOf Int.minInt, valOf Int.maxInt);
+val rlo = range (valOf Int.minInt, valOf Int.minInt + 1);
+val rhi = range (valOf Int.maxInt - 1, valOf Int.maxInt);
+
+val test1a = 
+    check'(fn () => r42 (newgen()) = 42);
+val test1b = 
+    check'(fn () => (range (42, 42) (newgen()); false) 
+	   handle Fail s => true | _ => false);
+val test1c = check'(fn () => (rmax (newgen()); true));
+val test1d = 
+    check'(fn () => (rlo (newgen()) = valOf Int.minInt));
+val test1e = 
+    check'(fn () => (rhi (newgen()) = valOf Int.maxInt - 1));
+
+val rl42 =  rangelist (42, 43);
+val rlmax = rangelist (valOf Int.minInt, valOf Int.maxInt);
+val rllo = rangelist (valOf Int.minInt, valOf Int.minInt + 1);
+val rlhi = rangelist (valOf Int.maxInt - 1, valOf Int.maxInt);
+
+val test2a = 
+    check'(fn () => List.all (fn x => x=42) (rl42 (1000, newgen())));
+val test2b = 
+    check'(fn () => (rangelist (42, 42) (10, newgen()); false) 
+	   handle Fail s => true | _ => false);
+val test2c = check'(fn () => (rlmax (1000, newgen()); true));
+
+val test2d = 
+    check'(fn () => List.all (fn x => x = valOf Int.minInt)
+		             (rllo (1000, newgen())));
+val test2e = 
+    check'(fn () => List.all (fn x => x = valOf Int.maxInt-1)
+		             (rlhi (1000, newgen())));
+
+val rl8 = rangelist (~2, 6);
+val test3a = 
+    check'(fn () => (List.foldl Int.max ~2 (rl8 (1000, newgen())) = 5
+		     andalso
+		     List.foldl Int.min 6 (rl8 (1000, newgen())) = ~2));
+end
diff -Nru mosml-2.01/src/mosmllib/test/rbset.sml mosml-2.10.1/src/mosmllib/test/rbset.sml
--- mosml-2.01/src/mosmllib/test/rbset.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/rbset.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,256 @@
+(* test/rbset.sml 2001-10-28 *)
+
+app load ["Rbset", "Random", "Listsort"];
+
+use "auxil.sml";
+
+local 
+    open Rbset
+    val s0 = empty Int.compare;
+    val s1  = addList(empty Int.compare, [43,25,13,14]);
+    val s2a = addList(empty Int.compare, [43,1,2,3]);
+    val s2b = addList(empty Int.compare, [43,2,1,3,43,43]);
+    val s3  = addList(empty Int.compare, [1,3]);
+    val s4  = addList(empty Int.compare, [117]);
+
+    val nonemptysets = [(s1, [13,14,25,43]),
+			(s2a, [1,2,3,43]), 
+			(s2b, [1,2,3,43]) ,
+			(s3 , [1,3]),
+			(s4 , [117])];
+
+    (* Make enough small-range random int sets so that they will have
+       duplicates and some will have a non-empty intersection *)
+
+    open Random 
+	    
+    val rnd = newgenseed 188.0	(* Use this for debugging *)
+    val rnd = newgen ()  
+
+    fun mkrandomset maxsize = 
+	let val size = range (0, maxsize) rnd
+	    val ys = rangelist(0, 1000) (size, rnd)      (* all >= 0 *)
+	    val xs = Listsort.sort Int.compare ys
+	    fun dropdups last [] = []
+	      | dropdups last (x1 :: xr) =
+		if last = x1 then dropdups last xr
+		else x1 :: dropdups x1 xr
+	in 
+	    (addList(empty Int.compare, ys), dropdups ~1 xs)
+	end
+
+    fun mkrandomsets maxsize count = 
+	List.tabulate(count, fn _ => mkrandomset maxsize)
+
+    val allsets = (s0, []) :: nonemptysets @ mkrandomsets 500 20;
+
+    (* Merge without duplicates *)
+
+    fun mergeUniq ordr ([],     ys) = ys
+      | mergeUniq ordr (x1::xr, ys) = 
+	let fun take x1 xr []       = x1 :: xr
+	      | take x1 xr (y1::yr) = 
+	        (case ordr(x1, y1) of 
+		     LESS    => x1 :: take y1 yr xr
+		   | GREATER => y1 :: take x1 xr yr
+		   | EQUAL   => take x1 xr yr)
+	in take x1 xr ys end
+
+    fun swap (x, y) = (y, x)
+
+    val minusOne = singleton Int.compare ~1;	 (* not in any set *)
+    val oneMega = singleton Int.compare 1000000; (* not in any set *)
+
+in
+    (* equal *)
+
+    val test1 = 
+	check'(fn _ => 
+	       equal(s0, s0)
+	       andalso equal(s1, s1)
+	       andalso equal(s2a, s2b)
+	       andalso not (equal(s0, s1))
+	       andalso not (equal(s1, s0))
+	       andalso not (equal(s1, s2a))
+	       andalso not (equal(s1, s2a))
+	       andalso not (equal(s2a, s3))
+	       andalso equal(s4, singleton Int.compare 117)
+	       andalso equal(singleton Int.compare 117, 
+			     singleton Int.compare 117));
+
+    (* listItems, isEmpty, numItems, member *)
+
+    fun chkmems(s, xs) =
+	listItems s = xs
+	andalso isEmpty s = (xs = [])
+	andalso isEmpty s = (numItems s = 0)
+	andalso List.all (fn x => member(s, x)) xs
+	andalso List.all (fn x => numItems s = List.length xs) allsets
+	andalso not (member(s, ~999999));
+
+
+    val test2 = 
+	check'(fn _ => List.all chkmems allsets);
+
+    (* isSubset *)
+
+    val test3 = 
+	check'(fn _ => 
+	       List.all (fn (s, xs) => isSubset(s0, s)) allsets
+ 	       andalso List.all (fn (s, xs) => isSubset(s, s)) allsets
+ 	       andalso not (isSubset(s1, s0))
+ 	       andalso isSubset(s3, s2a)
+	       andalso isSubset(s3, s2b)
+	       andalso isSubset(s2a, s2b)
+	       andalso isSubset(s2b, s2a));
+
+    (* min, max *)
+
+    val test4 = 
+	check'(fn _ => 
+	       min s0 = NONE
+	       andalso max s0 = NONE
+	       andalso List.all (fn (s, xs) => 
+				 min s = SOME (List.hd xs)) allsets
+	       andalso List.all (fn (s, xs) => 
+				 max s = SOME (List.last xs)) allsets)
+
+    (* hash *)
+
+    fun inthash i = 0w2 * Word.fromInt i
+
+    val test4 = 
+	check'(fn _ => 
+	       hash inthash s0 = 0w0
+	       andalso List.all (fn (s, xs) => hash inthash s = 
+				 List.foldl (op+) 0w0 (List.map inthash xs))
+	                        allsets)
+	
+    (* delete *)
+
+    val test5 =
+	check'(fn _ => 
+	       List.all (fn (s, xs) => 
+			 isEmpty(List.foldl (delete o swap) s xs)) allsets
+	       andalso 
+	       List.all (fn (s, xs) => 
+			 isEmpty(List.foldr (delete o swap) s xs)) allsets);
+
+    (* union *)
+
+    val test6 =
+	check'(fn _ => 
+	       List.all (fn (s, xs) => equal(union(s, s), s)) allsets
+	       andalso 
+	       List.all (fn (s, xs) => equal(union(s0, s), s)) allsets
+	       andalso 
+	       List.all (fn (s, xs) => equal(union(s, s0), s)) allsets
+	       andalso 
+	       List.all (fn (s, xs) => listItems(union(s, minusOne)) 
+			 = ~1 :: xs) allsets
+	       andalso 
+	       List.all (fn (s, xs) => listItems(union(minusOne, s)) 
+			 = ~1 :: xs) allsets 
+	       andalso 
+	       List.all (fn (s, xs) => listItems(union(s, oneMega)) 
+			 = xs @ [1000000]) allsets
+	       andalso 
+	       List.all (fn (s, xs) => listItems(union(oneMega, s)) 
+			 = xs @ [1000000]) allsets)
+
+    (* intersection *)
+
+    val test7 =
+	check'(fn _ => 
+	       List.all (fn (s, xs) => equal(intersection(s, s), s)) allsets
+	       andalso 
+	       List.all (fn (s, xs) => equal(intersection(s0, s), s0)) allsets
+	       andalso 
+	       List.all (fn (s, xs) => equal(intersection(s, s0), s0)) allsets
+	       andalso 
+	       List.all (fn (s, xs) => isEmpty(intersection(s, minusOne)))
+			allsets
+	       andalso 
+	       List.all (fn (s, xs) => isEmpty(intersection(minusOne, s)))
+	                allsets 
+	       andalso 
+	       List.all (fn (s, xs) => isEmpty(intersection(s, oneMega)))
+	                allsets
+	       andalso 
+	       List.all (fn (s, xs) => isEmpty(intersection(oneMega, s))) 
+	                allsets)
+
+    (* difference *)
+
+    val test8 =
+	check'(fn _ => 
+	       List.all (fn (s, xs) => equal(difference(s, s), s0)) allsets
+	       andalso 
+	       List.all (fn (s, xs) => equal(difference(s0, s), s0)) allsets
+	       andalso 
+	       List.all (fn (s, xs) => equal(difference(s, s0), s)) allsets
+	       andalso 
+	       List.all (fn (s, xs) => equal(difference(s, minusOne), s))
+			allsets
+	       andalso 
+	       List.all (fn (s, xs) => equal(difference(minusOne, s), 
+					     minusOne))
+	                allsets 
+	       andalso 
+	       List.all (fn (s, xs) => equal(difference(s, oneMega), s))
+	                allsets
+	       andalso 
+	       List.all (fn (s, xs) => equal(difference(oneMega, s), oneMega))
+	                allsets)
+
+    (* union, intersection, difference *)
+
+    (* Check: card(s1 U s2) + card(s1 n s2) = card(s1) + card(s2) *)
+
+    fun chkcard s1 s2 =
+	  numItems(union(s1, s2)) + numItems(intersection(s1, s2))
+	= numItems s1 + numItems s2
+
+    (* Check: (s1 \ s2) u (s2 \ s1) = (s1 u s2) \ (s1 n s2) *)
+
+    fun chkdiff s1 s2 =
+	  equal(union(difference(s1, s2), difference(s2, s1)),
+		difference(union(s1, s2), intersection(s1, s2)));
+		 
+    fun chkunion s1 s2 = 
+	  mergeUniq Int.compare (listItems s1, listItems s2) 
+	= listItems(union(s1,s2))
+
+    val test9 = 
+	check'(fn _ => 
+	List.all (fn (s1, xs1) => 
+	List.all (fn (s2, xs2) => chkcard s1 s2
+		                  andalso chkdiff s1 s2
+				  andalso chkunion s1 s2)
+		  allsets)
+	       allsets);
+
+    (* compare *)
+
+    (* app, revapp *)
+
+    (* foldl, foldr *)
+
+    (* map, mapMono *)
+
+    (* find *)
+
+    (* subset, subList *)
+
+    val i5000 = List.tabulate(5000, fn i => i);
+
+    val i4000 = List.rev(List.tabulate(1000, fn i => i+4000));
+	
+    val set1 = addList(empty Int.compare, i5000);
+
+    val _ = print (Int.toString (depth set1) ^ "\n");
+
+    val set2 = List.foldr (delete o swap) set1 i4000;
+
+    val _ = print (Int.toString (depth set2) ^ "\n");
+end; 
diff -Nru mosml-2.01/src/mosmllib/test/result.ok mosml-2.10.1/src/mosmllib/test/result.ok
--- mosml-2.01/src/mosmllib/test/result.ok	2004-01-12 23:00:33.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/result.ok	2014-08-28 08:47:22.000000000 +0000
@@ -1,4 +1,4 @@
-Moscow ML version 2.01 (January 2004)
+Moscow ML version 2.01b (June 2005)
 Enter `quit();' to quit.
 [opening file "test.sml"]
 [opening file "array.sml"]
@@ -11,6 +11,7 @@
 > val checkrange = fn : int * int -> (int -> bool) -> string
 [closing file "auxil.sml"]
 > val it = () : unit
+> val it = () : unit
 > val a =  : int array
   val b =  : int array
   val c =  : int array
@@ -47,69 +48,35 @@
   val test9 = "OK" : string
   val test9a = "OK" : string
   val test9b = "OK" : string
-  val test9c = "OK" : string
-  val test9d = "OK" : string
-  val test9e = "OK" : string
-  val test9f = "OK" : string
-  val test9g = "OK" : string
-  val test9h = "OK" : string
-  val test9i = "OK" : string
-  val test9j = "OK" : string
   val g =  : int array
   val test10a = "OK" : string
   val test10b = "OK" : string
   val test10c = "OK" : string
   val test10d = "OK" : string
   val test10e = "OK" : string
-  val test10f = "OK" : string
-  val test10g = "OK" : string
-  val test10h = "OK" : string
-  val test10i = "OK" : string
   val test11a = "OK" : string
   val test11b = "OK" : string
   val test11c = "OK" : string
   val test11d = "OK" : string
   val test11e = "OK" : string
-  val test11f = "OK" : string
-  val test11g = "OK" : string
-  val test11h = "OK" : string
-  val test11i = "OK" : string
-  val test11j = "OK" : string
-  val test11k = "OK" : string
   val array0 =  : int array
   val test12a = "OK" : string
   val test12b = "OK" : string
+  val test12c = "OK" : string
   val test12d = "OK" : string
   val test12e = "OK" : string
+  val test12f = "OK" : string
+  val test12g = "OK" : string
+  val test12h = "OK" : string
+  val test12i = "OK" : string
   val test13a = "OK" : string
   val test13b = "OK" : string
-  val test13c = "OK" : string
-  val test13d = "OK" : string
-  val test13e = "OK" : string
-  val test13f = "OK" : string
-  val test13g = "OK" : string
-  val test13h = "OK" : string
-  val test13i = "OK" : string
-  val test13j = "OK" : string
-  val test13k = "OK" : string
-  val test13l = "OK" : string
-  val test13m = "OK" : string
-  val test13n = "OK" : string
+  val test14a = "OK" : string
+  val test14b = "OK" : string
+  val test14c = "OK" : string
   val test15a = "OK" : string
-  val test15b = "OK" : string
-  val test15c = "OK" : string
-  val test15d = "OK" : string
-  val test15e = "OK" : string
-  val test15f = "OK" : string
-  val test15g = "OK" : string
-  val test15h = "OK" : string
   val test16a = "OK" : string
-  val test16b = "OK" : string
-  val test16c = "OK" : string
-  val test16d = "OK" : string
-  val test16e = "OK" : string
-  val test16f = "OK" : string
-  val test16g = "OK" : string
+  val test17 = "OK" : string
 [closing file "array.sml"]
 [opening file "array2.sml"]
 [opening file "auxil.sml"]
@@ -157,6 +124,7 @@
   val test6e = "OK" : string
   val test6f = "OK" : string
   val test6g = "OK" : string
+  val 'a ### = fn : 'a list -> 'a vector
   val test6h = "OK" : string
   val test6i = "OK" : string
   val test6j = "OK" : string
@@ -269,6 +237,103 @@
   val test12k = "OK" : string
   val test12l = "OK" : string
 [closing file "array2.sml"]
+[opening file "arrayslice.sml"]
+[opening file "auxil.sml"]
+> infix 1 seq
+  val ('a, 'b) seq = fn : 'a * 'b -> 'b
+> val check = fn : bool -> string
+> val check' = fn : (unit -> bool) -> string
+> val range = fn : int * int -> (int -> bool) -> bool
+> val checkrange = fn : int * int -> (int -> bool) -> string
+[closing file "auxil.sml"]
+> val it = () : unit
+> val a =  : int array
+  val b =  : int array
+  val c =  : int array
+  val slice00 =  : int slice
+  val slice01 =  : int slice
+  val slice02 =  : int slice
+  val slice03 =  : int slice
+  val slice04 =  : int slice
+  val slice05 =  : int slice
+  val slicea07 =  : int slice
+  val slicea02 =  : int slice
+  val slicea23 =  : int slice
+  val slicea25 =  : int slice
+  val slice06 =  : int slice
+  val slice07 =  : int slice
+  val slice08 =  : int slice
+  val slice09 =  : int slice
+  val slice0s =
+    [, , , , , , , ,
+     , ] : int slice list
+  val sliceas = [, , , ] : int slice list
+  val test1a = "OK" : string
+  val test1b = "OK" : string
+  val test2a = "OK" : string
+  val test2b = "OK" : string
+  val test2c = "OK" : string
+  val test2d = "OK" : string
+  val test2e = "OK" : string
+  val test3a = "OK" : string
+  val test4a = "OK" : string
+  val test4b = "OK" : string
+  val test4c = "OK" : string
+  val test4d = "OK" : string
+  val test4e = "OK" : string
+  val test4f = "OK" : string
+  val test4g = "OK" : string
+  val test5 = "OK" : string
+  val test6a = "OK" : string
+  val test6b = "OK" : string
+  val test6c = "OK" : string
+  val sliced =  : int slice
+  val sliceb =  : int slice
+  val e =  : int array
+  val ev =
+    #[1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41,
+      51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21,
+      31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1,
+      11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51,
+      61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31,
+      41, 51, 61, 1, 11, 441, 551, 661, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21,
+      31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1,
+      11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51,
+      61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31,
+      41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11,
+      21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, ...] : int vector
+  val slicee =  : int slice
+  val test9a = "OK" : string
+  val test9b = "OK" : string
+  val g =  : int array
+  val sliceg =  : int slice
+  val test10a = "OK" : string
+  val sliceg0 =  : int slice
+  val test10b = "OK" : string
+  val sliceg1 =  : int slice
+  val test10c = "OK" : string
+  val sliceg202 =  : int slice
+  val test10d = "OK" : string
+  val test11a = "OK" : string
+  val test11b = "OK" : string
+  val test11c = "OK" : string
+  val test12a = "OK" : string
+  val test12b = "OK" : string
+  val test12c = "OK" : string
+  val test12d = "OK" : string
+  val test12e = "OK" : string
+  val test12f = "OK" : string
+  val test12g = "OK" : string
+  val test12h = "OK" : string
+  val test12i = "OK" : string
+  val test13 = "OK" : string
+  val test14a = "OK" : string
+  val test14b = "OK" : string
+  val test15 = "OK" : string
+  val test16 = "OK" : string
+  val test17a = "OK" : string
+  val test17b = "OK" : string
+[closing file "arrayslice.sml"]
 [opening file "arraysort.sml"]
 > val it = () : unit
 > val it = () : unit
@@ -373,15 +438,15 @@
 > val checkrange = fn : int * int -> (int -> bool) -> string
 [closing file "auxil.sml"]
 > val it = () : unit
-This is (local time) now:        Tue Jan 13 00:00:26 2004
-This is UTC now:                 Mon Jan 12 23:00:26 2004
-This is an hour from now:        Tue Jan 13 01:00:26 2004
-This is a day from now:          Wed Jan 14 00:00:26 2004
-This is a week from now:         Tue Jan 20 00:00:26 2004
-This is 120 days from now:       Wed May 12 01:00:26 2004
-This is 160 days from now:       Mon Jun 21 01:00:26 2004
-This is 200 days from now:       Sat Jul 31 01:00:26 2004
-This is 240 days from now:       Thu Sep  9 01:00:26 2004
+This is (local time) now:        Sun May  6 21:50:35 2007
+This is UTC now:                 Sun May  6 19:50:35 2007
+This is an hour from now:        Sun May  6 22:50:35 2007
+This is a day from now:          Mon May  7 21:50:35 2007
+This is a week from now:         Sun May 13 21:50:35 2007
+This is 120 days from now:       Mon Sep  3 21:50:35 2007
+This is 160 days from now:       Sat Oct 13 21:50:35 2007
+This is 200 days from now:       Thu Nov 22 20:50:35 2007
+This is 240 days from now:       Tue Jan  1 20:50:35 2008
 This is the epoch (UTC):         Thu Jan  1 00:00:00 1970
 The UTC millenium (UTC time):    Sat Jan  1 00:00:00 2000
 The UTC millenium (UTC time):    Sat Jan  1 00:00:00 2000
@@ -390,10 +455,10 @@
 The local millenium (UTC time):  Fri Dec 31 23:00:00 1999
 The UTC+01 millenium (UTC):      Fri Dec 31 23:00:00 1999
 The UTC-01 millenium (UTC):      Sat Jan  1 01:00:00 2000
-This is today's number:          013 (internally: 12)
-This is today's weekday:         Tuesday
-This is the name of this month:  January
-Today's ISO date:                2004-01-13
+This is today's number:          126 (internally: 125)
+This is today's weekday:         Sunday
+This is the name of this month:  May
+Today's ISO date:                2007-05-06
 > val test1 = "OK" : string
   val test2 = "OK" : string
   val test3 = "OK" : string
@@ -627,7 +692,8 @@
   val incrv = fn : int -> unit
   val checkv = fn : unit -> string
   val test14 = fn : unit -> string
-  val test15 = "OK" : string
+  val test15a = "OK" : string
+  val test15b = fn : unit -> string
   val test16 = "OK" : string
   val test17 = "OK" : string
   val test18 = "OK" : string
@@ -654,6 +720,7 @@
   val test36b = "OK" : string
   val test36c = "OK" : string
   val test37a = "OK" : string
+  val test38 = "OK" : string
 [closing file "list.sml"]
 [opening file "listpair.sml"]
 [opening file "auxil.sml"]
@@ -668,10 +735,12 @@
 > val test1 = "OK" : string
   val test2a = "OK" : string
   val test2b = "OK" : string
-  val test3a = "OK" : string
   val reset = fn : unit -> unit
   val incrv = fn : int -> unit
   val checkv = fn : unit -> string
+  val checkv6 = fn : unit -> string
+  val checkv0 = fn : unit -> string
+  val test3a = "OK" : string
   val test3b = "OK" : string
   val test4 = "OK" : string
   val test5a = "OK" : string
@@ -681,14 +750,50 @@
   val test5e = "OK" : string
   val test6 = "OK" : string
   val test7 = "OK" : string
+  val test8a = "OK" : string
+  val test8b = "OK" : string
+  val test9a = "OK" : string
+  val test9b = "OK" : string
+  val test9c = "OK" : string
+  val test9d = "OK" : string
+  val test9e = "OK" : string
+  val test10a = "OK" : string
+  val test10b = "OK" : string
+  val test10c = "OK" : string
+  val test10d = "OK" : string
+  val test11a = "OK" : string
+  val test11b = "OK" : string
+  val test11c = "OK" : string
+  val test12a = "OK" : string
+  val test12b = "OK" : string
+  val test13a = "OK" : string
+  val test13b = "OK" : string
+  val test13c = "OK" : string
 [closing file "listpair.sml"]
 [opening file "listsort.sml"]
 > val it = () : unit
+[opening file "auxil.sml"]
+> infix 1 seq
+  val ('a, 'b) seq = fn : 'a * 'b -> 'b
+> val check = fn : bool -> string
+> val check' = fn : (unit -> bool) -> string
+> val range = fn : int * int -> (int -> bool) -> bool
+> val checkrange = fn : int * int -> (int -> bool) -> string
+[closing file "auxil.sml"]
 > val it = () : unit
-> val it = () : unit
-> val test1 = true : bool
-  val test2 = true : bool
-  val test3 = true : bool
+> val test1r = "OK" : string
+  val test1i = "OK" : string
+  val test2r = "OK" : string
+  val test2i = "OK" : string
+  val test3r = "OK" : string
+  val test3i = "OK" : string
+  val 'a double = fn : 'a list -> 'a list
+  val test4 = "OK" : string
+  val test5 = "OK" : string
+  val inteqccheck = fn :
+  (int * int -> order) -> int list -> int list list -> bool
+  val f = fn : int list * int list list -> bool
+  val test6 = "OK" : string
 [closing file "listsort.sml"]
 [opening file "math.sml"]
 [opening file "auxil.sml"]
@@ -803,6 +908,86 @@
   val test5a = "OK" : string
   val test5b = "OK" : string
 [closing file "mosml.sml"]
+[opening file "polyhash.sml"]
+> val it = () : unit
+[opening file "auxil.sml"]
+> infix 1 seq
+  val ('a, 'b) seq = fn : 'a * 'b -> 'b
+> val check = fn : bool -> string
+> val check' = fn : (unit -> bool) -> string
+> val range = fn : int * int -> (int -> bool) -> bool
+> val checkrange = fn : int * int -> (int -> bool) -> string
+[closing file "auxil.sml"]
+> val it = () : unit
+> New type names: =reflist
+  val test1 = "OK" : string
+  val test2 = "OK" : string
+  val test3 = "OK" : string
+  val mkstr = fn : int -> string -> string
+  val equal = fn : string -> int -> bool
+  val unequal = fn : string -> int -> bool
+  val blank128 =
+    "                                                                                                                                "
+     : string
+  val test4 = "OK" : string
+  val test5 = "OK" : string
+  val test6 = "OK" : string
+  val test7 = "OK" : string
+  val t =  : (int, string) hash_table
+  val test8 = "OK" : string
+  val test9 = "OK" : string
+  val test10 = "OK" : string
+[closing file "polyhash.sml"]
+[opening file "process.sml"]
+[opening file "auxil.sml"]
+> infix 1 seq
+  val ('a, 'b) seq = fn : 'a * 'b -> 'b
+> val check = fn : bool -> string
+> val check' = fn : (unit -> bool) -> string
+> val range = fn : int * int -> (int -> bool) -> bool
+> val checkrange = fn : int * int -> (int -> bool) -> string
+[closing file "auxil.sml"]
+> val it = () : unit
+sh: nonsuchprogramexists: command not found
+> val test1 = "OK" : string
+  val test2 = "OK" : string
+  val test3a = "OK" : string
+  val test3b = "OK" : string
+  val test3c = "OK" : string
+  val test4 = "OK" : string
+[closing file "process.sml"]
+[opening file "random.sml"]
+[opening file "auxil.sml"]
+> infix 1 seq
+  val ('a, 'b) seq = fn : 'a * 'b -> 'b
+> val check = fn : bool -> string
+> val check' = fn : (unit -> bool) -> string
+> val range = fn : int * int -> (int -> bool) -> bool
+> val checkrange = fn : int * int -> (int -> bool) -> string
+[closing file "auxil.sml"]
+> val it = () : unit
+> val it = () : unit
+> val r42 = fn : generator -> int
+  val rmax = fn : generator -> int
+  val rlo = fn : generator -> int
+  val rhi = fn : generator -> int
+  val test1a = "OK" : string
+  val test1b = "OK" : string
+  val test1c = "OK" : string
+  val test1d = "OK" : string
+  val test1e = "OK" : string
+  val rl42 = fn : int * generator -> int list
+  val rlmax = fn : int * generator -> int list
+  val rllo = fn : int * generator -> int list
+  val rlhi = fn : int * generator -> int list
+  val test2a = "OK" : string
+  val test2b = "OK" : string
+  val test2c = "OK" : string
+  val test2d = "OK" : string
+  val test2e = "OK" : string
+  val rl8 = fn : int * generator -> int list
+  val test3a = "OK" : string
+[closing file "random.sml"]
 [opening file "real.sml"]
 [opening file "auxil.sml"]
 > infix 1 seq
@@ -929,6 +1114,10 @@
   val test23 = "OK" : string
   val test24 = "OK" : string
   val test25 = "OK" : string
+  val test26 = "OK" : string
+  val test27 = "OK" : string
+  val test28 = "OK" : string
+  val test29 = "OK" : string
 [closing file "string.sml"]
 [opening file "stringcvt.sml"]
 [opening file "auxil.sml"]
@@ -1026,12 +1215,17 @@
   val test30d = "OK" : string
   val test30e = "OK" : string
   val test30f = "OK" : string
-  val test31 = "OK" : string
+  val test31a = "OK" : string
+  val test31b = "OK" : string
+  val test31c = "OK" : string
   val eqspan = fn : substring * substring * substring -> bool
   val test32a = "OK" : string
   val test32c = "OK" : string
   val test32d = "OK" : string
   val test32b = "OK" : string
+  val test33a = "OK" : string
+  val test33b = "OK" : string
+  val test34 = "OK" : string
 [closing file "substring.sml"]
 [opening file "textio.sml"]
 [opening file "auxil.sml"]
@@ -1099,12 +1293,7 @@
 > val test1 = "OK" : string
   val test2a = "OK" : string
   val test2b = "OK" : string
-  val test2c = "OK" : string
-  val test2d = "OK" : string
-  val test2e = "OK" : string
   val test3a = "OK" : string
-  val test3b = "OK" : string
-  val test3c = "OK" : string
   val test4a = "OK" : string
   val test6a = "OK" : string
   val test7a = "OK" : string
@@ -1113,9 +1302,11 @@
   val test9b = "OK" : string
   val test9c = "OK" : string
   val chk = fn : string * int -> string
-  val test10a = ["OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK"] :
-  string list
-  val test10b = ["OK", "OK", "OK", "OK", "OK"] : string list
+  val test10a =
+    ["OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK",
+     "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK",
+     "OK"] : string list
+  val test10b = ["OK", "OK", "OK", "OK", "OK", "OK"] : string list
 [closing file "time.sml"]
 [opening file "timer.sml"]
 [opening file "auxil.sml"]
@@ -1129,14 +1320,14 @@
 > val it = () : unit
 
 Each line below should show roughly the same User, System, and Gc times:
-User: 0.120  System: 0.000  Gc: 0.000  Real: 0.123
-User: 0.130  System: 0.000  Gc: 0.000  Real: 0.123
-User: 0.120  System: 0.000  Gc: 0.000  Real: 0.123
-User: 0.120  System: 0.000  Gc: 0.000  Real: 0.124
-User: 0.130  System: 0.000  Gc: 0.000  Real: 0.124
-User: 0.110  System: 0.070  Gc: 0.000  Real: 0.285
-User: 0.120  System: 0.000  Gc: 0.000  Real: 0.126
-User: 0.130  System: 0.000  Gc: 0.000  Real: 0.125
+User: 0.040  System: 0.000  Gc: 0.000  Real: 0.041
+User: 0.044  System: 0.000  Gc: 0.000  Real: 0.042
+User: 0.044  System: 0.000  Gc: 0.000  Real: 0.042
+User: 0.040  System: 0.000  Gc: 0.000  Real: 0.042
+User: 0.044  System: 0.000  Gc: 0.000  Real: 0.042
+User: 0.040  System: 0.000  Gc: 0.000  Real: 0.042
+User: 0.044  System: 0.000  Gc: 0.000  Real: 0.042
+User: 0.040  System: 0.000  Gc: 0.000  Real: 0.042
 > val test1 = "OK" : string
   val test2 = "OK" : string
   val test3 = "OK" : string
@@ -1195,9 +1386,11 @@
   val test5a = "OK" : string
   val test6a = "OK" : string
   val test6b = "OK" : string
+  val mka = fn : string * string -> string
   val test7a = "OK" : string
   val test7b = "OK" : string
   val test7c = "OK" : string
+  val mkr = fn : string * string -> string
   val test8a = "OK" : string
   val test8b = "OK" : string
   val test8c = "OK" : string
@@ -1223,9 +1416,12 @@
 > val checkrange = fn : int * int -> (int -> bool) -> string
 [closing file "auxil.sml"]
 > val it = () : unit
+! Warning: Value polymorphism:
+! Free type variable(s) at top level in value identifier vec0
 > val a = #[0, 1, 2, 3, 4, 5, 6] : int vector
   val b = #[44, 55, 66] : int vector
   val c = #[0, 1, 2, 3, 4, 5, 6] : int vector
+  val vec0 = #[] : 'a vector
   val test1 = "OK" : string
   val test2 = "OK" : string
   val d =
@@ -1256,34 +1452,133 @@
   val test8 = "OK" : string
   val f = #[44, 55, 66] : int vector
   val test9 = "OK" : string
-  val test9a = "OK" : string
-  val test9b = "OK" : string
-  val test9c = "OK" : string
-  val test9d = "OK" : string
-  val test9e = "OK" : string
-  val test9f = "OK" : string
-  val test9g = "OK" : string
-  val test9h = "OK" : string
-  val test9i = "OK" : string
-  val ('a, 'b, ''c) chkiter = fn :
-  ((int -> 'a) -> 'b -> ''c) -> (int -> 'a) -> 'b -> ''c * int -> string
-  val ('a, 'b, 'c, ''d) chkiteri = fn :
-  ((int * 'a -> 'b) -> 'c -> ''d) -> ('a -> 'b) -> 'c -> ''d * int -> string
+  val ('b, 'c, ''d) chkiter = fn :
+  ((int -> 'b) -> 'c -> ''d) -> (int -> 'b) -> 'c -> ''d * int -> string
+  val ('b, 'c, 'd, ''e) chkiteri = fn :
+  ((int * 'b -> 'c) -> 'd -> ''e) -> ('b -> 'c) -> 'd -> ''e * int -> string
+  val ('b, 'c, 'd, 'e, ''f) chkfold = fn :
+  ((int * 'b -> 'c) -> 'd -> 'e -> ''f) -> (int * 'b -> 'c) -> 'd -> 'e ->
+  ''f * int -> string
+  val ('b, 'c, 'd, 'e, 'f, ''g) chkfoldi = fn :
+  ((int * 'b * 'c -> 'd) -> 'e -> 'f -> ''g) -> ('b * 'c -> 'd) -> 'e -> 'f ->
+  ''g * int -> string
   val test10a = "OK" : string
+  val test10b = "OK" : string
+  val test10c = "OK" : string
+  val test10d = "OK" : string
+  val test10e = "OK" : string
+  val test10f = "OK" : string
+  val test10g = "OK" : string
   val test11a = "OK" : string
   val test11b = "OK" : string
   val test11c = "OK" : string
   val test11d = "OK" : string
   val test11e = "OK" : string
-  val test11f = "OK" : string
-  val test11g = "OK" : string
-  val test11h = "OK" : string
-  val test11i = "OK" : string
+  val test12a = "OK" : string
+  val test12b = "OK" : string
+  val test12c = "OK" : string
+  val test12d = "OK" : string
+  val test13 = "OK" : string
+  val test14 = "OK" : string
+  val test15 = "OK" : string
+  val test16 = "OK" : string
 [closing file "vector.sml"]
+[opening file "vectorslice.sml"]
+[opening file "auxil.sml"]
+> infix 1 seq
+  val ('b, 'c) seq = fn : 'b * 'c -> 'c
+> val check = fn : bool -> string
+> val check' = fn : (unit -> bool) -> string
+> val range = fn : int * int -> (int -> bool) -> bool
+> val checkrange = fn : int * int -> (int -> bool) -> string
+[closing file "auxil.sml"]
+> val it = () : unit
+> val a = #[1, 11, 21, 31, 41, 51, 61] : int vector
+  val b = #[441, 551, 661] : int vector
+  val c = #[1, 11, 21, 31, 41, 51, 61] : int vector
+  val slice00 =  : int slice
+  val slice01 =  : int slice
+  val slice02 =  : int slice
+  val slice03 =  : int slice
+  val slice04 =  : int slice
+  val slice05 =  : int slice
+  val slicea07 =  : int slice
+  val slicea02 =  : int slice
+  val slicea23 =  : int slice
+  val slicea25 =  : int slice
+  val slice06 =  : int slice
+  val slice07 =  : int slice
+  val slice08 =  : int slice
+  val slice09 =  : int slice
+  val slice0s =
+    [, , , , , , , ,
+     , ] : int slice list
+  val sliceas = [, , , ] : int slice list
+  val test1a = "OK" : string
+  val test1b = "OK" : string
+  val test2a = "OK" : string
+  val test2b = "OK" : string
+  val test2c = "OK" : string
+  val test2d = "OK" : string
+  val test2e = "OK" : string
+  val test3a = "OK" : string
+  val test4a = "OK" : string
+  val test4b = "OK" : string
+  val test4c = "OK" : string
+  val test4d = "OK" : string
+  val test4e = "OK" : string
+  val test4f = "OK" : string
+  val test4g = "OK" : string
+  val test5 = "OK" : string
+  val sliced =  : int slice
+  val sliceb =  : int slice
+  val e =  : int array
+  val ev =
+    #[1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41,
+      51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21,
+      31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1,
+      11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51,
+      61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31,
+      41, 51, 61, 1, 11, 441, 551, 661, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21,
+      31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1,
+      11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51,
+      61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31,
+      41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, 61, 1, 11,
+      21, 31, 41, 51, 61, 1, 11, 21, 31, 41, 51, ...] : int vector
+  val slicee =  : int slice
+  val test9a = "OK" : string
+  val test9b = "OK" : string
+  val g =  : int array
+  val sliceg =  : int slice
+  val test10a = "OK" : string
+  val sliceg0 =  : int slice
+  val test10b = "OK" : string
+  val sliceg1 =  : int slice
+  val test10c = "OK" : string
+  val sliceg202 =  : int slice
+  val test10d = "OK" : string
+  val test11a = "OK" : string
+  val test11b = "OK" : string
+  val test11c = "OK" : string
+  val test12a = "OK" : string
+  val test12b = "OK" : string
+  val test12c = "OK" : string
+  val test12d = "OK" : string
+  val test12f = "OK" : string
+  val test12g = "OK" : string
+  val test12h = "OK" : string
+  val test12i = "OK" : string
+  val test13 = "OK" : string
+  val test14a = "OK" : string
+  val test14b = "OK" : string
+  val test15 = "OK" : string
+  val test17a = "OK" : string
+  val test17b = "OK" : string
+[closing file "vectorslice.sml"]
 [opening file "weak.sml"]
 [opening file "auxil.sml"]
 > infix 1 seq
-  val ('a, 'b) seq = fn : 'a * 'b -> 'b
+  val ('b, 'c) seq = fn : 'b * 'c -> 'c
 > val check = fn : bool -> string
 > val check' = fn : (unit -> bool) -> string
 > val range = fn : int * int -> (int -> bool) -> bool
@@ -1298,7 +1593,7 @@
 test6:
 test7:
 test8:
-//////////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////////////////////////////////////
 > val a =  : int list array
   val test1 = "OK" : string
   val test2 = "OK" : string
@@ -1314,7 +1609,7 @@
 [opening file "word.sml"]
 [opening file "auxil.sml"]
 > infix 1 seq
-  val ('a, 'b) seq = fn : 'a * 'b -> 'b
+  val ('b, 'c) seq = fn : 'b * 'c -> 'c
 > val check = fn : bool -> string
 > val check' = fn : (unit -> bool) -> string
 > val range = fn : int * int -> (int -> bool) -> bool
@@ -1331,8 +1626,12 @@
   val test7b = "OK" : string
   val test8a = "OK" : string
   val test8b = "OK" : string
-  val maxposint = 1073741823 : int
-  val maxnegint = ~1073741824 : int
+  val test8c = "OK" : string
+  val test8d = "OK" : string
+  val test8e = "OK" : string
+  val test8f = "OK" : string
+  val test8g = "OK" : string
+  val test8h = "OK" : string
   val pwr2 = fn : int -> int
   val rwp = fn : int -> int -> int
   val test9a = "OK" : string
@@ -1375,7 +1674,7 @@
   val test12q = "OK" : string
   val test12r = "OK" : string
   val test12s = "OK" : string
-  val 'a chk = fn : ('a -> word option) -> 'a * int -> string
+  val 'b chk = fn : ('b -> word option) -> 'b * int -> string
   val chkScan = fn : radix -> string * int -> string
   val test13a =
     ["OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK",
@@ -1416,7 +1715,7 @@
 [opening file "word8.sml"]
 [opening file "auxil.sml"]
 > infix 1 seq
-  val ('a, 'b) seq = fn : 'a * 'b -> 'b
+  val ('b, 'c) seq = fn : 'b * 'c -> 'c
 > val check = fn : bool -> string
 > val check' = fn : (unit -> bool) -> string
 > val range = fn : int * int -> (int -> bool) -> bool
@@ -1439,6 +1738,11 @@
   val test8a = "OK" : string
   val test8b = "OK" : string
   val test8c = "OK" : string
+  val test8d = "OK" : string
+  val test8e = "OK" : string
+  val test8f = "OK" : string
+  val test8g = "OK" : string
+  val test8h = "OK" : string
   val test9a = "OK" : string
   val test9b = "OK" : string
   val test9c = "OK" : string
@@ -1476,7 +1780,7 @@
   val test12o = "OK" : string
   val test12p = "OK" : string
   val test12q = "OK" : string
-  val 'a chk = fn : ('a -> word8 option) -> 'a * int -> string
+  val 'b chk = fn : ('b -> word8 option) -> 'b * int -> string
   val chkScan = fn : radix -> string * int -> string
   val test13a =
     ["OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK", "OK",
@@ -1529,7 +1833,7 @@
 [opening file "word8array.sml"]
 [opening file "auxil.sml"]
 > infix 1 seq
-  val ('a, 'b) seq = fn : 'a * 'b -> 'b
+  val ('b, 'c) seq = fn : 'b * 'c -> 'c
 > val check = fn : bool -> string
 > val check' = fn : (unit -> bool) -> string
 > val range = fn : int * int -> (int -> bool) -> bool
@@ -1563,39 +1867,112 @@
   val test9 = "OK" : string
   val test9a = "OK" : string
   val test9b = "OK" : string
-  val test9c = "OK" : string
-  val test9d = "OK" : string
-  val test9e = "OK" : string
-  val test9f = "OK" : string
-  val test9g = "OK" : string
-  val test9h = "OK" : string
-  val test9i = "OK" : string
   val g =  : array
   val test10a = "OK" : string
   val test10b = "OK" : string
   val test10c = "OK" : string
   val test10d = "OK" : string
   val test10e = "OK" : string
-  val test10f = "OK" : string
-  val test10g = "OK" : string
-  val test10h = "OK" : string
-  val test10i = "OK" : string
   val test11a = "OK" : string
   val test11b = "OK" : string
   val test11c = "OK" : string
   val test11d = "OK" : string
   val test11e = "OK" : string
-  val test11f = "OK" : string
-  val test11g = "OK" : string
-  val test11h = "OK" : string
-  val test11i = "OK" : string
-  val test11j = "OK" : string
-  val test11k = "OK" : string
+  val test12 = "OK" : string
+  val test13 = "OK" : string
+  val test14 = "OK" : string
+  val test15 = "OK" : string
 [closing file "word8array.sml"]
+[opening file "word8arrayslice.sml"]
+[opening file "auxil.sml"]
+> infix 1 seq
+  val ('b, 'c) seq = fn : 'b * 'c -> 'c
+> val check = fn : bool -> string
+> val check' = fn : (unit -> bool) -> string
+> val range = fn : int * int -> (int -> bool) -> bool
+> val checkrange = fn : int * int -> (int -> bool) -> string
+[closing file "auxil.sml"]
+> val it = () : unit
+> val a =  : array
+  val b =  : array
+  val c =  : array
+  val slice00 =  : slice
+  val slice01 =  : slice
+  val slice02 =  : slice
+  val slice03 =  : slice
+  val slice04 =  : slice
+  val slice05 =  : slice
+  val slicea07 =  : slice
+  val slicea02 =  : slice
+  val slicea23 =  : slice
+  val slicea25 =  : slice
+  val slice06 =  : slice
+  val slice07 =  : slice
+  val slice08 =  : slice
+  val slice09 =  : slice
+  val slice0s =
+    [, , , , , , , ,
+     , ] : slice list
+  val sliceas = [, , , ] : slice list
+  val test1a = "OK" : string
+  val test1b = "OK" : string
+  val test2a = "OK" : string
+  val test2b = "OK" : string
+  val test2c = "OK" : string
+  val test2d = "OK" : string
+  val test2e = "OK" : string
+  val test3a = "OK" : string
+  val test4a = "OK" : string
+  val test4b = "OK" : string
+  val test4c = "OK" : string
+  val test4d = "OK" : string
+  val test4e = "OK" : string
+  val test4f = "OK" : string
+  val test4g = "OK" : string
+  val test5 = "OK" : string
+  val test6a = "OK" : string
+  val test6b = "OK" : string
+  val test6c = "OK" : string
+  val sliced =  : slice
+  val sliceb =  : slice
+  val e =  : array
+  val ev =  : vector/1
+  val slicee =  : slice
+  val test9a = "OK" : string
+  val test9b = "OK" : string
+  val g =  : array
+  val sliceg =  : slice
+  val test10a = "OK" : string
+  val sliceg0 =  : slice
+  val test10b = "OK" : string
+  val sliceg1 =  : slice
+  val test10c = "OK" : string
+  val sliceg202 =  : slice
+  val test10d = "OK" : string
+  val test11a = "OK" : string
+  val test11b = "OK" : string
+  val test11c = "OK" : string
+  val test12a = "OK" : string
+  val test12b = "OK" : string
+  val test12c = "OK" : string
+  val test12d = "OK" : string
+  val test12e = "OK" : string
+  val test12f = "OK" : string
+  val test12g = "OK" : string
+  val test12h = "OK" : string
+  val test12i = "OK" : string
+  val test13 = "OK" : string
+  val test14a = "OK" : string
+  val test14b = "OK" : string
+  val test15 = "OK" : string
+  val test16 = "OK" : string
+  val test17a = "OK" : string
+  val test17b = "OK" : string
+[closing file "word8arrayslice.sml"]
 [opening file "word8vector.sml"]
 [opening file "auxil.sml"]
 > infix 1 seq
-  val ('a, 'b) seq = fn : 'a * 'b -> 'b
+  val ('b, 'c) seq = fn : 'b * 'c -> 'c
 > val check = fn : bool -> string
 > val check' = fn : (unit -> bool) -> string
 > val range = fn : int * int -> (int -> bool) -> bool
@@ -1621,28 +1998,116 @@
   val test8 = "OK" : string
   val f =  : vector/1
   val test9 = "OK" : string
-  val test9a = "OK" : string
-  val test9b = "OK" : string
-  val test9c = "OK" : string
-  val test9d = "OK" : string
-  val test9e = "OK" : string
-  val test9f = "OK" : string
-  val test9g = "OK" : string
-  val test9h = "OK" : string
-  val test9i = "OK" : string
-  val ('a, 'b, ''c) chkiter = fn :
-  ((word8 -> 'a) -> 'b -> ''c) -> (word8 -> 'a) -> 'b -> ''c * word8 -> string
-  val ('a, 'b, 'c, ''d) chkiteri = fn :
-  ((int * 'a -> 'b) -> 'c -> ''d) -> ('a -> 'b) -> 'c -> ''d * int -> string
+  val ('b, 'c, ''d) chkiter = fn :
+  ((word8 -> 'b) -> 'c -> ''d) -> (word8 -> 'b) -> 'c -> ''d * word8 -> string
+  val ('b, 'c, 'd, ''e) chkiteri = fn :
+  ((int * 'b -> 'c) -> 'd -> ''e) -> ('b -> 'c) -> 'd -> ''e * int -> string
+  val ('b, 'c, 'd, 'e, ''f) chkfold = fn :
+  ((word8 * 'b -> 'c) -> 'd -> 'e -> ''f) -> (word8 * 'b -> 'c) -> 'd -> 'e ->
+  ''f * word8 -> string
+  val ('b, 'c, 'd, 'e, 'f, ''g) chkfoldi = fn :
+  ((int * 'b * 'c -> 'd) -> 'e -> 'f -> ''g) -> ('b * 'c -> 'd) -> 'e -> 'f ->
+  ''g * int -> string
   val test10a = "OK" : string
+  val test10b = "OK" : string
+  val test10c = "OK" : string
+  val test10d = "OK" : string
+  val test10e = "OK" : string
+  val test10f = "OK" : string
+  val test10g = "OK" : string
   val test11a = "OK" : string
   val test11b = "OK" : string
   val test11c = "OK" : string
   val test11d = "OK" : string
   val test11e = "OK" : string
-  val test11f = "OK" : string
-  val test11g = "OK" : string
-  val test11h = "OK" : string
-  val test11i = "OK" : string
+  val test12a = "OK" : string
+  val test12b = "OK" : string
+  val test12c = "OK" : string
+  val test12d = "OK" : string
+  val test13 = "OK" : string
+  val test14 = "OK" : string
+  val test15 = "OK" : string
+  val test16 = "OK" : string
 [closing file "word8vector.sml"]
+[opening file "word8vectorslice.sml"]
+[opening file "auxil.sml"]
+> infix 1 seq
+  val ('b, 'c) seq = fn : 'b * 'c -> 'c
+> val check = fn : bool -> string
+> val check' = fn : (unit -> bool) -> string
+> val range = fn : int * int -> (int -> bool) -> bool
+> val checkrange = fn : int * int -> (int -> bool) -> string
+[closing file "auxil.sml"]
+> val it = () : unit
+> val a =  : vector/1
+  val b =  : vector/1
+  val c =  : vector/1
+  val slice00 =  : slice
+  val slice01 =  : slice
+  val slice02 =  : slice
+  val slice03 =  : slice
+  val slice04 =  : slice
+  val slice05 =  : slice
+  val slicea07 =  : slice
+  val slicea02 =  : slice
+  val slicea23 =  : slice
+  val slicea25 =  : slice
+  val slice06 =  : slice
+  val slice07 =  : slice
+  val slice08 =  : slice
+  val slice09 =  : slice
+  val slice0s =
+    [, , , , , , , ,
+     , ] : slice list
+  val sliceas = [, , , ] : slice list
+  val test1a = "OK" : string
+  val test1b = "OK" : string
+  val test2a = "OK" : string
+  val test2b = "OK" : string
+  val test2c = "OK" : string
+  val test2d = "OK" : string
+  val test2e = "OK" : string
+  val test3a = "OK" : string
+  val test4a = "OK" : string
+  val test4b = "OK" : string
+  val test4c = "OK" : string
+  val test4d = "OK" : string
+  val test4e = "OK" : string
+  val test4f = "OK" : string
+  val test4g = "OK" : string
+  val test5 = "OK" : string
+  val sliced =  : slice
+  val sliceb =  : slice
+  val e =  : array
+  val ev =  : vector/1
+  val slicee =  : slice
+  val test9a = "OK" : string
+  val test9b = "OK" : string
+  val g =  : array
+  val sliceg =  : slice
+  val test10a = "OK" : string
+  val sliceg0 =  : slice
+  val test10b = "OK" : string
+  val sliceg1 =  : slice
+  val test10c = "OK" : string
+  val sliceg202 =  : slice
+  val test10d = "OK" : string
+  val test11a = "OK" : string
+  val test11b = "OK" : string
+  val test11c = "OK" : string
+  val test12a = "OK" : string
+  val test12b = "OK" : string
+  val test12c = "OK" : string
+  val test12d = "OK" : string
+  val test12f = "OK" : string
+  val test12g = "OK" : string
+  val test12h = "OK" : string
+  val test12i = "OK" : string
+  val test13 = "OK" : string
+  val test14a = "OK" : string
+  val test14b = "OK" : string
+  val test15 = "OK" : string
+  val test17a = "OK" : string
+  val test17b = "OK" : string
+[closing file "word8vectorslice.sml"]
 > val it = () : unit
diff -Nru mosml-2.01/src/mosmllib/test/string.sml mosml-2.10.1/src/mosmllib/test/string.sml
--- mosml-2.01/src/mosmllib/test/string.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/string.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,5 +1,5 @@
 (* test/string.sml 
-   PS 1994-12-10, 1995-06-14, 1996-05-16 *)
+   PS 1994-12-10, 1995-06-14, 1996-05-16, 2000-10-18 *)
 
 use "auxil.sml";
 
@@ -362,4 +362,59 @@
 	   andalso not (isPrefix "Abcde"  "abcde")
 	   andalso not (isPrefix "abcdE"  "abcde"))
 
+val test26 = 
+    check'(fn _ => 
+	   isSuffix "" ""
+	   andalso isSuffix ""  "abcde"
+	   andalso isSuffix "e"  "abcde"
+	   andalso isSuffix "bcde"  "abcde"
+	   andalso isSuffix "abcde"  "abcde"
+	   andalso not (isSuffix "abcde"  "")
+	   andalso not (isSuffix "abcdef"  "abcde")
+	   andalso not (isSuffix "Abcde"  "abcde")
+	   andalso not (isSuffix "abcdE"  "abcde"))
+
+val test27 = 
+    check'(fn _ => 
+	   isSubstring "" ""
+	   andalso isSubstring ""  "abcde"
+	   andalso isSubstring "a"  "abcde"
+	   andalso isSubstring "e"  "abcde"
+	   andalso isSubstring "bcde"  "abcde"
+	   andalso isSubstring "abcde" "abcde"
+	   andalso isSubstring "b"     "abcde"
+	   andalso isSubstring "bcd"   "abcde"
+	   andalso not (isSubstring "abcde"  "")
+	   andalso not (isSubstring "abcdef"  "abcde")
+	   andalso not (isSubstring "Abcde"  "abcde")
+	   andalso not (isSubstring "abcdE"  "abcde"))
+
+val test28 = 
+    check'(fn _ =>
+	   let fun invcompare (c1, c2) = Char.compare (c2, c1) 
+	       fun coll s1 s2 = collate invcompare (s1, s2)
+	   in 
+	       coll "" "" = EQUAL
+	       andalso coll "" " " = LESS
+	       andalso coll " " "" = GREATER
+	       andalso coll "ABCD" "ABCD" = EQUAL
+	       andalso coll "ABCD" "ABCD " = LESS
+	       andalso coll "ABCD " "ABCD" = GREATER
+	       andalso coll "B" "ABCD" = LESS
+	       andalso coll "ABCD" "B" = GREATER
+	       andalso coll "CCCB" "CCCABCD" = LESS
+	       andalso coll "CCCABCD" "CCCB" = GREATER
+	       andalso coll "CCCB" "CCCA" = LESS
+	       andalso coll "CCCA" "CCCB" = GREATER
+	   end)
+
+val test29 = 
+    check'(fn _ =>
+	   concatWith "+" [] = ""
+	   andalso concatWith "" [] = ""
+	   andalso concatWith "+" ["abc"] = "abc"
+	   andalso concatWith "+" ["h3", "h2", "h1"] = "h3+h2+h1"
+	   andalso concatWith "+-" ["h3", "h2", "h1"] = "h3+-h2+-h1"
+	   andalso concatWith "+-" ["", "", ""]="+-+-"
+	   andalso concatWith "" ["h3", "h2", "h1"] = "h3h2h1")
 end
diff -Nru mosml-2.01/src/mosmllib/test/substring.sml mosml-2.10.1/src/mosmllib/test/substring.sml
--- mosml-2.01/src/mosmllib/test/substring.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/substring.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,4 +1,4 @@
-(* test/substring.sml 1995-04-27, 1997-06-03, 1999-03-02 *)
+(* test/substring.sml 1995-04-27, 1997-06-03, 1999-03-02, 2000-10-17 *)
 
 use "auxil.sml";
 
@@ -8,8 +8,8 @@
 
     val s1 = ""				(* String.size s1 =  0 *)
     and s2 = "ABCDE\tFGHI";		(* String.size s2 = 10 *)
-    val ss1 = all s1			(* size s1 =  0 *)
-    and ss2 = all s2;			(* size s2 = 10 *)
+    val ss1 = full s1			(* size s1 =  0 *)
+    and ss2 = full s2;			(* size s2 = 10 *)
 
     val sa = "AAAAaAbAABBBB";		(* String.size sa = 14 *)
     (*            45678      *)
@@ -51,8 +51,8 @@
     check'(fn _ =>
 	   string ssa1 = ""
 	   andalso string ssa2 = "aAbAA"
-	   andalso s1 = string (all s1) 
-	   andalso s2 = string (all s2));
+	   andalso s1 = string (full s1) 
+	   andalso s2 = string (full s2));
 
 val test2a = 
     check'(fn _ => 
@@ -180,8 +180,8 @@
 	   andalso GREATER = compare(ssa2, triml 1 ssa2)
 	   andalso LESS = compare(trimr 1 ssa2, ssa2)
 	   andalso GREATER = compare(ssa2, trimr 1 ssa2)
-	   andalso LESS = compare(all "AB", ssa2)
-	   andalso GREATER = compare(ssa2, all "AB"));
+	   andalso LESS = compare(full "AB", ssa2)
+	   andalso GREATER = compare(ssa2, full "AB"));
 
 fun finda c = c <> #"A";
 fun findb c = c <> #"B";
@@ -274,8 +274,8 @@
 val test25 = 
     check'(fn _ => 
 	   null(tokens (fn _ => true) ss3)
-	   andalso null(tokens (fn _ => false) (all ""))
-	   andalso null(tokens (contains " ()") (all "(()())(( ()"))
+	   andalso null(tokens (fn _ => false) (full ""))
+	   andalso null(tokens (contains " ()") (full "(()())(( ()"))
 	   andalso ["this","is","a","clear","text"] = 
                            map string (tokens (contains " ()") ss3));
 
@@ -349,7 +349,7 @@
        | _ => "OK";
 
 (* val sa = "AAAAaAbAABBBB"; *)
-val test31 = 
+val test31a = 
     check'(fn _ => 
 	   isPrefix "" (substring(sa, 0, 0))
 	   andalso isPrefix "" (substring(sa, 13, 0))
@@ -357,21 +357,53 @@
 	   andalso isPrefix "aAbAA" ssa2
 	   andalso isPrefix "aAbA" ssa2
 	   andalso not (isPrefix "aAbAAB" ssa2)
-	   andalso not (isPrefix "aAbAAB" ssa1))
+	   andalso not (isPrefix "aAbAAB" ssa1)
+	   andalso not (isPrefix "AAA" ssa2)
+	   andalso not (isPrefix "AaA" ssa2)
+	   andalso not (isPrefix "AAB" ssa2))
+
+(* val sa = "AAAAaAbAABBBB"; *)
+val test31b = 
+    check'(fn _ => 
+	   isSuffix "" (substring(sa, 0, 0))
+	   andalso isSuffix "" (substring(sa, 13, 0))
+	   andalso isSuffix "" ssa1
+	   andalso isSuffix "aAbAA" ssa2
+	   andalso isSuffix "AbAA" ssa2
+	   andalso not (isSuffix "baAbAA" ssa2)
+	   andalso not (isSuffix "baAbAA" ssa1)
+	   andalso not (isSuffix "AAA" ssa2)
+	   andalso not (isSuffix "AaA" ssa2)
+	   andalso not (isSuffix "AAB" ssa2))
+
+(* val sa = "AAAAaAbAABBBB"; *)
+val test31c = 
+    check'(fn _ => 
+	   isSubstring "" (substring(sa, 0, 0))
+	   andalso isSubstring "" (substring(sa, 13, 0))
+	   andalso isSubstring "" ssa1
+	   andalso isSubstring "aAbAA" ssa2
+	   andalso isSubstring "AbAA" ssa2
+	   andalso isSubstring "aAbA" ssa2
+	   andalso not (isSubstring "baAbAA" ssa2)
+	   andalso not (isSubstring "baAbAA" ssa1)
+	   andalso not (isSubstring "AAA" ssa2)
+	   andalso not (isSubstring "AaA" ssa2)
+	   andalso not (isSubstring "AAB" ssa2))
 
 fun eqspan(sus1, sus2, res) = base(span(sus1, sus2)) = base res
 
 val test32a = check'(fn _ =>
-   eqspan(substring(sa, 0, 0), substring(sa, 0, 13), all sa)
-   andalso eqspan(substring(sa, 0, 13), substring(sa, 13, 0), all sa)
+   eqspan(substring(sa, 0, 0), substring(sa, 0, 13), full sa)
+   andalso eqspan(substring(sa, 0, 13), substring(sa, 13, 0), full sa)
    andalso eqspan(substring(sa, 5, 0), substring(sa, 5, 0), substring(sa, 5,0))
-   andalso eqspan(substring(sa, 0, 5), substring(sa, 5, 8), all sa)
-   andalso eqspan(substring(sa, 0, 13), substring(sa, 0, 13), all sa)
+   andalso eqspan(substring(sa, 0, 5), substring(sa, 5, 8), full sa)
+   andalso eqspan(substring(sa, 0, 13), substring(sa, 0, 13), full sa)
    andalso eqspan(substring(sa, 5, 4), substring(sa, 2, 4), substring(sa,5,1))
    andalso eqspan(substring(sa, 2, 5), substring(sa, 6, 3), substring(sa, 2,7))
    andalso eqspan(substring("abcd", 1, 0), substring("abcd", 1, 2), 
 		  substring("abcd", 1, 2))
-   andalso eqspan(substring("", 0, 0), substring("", 0, 0), all ""))
+   andalso eqspan(substring("", 0, 0), substring("", 0, 0), full ""))
 
 val test32b = (span(substring("a", 0, 0), substring("b", 0, 0)) seq "WRONG") 
               handle Span => "OK" | _ => "WRONG";
@@ -385,4 +417,52 @@
 val test32b = (span(substring("a", 0, 0), substring("b", 0, 0)) seq "WRONG") 
               handle Span => "OK" | _ => "WRONG";
 
+val test33a = 
+    check'(fn _ =>
+	   let fun invcompare (c1, c2) = Char.compare (c2, c1) 
+	       fun coll s1 s2 = collate invcompare (full s1, full s2)
+	   in 
+	       coll "" "" = EQUAL
+	       andalso coll "" " " = LESS
+	       andalso coll " " "" = GREATER
+	       andalso coll "ABCD" "ABCD" = EQUAL
+	       andalso coll "ABCD" "ABCD " = LESS
+	       andalso coll "ABCD " "ABCD" = GREATER
+	       andalso coll "B" "ABCD" = LESS
+	       andalso coll "ABCD" "B" = GREATER
+	       andalso coll "CCCB" "CCCABCD" = LESS
+	       andalso coll "CCCABCD" "CCCB" = GREATER
+	       andalso coll "CCCB" "CCCA" = LESS
+	       andalso coll "CCCA" "CCCB" = GREATER
+	   end)
+
+(* val sa = "AAAAaAbAABBBB"; *)
+(*           0123456789012   *)
+val test33b = 
+    check'(fn _ =>
+  let fun invcompare (c1, c2) = Char.compare (c2, c1) 
+      fun coll s1 s2 = collate invcompare (s1, s2)
+  in 
+      coll (full sa) (substring(sa, 0, 13)) = EQUAL
+      andalso coll (substring(sa, 0, 0)) (substring(sa, 13, 0)) = EQUAL
+      andalso coll (substring(sa, 0, 0)) (substring(sa, 0, 13)) = LESS
+      andalso coll (substring(sa, 0, 13)) (substring(sa, 0, 0)) = GREATER
+      andalso coll (substring(sa, 0, 3)) (substring(sa, 1, 3)) = EQUAL
+      andalso coll (substring(sa, 0, 4)) (substring(sa, 1, 4)) = GREATER
+      andalso coll (substring(sa, 1, 4)) (substring(sa, 0, 4)) = LESS
+  end)
+
+val test34 = 
+    check'(fn _ =>
+	   concatWith "+" [] = ""
+	   andalso concatWith "" [] = ""
+	   andalso concatWith "+" [full "abc"] = "abc"
+	   andalso concatWith "+" [full "h3", full "h2", full "h1"] = "h3+h2+h1"
+	   andalso concatWith "+-" [full "h3", full "h2", full "h1"]="h3+-h2+-h1"
+	   andalso concatWith "+-" [full "", full "", full ""]="+-+-"
+	   andalso concatWith "" [full "h3", full "h2", full "h1"] = "h3h2h1"
+	   andalso concatWith "678" [ssa1, ssa1, ssa1]="678678"
+	   andalso concatWith "678" [ssa2, ssa2, ssa2]="aAbAA678aAbAA678aAbAA"
+	   andalso concatWith "678" [ssa2, ssa1, ss2, ss1] = 
+	   "aAbAA678678ABCDE\tFGHI678")
 end; 
diff -Nru mosml-2.01/src/mosmllib/test/test.sml mosml-2.10.1/src/mosmllib/test/test.sml
--- mosml-2.01/src/mosmllib/test/test.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/test.sml	2014-08-28 08:47:22.000000000 +0000
@@ -6,6 +6,7 @@
 app use
 ["array.sml",
  "array2.sml",
+ "arrayslice.sml",
  "arraysort.sml",			(* MOSML *)
  "bytechar.sml",
  "callback.sml",			(* MOSML *)
@@ -18,6 +19,9 @@
  "listsort.sml",			(* MOSML *)
  "math.sml",
  "mosml.sml",				(* MOSML *)
+ "polyhash.sml",			(* MOSML *)
+ "process.sml",
+ "random.sml",				(* MOSML *)
  "real.sml",
  "string.sml",
  "stringcvt.sml",
@@ -27,10 +31,13 @@
  "timer.sml",
  "unixpath.sml",
  "vector.sml",
+ "vectorslice.sml",
  "weak.sml",				(* MOSML *)
  "word.sml",
  "word8.sml",
  "word8array.sml",
- "word8vector.sml"];
+ "word8arrayslice.sml",
+ "word8vector.sml",
+ "word8vectorslice.sml"];
 
 ignore(Process.exit Process.success);
diff -Nru mosml-2.01/src/mosmllib/test/timer.sml mosml-2.10.1/src/mosmllib/test/timer.sml
--- mosml-2.01/src/mosmllib/test/timer.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/timer.sml	2014-08-28 08:47:22.000000000 +0000
@@ -26,8 +26,8 @@
 end
 
 local
-    val op <= = fn ({usr=usr1, sys=sys1, gc=gc1}, {usr=usr2, sys=sys2, gc=gc2})
-	=> usr1 <= usr2 andalso sys1 <= sys2 andalso gc1 <= gc1;
+    val op <= = fn ({usr=usr1, sys=sys1}, {usr=usr2, sys=sys2})
+	=> usr1 <= usr2 andalso sys1 <= sys2;
     fun cput1 < cput2 = (cput1 <= cput2) andalso (cput1 <> cput2);
 in
 val test3 = check(checkCPUTimer totalCPUTime <= checkCPUTimer totalCPUTime
@@ -46,7 +46,8 @@
 	    val cputimer  = startCPUTimer ()
 	    val realtimer = startRealTimer ()
 	    val res = f arg
-	    val {usr, sys, gc} = checkCPUTimer cputimer;
+	    val {usr, sys} = checkCPUTimer cputimer;
+	    val gc = checkGCTime cputimer;
 	    val rea = checkRealTimer realtimer;
 	    fun format t = Time.toString t
 	in 
diff -Nru mosml-2.01/src/mosmllib/test/time.sml mosml-2.10.1/src/mosmllib/test/time.sml
--- mosml-2.01/src/mosmllib/test/time.sml	2004-01-12 22:40:59.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/time.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,5 +1,5 @@
 (* test/time.sml
-   PS 1995-03-23
+   PS 1995-03-23, 2000-10-24
 *)
 
 use "auxil.sml";
@@ -9,14 +9,16 @@
     open Time
     val bigt = fromSeconds 987654321 + fromMicroseconds 500012;
     val litt = fromSeconds 454 + fromMicroseconds 501701
+    val nbigt = fromSeconds ~987654321 + fromMicroseconds ~500012;
+    val nlitt = fromSeconds ~454 + fromMicroseconds ~501701
 in
 
 val test1 = 
-    check'(fn _ => zeroTime + bigt = bigt 
-	   andalso bigt + zeroTime = bigt 
+    check'(fn _ => 
+	   zeroTime + bigt = bigt 
 	   andalso bigt - zeroTime = bigt
-	   andalso zeroTime + zeroTime = zeroTime
-	   andalso zeroTime - zeroTime = zeroTime);
+	   andalso zeroTime + nbigt = nbigt 
+	   andalso nbigt - zeroTime = nbigt);
 
 val test2a = 
     check'(fn _ => toSeconds zeroTime = 0
@@ -27,38 +29,47 @@
     check'(fn _ => toSeconds bigt = 987654321
 	   andalso toSeconds litt = 454
 	   andalso toMilliseconds litt = 454501
-	   andalso toMicroseconds litt = 454501701);
-val test2c = (fromSeconds ~1 seq "WRONG")
-             handle Time => "OK" | _ => "WRONG";
-val test2d = (fromMilliseconds ~1 seq "WRONG")
-             handle Time => "OK" | _ => "WRONG";
-val test2e = (fromMicroseconds ~1 seq "WRONG")
-             handle Time => "OK" | _ => "WRONG";
+	   andalso toMicroseconds litt = 454501701
+	   andalso toSeconds nbigt = ~987654321
+	   andalso toSeconds nlitt = ~454
+	   andalso toMilliseconds nlitt = ~454501
+	   andalso toMicroseconds nlitt = ~454501701);
 
 val test3a = 
     check'(fn _ => fromReal 0.0 = zeroTime
-	   andalso fromReal 10.25 = fromSeconds 10 + fromMilliseconds 250);
-val test3b = (fromReal ~1.0 seq "WRONG")
-             handle Time => "OK" | _ => "WRONG";
-val test3c = (fromReal 1E300 seq "WRONG")
-             handle Time => "OK" | _ => "WRONG"; 
+	   andalso fromReal 10.25 = fromSeconds 10 + fromMilliseconds 250
+	   andalso fromReal 10.000025 = fromSeconds 10 + fromMicroseconds 25);
 
 val test4a = 
-    check'(fn _ => toReal (fromReal 100.25) = 100.25);
+    check'(fn _ => 
+	   toReal (fromReal 100.25) = 100.25
+	   andalso toReal (fromReal 100.015625) = 100.015625);
 
 val test6a = 
     check'(fn _ => bigt + litt = litt + bigt
 	   andalso (bigt + litt) - litt = bigt
-	   andalso (bigt - litt) + litt = bigt);
+	   andalso (bigt - litt) + litt = bigt
+	   andalso nbigt + nlitt = nlitt + nbigt
+	   andalso (nbigt + nlitt) - nlitt = nbigt
+	   andalso (nbigt - nlitt) + nlitt = nbigt
+	   andalso nbigt + litt = litt + nbigt
+	   andalso (bigt + nlitt) - nlitt = bigt
+	   andalso (nbigt - litt) + litt = nbigt);
 
 val test7a = 
     check'(fn _ => litt <= litt andalso litt >= litt
 	   andalso zeroTime < litt andalso litt > zeroTime
+	   andalso zeroTime > nlitt andalso nlitt < zeroTime
 	   andalso litt < bigt andalso bigt > litt
+	   andalso nbigt < nlitt andalso nlitt > nbigt
 	   andalso not (litt > bigt) 
 	   andalso not (bigt < litt) 
 	   andalso not(litt < litt)
-	   andalso not(litt > litt));
+	   andalso not(litt > litt)
+	   andalso not (nbigt > nlitt) 
+	   andalso not (nlitt < nbigt) 
+	   andalso not(nlitt < nlitt)
+	   andalso not(nlitt > nlitt));
 
 val test8a = 
     check'(fn _ => now() <= now() 
@@ -74,8 +85,14 @@
 	   andalso fmt 3 litt = "454.502"
 	   andalso fmt 4 litt = "454.5017"
 	   andalso fmt 5 litt = "454.50170"
-	   andalso fmt 6 litt = "454.501701");
-
+	   andalso fmt 6 litt = "454.501701"
+	   andalso fmt 1 nlitt = "~454.5"
+	   andalso fmt 2 nlitt = "~454.50"
+	   andalso fmt 3 nlitt = "~454.502"
+	   andalso fmt 4 nlitt = "~454.5017"
+	   andalso fmt 5 nlitt = "~454.50170"
+	   andalso fmt 6 nlitt = "~454.501701");
+    
 val test9c =
     check'(fn _ => toString zeroTime = "0.000"
 	   andalso toString(fromReal(Math.pow(2.0,30.0))-fromReal 1.0)
@@ -87,7 +104,7 @@
 	   andalso toString(fromReal(Math.pow(2.0,30.0))-fromReal 1.0+
 			    fromReal(Math.pow(2.0,30.0)))
 	   = "2147483647.000");
-    
+
 fun chk (s, r) = 
     check'(fn _ => 
 	   case fromString s of
@@ -99,8 +116,23 @@
          [("189", 189000000),
 	  ("189.1", 189100000),
 	  ("189.125125", 189125125),
+	  ("+189", 189000000),
+	  ("+189.1", 189100000),
+	  ("+189.125125", 189125125),
+	  ("~189", ~189000000),
+	  ("~189.1", ~189100000),
+	  ("~189.125125", ~189125125),
+	  ("-189", ~189000000),
+	  ("-189.1", ~189100000),
+	  ("-189.125125", ~189125125),
 	  (".1", 100000),
 	  (".125125", 125125),
+	  ("+.1", 100000),
+	  ("+.125125", 125125),
+	  ("~.1", ~100000),
+	  ("~.125125", ~125125),
+	  ("-.1", ~100000),
+	  ("-.125125", ~125125),
 	  (" \n\t189crap", 189000000),
 	  (" \n\t189.1crap", 189100000),
 	  (" \n\t189.125125crap", 189125125),
@@ -109,5 +141,5 @@
 
 val test10b = 
     List.map (fn s => case fromString s of NONE => "OK" | _ => "WRONG")
-         ["", "+189", "~189", "now", "Monday"];
+         ["", "+ 189", "~ 189", "- 189", "now", "Monday"];
 end
diff -Nru mosml-2.01/src/mosmllib/test/unixpath.sml mosml-2.10.1/src/mosmllib/test/unixpath.sml
--- mosml-2.01/src/mosmllib/test/unixpath.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/unixpath.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,4 +1,4 @@
-(* test/unixpath.sml 6 -- for Unix, 1995-05-23 *)
+(* test/unixpath.sml 6 -- for Unix, 1995-05-23, 2000-10-20 *)
 
 use "auxil.sml";
 
@@ -124,35 +124,38 @@
 val test6b = (concat ("a", "/b") seq "WRONG")
              handle Path => "OK" | _ => "WRONG";
 
+fun mka(p1,p2) = mkAbsolute{path=p1, relativeTo=p2};
+
 val test7a = 
     check'(fn _ => 
-	   mkAbsolute("/a/b", "/c/d") = "/a/b"
-	   andalso mkAbsolute("/", "/c/d") = "/"
-	   andalso mkAbsolute("a/b", "/c/d") = "/c/d/a/b");
-val test7b = (mkAbsolute("a", "c/d") seq "WRONG")
+	   mka("/a/b", "/c/d") = "/a/b"
+	   andalso mka("/", "/c/d") = "/"
+	   andalso mka("a/b", "/c/d") = "/c/d/a/b");
+val test7b = (mka("a", "c/d") seq "WRONG")
              handle Path => "OK" | _ => "WRONG";
-val test7c = (mkAbsolute("/a", "c/d") seq "WRONG")
+val test7c = (mka("/a", "c/d") seq "WRONG")
               handle Path => "OK" | _ => "WRONG";
 
+fun mkr(p1, p2) = mkRelative{path=p1, relativeTo=p2}
 val test8a = 
     check'(fn _ => 
-	   mkRelative("a/b", "/c/d") = "a/b"
-	   andalso mkRelative("/", "/a/b/c")	   = "../../.." 
-	   andalso mkRelative("/a/", "/a/b/c")	   = "../../" 
-	   andalso mkRelative("/a/b/", "/a/c")	   = "../b/"     
-	   andalso mkRelative("/a/b", "/a/c/")	   = "../b"      
-	   andalso mkRelative("/a/b/", "/a/c/")	   = "../b/"     
-	   andalso mkRelative("/", "/")		   = "."	      
-	   andalso mkRelative("/", "/.")	   = "."	      
-	   andalso mkRelative("/", "/..")	   = "."	      
-	   andalso mkRelative("/", "/a")	   = ".."	      
-	   andalso mkRelative("/a/b/../c", "/a/d") = "../b/../c" 
-	   andalso mkRelative("/a/b", "/c/d")      = "../../a/b"
-	   andalso mkRelative("/c/a/b", "/c/d")    = "../a/b"
-	   andalso mkRelative("/c/d/a/b", "/c/d")  = "a/b");
-val test8b = (mkRelative("/a", "c/d") seq "WRONG")
+	           mkr("a/b", "/c/d")       = "a/b"
+	   andalso mkr("/", "/a/b/c")	    = "../../.." 
+	   andalso mkr("/a/", "/a/b/c")	    = "../../" 
+	   andalso mkr("/a/b/", "/a/c")	    = "../b/"     
+	   andalso mkr("/a/b", "/a/c/")	    = "../b"      
+	   andalso mkr("/a/b/", "/a/c/")    = "../b/"     
+	   andalso mkr("/", "/")	    = "."	      
+	   andalso mkr("/", "/.")	    = "."	      
+	   andalso mkr("/", "/..")	    = "."	      
+	   andalso mkr("/", "/a")	    = ".."	      
+	   andalso mkr("/a/b/../c", "/a/d") = "../b/../c" 
+	   andalso mkr("/a/b", "/c/d")      = "../../a/b"
+	   andalso mkr("/c/a/b", "/c/d")    = "../a/b"
+	   andalso mkr("/c/d/a/b", "/c/d")  = "a/b");
+val test8b = (mkr("/a", "c/d") seq "WRONG")
               handle Path => "OK" | _ => "WRONG";
-val test8c = (mkRelative("a", "c/d") seq "WRONG")
+val test8c = (mkr("a", "c/d") seq "WRONG")
               handle Path => "OK" | _ => "WRONG";
 
 val test9a = let
diff -Nru mosml-2.01/src/mosmllib/test/vectorslice.sml mosml-2.10.1/src/mosmllib/test/vectorslice.sml
--- mosml-2.01/src/mosmllib/test/vectorslice.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/vectorslice.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,325 @@
+(* test/vectorslice.sml -- some test cases for VectorSlice 
+   sestoft@dina.kvl.dk 2000-10-20 *)
+
+use "auxil.sml";
+
+local 
+    open Vector VectorSlice 
+    infix 9 sub
+    val array0 = Array.fromList []
+    val vec0 = fromList []
+    fun cons (x,r) = x ::  r
+    fun consi (i,x,r) = (i,x) ::  r
+
+in
+
+val a = fromList [1,11,21,31,41,51,61];
+val b = fromList [441,551,661];
+val c = fromList [1,11,21,31,41,51,61];
+
+val slice00 = slice(vec0, 0, NONE)
+val slice01 = slice(vec0, 0, SOME 0)
+val slice02 = slice(a, 0, SOME 0)
+val slice03 = slice(a, 7, NONE)
+val slice04 = slice(a, 7, SOME 0)
+val slice05 = slice(a, 4, SOME 0)
+
+val slicea07 = full a
+val slicea02 = slice(a, 0, SOME 2); 
+val slicea23 = slice(a, 2, SOME 3); 
+val slicea25 = slice(a, 2, SOME 5); 
+
+val slice06 = subslice(slicea23, 0, SOME 0)
+val slice07 = subslice(slicea23, 1, SOME 0)
+val slice08 = subslice(slicea23, 3, NONE)
+val slice09 = subslice(slicea23, 3, SOME 0)
+
+val slice0s = [slice00, slice01, slice02, slice03, slice04, slice05,
+	       slice06, slice07, slice08, slice09];
+
+val sliceas = [slicea07, slicea02, slicea23, slicea25];
+
+val test1a = 
+    check'(fn _ => List.all 
+	   (fn sli => vector sli = #[] 
+	    andalso length sli = 0
+	    andalso isEmpty sli
+	    andalso vector (subslice(sli, 0, NONE)) = #[]
+	    andalso vector (subslice(sli, 0, SOME 0)) = #[]
+	    andalso all (fn _ => false) sli
+	    andalso not (exists (fn _ => true) sli)
+	    andalso NONE = find (fn _ => true) sli
+	    andalso NONE = findi (fn _ => true) sli
+	    andalso not (Option.isSome (getItem sli))
+	    andalso (ArraySlice.copyVec{src=sli, dst=array0, di=0}; true)
+	    andalso (app (fn _ => raise Fail "1a app") sli; true)
+	    andalso (appi (fn _ => raise Fail "1a appi") sli; true)
+	    andalso foldl cons [1,2] sli = [1,2]
+	    andalso foldli consi [] sli = []
+	    andalso foldr cons [1,2] sli = [1,2]
+	    andalso foldri consi [] sli = []
+	    andalso collate Int.compare (sli, slice00) = EQUAL)
+	   slice0s);
+
+val test1b = 
+    check'(fn _ => 
+	   vector slicea02 = #[1, 11]
+	   andalso vector slicea23 = #[21,31,41]
+	   andalso vector slicea25 = #[21,31,41,51,61]
+	   andalso vector slicea07 = #[1,11,21,31,41,51,61]
+	   andalso base slicea02 = (a, 0, 2)
+	   andalso base slicea23 = (a, 2, 3)
+	   andalso base slicea25 = (a, 2, 5)
+	   andalso base slicea07 = (a, 0, 7)
+	   andalso length slicea02 = 2
+	   andalso length slicea23 = 3
+	   andalso length slicea25 = 5
+	   andalso length slicea07 = 7);
+
+val test2a = 
+    check'(fn _ => 
+	   slicea07 sub 0 = 1 
+	   andalso slicea07 sub 6 = 61 
+	   andalso slicea23 sub 0 = 21 
+	   andalso slicea23 sub 2 = 41);
+
+val test2b = 
+    (slicea07 sub ~1; "WRONG") handle Subscript => "OK" | _ => "WRONG";
+
+val test2c = 
+    (slicea07 sub 7; "WRONG") handle Subscript => "OK" | _ => "WRONG";
+
+val test2c = 
+    (slicea23 sub ~1; "WRONG") handle Subscript => "OK" | _ => "WRONG";
+
+val test2d = 
+    (slicea23 sub 3; "WRONG") handle Subscript => "OK" | _ => "WRONG";
+
+val test2e = 
+    check'(fn _ =>
+	   List.all (fn sli => ((sli sub 0; false) 
+				handle Subscript => true)) slice0s);
+
+val test3a = 
+    check'(fn _ => List.all (not o isEmpty) sliceas)
+
+val test4a =
+    check'(fn _ => vector (subslice(slicea23, 0, SOME 0)) = #[]
+	   andalso vector (subslice(slicea23, 0, NONE)) = #[21,31,41]
+	   andalso vector (subslice(slicea23, 0, SOME 1)) = #[21]
+	   andalso vector (subslice(slicea23, 0, SOME 2)) = #[21,31]
+	   andalso vector (subslice(slicea23, 1, SOME 2)) = #[31,41]
+	   andalso vector (subslice(slicea23, 3, SOME 0)) = #[]);
+
+val test4b =
+    (subslice(slicea23, 3, SOME 1); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4c =
+    (subslice(slicea23, ~1, NONE); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4d =
+    (subslice(slicea23, ~1, SOME 2); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4e =
+    (subslice(slicea23, 4, NONE); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4f =
+    (subslice(slicea23, 4, SOME ~2); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4g =
+    (subslice(slicea23, 2, SOME 2); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test5 = 
+    check'(fn _ => let val (i1, r1) = Option.valOf (getItem slicea23)
+		       val (i2, r2) = Option.valOf (getItem r1)
+		       val (i3, r3) = Option.valOf (getItem r2)
+		   in 
+		       i1 = 21 andalso i2 = 31 andalso i3 = 41 
+		       andalso not (Option.isSome (getItem r3))
+		   end);
+
+val sliced = full (tabulate(100, fn i => i mod 7 * 10 + 1));
+val sliceb = full b;
+
+val e = Array.array(203, 0);
+val _ = (ArraySlice.copyVec{src=sliced, dst=e, di=0}; 
+	 ArraySlice.copyVec{src=sliceb, dst=e, di=length sliced};
+	 ArraySlice.copyVec{src=sliced, dst=e, 
+			    di=length sliced + length sliceb});
+
+val ev = Vector.concat [vector sliced, vector sliceb, vector sliced]; 
+(* length e = 203 *)
+
+val slicee = full (Array.vector e)
+
+val test9a = 
+    check'(fn () => vector(subslice(slicee, 100, SOME 3)) = vector sliceb);
+val test9b = 
+    check'(fn () => 
+	   ev = vector (subslice(slicee, 0, SOME (length slicee)))
+	   andalso ev = vector (subslice(slicee, 0, NONE)));
+
+val _ = ArraySlice.copyVec{src=slicee, dst=e, di=0};
+val g = Array.array(203, 9999999);
+val _ = ArraySlice.copyVec{src=slicee, dst=g, di=0};
+
+val sliceg = full (Array.vector g);
+
+val test10a = 
+	   check'(fn () => ev = Array.vector e
+		  andalso ev = Array.vector g);
+
+val sliceg0 = slice(Array.vector g, 0, SOME (Array.length g - 1));
+val _ = ArraySlice.copyVec{src=sliceg0, dst=g, di=1};
+val test10b = 
+    check'(fn () => 
+	   vector sliceb = vector (slice(Array.vector g, 101, SOME 3)));
+
+val sliceg1 = slice(Array.vector g, 1, SOME (Array.length g - 1));
+val _ = ArraySlice.copyVec{src=sliceg1, dst=g, di=0};
+val test10c = 
+    check'(fn () => 
+	   vector sliceb = vector (slice(Array.vector g, 100, SOME 3)));
+
+val sliceg202 = slice(Array.vector g, 202, SOME 1);
+val _ = ArraySlice.copyVec{src=sliceg202, dst=g, di=202};
+val test10d = 
+    check'(fn () => Array.sub(g, 202) = 10 * (202-1-103) mod 7 + 1);
+
+val test11a = (ArraySlice.copyVec{src=sliceg, dst=g, di= ~1}; "WRONG") 
+              handle Subscript => "OK" | _ => "WRONG"
+val test11b = (ArraySlice.copyVec{src=sliceg1, dst=g, di=0}; "OK") 
+              handle _ => "WRONG"
+val test11c = (ArraySlice.copyVec{src=sliceg, dst=g, di=1}; "WRONG") 
+              handle Subscript => "OK" | _ => "WRONG"
+
+local 
+    val v = ref 0
+    fun setv c = v := c;
+    fun addv c = v := c + !v;
+    fun setvi (i, c) = v := c + i;
+    fun setvif (i, c, _) = v := c + i;
+    fun addvi (i, c) = v := c + i + !v;
+    fun cons (x,r) = x ::  r
+    fun consi (i,x,r) = (i,x) ::  r
+    val inplist = [1,2,3,4,7,9,13,4,5,6,8,0];
+    val inpa = Vector.fromList inplist
+    val inp = slice(inpa, 4, SOME 3)
+    val pnia = Vector.fromList (rev inplist)
+    val pni = slice(pnia, 5, SOME 3)
+in 
+
+val test12a =
+    check'(fn _ =>
+	           foldl cons [1,2] inp = [13,9,7,1,2]
+	   andalso (foldl (fn (x, _) => setv x) () inp; !v = 13));
+
+val test12b =
+    check'(fn _ =>
+	           foldr cons [1,2] inp = [7,9,13,1,2]
+	   andalso (foldr (fn (x, _) => setv x) () inp; !v = 7));
+
+val test12c =
+    check'(fn _ =>
+	   find (fn _ => false) inp = NONE
+	   andalso find (fn x => x=7) inp = SOME 7
+	   andalso find (fn x => x=9) inp = SOME 9
+	   andalso (setv 0; find (fn x => (addv x; x=9)) inp; !v = 7+9));
+
+val test12d = 
+    check'(fn _ =>
+           ((setv 0; app addv inp; !v = 7+9+13)
+	    andalso (app setv inp; !v = 13)));
+
+val test12f = 
+    check'(fn _ => 
+	   not (exists (fn i => i>13) inp)
+	   andalso exists (fn i => i>12) inp);
+val test12g = 
+    check'(fn _ => 
+	   (setv 117; exists (fn x => (setv x; false)) slice05; !v = 117)
+	   andalso (setv 0; exists (fn x => (addv x; false)) inp; !v = 7+9+13)
+	   andalso (exists (fn x => (setv x; false)) inp; !v = 13));
+val test12h = 
+    check'(fn _ => 
+	   not (all (fn i => i<13) inp)
+	   andalso all (fn i => i<14) inp);
+val test12i = 
+    check'(fn _ => 
+	   (setv 117; all (fn x => (setv x; true)) slice05; !v = 117)
+	   andalso (setv 0; all (fn x => (addv x; true)) inp; !v = 7+9+13)
+	   andalso (all (fn x => (setv x; true)) inp; !v = 13));
+
+
+val test13 =
+    check'(fn _ =>
+	   foldli consi [] inp = [(6,13),(5,9),(4,7)]
+	   andalso foldri consi [] inp = [(4,7),(5,9),(6,13)]
+	   andalso (setv 117; foldli setvif () inp; !v = 6+13)
+	   andalso (setv 117; foldri setvif () inp; !v = 4+7));
+
+val test14a =
+    check'(fn _ =>
+	   findi (fn _ => false) inp = NONE
+	   andalso findi (fn (i,x) => x=9) inp = SOME (5,9)
+	   andalso findi (fn (i,x) => i=6) inp = SOME (6,13));
+
+val test14b =
+    check'(fn _ =>	   
+	   List.all (fn sli => NONE=findi (fn (j, x) => j*10+1<>x) sli)
+	            sliceas)
+
+val test15 = 
+    check'(fn _ =>
+           ((setvi (0,0); appi addvi inp; !v = 4+7+5+9+6+13)
+	   andalso (appi setvi inp; !v = 6+13)));
+
+end
+
+val test17a = 
+    check'(fn _ =>
+	   let fun invcompare (c1, c2) = Char.compare (c2, c1) 
+	       fun coll s1 s2 = 
+		   collate invcompare (full (fromList (explode s1)), 
+				       full (fromList (explode s2)))
+	   in 
+	       coll "" "" = EQUAL
+	       andalso coll "" " " = LESS
+	       andalso coll " " "" = GREATER
+	       andalso coll "ABCD" "ABCD" = EQUAL
+	       andalso coll "ABCD" "ABCD " = LESS
+	       andalso coll "ABCD " "ABCD" = GREATER
+	       andalso coll "B" "ABCD" = LESS
+	       andalso coll "ABCD" "B" = GREATER
+	       andalso coll "CCCB" "CCCABCD" = LESS
+	       andalso coll "CCCABCD" "CCCB" = GREATER
+	       andalso coll "CCCB" "CCCA" = LESS
+	       andalso coll "CCCA" "CCCB" = GREATER
+	   end)
+
+val test17b = 
+    check'(fn _ =>
+  let val sa = fromList(explode "AAAAaAbAABBBB");
+                              (* 0123456789012 *)
+      fun invcompare (c1, c2) = Char.compare (c2, c1) 
+      fun coll s1 s2 = collate invcompare (s1, s2)
+  in 
+      coll (full sa) (slice(sa, 0, SOME 13)) = EQUAL
+      andalso coll (slice(sa, 0, SOME 0)) (slice(sa, 13, SOME 0)) = EQUAL
+      andalso coll (slice(sa, 0, SOME 0)) (slice(sa, 0, SOME 13)) = LESS
+      andalso coll (slice(sa, 0, SOME 13)) (slice(sa, 0, SOME 0)) = GREATER
+      andalso coll (slice(sa, 0, SOME 3)) (slice(sa, 1, SOME 3)) = EQUAL
+      andalso coll (slice(sa, 0, SOME 4)) (slice(sa, 1, SOME 4)) = GREATER
+      andalso coll (slice(sa, 1, SOME 4)) (slice(sa, 0, SOME 4)) = LESS
+  end)
+end
+
+
+
+
diff -Nru mosml-2.01/src/mosmllib/test/vector.sml mosml-2.10.1/src/mosmllib/test/vector.sml
--- mosml-2.01/src/mosmllib/test/vector.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/vector.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,5 +1,5 @@
 (* test/vector.sml -- some test cases for Vector 
-   PS 1994-12-10, 1995-06-14, 1997-03-07 *)
+   PS 1994-12-10, 1995-06-14, 1997-03-07, 2000-10-17 *)
 
 use "auxil.sml";
 
@@ -11,6 +11,7 @@
 val a = fromList [0,1,2,3,4,5,6];
 val b = fromList [44,55,66];
 val c = fromList [0,1,2,3,4,5,6];
+val vec0 = fromList [];
 
 val test1 = check'(fn _ => a<>b);
 val test2 = check'(fn _ => a=c);
@@ -39,28 +40,10 @@
 
 val test8 = check'(fn _ => length (concat []) = 0);
 
-val f = extract (e, 100, SOME 3);
+val f = VectorSlice.vector(VectorSlice.slice(e, 100, SOME 3));
 
 val test9 = check'(fn _ => f = b);
 
-val test9a = check'(fn _ => e = extract(e, 0, SOME (length e)) 
-		    andalso e = extract(e, 0, NONE));
-val test9b = check'(fn _ => fromList [] = extract(e, 100, SOME 0));
-val test9c = (extract(e, ~1, SOME (length e))  seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9d = (extract(e, length e + 1, SOME 0)  seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9e = (extract(e, 0, SOME (length e+1)) seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9f = (extract(e, 20, SOME ~1)        seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9g = (extract(e, ~1, NONE)  seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9h = (extract(e, length e + 1, NONE)  seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9i = check'(fn _ => fromList [] = extract(e, length e, SOME 0)
-		    andalso fromList [] = extract(e, length e, NONE));
-
 fun chkiter iter f vec reslast =
     check'(fn _ =>
 	   let val last = ref ~1
@@ -73,32 +56,96 @@
 	       val res = iter (fn (i, x) => (last := i; f x)) vec
 	   in (res, !last) = reslast end)
 
+fun chkfold fold f start vec reslast =
+    check'(fn _ =>
+	   let val last = ref ~1
+	       val res = fold (fn (x, r) => (last := x; f(x, r))) start vec
+	   in (res, !last) = reslast end)
+fun chkfoldi fold f start vec reslast =
+    check'(fn _ =>
+	   let val last = ref ~1
+	       val res = fold (fn (i, x, r) => (last := i; f(x, r))) start vec
+	   in (res, !last) = reslast end)
+
 val test10a = 
     chkiter map (fn x => 2*x) b (fromList [88,110,132], 66)
+val test10b = 
+    chkiter app (fn x => ignore(2*x)) b ((), 66)
+val test10c = 
+    chkiter find (fn x => false) b (NONE, 66)
+val test10d = 
+    chkiter exists (fn x => false) b (false, 66)
+val test10e = 
+    chkiter all (fn x => true) b (true, 66)
+val test10f = 
+    chkfold foldl (op +) 0 b (165, 66)
+val test10g = 
+    chkfold foldr (op +) 0 b (165, 44)
 
 val test11a = 
-    chkiteri mapi (fn x => 2*x) (b, 0, NONE) (fromList [88,110,132], 2)
+    chkiteri mapi (fn x => 2*x) b (fromList [88,110,132], 2)
 val test11b = 
-    chkiteri mapi (fn x => 2*x) (b, 1, NONE) (fromList [110,132], 2)
+    chkiteri appi (fn x => ignore(2*x)) b ((), 2)
 val test11c = 
-    chkiteri mapi (fn x => 2*x) (b, 1, SOME 0) (fromList [], ~1)
+    chkiteri findi (fn x => false) b (NONE, 2)
 val test11d = 
-    chkiteri mapi (fn x => 2*x) (b, 1, SOME 1) (fromList [110], 1)
+    chkfoldi foldli (op +) 0 b (165, 2)
 val test11e = 
-    chkiteri mapi (fn x => 2*x) (b, 3, NONE) (fromList [], ~1)
+    chkfoldi foldri (op +) 0 b (165, 0)
 
-val test11f =
-    (mapi #2 (b, 0, SOME 4) seq "WRONG") 
-    handle Subscript => "OK" | _ => "WRONG";
-val test11g =
-    (mapi #2 (b, 3, SOME 1) seq "WRONG") 
+val test12a = 
+    check'(fn _ => 
+	   a = update(a, 0, 0) 
+	   andalso a = update(a, 6, 6)
+	   andalso #[78,1,2,3,4,5,6] = update(a, 0, 78)
+	   andalso #[0,1,2,333,4,5,6] = update(a, 3, 333))
+val test12b =
+    (update(b, ~1, 17) seq "WRONG") 
     handle Subscript => "OK" | _ => "WRONG";
-val test11h =
-    (mapi #2 (b, 4, SOME 0) seq "WRONG") 
+val test12c =
+    (update(b, 7, 17) seq "WRONG") 
     handle Subscript => "OK" | _ => "WRONG";
-val test11i =
-    (mapi #2 (b, 4, NONE) seq "WRONG") 
+val test12d =
+    (update(#[], 0, 17) seq "WRONG") 
     handle Subscript => "OK" | _ => "WRONG";
-end;
 
+val test13 = 
+    check'(fn _ =>
+	   let fun invcompare (c1, c2) = Char.compare (c2, c1) 
+	       fun coll s1 s2 = 
+		   collate invcompare (fromList (explode s1), 
+				       fromList (explode s2))
+	   in 
+	       coll "" "" = EQUAL
+	       andalso coll "" " " = LESS
+	       andalso coll " " "" = GREATER
+	       andalso coll "ABCD" "ABCD" = EQUAL
+	       andalso coll "ABCD" "ABCD " = LESS
+	       andalso coll "ABCD " "ABCD" = GREATER
+	       andalso coll "B" "ABCD" = LESS
+	       andalso coll "ABCD" "B" = GREATER
+	       andalso coll "CCCB" "CCCABCD" = LESS
+	       andalso coll "CCCABCD" "CCCB" = GREATER
+	       andalso coll "CCCB" "CCCA" = LESS
+	       andalso coll "CCCA" "CCCB" = GREATER
+	   end)
+
+val test14 = 
+    check'(fn _ => 
+	   NONE = find (fn i => i>7) a
+	   andalso SOME 5 = find (fn i => i>4) a
+	   andalso NONE = find (fn _ => true) #[]);
+
+val test15 = 
+    check'(fn _ => 
+	   not (exists (fn i => i>7) a)
+	   andalso exists (fn i => i>4) a
+	   andalso not (exists (fn _ => true) #[]));
+
+val test16 = 
+    check'(fn _ => 
+	   not (all (fn i => i<6) a)
+	   andalso all (fn i => i<7) a
+	   andalso all (fn _ => false) #[]);
+end;
 
diff -Nru mosml-2.01/src/mosmllib/test/word8arrayslice.sml mosml-2.10.1/src/mosmllib/test/word8arrayslice.sml
--- mosml-2.01/src/mosmllib/test/word8arrayslice.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/word8arrayslice.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,358 @@
+(* test/word8arrayslice.sml -- some test cases for Word8ArraySlice 
+   sestoft@dina.kvl.dk 2000-10-25 *)
+
+use "auxil.sml";
+
+local 
+    open Word8Array Word8ArraySlice 
+    infix 9 sub
+    val array0 = fromList []
+    fun cons (x,r) = x ::  r
+    fun consi (i,x,r) = (i,x) ::  r
+    val i2w = Word8.fromInt;
+    fun l2a xs = Word8Array.fromList (List.map i2w xs)
+    fun l2v xs = Word8Vector.fromList (List.map i2w xs)
+    fun cl2a xs = Word8Array.fromList (List.map (i2w o Char.ord) xs)
+in
+
+val a = l2a [1,11,21,31,41,51,61];
+val b = l2a [44,55,66];
+val c = l2a [1,11,21,31,41,51,61];
+
+val slice00 = slice(array0, 0, NONE)
+val slice01 = slice(array0, 0, SOME 0)
+val slice02 = slice(a, 0, SOME 0)
+val slice03 = slice(a, 7, NONE)
+val slice04 = slice(a, 7, SOME 0)
+val slice05 = slice(a, 4, SOME 0)
+
+val slicea07 = full a
+val slicea02 = slice(a, 0, SOME 2); 
+val slicea23 = slice(a, 2, SOME 3); 
+val slicea25 = slice(a, 2, SOME 5); 
+
+val slice06 = subslice(slicea23, 0, SOME 0)
+val slice07 = subslice(slicea23, 1, SOME 0)
+val slice08 = subslice(slicea23, 3, NONE)
+val slice09 = subslice(slicea23, 3, SOME 0)
+
+val slice0s = [slice00, slice01, slice02, slice03, slice04, slice05,
+	       slice06, slice07, slice08, slice09];
+
+val sliceas = [slicea07, slicea02, slicea23, slicea25];
+
+val test1a = 
+    check'(fn _ => List.all 
+	   (fn sli => vector sli = l2v [] 
+	    andalso length sli = 0
+	    andalso isEmpty sli
+	    andalso vector (subslice(sli, 0, NONE)) = l2v []
+	    andalso vector (subslice(sli, 0, SOME 0)) = l2v []
+	    andalso all (fn _ => false) sli
+	    andalso not (exists (fn _ => true) sli)
+	    andalso NONE = find (fn _ => true) sli
+	    andalso NONE = findi (fn _ => true) sli
+	    andalso not (Option.isSome (getItem sli))
+	    andalso (copy{src=sli, dst=array0, di=0}; true)
+	    andalso (app (fn _ => raise Fail "1a app") sli; true)
+	    andalso (appi (fn _ => raise Fail "1a appi") sli; true)
+	    andalso foldl cons [0w1,0w2] sli = [0w1,0w2]
+	    andalso foldli consi [] sli = []
+	    andalso foldr cons [0w1,0w2] sli = [0w1,0w2]
+	    andalso foldri consi [] sli = []
+	    andalso (modify Word8.~ sli; vector sli = l2v [])
+	    andalso (modifyi (fn (_, x) => Word8.~ x) sli; vector sli = l2v [])
+	    andalso collate Word8.compare (sli, slice00) = EQUAL)
+	   slice0s);
+
+val test1b = 
+    check'(fn _ => 
+	   vector slicea02 = l2v[1, 11]
+	   andalso vector slicea23 = l2v[21,31,41]
+	   andalso vector slicea25 = l2v[21,31,41,51,61]
+	   andalso vector slicea07 = l2v[1,11,21,31,41,51,61]
+	   andalso base slicea02 = (a, 0, 2)
+	   andalso base slicea23 = (a, 2, 3)
+	   andalso base slicea25 = (a, 2, 5)
+	   andalso base slicea07 = (a, 0, 7)
+	   andalso length slicea02 = 2
+	   andalso length slicea23 = 3
+	   andalso length slicea25 = 5
+	   andalso length slicea07 = 7);
+
+val test2a = 
+    check'(fn _ => 
+	   slicea07 sub 0 = 0w1 
+	   andalso slicea07 sub 6 = 0w61 
+	   andalso slicea23 sub 0 = 0w21 
+	   andalso slicea23 sub 2 = 0w41);
+
+val test2b = 
+    (slicea07 sub ~1; "WRONG") handle Subscript => "OK" | _ => "WRONG";
+
+val test2c = 
+    (slicea07 sub 7; "WRONG") handle Subscript => "OK" | _ => "WRONG";
+
+val test2c = 
+    (slicea23 sub ~1; "WRONG") handle Subscript => "OK" | _ => "WRONG";
+
+val test2d = 
+    (slicea23 sub 3; "WRONG") handle Subscript => "OK" | _ => "WRONG";
+
+val test2e = 
+    check'(fn _ =>
+	   List.all (fn sli => ((sli sub 0; false) 
+				handle Subscript => true)) slice0s);
+
+val test3a = 
+    check'(fn _ => List.all (not o isEmpty) sliceas)
+
+val test4a =
+    check'(fn _ => vector (subslice(slicea23, 0, SOME 0)) = l2v[]
+	   andalso vector (subslice(slicea23, 0, NONE)) = l2v[21,31,41]
+	   andalso vector (subslice(slicea23, 0, SOME 1)) = l2v[21]
+	   andalso vector (subslice(slicea23, 0, SOME 2)) = l2v[21,31]
+	   andalso vector (subslice(slicea23, 1, SOME 2)) = l2v[31,41]
+	   andalso vector (subslice(slicea23, 3, SOME 0)) = l2v[]);
+
+val test4b =
+    (subslice(slicea23, 3, SOME 1); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4c =
+    (subslice(slicea23, ~1, NONE); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4d =
+    (subslice(slicea23, ~1, SOME 2); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4e =
+    (subslice(slicea23, 4, NONE); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4f =
+    (subslice(slicea23, 4, SOME ~2); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4g =
+    (subslice(slicea23, 2, SOME 2); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test5 = 
+    check'(fn _ => let val (i1, r1) = Option.valOf (getItem slicea23)
+		       val (i2, r2) = Option.valOf (getItem r1)
+		       val (i3, r3) = Option.valOf (getItem r2)
+		   in 
+		       i1 = 0w21 andalso i2 = 0w31 andalso i3 = 0w41 
+		       andalso not (Option.isSome (getItem r3))
+		   end);
+
+val test6a = (update(slicea23, ~1, 0w99) seq "WRONG")
+             handle Subscript => "OK" | _ => "WRONG";
+val test6b = (update(slicea23, 3, 0w99) seq "WRONG")
+             handle Subscript => "OK" | _ => "WRONG";
+
+val test6c = 
+    check'(fn _ => 
+	   (update(slicea23, 0, 0w99); Word8Array.sub(a, 2) = 0w99)
+	   andalso (update(slicea23, 2, 0w199); Word8Array.sub(a, 4) = 0w199)
+	   andalso (update(slicea23, 0, 0w21);  Word8Array.sub(a, 2) = 0w21)
+	   andalso (update(slicea23, 2, 0w41);  Word8Array.sub(a, 4) = 0w41));
+
+val sliced = full (tabulate(100, fn i => i2w(i mod 7 * 10 + 1)));
+val sliceb = full b;
+
+val e = array(203, 0w0);
+val _ = (copy{src=sliced, dst=e, di=0}; 
+	 copy{src=sliceb, dst=e, di=length sliced};
+	 copy{src=sliced, dst=e, di=length sliced + length sliceb});
+
+val ev = Word8Vector.concat [vector sliced, vector sliceb, vector sliced]; 
+(* length e = 203 *)
+
+val slicee = full e
+
+val test9a = 
+    check'(fn () => vector(subslice(slicee, 100, SOME 3)) = vector sliceb);
+val test9b = 
+    check'(fn () => 
+	   ev = vector (subslice(slicee, 0, SOME (length slicee)))
+	   andalso ev = vector (subslice(slicee, 0, NONE)));
+
+val _ = copy{src=slicee, dst=e, di=0};
+val g = array(203, 0w99);
+val _ = copy{src=slicee, dst=g, di=0};
+
+val sliceg = full g;
+
+val test10a = 
+	   check'(fn () => ev = Word8Array.vector e
+		  andalso ev = Word8Array.vector g);
+
+val sliceg0 = slice(g, 0, SOME (Word8Array.length g - 1));
+val _ = copy{src=sliceg0, dst=g, di=1};
+val test10b = check'(fn () => vector sliceb = vector (slice(g, 101, SOME 3)));
+
+val sliceg1 = slice(g, 1, SOME (Word8Array.length g - 1));
+val _ = copy{src=sliceg1, dst=g, di=0};
+val test10c = check'(fn () => vector sliceb = vector (slice(g, 100, SOME 3)));
+
+val sliceg202 = slice(g, 202, SOME 1);
+val _ = copy{src=sliceg202, dst=g, di=202};
+val test10d = 
+    check'(fn () => sliceg sub 202 = i2w(10 * (202-1-103) mod 7 + 1));
+
+val test11a = (copy{src=sliceg, dst=g, di= ~1}; "WRONG") 
+              handle Subscript => "OK" | _ => "WRONG"
+val test11b = (copy{src=sliceg1, dst=g, di=0}; "OK") 
+              handle _ => "WRONG"
+val test11c = (copy{src=sliceg, dst=g, di=1}; "WRONG") 
+              handle Subscript => "OK" | _ => "WRONG"
+
+local 
+    val v = ref 0w0
+    fun setv c = v := c;
+    fun addv c = v := c + !v;
+    fun setvi (i, c) = v := c + i2w i;
+    fun setvif (i, c, _) = v := c + i2w i;
+    fun addvi (i, c) = v := c + i2w i + !v;
+    fun cons (x,r) = x ::  r
+    fun consi (i,x,r) = (i,x) ::  r
+    val inplist = [1,2,3,4,7,9,13,4,5,6,8,0];
+    val inpa = l2a inplist
+    val inp = slice(inpa, 4, SOME 3)
+    val pnia = l2a (rev inplist)
+    val pni = slice(pnia, 5, SOME 3)
+    fun resetinp () = copy{src=full(l2a inplist), dst=inpa, di=0}
+in 
+
+val test12a =
+    check'(fn _ =>
+	           foldl cons [0w1,0w2] inp = [0w13,0w9,0w7,0w1,0w2]
+	   andalso (foldl (fn (x, _) => setv x) () inp; !v = 0w13));
+
+val test12b =
+    check'(fn _ =>
+	           foldr cons [0w1,0w2] inp = [0w7,0w9,0w13,0w1,0w2]
+	   andalso (foldr (fn (x, _) => setv x) () inp; !v = 0w7));
+
+val test12c =
+    check'(fn _ =>
+	   find (fn _ => false) inp = NONE
+	   andalso find (fn x => x=0w7) inp = SOME 0w7
+	   andalso find (fn x => x=0w9) inp = SOME 0w9
+	   andalso (setv 0w0; find (fn x => (addv x; x=0w9)) inp; !v = 0w7+0w9));
+
+val test12d = 
+    check'(fn _ =>
+           ((setv 0w0; app addv inp; !v = 0w7+0w9+0w13)
+	    andalso (app setv inp; !v = 0w13)));
+
+val test12e = 
+    check'(fn _ =>
+	   (resetinp(); modify Word8.~ inp; 
+	    foldr (op::) [] inp = [Word8.~ 0w7, Word8.~ 0w9, Word8.~ 0w13])
+	   andalso (resetinp(); setv 0w117; 
+		    modify (fn x => (setv x; 0w37)) inp; !v = 0w13))
+
+val _ = resetinp(); 
+
+val test12f = 
+    check'(fn _ => 
+	   not (exists (fn i => i>0w13) inp)
+	   andalso exists (fn i => i>0w12) inp);
+val test12g = 
+    check'(fn _ => 
+	   (setv 0w117; exists (fn x => (setv x; false)) slice05; !v = 0w117)
+	   andalso (setv 0w0; exists (fn x => (addv x; false)) inp; 
+		    !v = 0w7+0w9+0w13)
+	   andalso (exists (fn x => (setv x; false)) inp; !v = 0w13));
+val test12h = 
+    check'(fn _ => 
+	   not (all (fn i => i<0w13) inp)
+	   andalso all (fn i => i<0w14) inp);
+val test12i = 
+    check'(fn _ => 
+	   (setv 0w117; all (fn x => (setv x; true)) slice05; !v = 0w117)
+	   andalso (setv 0w0; all (fn x => (addv x; true)) inp; 
+		    !v = 0w7+0w9+0w13)
+	   andalso (all (fn x => (setv x; true)) inp; !v = 0w13));
+
+val _ = resetinp();
+
+val test13 =
+    check'(fn _ =>
+	   foldli consi [] inp = [(6,0w13),(5,0w9),(4,0w7)]
+	   andalso foldri consi [] inp = [(4,0w7),(5,0w9),(6,0w13)]
+	   andalso (resetinp(); setv 0w117; 
+		    foldli setvif () inp; !v = 0w6+0w13)
+	   andalso (resetinp(); setv 0w117; 
+		    foldri setvif () inp; !v = 0w4+0w7));
+
+val _ = resetinp();
+
+val test14a =
+    check'(fn _ =>
+	   findi (fn _ => false) inp = NONE
+	   andalso findi (fn (i,x) => x=0w9) inp = SOME (5,0w9)
+	   andalso findi (fn (i,x) => i=6) inp = SOME (6,0w13));
+
+val test14b =
+    check'(fn _ =>	   
+	   List.all (fn sli => NONE=findi (fn (j, x) => i2w(j*10+1)<>x) sli)
+	            sliceas)
+
+val test15 = 
+    check'(fn _ =>
+           ((setvi (0,0w0); appi addvi inp; !v = 0w4+0w7+0w5+0w9+0w6+0w13)
+	   andalso (appi setvi inp; !v = 0w6+0w13)));
+
+val test16 = 
+    check'(fn _ =>
+	   let fun iwsub (i, w) = i2w i - w
+	   in 
+	       (resetinp(); modifyi iwsub inp; 
+		vector inp = l2v[~3,~4,~7])
+	       andalso (resetinp(); setv 0w117; 
+			modifyi (fn x => (setvi x; 0w37)) inp; !v = 0w6+0w13)
+	   end);
+end
+
+val test17a = 
+    check'(fn _ =>
+	   let fun invcompare (c1, c2) = Word8.compare (c2, c1) 
+	       fun coll s1 s2 = 
+		   collate invcompare (full (cl2a (explode s1)),
+				       full (cl2a (explode s2)))
+	   in 
+	       coll "" "" = EQUAL
+	       andalso coll "" " " = LESS
+	       andalso coll " " "" = GREATER
+	       andalso coll "ABCD" "ABCD" = EQUAL
+	       andalso coll "ABCD" "ABCD " = LESS
+	       andalso coll "ABCD " "ABCD" = GREATER
+	       andalso coll "B" "ABCD" = LESS
+	       andalso coll "ABCD" "B" = GREATER
+	       andalso coll "CCCB" "CCCABCD" = LESS
+	       andalso coll "CCCABCD" "CCCB" = GREATER
+	       andalso coll "CCCB" "CCCA" = LESS
+	       andalso coll "CCCA" "CCCB" = GREATER
+	   end)
+
+val test17b = 
+    check'(fn _ =>
+  let val sa = cl2a (explode "AAAAaAbAABBBB");
+                           (* 0123456789012 *)
+      fun invcompare (c1, c2) = Word8.compare (c2, c1) 
+      fun coll s1 s2 = collate invcompare (s1, s2)
+  in 
+      coll (full sa) (slice(sa, 0, SOME 13)) = EQUAL
+      andalso coll (slice(sa, 0, SOME 0)) (slice(sa, 13, SOME 0)) = EQUAL
+      andalso coll (slice(sa, 0, SOME 0)) (slice(sa, 0, SOME 13)) = LESS
+      andalso coll (slice(sa, 0, SOME 13)) (slice(sa, 0, SOME 0)) = GREATER
+      andalso coll (slice(sa, 0, SOME 3)) (slice(sa, 1, SOME 3)) = EQUAL
+      andalso coll (slice(sa, 0, SOME 4)) (slice(sa, 1, SOME 4)) = GREATER
+      andalso coll (slice(sa, 1, SOME 4)) (slice(sa, 0, SOME 4)) = LESS
+  end)
+end
diff -Nru mosml-2.01/src/mosmllib/test/word8array.sml mosml-2.10.1/src/mosmllib/test/word8array.sml
--- mosml-2.01/src/mosmllib/test/word8array.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/word8array.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,5 +1,5 @@
 (* test/word8array.sml -- some test cases for Word8Array 
-   PS 1994-12-21, 1995-05-11 *)
+   PS 1994-12-21, 1995-05-11, 2000-10-24 *)
 
 use "auxil.sml";
 
@@ -49,11 +49,11 @@
 val test6c = check'(fn () => c sub 0 = i2w 0);
 
 val e = array(203, i2w 0);
-val _ = (copy{src=d, si=0, dst=e, di=0,        len=NONE}; 
-	 copy{src=b, si=0, dst=e, di=length d, len=NONE};
-	 copy{src=d, si=0, dst=e, di=length d + length b, len=NONE});
+val _ = (copy{src=d, dst=e, di=0}; 
+	 copy{src=b, dst=e, di=length d};
+	 copy{src=d, dst=e, di=length d + length b});
 	 
-fun a2v a = extract(a, 0, NONE);
+fun a2v a = vector a;
 val ev = Word8Vector.concat [a2v d, a2v b, a2v d];
 
 val test7 = check'(fn () => length e = 203);
@@ -63,82 +63,82 @@
 val test8b = (update(e, length e, w127); "WRONG")
              handle Subscript => "OK" | _ => "WRONG";
 
-val f = extract (e, 100, SOME 3);
+val f = Word8ArraySlice.vector(Word8ArraySlice.slice(e, 100, SOME 3));
 
 val test9 = check'(fn () => f = a2v b);
 
-val test9a = check'(fn () => ev = extract(e, 0, NONE)
-		    andalso ev = extract(e, 0, SOME (length e)));
+val test9a = 
+    check'(fn () => ev = vector e);
 val test9b = 
-    check'(fn () => Word8Vector.fromList [] = extract(e, 100, SOME 0));
-val test9c = (extract(e, ~1, SOME (length e))  seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9d = (extract(e, length e+1, SOME 0) seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9e = (extract(e, 0, SOME (length e+1)) seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9f = (extract(e, 20, SOME ~1)        seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9g = (extract(e, ~1, NONE)  seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9h = (extract(e, length e+1, NONE) seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9i = 
-    check'(fn () => a2v (fromList []) = extract(e, length e, SOME 0)
-	   andalso a2v (fromList []) = extract(e, length e, NONE));
+    check'(fn () => Word8Vector.fromList [] = vector array0);
 
-val _ = copy{src=e, si=0, dst=e, di=0, len=NONE};
-val g = array(203, w127);
-val _ = copy{src=e, si=0, dst=g, di=0, len=NONE};
-
-val test10a = check'(fn () => ev = extract(e, 0, NONE)
-		      andalso ev = extract(e, 0, SOME (length e)));
-val test10b = check'(fn () => ev = extract(g, 0, NONE)
-		     andalso ev = extract(g, 0, SOME (length g)));
-
-val _ = copy{src=g, si=203, dst=g, di=0, len=SOME 0};
-val test10c = check'(fn () => ev = extract(g, 0, NONE));
-
-val _ = copy{src=g, si=0, dst=g, di=203, len=SOME 0};
-val test10d = check'(fn () => ev = extract(g, 0, NONE));
-
-val _ = copy{src=g, si=0, dst=g, di=1, len=SOME (length g-1)};
-val test10e = check'(fn () => a2v b = extract(g, 101, SOME 3));
-
-val _ = copy{src=g, si=1, dst=g, di=0, len=SOME(length g-1)};
-val test10f = check'(fn () => a2v b = extract(g, 100, SOME 3));
-
-val _ = copy{src=g, si=202, dst=g, di=202, len=SOME 1};
-val test10g = check'(fn () => g sub 202 = i2w ((202-1-103) mod 7));
-val test10h = check'(fn () =>
-		     (copy{src=array0, si=0, dst=array0, di=0, len=NONE}; 
-		      array0 <> array(0, w127)));
-val test10i = check'(fn () =>
-		     (copy{src=array0, si=0, dst=array0, di=0, len=SOME 0}; 
-		      array0 <> array(0, w127)));
 
-val test11a = (copy{src=g, si= ~1, dst=g, di=0, len=NONE}; "WRONG") 
-              handle Subscript => "OK" | _ => "WRONG"
-val test11b = (copy{src=g, si=0, dst=g, di= ~1, len=NONE}; "WRONG") 
-              handle Subscript => "OK" | _ => "WRONG"
-val test11c = (copy{src=g, si=1, dst=g, di=0, len=NONE}; "OK") 
-              handle _ => "WRONG"
-val test11d = (copy{src=g, si=0, dst=g, di=1, len=NONE}; "WRONG") 
-              handle Subscript => "OK" | _ => "WRONG"
-val test11e = (copy{src=g, si=203, dst=g, di=0, len=NONE}; "OK") 
-              handle _ => "WRONG"
+val _ = copy{src=e, dst=e, di=0};
+val g = array(203, w127);
+val _ = copy{src=e, dst=g, di=0};
 
-val test11f = (copy{src=g, si= ~1, dst=g, di=0, len=SOME (length g)}; "WRONG") 
-              handle Subscript => "OK" | _ => "WRONG"
-val test11g = (copy{src=g, si=0, dst=g, di= ~1, len=SOME (length g)}; "WRONG") 
-              handle Subscript => "OK" | _ => "WRONG"
-val test11h = (copy{src=g, si=1, dst=g, di=0, len=SOME (length g)}; "WRONG") 
-              handle Subscript => "OK" | _ => "WRONG"
-val test11i = (copy{src=g, si=0, dst=g, di=1, len=SOME (length g)}; "WRONG") 
-              handle Subscript => "OK" | _ => "WRONG"
-val test11j = (copy{src=g, si=0, dst=g, di=0, len=SOME (length g+1)}; "WRONG") 
-              handle Subscript => "OK" | _ => "WRONG"
-val test11k = (copy{src=g, si=203, dst=g, di=0, len=SOME 1}; "WRONG") 
-              handle Subscript => "OK" | _ => "WRONG"
+val test10a = check'(fn () => ev = vector g);
 
+val test10b = 
+    check'(fn () => (copy{src=array0, dst=array0, di=0}; 
+		     array0 <> array(0, 0w99)));
+val test10c = 
+    check'(fn () => (copy{src=array0, dst=g, di=0}; 
+		     ev = vector g));
+val test10d = 
+    check'(fn () => (copy{src=array0, dst=g, di=203}; 
+		     ev = vector g));
+val test10e = 
+    check'(fn () => (copy{src=array0, dst=g, di=1}; 
+		     ev = vector g));
+
+val test11a = (copy{src=g, dst=g, di=1}; "WRONG") 
+              handle Subscript => "OK" | _ => "WRONG"
+val test11b = (copy{src=g, dst=g, di= 202}; "WRONG") 
+              handle Subscript => "OK" | _ => "WRONG"
+val test11c = (copy{src=b, dst=g, di = ~1}; "WRONG") 
+              handle Subscript => "OK" | _ => "WRONG"
+val test11d = (copy{src=b, dst=g, di=203}; "WRONG") 
+              handle Subscript => "OK" | _ => "WRONG"
+val test11e = check'(fn () => ev = vector g);
+
+val test12 = 
+    check'(fn _ =>
+	   let fun invcompare (c1, c2) = Word8.compare(c2, c1)
+	       val fromString = 
+		   fromList o List.map (Word8.fromInt o ord) o explode 
+	       fun coll s1 s2 = 
+		   collate invcompare (fromString s1, fromString s2)
+	   in 
+	       coll "" "" = EQUAL
+	       andalso coll "" " " = LESS
+	       andalso coll " " "" = GREATER
+	       andalso coll "ABCD" "ABCD" = EQUAL
+	       andalso coll "ABCD" "ABCD " = LESS
+	       andalso coll "ABCD " "ABCD" = GREATER
+	       andalso coll "B" "ABCD" = LESS
+	       andalso coll "ABCD" "B" = GREATER
+	       andalso coll "CCCB" "CCCABCD" = LESS
+	       andalso coll "CCCABCD" "CCCB" = GREATER
+	       andalso coll "CCCB" "CCCA" = LESS
+	       andalso coll "CCCA" "CCCB" = GREATER
+	   end)
+
+val test13 = 
+    check'(fn _ => 
+	   NONE = find (fn i => i > 0w7) a
+	   andalso SOME 0w5 = find (fn i => i > 0w4) a
+	   andalso NONE = find (fn _ => true) (fromList []));
+
+val test14 = 
+    check'(fn _ => 
+	   not (exists (fn i => i > 0w7) a)
+	   andalso exists (fn i => i > 0w4) a
+	   andalso not (exists (fn _ => true) (fromList [])));
+
+val test15 = 
+    check'(fn _ => 
+	   not (all (fn i => i < 0w6) a)
+	   andalso all (fn i => i < 0w7) a
+	   andalso all (fn _ => false) (fromList []));
 end;
diff -Nru mosml-2.01/src/mosmllib/test/word8.sml mosml-2.10.1/src/mosmllib/test/word8.sml
--- mosml-2.01/src/mosmllib/test/word8.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/word8.sml	2014-08-28 08:47:22.000000000 +0000
@@ -66,6 +66,14 @@
     (fn i => let val r = w2i (notb (i2w i)) 
 	     in 0 <= r andalso r < 256 end);
 
+val test8d = check (0 = w2i (~ (i2w 0)));
+val test8e = check (1 = w2i (~ (i2w ~1)));
+val test8f = check (2 = w2i (~ (i2w ~2))); 
+val test8g = check (127 = w2i (~ (i2w ~127))); 
+val test8h = checkrange (~1000,1000)
+    (fn i => let val r = w2i (~ (i2w i)) 
+	     in 0 <= r andalso r < 256 end);
+
 val test9a = checkrange (0,7)
     (fn k => pwr2 k = w2i (<< (i2w 1, i2W k)));
 val test9b = checkrange (8,70)
diff -Nru mosml-2.01/src/mosmllib/test/word8vectorslice.sml mosml-2.10.1/src/mosmllib/test/word8vectorslice.sml
--- mosml-2.01/src/mosmllib/test/word8vectorslice.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/word8vectorslice.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,329 @@
+(* test/word8vectorslice.sml -- some test cases for Word8VectorSlice 
+   sestoft@dina.kvl.dk 2000-10-24 *)
+
+use "auxil.sml";
+
+local 
+    open Word8Vector;
+    open Word8VectorSlice;
+    infix 9 sub
+    val array0 = Word8Array.fromList []
+    val vec0 = fromList []
+    fun cons (x,r) = x ::  r
+    fun consi (i,x,r) = (i,x) ::  r
+    val i2w = Word8.fromInt;
+    fun l2v xs = Word8Vector.fromList (List.map i2w xs)
+in
+
+val a = l2v [1,11,21,31,41,51,61];
+val b = l2v [44,55,66];
+val c = l2v [1,11,21,31,41,51,61];
+
+val slice00 = slice(vec0, 0, NONE)
+val slice01 = slice(vec0, 0, SOME 0)
+val slice02 = slice(a, 0, SOME 0)
+val slice03 = slice(a, 7, NONE)
+val slice04 = slice(a, 7, SOME 0)
+val slice05 = slice(a, 4, SOME 0)
+
+val slicea07 = full a
+val slicea02 = slice(a, 0, SOME 2); 
+val slicea23 = slice(a, 2, SOME 3); 
+val slicea25 = slice(a, 2, SOME 5); 
+
+val slice06 = subslice(slicea23, 0, SOME 0)
+val slice07 = subslice(slicea23, 1, SOME 0)
+val slice08 = subslice(slicea23, 3, NONE)
+val slice09 = subslice(slicea23, 3, SOME 0)
+
+val slice0s = [slice00, slice01, slice02, slice03, slice04, slice05,
+	       slice06, slice07, slice08, slice09];
+
+val sliceas = [slicea07, slicea02, slicea23, slicea25];
+
+val test1a = 
+    check'(fn _ => List.all 
+	   (fn sli => vector sli = fromList [] 
+	    andalso length sli = 0
+	    andalso isEmpty sli
+	    andalso vector (subslice(sli, 0, NONE)) = fromList [] 
+	    andalso vector (subslice(sli, 0, SOME 0)) = fromList [] 
+	    andalso all (fn _ => false) sli
+	    andalso not (exists (fn _ => true) sli)
+	    andalso NONE = find (fn _ => true) sli
+	    andalso NONE = findi (fn _ => true) sli
+	    andalso not (Option.isSome (getItem sli))
+	    andalso (Word8ArraySlice.copyVec{src=sli, dst=array0, di=0}; true)
+	    andalso (app (fn _ => raise Fail "1a app") sli; true)
+	    andalso (appi (fn _ => raise Fail "1a appi") sli; true)
+	    andalso foldl cons [0w1,0w2] sli = [0w1,0w2]
+	    andalso foldli consi [] sli = []
+	    andalso foldr cons [0w1,0w2] sli = [0w1,0w2]
+	    andalso foldri consi [] sli = []
+	    andalso collate Word8.compare (sli, slice00) = EQUAL)
+	   slice0s);
+
+val test1b = 
+    check'(fn _ => 
+	   vector slicea02 = l2v [1, 11]
+	   andalso vector slicea23 = l2v [21,31,41]
+	   andalso vector slicea25 = l2v [21,31,41,51,61]
+	   andalso vector slicea07 = l2v [1,11,21,31,41,51,61]
+	   andalso base slicea02 = (a, 0, 2)
+	   andalso base slicea23 = (a, 2, 3)
+	   andalso base slicea25 = (a, 2, 5)
+	   andalso base slicea07 = (a, 0, 7)
+	   andalso length slicea02 = 2
+	   andalso length slicea23 = 3
+	   andalso length slicea25 = 5
+	   andalso length slicea07 = 7);
+
+val test2a = 
+    check'(fn _ => 
+	   slicea07 sub 0 = 0w1 
+	   andalso slicea07 sub 6 = 0w61 
+	   andalso slicea23 sub 0 = 0w21 
+	   andalso slicea23 sub 2 = 0w41);
+
+val test2b = 
+    (slicea07 sub ~1; "WRONG") handle Subscript => "OK" | _ => "WRONG";
+
+val test2c = 
+    (slicea07 sub 7; "WRONG") handle Subscript => "OK" | _ => "WRONG";
+
+val test2c = 
+    (slicea23 sub ~1; "WRONG") handle Subscript => "OK" | _ => "WRONG";
+
+val test2d = 
+    (slicea23 sub 3; "WRONG") handle Subscript => "OK" | _ => "WRONG";
+
+val test2e = 
+    check'(fn _ =>
+	   List.all (fn sli => ((sli sub 0; false) 
+				handle Subscript => true)) slice0s);
+
+val test3a = 
+    check'(fn _ => List.all (not o isEmpty) sliceas)
+
+val test4a =
+    check'(fn _ => vector (subslice(slicea23, 0, SOME 0)) = l2v []
+	   andalso vector (subslice(slicea23, 0, NONE))   = l2v [21,31,41]
+	   andalso vector (subslice(slicea23, 0, SOME 1)) = l2v [21]
+	   andalso vector (subslice(slicea23, 0, SOME 2)) = l2v [21,31]
+	   andalso vector (subslice(slicea23, 1, SOME 2)) = l2v [31,41]
+	   andalso vector (subslice(slicea23, 3, SOME 0)) = l2v []);
+
+val test4b =
+    (subslice(slicea23, 3, SOME 1); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4c =
+    (subslice(slicea23, ~1, NONE); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4d =
+    (subslice(slicea23, ~1, SOME 2); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4e =
+    (subslice(slicea23, 4, NONE); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4f =
+    (subslice(slicea23, 4, SOME ~2); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test4g =
+    (subslice(slicea23, 2, SOME 2); "WRONG") 
+    handle Subscript => "OK" | _ => "WRONG";    
+
+val test5 = 
+    check'(fn _ => let val (i1, r1) = Option.valOf (getItem slicea23)
+		       val (i2, r2) = Option.valOf (getItem r1)
+		       val (i3, r3) = Option.valOf (getItem r2)
+		   in 
+		       i1 = 0w21 andalso i2 = 0w31 andalso i3 = 0w41 
+		       andalso not (Option.isSome (getItem r3))
+		   end);
+
+val sliced = full (tabulate(100, fn i => i2w (i mod 7 * 10 + 1)));
+val sliceb = full b;
+
+val e = Word8Array.array(203, 0w0);
+val _ = (Word8ArraySlice.copyVec{src=sliced, dst=e, di=0}; 
+	 Word8ArraySlice.copyVec{src=sliceb, dst=e, di=length sliced};
+	 Word8ArraySlice.copyVec{src=sliced, dst=e, 
+			    di=length sliced + length sliceb});
+
+val ev = Word8Vector.concat [vector sliced, vector sliceb, vector sliced]; 
+(* length e = 203 *)
+
+val slicee = full (Word8Array.vector e)
+
+val test9a = 
+    check'(fn () => vector(subslice(slicee, 100, SOME 3)) = vector sliceb);
+val test9b = 
+    check'(fn () => 
+	   ev = vector (subslice(slicee, 0, SOME (length slicee)))
+	   andalso ev = vector (subslice(slicee, 0, NONE)));
+
+val _ = Word8ArraySlice.copyVec{src=slicee, dst=e, di=0};
+val g = Word8Array.array(203, 0w99);
+val _ = Word8ArraySlice.copyVec{src=slicee, dst=g, di=0};
+
+val sliceg = full (Word8Array.vector g);
+
+val test10a = 
+	   check'(fn () => ev = Word8Array.vector e
+		  andalso ev = Word8Array.vector g);
+
+val sliceg0 = slice(Word8Array.vector g, 0, SOME (Word8Array.length g - 1));
+val _ = Word8ArraySlice.copyVec{src=sliceg0, dst=g, di=1};
+val test10b = 
+    check'(fn () => 
+	   vector sliceb = vector (slice(Word8Array.vector g, 101, SOME 3)));
+
+val sliceg1 = slice(Word8Array.vector g, 1, SOME (Word8Array.length g - 1));
+val _ = Word8ArraySlice.copyVec{src=sliceg1, dst=g, di=0};
+val test10c = 
+    check'(fn () => 
+	   vector sliceb = vector (slice(Word8Array.vector g, 100, SOME 3)));
+
+val sliceg202 = slice(Word8Array.vector g, 202, SOME 1);
+val _ = Word8ArraySlice.copyVec{src=sliceg202, dst=g, di=202};
+val test10d = 
+    check'(fn () => Word8Array.sub(g, 202) = i2w(10 * (202-1-103) mod 7 + 1));
+
+val test11a = (Word8ArraySlice.copyVec{src=sliceg, dst=g, di= ~1}; "WRONG") 
+              handle Subscript => "OK" | _ => "WRONG"
+val test11b = (Word8ArraySlice.copyVec{src=sliceg1, dst=g, di=0}; "OK") 
+              handle _ => "WRONG"
+val test11c = (Word8ArraySlice.copyVec{src=sliceg, dst=g, di=1}; "WRONG") 
+              handle Subscript => "OK" | _ => "WRONG"
+
+local 
+    val v = ref 0w0
+    fun setv c = v := c;
+    fun addv c = v := c + !v;
+    fun setvi (i, c) = v := c + i2w i;
+    fun setvif (i, c, _) = v := c + i2w i;
+    fun addvi (i, c) = v := c + i2w i + !v;
+    fun cons (x,r) = x ::  r
+    fun consi (i,x,r) = (i,x) ::  r
+    val inplist = [1,2,3,4,7,9,13,4,5,6,8,0];
+    val inpa = l2v inplist
+    val inp = slice(inpa, 4, SOME 3)
+    val pnia = l2v (rev inplist)
+    val pni = slice(pnia, 5, SOME 3)
+in 
+
+val test12a =
+    check'(fn _ =>
+	           foldl cons [0w1,0w2] inp = [0w13,0w9,0w7,0w1,0w2]
+	   andalso (foldl (fn (x, _) => setv x) () inp; !v = 0w13));
+
+val test12b =
+    check'(fn _ =>
+	           foldr cons [0w1,0w2] inp = [0w7,0w9,0w13,0w1,0w2]
+	   andalso (foldr (fn (x, _) => setv x) () inp; !v = 0w7));
+
+val test12c =
+    check'(fn _ =>
+	   find (fn _ => false) inp = NONE
+	   andalso find (fn x => x=0w7) inp = SOME 0w7
+	   andalso find (fn x => x=0w9) inp = SOME 0w9
+	   andalso (setv 0w0; find (fn x => (addv x; x=0w9)) inp; 
+		    !v = 0w7+0w9));
+
+val test12d = 
+    check'(fn _ =>
+           ((setv 0w0; app addv inp; !v = 0w7+0w9+0w13)
+	    andalso (app setv inp; !v = 0w13)));
+
+val test12f = 
+    check'(fn _ => 
+	   not (exists (fn i => i>0w13) inp)
+	   andalso exists (fn i => i>0w12) inp);
+val test12g = 
+    check'(fn _ => 
+	   (setv 0w117; exists (fn x => (setv x; false)) slice05; !v = 0w117)
+	   andalso (setv 0w0; exists (fn x => (addv x; false)) inp; 
+		    !v = 0w7+0w9+0w13)
+	   andalso (exists (fn x => (setv x; false)) inp; !v = 0w13));
+val test12h = 
+    check'(fn _ => 
+	   not (all (fn i => i<0w13) inp)
+	   andalso all (fn i => i<0w14) inp);
+val test12i = 
+    check'(fn _ => 
+	   (setv 0w117; all (fn x => (setv x; true)) slice05; !v = 0w117)
+	   andalso (setv 0w0; all (fn x => (addv x; true)) inp; 
+		    !v = 0w7+0w9+0w13)
+	   andalso (all (fn x => (setv x; true)) inp; !v = 0w13));
+
+val test13 =
+    check'(fn _ =>
+	   foldli consi [] inp = [(6,0w13),(5,0w9),(4,0w7)]
+	   andalso foldri consi [] inp = [(4,0w7),(5,0w9),(6,0w13)]
+	   andalso (setv 0w117; foldli setvif () inp; !v = 0w6+0w13)
+	   andalso (setv 0w117; foldri setvif () inp; !v = 0w4+0w7));
+
+val test14a =
+    check'(fn _ =>
+	   findi (fn _ => false) inp = NONE
+	   andalso findi (fn (i,x) => x=0w9) inp = SOME (5,0w9)
+	   andalso findi (fn (i,x) => i=6) inp = SOME (6,0w13));
+
+val test14b =
+    check'(fn _ =>	   
+	   List.all (fn sli => NONE=findi (fn (j, x) => i2w(j*10+1)<>x) sli)
+	            sliceas)
+
+val test15 = 
+    check'(fn _ =>
+           ((setvi (0,0w0); appi addvi inp; !v = i2w(4+7+5+9+6+13))
+	   andalso (appi setvi inp; !v = 0w6+0w13)));
+
+end
+
+val test17a = 
+    check'(fn _ =>
+	   let fun invcompare (c1, c2) = Word8.compare (c2, c1) 
+	       fun coll s1 s2 = 
+		   collate invcompare (full (Byte.stringToBytes s1), 
+				       full (Byte.stringToBytes s2))
+	   in 
+	       coll "" "" = EQUAL
+	       andalso coll "" " " = LESS
+	       andalso coll " " "" = GREATER
+	       andalso coll "ABCD" "ABCD" = EQUAL
+	       andalso coll "ABCD" "ABCD " = LESS
+	       andalso coll "ABCD " "ABCD" = GREATER
+	       andalso coll "B" "ABCD" = LESS
+	       andalso coll "ABCD" "B" = GREATER
+	       andalso coll "CCCB" "CCCABCD" = LESS
+	       andalso coll "CCCABCD" "CCCB" = GREATER
+	       andalso coll "CCCB" "CCCA" = LESS
+	       andalso coll "CCCA" "CCCB" = GREATER
+	   end)
+
+val test17b = 
+    check'(fn _ =>
+  let val sa = Byte.stringToBytes "AAAAaAbAABBBB";
+                                (* 0123456789012 *)
+      fun invcompare (c1, c2) = Word8.compare (c2, c1) 
+      fun coll s1 s2 = collate invcompare (s1, s2)
+  in 
+      coll (full sa) (slice(sa, 0, SOME 13)) = EQUAL
+      andalso coll (slice(sa, 0, SOME 0)) (slice(sa, 13, SOME 0)) = EQUAL
+      andalso coll (slice(sa, 0, SOME 0)) (slice(sa, 0, SOME 13)) = LESS
+      andalso coll (slice(sa, 0, SOME 13)) (slice(sa, 0, SOME 0)) = GREATER
+      andalso coll (slice(sa, 0, SOME 3)) (slice(sa, 1, SOME 3)) = EQUAL
+      andalso coll (slice(sa, 0, SOME 4)) (slice(sa, 1, SOME 4)) = GREATER
+      andalso coll (slice(sa, 1, SOME 4)) (slice(sa, 0, SOME 4)) = LESS
+  end)
+end
+
+
+
+
diff -Nru mosml-2.01/src/mosmllib/test/word8vector.sml mosml-2.10.1/src/mosmllib/test/word8vector.sml
--- mosml-2.01/src/mosmllib/test/word8vector.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/word8vector.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,5 +1,5 @@
-(* test/vector.sml -- some test cases for Vector 
-   PS 1994-12-10, 1995-06-14 *)
+(* test/word8vector.sml -- some test cases for Word8Vector 
+   PS 1994-12-10, 1995-06-14, 2000-10-24 *)
 
 use "auxil.sml";
 
@@ -40,28 +40,10 @@
 
 val test8 = check'(fn _ => length (concat []) = 0);
 
-val f = extract (e, 100, SOME 3);
+val f = Word8VectorSlice.vector(Word8VectorSlice.slice(e, 100, SOME 3));
 
 val test9 = check'(fn _ => f = b);
 
-val test9a = check'(fn _ => e = extract(e, 0, SOME (length e)) 
-		    andalso e = extract(e, 0, NONE));
-val test9b = check'(fn _ => fromList [] = extract(e, 100, SOME 0));
-val test9c = (extract(e, ~1, SOME (length e))  seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9d = (extract(e, length e + 1, SOME 0)  seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9e = (extract(e, 0, SOME (length e+1)) seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9f = (extract(e, 20, SOME ~1)        seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9g = (extract(e, ~1, NONE)  seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9h = (extract(e, length e + 1, NONE)  seq "WRONG") 
-             handle Subscript => "OK" | _ => "WRONG"
-val test9i = check'(fn _ => fromList [] = extract(e, length e, SOME 0)
-		    andalso fromList [] = extract(e, length e, NONE));
-
 fun chkiter iter f vec reslast =
     check'(fn _ =>
 	   let val last = ref 0w255
@@ -73,31 +55,97 @@
 	   let val last = ref ~1
 	       val res = iter (fn (i, x) => (last := i; f x)) vec
 	   in (res, !last) = reslast end)
+fun chkfold fold f start vec reslast =
+    check'(fn _ =>
+	   let val last = ref 0w255
+	       val res = fold (fn (x, r) => (last := x; f(x, r))) start vec
+	   in (res, !last) = reslast end)
+fun chkfoldi fold f start vec reslast =
+    check'(fn _ =>
+	   let val last = ref ~1
+	       val res = fold (fn (i, x, r) => (last := i; f(x, r))) start vec
+	   in (res, !last) = reslast end)
 
 val test10a = 
     chkiter map (fn x => 0w2*x) b (fromList [0w88,0w110,0w132], 0w66)
+val test10b = 
+    chkiter app (fn x => ignore(0w2*x)) b ((), 0w66)
+val test10c = 
+    chkiter find (fn x => false) b (NONE, 0w66)
+val test10d = 
+    chkiter exists (fn x => false) b (false, 0w66)
+val test10e = 
+    chkiter all (fn x => true) b (true, 0w66)
+val test10f = 
+    chkfold foldl (op +) 0w0 b (0w165, 0w66)
+val test10g = 
+    chkfold foldr (op +) 0w0 b (0w165, 0w44)
 
 val test11a = 
-    chkiteri mapi (fn x => 0w2*x) (b, 0, NONE) (fromList [0w88,0w110,0w132], 2)
+    chkiteri mapi (fn x => 0w2*x) b (fromList [0w88,0w110,0w132], 2)
 val test11b = 
-    chkiteri mapi (fn x => 0w2*x) (b, 1, NONE) (fromList [0w110,0w132], 2)
+    chkiteri appi (fn x => ignore(0w2*x)) b ((), 2)
 val test11c = 
-    chkiteri mapi (fn x => 0w2*x) (b, 1, SOME 0) (fromList [], ~1)
+    chkiteri findi (fn x => false) b (NONE, 2)
 val test11d = 
-    chkiteri mapi (fn x => 0w2*x) (b, 1, SOME 1) (fromList [0w110], 1)
+    chkfoldi foldli (op +) 0w0 b (0w165, 2)
 val test11e = 
-    chkiteri mapi (fn x => 0w2*x) (b, 3, NONE) (fromList [], ~1)
+    chkfoldi foldri (op +) 0w0 b (0w165, 0)
 
-val test11f =
-    (mapi #2 (b, 0, SOME 4) seq "WRONG") 
-    handle Subscript => "OK" | _ => "WRONG";
-val test11g =
-    (mapi #2 (b, 3, SOME 1) seq "WRONG") 
+val test12a = 
+    check'(fn _ => 
+	   a = update(a, 0, 0w0) 
+	   andalso a = update(a, 6, 0w6)
+	   andalso fromList (List.map i2w [78,1,2,3,4,5,6]) 
+	           = update(a, 0, 0w78)
+	   andalso fromList (List.map i2w [0,1,2,33,4,5,6]) 
+	           = update(a, 3, 0w33))
+val test12b =
+    (update(b, ~1, 0w17) seq "WRONG") 
     handle Subscript => "OK" | _ => "WRONG";
-val test11h =
-    (mapi #2 (b, 4, SOME 0) seq "WRONG") 
+val test12c =
+    (update(b, 7, 0w17) seq "WRONG") 
     handle Subscript => "OK" | _ => "WRONG";
-val test11i =
-    (mapi #2 (b, 4, NONE) seq "WRONG") 
+val test12d =
+    (update(fromList [], 0, 0w17) seq "WRONG") 
     handle Subscript => "OK" | _ => "WRONG";
+
+val test13 = 
+    check'(fn _ =>
+	   let fun invcompare (c1, c2) = Word8.compare(c2, c1)
+	       fun coll s1 s2 = 
+		   collate invcompare (Byte.stringToBytes s1,
+				       Byte.stringToBytes s2)
+	   in 
+	       coll "" "" = EQUAL
+	       andalso coll "" " " = LESS
+	       andalso coll " " "" = GREATER
+	       andalso coll "ABCD" "ABCD" = EQUAL
+	       andalso coll "ABCD" "ABCD " = LESS
+	       andalso coll "ABCD " "ABCD" = GREATER
+	       andalso coll "B" "ABCD" = LESS
+	       andalso coll "ABCD" "B" = GREATER
+	       andalso coll "CCCB" "CCCABCD" = LESS
+	       andalso coll "CCCABCD" "CCCB" = GREATER
+	       andalso coll "CCCB" "CCCA" = LESS
+	       andalso coll "CCCA" "CCCB" = GREATER
+	   end)
+
+val test14 = 
+    check'(fn _ => 
+	   NONE = find (fn i => i > 0w7) a
+	   andalso SOME 0w5 = find (fn i => i > 0w4) a
+	   andalso NONE = find (fn _ => true) (fromList []));
+
+val test15 = 
+    check'(fn _ => 
+	   not (exists (fn i => i > 0w7) a)
+	   andalso exists (fn i => i > 0w4) a
+	   andalso not (exists (fn _ => true) (fromList [])));
+
+val test16 = 
+    check'(fn _ => 
+	   not (all (fn i => i < 0w6) a)
+	   andalso all (fn i => i < 0w7) a
+	   andalso all (fn _ => false) (fromList []));
 end;
diff -Nru mosml-2.01/src/mosmllib/test/word.sml mosml-2.10.1/src/mosmllib/test/word.sml
--- mosml-2.01/src/mosmllib/test/word.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/test/word.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,6 +1,7 @@
 (* test/word.sml -- some test cases for Word, appropriate for a two's
    complement machine whose Int.precision = SOME 31 
-   PS 1995-03-19, 1995-07-12, 1995-11-06, 1996-04-01, 1996-10-01 *)
+   PS 1995-03-19, 1995-07-12, 1995-11-06, 1996-04-01, 1996-10-01,
+   2000-10-24 *)
 
 use "auxil.sml";
 
@@ -10,6 +11,8 @@
 	[op>, op<, op>=, op<=] : (int * int -> bool) list
     val [add, sub, mul, idiv,   imod] = 
 	[op+, op-, op*, op div, op mod] : (int * int -> int) list
+    val maxposint = valOf Int.maxInt;
+    val maxnegint = ~maxposint-1;
     open Word;
     val op > = gt and op < = lt and op >= = ge and op <= = le;
     val op + = add and op - = sub and op * = mul 
@@ -40,9 +43,17 @@
 
 val test8a = check (~1 = Word.toIntX (notb (i2w 0)));
 val test8b = check (0 = w2i (notb (i2w ~1)));
+val test8c = checkrange (~1000,1000)
+    (fn i => let val w = i2w i
+	     in w = notb(notb w) end);
+val test8d = check (0 = Word.toIntX (~ (i2w 0)));
+val test8e = check (1 = w2i (~ (i2w ~1)));
+val test8f = check (2 = w2i (~ (i2w ~2))); 
+val test8g = check (1023 = w2i (~ (i2w ~1023))); 
+val test8h = checkrange (~1000,1000)
+    (fn i => let val w = i2w i
+	     in w = ~(~w) end);
 
-val maxposint = valOf Int.maxInt;
-val maxnegint = ~maxposint-1;
 fun pwr2 0 = 1 
   | pwr2 n = 2 * pwr2 (n-1);
 fun rwp i 0 = i
@@ -68,7 +79,7 @@
 
 val test10a = checkrange (1,65)
     (fn k => 0 = w2i (~>> (i2w 1, i2w k)));
-val test10b = checkrange (1,65)
+val test10b = checkrange (0,65)
     (fn k => ~1 = toIntX (~>> (i2w ~1, i2w k)));
 val test10c = checkrange (~513, 513)
     (fn i => i div 2 = toIntX (~>> (i2w i, i2w 1)));
diff -Nru mosml-2.01/src/mosmllib/TextIO.sig mosml-2.10.1/src/mosmllib/TextIO.sig
--- mosml-2.01/src/mosmllib/TextIO.sig	2000-06-01 19:57:44.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/TextIO.sig	2014-08-28 08:47:22.000000000 +0000
@@ -14,7 +14,7 @@
 val inputNoBlock : instream -> vector option
 val input1       : instream -> elem option
 val inputN       : instream * int -> vector
-val inputLine    : instream -> string
+val inputLine    : instream -> string option
 val endOfStream  : instream -> bool
 val lookahead    : instream -> elem option
 
@@ -53,7 +53,7 @@
    `translated' by converting (e.g.) the double newline CRLF to a
    single newline character \n.
 
-   [instream] is the type of state-based characters input streams.
+   [instream] is the type of state-based character input streams.
 
    [outstream] is the type of state-based character output streams.
 
@@ -96,11 +96,11 @@
    (This is the behaviour of the `input' function prescribed in the
    1990 Definition of Standard ML).
 
-   [inputLine istr] returns one line of text, including the
-   terminating newline character.  If end of stream is reached before
-   a newline character, then the remaining part of the stream is
-   returned, with a newline character added.  If istr is at end of
-   stream or is closed, then the empty string "" is returned.
+   [inputLine istr] returns SOME ln, where ln is one line of text,
+   including the terminating newline character.  If end of stream is
+   reached before a newline character, then the remaining part of the
+   stream is returned, with a newline character added.  If istr is at
+   end of stream or is closed, then NONE is returned.
 
    [endOfStream istr] returns false if any elements are available in
    istr; returns true if istr is at end of stream or closed; blocks if
diff -Nru mosml-2.01/src/mosmllib/TextIO.sml mosml-2.10.1/src/mosmllib/TextIO.sml
--- mosml-2.01/src/mosmllib/TextIO.sml	2000-04-28 09:38:45.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/TextIO.sml	2014-08-28 08:47:22.000000000 +0000
@@ -282,7 +282,7 @@
 	 if os = stdErr then caml_flush oc else ());
 
 fun inputLine (is as ref {closed, ic, name}) =
-  if closed then "" else
+  if closed then NONE else
   let val max = ref 127
       val tmp = ref (create_string_ (!max))
       fun realloc () =
@@ -303,7 +303,7 @@
 	     | SOME c => (set_nth_char_ (!tmp) len c;
 			  if c = #"\n" then sub_string_ (!tmp) 0 (len+1) 
 			               else h (len+1)))
-  in if endOfStream is then "" else h 0 end;
+  in if endOfStream is then NONE else SOME(h 0) end;
 
 fun openOut (s : string) : outstream =
     ref {closed=false, oc=caml_open_out s, name=s}
diff -Nru mosml-2.01/src/mosmllib/Timer.sig mosml-2.10.1/src/mosmllib/Timer.sig
--- mosml-2.01/src/mosmllib/Timer.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Timer.sig	2014-08-28 08:47:22.000000000 +0000
@@ -5,8 +5,11 @@
 
 val startCPUTimer  : unit -> cpu_timer
 val totalCPUTimer  : unit -> cpu_timer
-val checkCPUTimer  : cpu_timer -> 
-                     { usr : Time.time, sys : Time.time, gc : Time.time }
+val checkCPUTimer  : cpu_timer -> { usr : Time.time, sys : Time.time }
+val checkGCTime    : cpu_timer -> Time.time
+val checkCPUTimes  : cpu_timer -> { nongc : {usr : Time.time, sys : Time.time},
+                                    gc    : {usr : Time.time, sys : Time.time}
+                                  }
 
 val startRealTimer : unit -> real_timer
 val totalRealTimer : unit -> real_timer
@@ -25,12 +28,24 @@
    [totalCPUTimer ()] returns a cpu_timer started at the moment the 
    library was loaded.
 
-   [checkCPUTimer tmr] returns {usr, sys, gc} where usr is the amount
-   of user CPU time consumed since tmr was started, gc is the amount
-   of user CPU time spent on garbage collection, and sys is the
-   amount of system CPU time consumed since tmr was started.  Note
-   that gc time is included in the usr time.  Under MS DOS, usr time
-   and gc time are measured in real time.
+   [checkCPUTimer tmr] returns {usr, sys} where usr is the amount of
+   user CPU time consumed since tmr was started and sys is the amount
+   of system CPU time consumed since tmr was started.  Note that
+   garbage collection time is included in the usr time.  Under MS DOS
+   and MS Windows, usr time is measured as real time.
+
+   [checkGCTime tmr] returns the amount of user CPU time spent on
+   garbage collection since tmr was started.  Under MS DOS and MS
+   Windows, gc time is measured in real time.
+
+   [checkCPUTimes tmr] returns the amount of CPU time consumed since
+   tmr was started spilt into time spend in the program (nongc) and on
+   garbage collecttion (gc). For both nongc and gc a record {usr, sys}
+   is returned where usr is the amount of user CPU time consumed since
+   tmr was started and sys is the amount of system CPU time consumed
+   since tmr was started.  Note that Moscow ML will allways attribute
+   all the system CPU time to the program (nongc).  That is,
+   #sys(#gc(checkCPUTimes tmr)) is always 0.
 
    [startRealTimer ()] returns a real_timer started at the moment of 
    the call.
diff -Nru mosml-2.01/src/mosmllib/Timer.sml mosml-2.10.1/src/mosmllib/Timer.sml
--- mosml-2.01/src/mosmllib/Timer.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Timer.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,4 +1,6 @@
-(* Timer -- new basis 1995-03-20, 1995-09-14, 1995-11-06, 1997-03-07 *)
+(* Timer -- new basis 1995-03-20, 1995-09-14, 1995-11-06, 1997-03-07 
+       kfl: 2003-05-26, 2008-05-05
+*)
 
 (* Under DOS, real time and cpu time are the same *)
 
@@ -20,13 +22,26 @@
 	    gc  = fromSeconds gcSec  + fromMicroseconds gcUsec}
 	end
 
-    fun checkCPUTimer {usr, sys, gc} = 
+    fun checkCPUTimes {usr, sys, gc} = 
 	let val {gcSec, gcUsec, sysSec, sysUsec, usrSec, usrUsec} 
-	        = getrutime_ () 
+	        = getrutime_ ()
+            val gcUsr = fromSeconds gcSec  + fromMicroseconds gcUsec - gc
+	in {nongc = {usr = fromSeconds usrSec + fromMicroseconds usrUsec 
+                           - usr - gcUsr,
+	             sys = fromSeconds sysSec + fromMicroseconds sysUsec - sys}
+           ,gc = {usr = gcUsr,
+                  sys = fromSeconds 0}
+           }
+	end
+
+    fun checkCPUTimer {usr, sys, gc} = 
+        let val {gcSec, gcUsec, sysSec, sysUsec, usrSec, usrUsec} 
+	        = getrutime_ ()
 	in {usr = fromSeconds usrSec + fromMicroseconds usrUsec - usr,
-	    sys = fromSeconds sysSec + fromMicroseconds sysUsec - sys,
-	    gc  = fromSeconds gcSec  + fromMicroseconds gcUsec  - gc}
+	    sys = fromSeconds sysSec + fromMicroseconds sysUsec - sys}
 	end
+	  
+    fun checkGCTime timer = #usr(#gc(checkCPUTimes timer))
 
     fun startRealTimer () = now ();
 
diff -Nru mosml-2.01/src/mosmllib/Time.sig mosml-2.10.1/src/mosmllib/Time.sig
--- mosml-2.01/src/mosmllib/Time.sig	2000-06-01 19:57:44.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Time.sig	2014-08-28 08:47:22.000000000 +0000
@@ -35,7 +35,7 @@
 (* 
    [time] is a type for representing durations as well as absolute
    points in time (which can be thought of as durations since some
-   fixed time zero).
+   fixed time zero).  Times can be negative, zero, or positive.
 
    [zeroTime] represents the 0-second duration, and the origin of time, 
    so zeroTime + t = t + zeroTime = t for all t.
@@ -43,43 +43,40 @@
    [now ()] returns the point in time at which the application occurs.
 
    [fromSeconds s] returns the time value corresponding to s seconds.  
-   Raises Time if s < 0.
 
    [fromMilliseconds ms] returns the time value corresponding to ms
-   milliseconds.  Raises Time if ms < 0.
+   milliseconds.  
 
    [fromMicroseconds us] returns the time value corresponding to us
-   microseconds.  Raises Time if us < 0.
+   microseconds.  
 
    [toSeconds t] returns the number of seconds represented by t,
-   truncated.  Raises Overflow if that number is not representable as
-   an int.
-
-   [toMilliseconds t] returns the number of milliseconds
-   represented by t, truncated.  Raises Overflow if that number is not
+   truncated (towards zero).  Raises Overflow if that number is not
    representable as an int.
 
-   [toMicroseconds t] returns the number of microseconds
-   represented by t, truncated.  Raises Overflow if t that number is
+   [toMilliseconds t] returns the number of milliseconds represented
+   by t, truncated (towards zero).  Raises Overflow if that number is
    not representable as an int.
 
-   [fromReal r] converts a real to a time value representing that
-   many seconds.  Raises Time if r < 0 or if r is not representable
-   as a time value.  It holds that realToTime 0.0 = zeroTime.  
-
-   [toReal t] converts a time the number of seconds it represents;
-   hence realToTime and timeToReal are inverses of each other when 
-   defined.  Raises Overflow if t is not representable as a real.
+   [toMicroseconds t] returns the number of microseconds represented
+   by t, truncated (towards zero).  Raises Overflow if t that number
+   is not representable as an int.
+
+   [fromReal r] converts a real to a time value representing that many
+   seconds.  It holds that fromReal 0.0 = zeroTime.
+
+   [toReal t] converts a time to the number of seconds it represents;
+   hence fromReal and toReal are inverses of each other.
 
    [fmt n t] returns as a string the number of seconds represented by
    t, rounded to n decimal digits.  If n <= 0, then no decimal digits
-   are reported. 
+   are reported.
 
    [toString t] returns as a string the number of seconds represented
    by t, rounded to 3 decimal digits.  Equivalent to (fmt 3 t).  
 
    [fromString s] returns SOME t where t is the time value represented
-   by the string s of form [\n\t ]*([0-9]+(\.[0-9]+)?)|(\.[0-9]+); 
+   by the string s of form [\n\t ]*[+~-]?(([0-9]+(\.[0-9]+)?)|(\.[0-9]+)); 
    or returns NONE if s cannot be parsed as a time value.
 
    [scan getc src], where getc is a character accessor, returns SOME
@@ -87,18 +84,18 @@
    if s cannot be parsed as a time value.
 
    [+] adds two time values. For reals r1, r2 >= 0.0, it holds that
-   realToTime r1 + realToTime r2 = realToTime(Real.+(r1,r2)).  
+   fromReal r1 + fromReal r2 = fromReal(Real.+(r1,r2)).  
    Raises Overflow if the result is not representable as a time value.
 
    [-] subtracts a time value from another.  That is, t1 - t2 is the
-   duration from t2 to t1.  Raises Time if t1 < t2 or if the result is
-   not representable as a time value.  It holds that t - zeroTime = t.
+   duration from t2 to t1 (which may be negative).  
+   It holds that t - zeroTime = t.
 
    [<]
    [<=]
    [>]
    [>=] compares time values.  For instance, for reals r1, r2 >= 0.0 
-   it holds that realToTime r1 < realToTime r2 iff Real.<(r1, r2)
+   it holds that  fromReal r1 < fromReal r2  iff Real.<(r1, r2)
 
    [compare(t1, t2)] returns LESS, EQUAL, or GREATER, according 
    as t1 precedes, equals, or follows t2 in time.
diff -Nru mosml-2.01/src/mosmllib/Time.sml mosml-2.10.1/src/mosmllib/Time.sml
--- mosml-2.01/src/mosmllib/Time.sml	2004-01-12 15:50:27.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Time.sml	2014-08-28 08:47:22.000000000 +0000
@@ -1,59 +1,41 @@
-(* Time -- new basis 1995-02-25, 1995-05-12 *)
+(* Time -- SML Basis Library 1995-02-25, 1995-05-12, 2000-10-24 *)
 
 local 
-    prim_val getrealtime_ : unit -> {sec : int, usec : int} 
-                                = 1 "sml_getrealtime";
+    prim_val getrealtime_ : unit -> real = 1 "sml_getrealtime";
     prim_val exp : real -> real = 1 "sml_exp";
     prim_val ln  : real -> real = 1 "sml_ln";
 
     fun negpow10 p = exp(ln 10.0 * real (~p));
-
-    (* Translation to obtain a longer time horizon.  Must agree with
-       TIMEBASE in file runtime/mosml.c *)
-    val timebase = ~1073741824;		
 in
-    type time = {sec : int, usec : int}
-    (* Invariant: sec >= timebase and 0 <= usec < 1000000.
-       Represents the duration (sec-timebase)+usec/1000000 seconds; 
-       or the duration since UTC 00:00 on 1 Jan 1970).
-     *)
+    type time = real
+    (* Represents the number of microseconds since, or before, 
+       UTC 00:00 on 1 Jan 1970. *)
 
     exception Time
 
-    val zeroTime = {sec = timebase, usec = 0};
+    val zeroTime = 0.0;
     fun now () = getrealtime_ ();
 
-    fun fromSeconds s = 
-	if s < 0 then raise Time else {sec=s+timebase, usec=0};
+    fun fromSeconds s = 1000000.0 * real s;
 
-    fun fromMilliseconds ms = 
-	if ms < 0 then raise Time else 
-	    {sec=ms div 1000+timebase, usec=ms mod 1000 * 1000};
+    fun fromMilliseconds ms = 1000.0 * real ms;
 
-    fun fromMicroseconds us = 
-	if us < 0 then raise Time else 
-	    {sec=us div 1000000+timebase, usec=us mod 1000000};
+    fun fromMicroseconds us = real us;
 
-    fun toSeconds {sec, usec} = sec-timebase;
+    fun toSeconds r = trunc(r/1000000.0);
 
-    fun toMilliseconds {sec, usec} = (sec-timebase) * 1000 + usec div 1000;
+    fun toMilliseconds r = trunc(r/1000.0);
 
-    fun toMicroseconds {sec, usec} = (sec-timebase) * 1000000 + usec;
+    fun toMicroseconds r = trunc r;
 
-    fun fromReal r =		       
-	let 
-	    val rf = if r < 0.0 then raise Time else floor (r + real timebase)
-	in
-	    {sec = rf, usec = floor (1000000.0 * (r+real timebase-real rf))} 
-	end handle Overflow => raise Time;
+    fun fromReal r = r * 1000000.0;
 
-    fun toReal {sec, usec} =
-	real sec - real timebase + real usec / 1000000.0;
+    fun toReal r = r / 1000000.0;
 
     fun timeToUnits (t, p) = floor(toReal t * negpow10 p + 0.5);
 
-    fun fmt p t =
-	Real.fmt (StringCvt.FIX (SOME (if p > 0 then p else 0))) (toReal t)
+    fun fmt p r =
+	Real.fmt (StringCvt.FIX (SOME (if p > 0 then p else 0))) (r/1000000.0);
 
     fun toString t = fmt 3 t;
 
@@ -63,72 +45,67 @@
 	fun decval c = Char.ord c - 48;
         fun pow10 0 = 1
 	  | pow10 n = 10 * pow10 (n-1)
-	fun mktime intgv decs fracv =
+	fun mktime neg intgv decs fracv =
 	    let val usecs = (pow10 (7-decs) * fracv + 5) div 10
+		val res = intgv * 1000000.0 + real usecs 
 	    in
-		{sec = floor(intgv+real timebase+0.5) + usecs div 1000000, 
-		 usec = usecs mod 1000000}
+		if neg then ~res else res		
 	    end
 	fun skipdigs src =
 	    case getc src of 
 		NONE          => src
 	      | SOME(c, rest) => if Char.isDigit c then skipdigs rest 
 				 else src
-	fun frac intgv decs fracv src =
-	    if decs >= 7 then SOME(mktime intgv decs fracv, skipdigs src)
+	fun frac neg intgv decs fracv src =
+	    if decs >= 7 then SOME(mktime neg intgv decs fracv, skipdigs src)
 	    else case getc src of
-		NONE          => SOME(mktime intgv decs fracv, src)
+		NONE          => SOME(mktime neg intgv decs fracv, src)
 	      | SOME(c, rest) => 
 		    if Char.isDigit c then 
-			frac intgv (decs+1) (10 * fracv + decval c) rest
+			frac neg intgv (decs+1) (10 * fracv + decval c) rest
 		    else 
-			SOME(mktime intgv decs fracv, src)
-	fun intg intgv src = 
+			SOME(mktime neg intgv decs fracv, src)
+	fun intg neg intgv src = 
 	    case getc src of
-		NONE              => SOME(mktime intgv 6 0, src)
-	      | SOME (#".", rest) => frac intgv 0 0 rest
+		NONE              => SOME(mktime neg intgv 6 0, src)
+	      | SOME (#".", rest) => frac neg intgv 0 0 rest
 	      | SOME (c, rest)    => 
 		    if Char.isDigit c then 
-			intg (10.0 * intgv + real(decval c)) rest 
-		    else SOME(mktime intgv 6 0, src)
-    in case skipWSget getc source of
-	NONE             => NONE
-      | SOME(#".", rest) => 
+			intg neg (10.0 * intgv + real(decval c)) rest 
+		    else SOME(mktime neg intgv 6 0, src)
+	fun nbr neg src =
+	    case getc src of
+		NONE             => NONE
+	      | SOME(#".", rest) => 
 		    (case getc rest of
 			 NONE          => NONE
 		       | SOME(c, rest) => 
-			     if Char.isDigit c then frac 0.0 1 (decval c) rest
-			     else NONE)
-      | SOME(c, rest)    => 
-	    if Char.isDigit c then intg (real (decval c)) rest else NONE
+			     if Char.isDigit c then 
+				 frac neg 0.0 1 (decval c) rest
+			     else 
+				 NONE)
+	      | SOME(c, rest)    => 
+		if Char.isDigit c then intg neg (real (decval c)) rest 
+		else NONE
+	val afterws = StringCvt.dropl Char.isSpace getc source
+    in case getc afterws of
+	NONE             => NONE
+      | SOME(#"+", rest) => nbr false rest
+      | SOME(#"~", rest) => nbr true  rest
+      | SOME(#"-", rest) => nbr true  rest
+      | _                => nbr false afterws
     end;
 
     fun fromString s = StringCvt.scanString scan s;
 
-    val op + = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
-	let val usecs = usec1 + usec2 in
-	    {sec  = trunc(real sec1 - real timebase 
-			  + real sec2 + real(usecs div 1000000)),
-	     usec = usecs mod 1000000}
-	end 
-    and op - = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
-	let val usecs = usec1 - usec2 
-	    val secs  = sec1 - sec2 + usecs div 1000000
-	in
-	    if secs < 0 then raise Time 
-	    else {sec = secs + timebase, usec = usecs mod 1000000}
-	end handle Overflow => raise Time;
-
-    val op <  = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
-	(sec1 < sec2) orelse (sec1=sec2 andalso usec1 < usec2)
-    and op <= = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
-	(sec1 < sec2) orelse (sec1=sec2 andalso usec1 <= usec2)
-    and op >  = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
-	(sec1 > sec2) orelse (sec1=sec2 andalso usec1 > usec2)
-    and op >= = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
-	(sec1 > sec2) orelse (sec1=sec2 andalso usec1 >= usec2);
-
     fun compare (x, y: time) = 
 	if xy then GREATER else EQUAL;
 
+    val op + = op + : time * time -> time
+    and op - = op - : time * time -> time
+
+    val op <  = op <  : time * time -> bool
+    and op <= = op <= : time * time -> bool
+    and op >  = op >  : time * time -> bool
+    and op >= = op >= : time * time -> bool
 end
diff -Nru mosml-2.01/src/mosmllib/Unix.sig mosml-2.10.1/src/mosmllib/Unix.sig
--- mosml-2.01/src/mosmllib/Unix.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Unix.sig	2014-08-28 08:47:22.000000000 +0000
@@ -1,14 +1,20 @@
 (* Unix -- SML Basis Library *)
-
-type proc
+signature Unix = sig 
+type ('a, 'b) proc
 type signal = Signal.signal
 
-val executeInEnv : string * string list * string list -> proc 
-val execute      : string * string list -> proc 
-val streamsOf    : proc -> TextIO.instream * TextIO.outstream
-val kill         : proc * signal -> unit
-val reap         : proc -> Process.status 
+val executeInEnv    : string * string list * string list -> ('a, 'b) proc 
+val execute         : string * string list -> ('a, 'b) proc
 
+val streamsOf       : (TextIO.instream, TextIO.outstream) proc 
+                       -> TextIO.instream * TextIO.outstream
+val textInstreamOf  : (TextIO.instream, 'a) proc -> TextIO.instream
+val textOutstreamOf : ('a, TextIO.outstream) proc -> TextIO.outstream
+val binInstreamOf   : (BinIO.instream, 'a) proc -> BinIO.instream
+val binOutstreamOf  : ('a, BinIO.outstream) proc -> BinIO.outstream 
+val kill            : ('a, 'b) proc * signal -> unit
+val reap            : ('a, 'b) proc -> OS.Process.status 
+end
 (* 
    This structure allows Moscow ML programs to start other processes
    and to communicate with them.  
@@ -54,6 +60,18 @@
    the source for the input stream ins, and the standard input of pr
    is the sink for the output stream outs.
 
+   [textInstreamOf pr] returns the text input stream associated with
+   process pr.  That is, the standard output of pr.
+
+   [textOutstreamOf pr] returns the text output stream associated with
+   process pr.  That is, the standard input of pr.
+
+   [binInstreamOf pr] returns the binary input stream associated with
+   process pr.  That is, the standard output of pr.
+
+   [binOutstreamOf pr] returns the binary output stream associated
+   with process pr.  That is, the standard input of pr.
+ 
    [reap pr] closes the input and output streams associated with pr,
    and then suspends the current (ML) process until the process
    corresponding to pr terminates.  Returns the exit status given by
diff -Nru mosml-2.01/src/mosmllib/Unix.sml mosml-2.10.1/src/mosmllib/Unix.sml
--- mosml-2.01/src/mosmllib/Unix.sml	2000-02-05 14:41:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Unix.sml	2014-08-28 08:47:22.000000000 +0000
@@ -2,8 +2,11 @@
 
 (* sestoft@dina.kvl.dk 1999-11-07 version 0.2 *)
 
+(* ken@friislarsen.net 2008-05-03 version 0.3 *)
+
 (* Type safety depends on the representation of TextIO.instream and
-   TextIO.outstream, and of Process.status
+   TextIO.outstream, BinIO.instream and BinIO.outstream and of
+   Process.status
  *)
 
 structure Unix :> Unix =
@@ -11,7 +14,17 @@
 
 type signal = Signal.signal
 
-type proc = { syspid : int, ins : TextIO.instream, outs : TextIO.outstream }
+(* Caml Light "channels" *)
+
+prim_type in_channel and out_channel;
+prim_val open_descriptor_in  : int -> in_channel  = 1 "open_descriptor";
+prim_val open_descriptor_out : int -> out_channel = 1 "open_descriptor";
+
+(* In Moscow ML TextIO and BinIO streams are represented the same way *)
+type instream = { closed: bool, ic: in_channel, name : string } ref;
+type outstream = { closed: bool, oc: out_channel, name : string } ref;
+
+type ('a, 'b) proc = { syspid : int, ins : instream, outs : outstream }
 
 local 
     open Dynlib
@@ -24,27 +37,22 @@
     fun app4 name = Dynlib.app4 (symb ("unix_"^name))
     fun app5 name = Dynlib.app5 (symb ("unix_"^name))
 
-(* Caml Light "channels" *)
-
-prim_type in_channel and out_channel;
-prim_val open_descriptor_in  : int -> in_channel  = 1 "open_descriptor";
-prim_val open_descriptor_out : int -> out_channel = 1 "open_descriptor";
 
 fun raiseIo fcn nam exn = 
     raise Io {function = "Unix." ^ fcn, name = nam, cause = exn};
 
 (* From Caml Light "channels" to SML instreams and outstreams: *)
 
-fun openInPipe fcn infd : TextIO.instream =
-    Obj.magic (ref {closed=false, 
-		    ic=open_descriptor_in infd, 
-		    name = ""})
+fun openInPipe fcn infd =
+    ref {closed=false, 
+	 ic=open_descriptor_in infd, 
+	 name = ""}
     handle exn as SysErr _ => raiseIo fcn "" exn;
 
-fun openOutPipe fcn outfd : TextIO.outstream =
-    Obj.magic (ref {closed=false, 
-		    oc=open_descriptor_out outfd, 
-		    name=""})
+fun openOutPipe fcn outfd =
+    ref {closed=false, 
+	 oc=open_descriptor_out outfd, 
+	 name=""}
     handle exn as SysErr _ => raiseIo fcn "" exn;
 
 in 
@@ -54,14 +62,14 @@
 fun killpid (s : signal) (syspid : int) : unit = 
     kill_ syspid (Word.toInt (Signal.toWord s))
 
-fun kill ({ syspid, ... } : proc, s : signal) : unit = 
+fun kill ({ syspid, ... } : ('a,'b) proc, s : signal) : unit = 
     killpid s syspid
     handle Fail s => raise Fail ("Unix.kill: " ^ s)
 
 val execute_ : string -> string vector -> string vector option
                -> int * int * int = app3 "execute"
 
-fun executewrap fcn cmd args envOpt : proc =
+fun executewrap fcn cmd args envOpt : ('a, 'b) proc =
     let val argvec = Vector.fromList (cmd :: args)
 	val envvec = Option.map Vector.fromList envOpt
 	val (syspid, infd, outfd) = execute_ cmd argvec envvec
@@ -72,22 +80,32 @@
     end
     handle Fail s => raise Fail ("Unix." ^ fcn ^ ": " ^ s)
 
-fun executeInEnv (cmd, args, env) : proc = 
+fun executeInEnv (cmd, args, env) : ('a, 'b) proc = 
     executewrap "executeInEnv" cmd args (SOME env)
 
-fun execute (cmd, args) : proc =
+fun execute (cmd, args) : ('a, 'b) proc =
     executewrap "execute" cmd args NONE
 
-fun streamsOf ({ syspid, ins, outs } : proc) 
-    : TextIO.instream * TextIO.outstream = (ins, outs)
+fun streamsOf ({syspid, ins, outs} : (TextIO.instream, TextIO.outstream) proc) 
+    : TextIO.instream * TextIO.outstream = Obj.magic (ins, outs)
+
+fun textInstreamOf ({syspid, ins, outs} : (TextIO.instream, 'a) proc) 
+    : TextIO.instream = Obj.magic ins
+fun binInstreamOf ({syspid, ins, outs} : (BinIO.instream, 'a) proc)
+    : BinIO.instream =  Obj.magic ins
+fun textOutstreamOf ({syspid, ins, outs} : ('a, TextIO.outstream) proc)
+    : TextIO.outstream = Obj.magic outs
+fun binOutstreamOf ({syspid, ins, outs} : ('a, BinIO.outstream) proc)
+    : BinIO.outstream = Obj.magic outs
+
 
 val waitpid_ : int -> int = app1 "waitpid"
 
-fun reap ({ syspid, ins, outs } : proc) : Process.status = 
+fun reap ({syspid, ins, outs} : ('a,'b) proc) : OS.Process.status = 
     let val status_ = waitpid_ syspid : int
     in 
-	TextIO.closeIn ins; 
-	TextIO.closeOut outs; 
+	TextIO.closeIn (Obj.magic ins); 
+	TextIO.closeOut (Obj.magic outs); 
 	Obj.magic status_ 
     end
     handle Fail s => raise Fail ("Unix.reap: " ^ s)
diff -Nru mosml-2.01/src/mosmllib/Vector.mlp mosml-2.10.1/src/mosmllib/Vector.mlp
--- mosml-2.01/src/mosmllib/Vector.mlp	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Vector.mlp	2014-08-28 08:47:22.000000000 +0000
@@ -41,16 +41,13 @@
     if i < 0 orelse i >= length v then raise Subscript
     else sub_ v i;
 
-fun extract (vec : 'a vector, i, sliceend) =
-    let val n = case sliceend of NONE => length vec - i | SOME n => n
-	val newvec = if i<0 orelse n<0 orelse i+n > length vec then
-	                 raise Subscript
-		     else
-			 vector_ n () : 'a vector
-	fun copy j = if j= length v then raise Subscript else ()
+	val stop = length v
+	val newvec = vector_ stop () 
+	fun lr j = if j < stop then (update_ newvec j (sub_ v j); lr (j+1))
+		   else ()
+    in lr 0; update_ newvec i x; newvec end
 
 fun concat vecs =
     let fun acc [] len       = len
@@ -68,6 +65,23 @@
 	    in copy 0; copyall (to+len1) vr end
     in copyall 0 vecs; newvec end;
 
+fun find (p : 'a -> bool) (a : 'a vector) : 'a option = 
+    let val stop = length a
+	fun lr j = 
+	    if j < stop then 
+		if p (sub_ a j) then SOME (sub_ a j) else lr (j+1)
+	    else NONE
+    in lr 0 end
+
+fun exists (p : 'a -> bool) (a : 'a vector) : bool = 
+    let val stop = length a
+	fun lr j = j < stop andalso (p (sub_ a j) orelse lr (j+1))
+    in lr 0 end
+
+fun all (p : 'a -> bool) (a : 'a vector) : bool = 
+    let val stop = length a
+	fun lr j = j >= stop orelse (p (sub_ a j) andalso lr (j+1))
+    in lr 0 end
 
 fun foldl f e a = 
     let	val stop = length a
@@ -94,6 +108,14 @@
 		   else ()
     in lr 0; newvec end
 
+fun findi (p : int * 'a -> bool) (a : 'a vector) : (int * 'a) option = 
+    let val stop = length a
+	fun lr j = 
+	    if j < stop then 
+		if p (j, sub_ a j) then SOME (j, sub_ a j) else lr (j+1)
+	    else NONE
+    in lr 0 end
+
 fun sliceend (a, i, NONE) = 
         if i<0 orelse i>length a then raise Subscript
 	else length a
@@ -101,40 +123,47 @@
 	if i<0 orelse n<0 orelse i+n>length a then raise Subscript
 	else i+n;
 
-fun foldli f e (slice as (a, i, _)) = 
-    let fun loop stop =
-	    let fun lr j res = 
-		if j < stop then lr (j+1) (f(j, sub_ a j, res))
-		else res
-	    in lr i e end
-    in loop (sliceend slice) end;
-
-fun foldri f e (slice as (a, i, _)) = 
-    let fun loop start =
-	    let fun rl j res = 
-		    if j >= i then rl (j-1) (f(j, sub_ a j, res))
-		    else res
-	    in rl start e end;
-    in loop (sliceend slice - 1) end
-
-fun appi f (slice as (a, i, _)) = 
-    let fun loop stop = 
-	    let	fun lr j = 
-		    if j < stop then (f(j, sub_ a j); lr (j+1)) 
-		    else ()
-	    in lr i end
-    in loop (sliceend slice) end;
-
-fun mapi (f : int * 'a -> 'b) (slice as (a : 'a vector, i, _)) : 'b vector = 
-    let val stop = sliceend slice
-	val newvec = vector_ (stop - i) () 
-	fun loop stop = 
-	    let	fun lr j = 
-		    if j < stop then 
-			(update_ newvec (j-i) (f(j, sub_ a j)); 
-			 lr (j+1)) 
-		    else ()
-	    in lr i end
-    in loop stop; newvec end;
+fun foldli f e a = 
+    let val stop = length a
+	fun lr j res = 
+	    if j < stop then lr (j+1) (f(j, sub_ a j, res))
+	    else res
+    in lr 0 e end;
+
+fun foldri f e a = 
+    let fun rl j res = 
+	    if j >= 0 then rl (j-1) (f(j, sub_ a j, res))
+	    else res
+    in rl (length a - 1) e end;
 
+fun appi f a = 
+    let val stop = length a
+	fun lr j = 
+	    if j < stop then (f(j, sub_ a j); lr (j+1)) 
+	    else ()
+    in lr 0 end;
+
+fun mapi (f : int * 'a -> 'b) (a : 'a vector) : 'b vector = 
+    let val stop = length a
+	val newvec = vector_ stop () 
+	fun lr j = 
+	    if j < stop then 
+		(update_ newvec j (f(j, sub_ a j)); 
+		 lr (j+1)) 
+	    else ()
+    in lr 0; newvec end;
+
+fun collate cmp (v1, v2) =
+    let val n1 = length v1 
+	and n2 = length v2
+	val stop = if n1 < n2 then n1 else n2
+	fun h j = (* At this point v1[0..j-1] = v2[0..j-1] *)
+	    if j = stop then if      n1 < n2 then LESS
+                             else if n1 > n2 then GREATER
+                             else                 EQUAL
+	    else
+		case cmp(sub_ v1 j, sub_ v2 j) of
+		    EQUAL => h (j+1)
+		  | res   => res
+    in h 0 end;
 end
diff -Nru mosml-2.01/src/mosmllib/Vector.sig mosml-2.10.1/src/mosmllib/Vector.sig
--- mosml-2.01/src/mosmllib/Vector.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Vector.sig	2014-08-28 08:47:22.000000000 +0000
@@ -8,18 +8,25 @@
 
 val length   : 'a vector -> int
 val sub      : 'a vector * int -> 'a
-val extract  : 'a vector * int * int option -> 'a vector
+val update   : 'a vector * int * 'a -> 'a vector
 val concat   : 'a vector list -> 'a vector
 
+val find     : ('a -> bool) -> 'a vector -> 'a option
+val exists   : ('a -> bool) -> 'a vector -> bool
+val all      : ('a -> bool) -> 'a vector -> bool
+
 val app      : ('a -> unit) -> 'a vector -> unit
 val map      : ('a -> 'b) -> 'a vector -> 'b vector
 val foldl    : ('a * 'b -> 'b) -> 'b -> 'a vector -> 'b
 val foldr    : ('a * 'b -> 'b) -> 'b -> 'a vector -> 'b
 
-val appi     : (int * 'a -> unit) -> 'a vector * int * int option -> unit
-val mapi     : (int * 'a -> 'b) -> 'a vector * int * int option -> 'b vector
-val foldli   : (int * 'a * 'b -> 'b) -> 'b -> 'a vector*int*int option -> 'b
-val foldri   : (int * 'a * 'b -> 'b) -> 'b -> 'a vector*int*int option -> 'b
+val findi    : (int * 'a -> bool) -> 'a vector -> (int * 'a) option
+val appi     : (int * 'a -> unit) -> 'a vector -> unit
+val mapi     : (int * 'a -> 'b) -> 'a vector -> 'b vector
+val foldli   : (int * 'a * 'b -> 'b) -> 'b -> 'a vector -> 'b
+val foldri   : (int * 'a * 'b -> 'b) -> 'b -> 'a vector -> 'b
+
+val collate  : ('a * 'a -> order) -> 'a vector * 'a vector -> order
 
 (* 
    ['ty vector] is the type of one-dimensional, immutable, zero-based
@@ -41,16 +48,27 @@
    [sub(v, i)] returns the i'th element of v, counting from 0.
    Raises Subscript if i<0 or i>=length v.
 
-   [extract(v, i, NONE)] returns a vector of the elements v[i..length v-1]
-   of v.  Raises Subscript if i<0 or i>length v.
-
-   [extract(v, i, SOME n)] returns a vector of the elements v[i..i+n-1]
-   of v.  Raises Subscript if i<0 or n<0 or i+n>length v.
+   [update(v, i, x)] creates a copy of v, sets position i to x, and
+   returns the new vector.  In contrast to Array.update, this is not a
+   constant-time operation, because it must copy the entire vector.
+   Raises Subscript if i<0 or i>=length v.
 
    [concat vs] returns a vector which is the concatenation from left
    to right og the vectors in vs.  Raises Size if the sum of the
    sizes of the vectors in vs is larger than maxLen.
 
+   [find p v] applies p to each element x of v, from left to right,
+   until p(x) evaluates to true; returns SOME x if such an x exists,
+   otherwise NONE.
+
+   [exists p v] applies p to each element x of v, from left to right,
+   until p(x) evaluates to true; returns true if such an x exists,
+   otherwise false.
+
+   [all p v] applies p to each element x of v, from left to right,
+   until p(x) evaluates to false; returns false if such an x exists,
+   otherwise true.
+
    [foldl f e v] folds function f over v from left to right.  That is,
    computes f(v[len-1], f(v[len-2], ..., f(v[1], f(v[0], e)) ...)),
    where len is the length of v.
@@ -64,60 +82,29 @@
    [map f v] applies f to v[j] for j=0,1,...,length v-1 and returns a 
    new vector containing the results.
    
+   The following iterators generalize the above ones by passing also
+   the vector element index j to the function being iterated.
 
-   The following iterators generalize the above ones in two ways:
-
-    * the index j is also being passed to the function being iterated;
-    * the iterators work on a slice (subvector) of a vector.
-
-   The slice (v, i, SOME n) denotes the subvector v[i..i+n-1].  That is,
-   v[i] is the first element of the slice, and n is the length of the
-   slice.  Valid only if 0 <= i <= i+n <= length v.
-
-   The slice (v, i, NONE) denotes the subvector v[i..length v-1].  That
-   is, the slice denotes the suffix of the vector starting at i.  Valid
-   only if 0 <= i <= length v.  Equivalent to (v, i, SOME(length v - i)).
-
-       slice             meaning 
-       ----------------------------------------------------------
-       (v, 0, NONE)      the whole vector             v[0..len-1]   
-       (v, 0, SOME n)    a left subvector (prefix)    v[0..n-1]
-       (v, i, NONE)      a right subvector (suffix)   v[i..len-1]
-       (v, i, SOME n)    a general slice              v[i..i+n-1] 
-
-   [foldli f e (v, i, SOME n)] folds function f over the subvector
-   v[i..i+n-1] from left to right.  That is, computes 
-   f(i+n-1, v[i+n-1], f(..., f(i+1, v[i+1], f(i, v[i], e)) ...)).  
-   Raises Subscript if i<0 or n<0 or i+n > length v.
-
-   [foldli f e (v, i, NONE)] folds function f over the subvector
-   v[i..len-1] from left to right, where len =  length v.  That is, 
-   computes f(len-1, v[len-1], f(..., f(i+1, v[i+1], f(i, v[i], e)) ...)).  
-   Raises Subscript if i<0 or i > length v.
-
-   [foldri f e (v, i, SOME n)] folds function f over the subvector
-   v[i..i+n-1] from right to left.  That is, computes 
-   f(i, v[i], f(i+1, v[i+1], ..., f(i+n-1, v[i+n-1], e) ...)).
-   Raises Subscript if i<0 or n<0 or i+n > length v.
-
-   [foldri f e (v, i, NONE)] folds function f over the subvector
-   v[i..len-1] from right to left, where len = length v.  That is, 
-   computes f(i, v[i], f(i+1, v[i+1], ..., f(len-1, v[len-1], e) ...)).
-   Raises Subscript if i<0 or i > length v.
-
-   [appi f (v, i, SOME n)] applies f to successive pairs (j, v[j]) for
-   j=i,i+1,...,i+n-1.  Raises Subscript if i<0 or n<0 or i+n > length v.
-
-   [appi f (v, i, NONE)] applies f to successive pairs (j, v[j]) for
-   j=i,i+1,...,len-1, where len = length v.  Raises Subscript if i<0
-   or i > length v.
-
-   [mapi f (v, i, SOME n)] applies f to successive pairs (j, v[j]) for 
-   j=i,i+1,...,i+n-1 and returns a new vector (of length n) containing 
-   the results.  Raises Subscript if i<0 or n<0 or i+n > length v.
-
-   [mapi f (v, i, NONE)] applies f to successive pairs (j, v[j]) for 
-   j=i,i+1,...,len-1, where len = length v, and returns a new vector
-   (of length len-i) containing the results.  Raises Subscript if i<0
-   or i > length v.
+   [findi p a] applies f to successive pairs (j, a[j]) for j=0,1,...,n-1, 
+   until p(j, a[j]) evaluates to true; returns SOME (j, a[j]) if such
+   a pair exists, otherwise NONE.
+
+   [foldli f e v] folds function f over the vector from left to right.
+   That is, computes f(n-1, v[n-1], f(..., f(1, v[1], f(0, v[0], e)) ...))  
+   where n = length v.
+
+   [foldri f e v] folds function f over the vector from right to left.  
+   That is, computes f(0, v[0], f(1, v[1], ..., f(n-1, v[n-1], e) ...))
+   where n = length v.
+
+   [appi f v] applies f to successive pairs (j, v[j]) for j=0,1,...,n-1
+   where n = length v.
+
+   [mapi f v] applies f to successive pairs (j, v[j]) for
+   j=0,1,...,n-1 where n = length v and returns a new vector
+   containing the results.  
+
+   [collate cmp (xs, ys)] returns LESS, EQUAL or GREATER according as
+   xs precedes, equals or follows ys in the lexicographic ordering on
+   vectors induced by the ordering cmp on elements.
 *)
diff -Nru mosml-2.01/src/mosmllib/VectorSlice.sig mosml-2.10.1/src/mosmllib/VectorSlice.sig
--- mosml-2.01/src/mosmllib/VectorSlice.sig	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/VectorSlice.sig	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,141 @@
+(* VectorSlice -- SML Basis Library *)
+
+type 'a slice
+
+val length   : 'a slice -> int
+val sub      : 'a slice * int -> 'a
+val slice    : 'a Vector.vector * int * int option -> 'a slice
+val full     : 'a Vector.vector -> 'a slice
+val subslice : 'a slice * int * int option -> 'a slice
+val base     : 'a slice -> 'a Vector.vector * int * int
+val vector   : 'a slice -> 'a Vector.vector
+val concat   : 'a slice list -> 'a Vector.vector
+val isEmpty  : 'a slice -> bool
+val getItem  : 'a slice -> ('a * 'a slice) option
+
+val find     : ('a -> bool) -> 'a slice -> 'a option
+val exists   : ('a -> bool) -> 'a slice -> bool
+val all      : ('a -> bool) -> 'a slice -> bool
+
+val app      : ('a -> unit) -> 'a slice -> unit
+val map      : ('a -> 'b) -> 'a slice -> 'b Vector.vector
+val foldl    : ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+val foldr    : ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+
+val findi    : (int * 'a -> bool) -> 'a slice -> (int * 'a) option
+val appi     : (int * 'a -> unit) -> 'a slice -> unit
+val mapi     : (int * 'a -> 'b) -> 'a slice -> 'b Vector.vector
+val foldli   : (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+val foldri   : (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+
+val collate  : ('a * 'a -> order) -> 'a slice * 'a slice -> order
+
+(* 
+   ['ty slice] is the type of vector slices, that is, sub-vectors.  
+   The slice (a,i,n) is valid if 0 <= i <= i+n <= size s, 
+                or equivalently, 0 <= i and 0 <= n and i+n <= size s.  
+   A valid slice sli = (a,i,n) represents the sub-vector a[i...i+n-1],
+   so the elements of sli are a[i], a[i+1], ..., a[i+n-1], and n is
+   the length of the slice.  Only valid slices can be constructed by
+   the functions below.
+
+   [length sli] returns the number n of elements in sli = (s,i,n).
+
+   [sub (sli, k)] returns the k'th element of the slice, that is,
+   a(i+k) where sli = (a,i,n).  Raises Subscript if k<0 or k>=n.
+
+   [slice (a, i, NONE)] creates the slice (a, i, length a-i),
+   consisting of the tail of a starting at i.  
+   Raises Subscript if i<0 or i > Vector.length a.  
+   Equivalent to slice (a, i, SOME(Vector.length a - i)).
+
+   [slice (a, i, SOME n)] creates the slice (a, i, n), consisting of
+   the sub-vector of a with length n starting at i.  Raises Subscript
+   if i<0 or n<0 or i+n > Vector.length a.  
+
+       slice             meaning 
+       -----------------------------------------------------------
+       (a, 0, NONE)      the whole vector              a[0..len-1]   
+       (a, 0, SOME n)    a left sub-vector (prefix)    a[0..n-1]
+       (a, i, NONE)      a right sub-vector (suffix)   a[i..len-1]
+       (a, i, SOME n)    a general slice               a[i..i+n-1] 
+
+   [full a] creates the slice (a, 0, Vector.length a).  
+   Equivalent to slice(a,0,NONE)
+
+   [subslice (sli, i', NONE)] returns the slice (a, i+i', n-i') when
+   sli = (a,i,n).  Raises Subscript if i' < 0 or i' > n.
+
+   [subslice (sli, i', SOME n')] returns the slice (a, i+i', n') when
+   sli = (a,i,n).  Raises Subscript if i' < 0 or n' < 0 or i'+n' > n.
+
+   [base sli] is the concrete triple (a, i, n) when sli = (a, i, n).
+
+   [vector sli] creates and returns a vector consisting of the
+   elements of the slice, that is, a[i..i+n-1] when sli = (a,i,n).
+
+   [concat slis] creates a vector containing the concatenation of the
+   slices in slis.
+
+   [isEmpty sli] returns true if the slice sli = (a,i,n) is empty,
+   that is, if n=0.
+
+   [getItem sli] returns SOME(x, rst) where x is the first element and
+   rst the remainder of sli, if sli is non-empty; otherwise returns
+   NONE.  
+
+   [find p sli] applies p to each element x of sli, from left to
+   right, until p(x) evaluates to true; returns SOME x if such an x
+   exists, otherwise NONE.
+
+   [exists p sli] applies p to each element x of sli, from left to right,
+   until p(x) evaluates to true; returns true if such an x exists,
+   otherwise false.
+
+   [all p sli] applies p to each element x of sli, from left to right,
+   until p(x) evaluates to false; returns false if such an x exists,
+   otherwise true.
+
+   [app f sli] applies f to all elements of sli = (a,i,n), from
+   left to right.  That is, applies f to a[j+i] for j=0,1,...,n.
+
+   [map f sli] applies f to all elements of sli = (a,i,n), from left
+   to right, and returns a vector of the results.
+
+   [foldl f e sli] folds function f over sli = (a,i,n) from left to right.  
+   That is, computes f(a[i+n-1], f(a[i+n-2],..., f(a[i+1], f(a[i], e))...)).
+
+   [foldr f e sli] folds function f over sli = (a,i,n) from right to left.  
+   That is, computes f(a[i], f(a[i+1],..., f(a[i+n-2], f(a[i+n-1], e))...)).
+
+   The following iterators generalize the above ones by also passing
+   the index into the vector a underlying the slice to the function
+   being iterated.
+
+   [findi p sli] applies p to the elements of sli = (a,i,n) and the
+   underlying vector indices, and returns the least (j, a[j]) for
+   which p(j, a[j]) evaluates to true, if any; otherwise returns NONE.
+   That is, evaluates p(j, a[j]) for j=i,..i+n-1 until it evaluates to
+   true for some j, then returns SOME(j, a[j]); otherwise returns NONE.
+
+   [appi f sli] applies f to the slice sli = (a,i,n) and the
+   underlying vector indices.  That is, applies f to successive pairs
+   (j, a[j]) for j=i,i+1,...,i+n-1.
+
+   [mapi f sli] applies f to the slice sli = (a,i,n) and the
+   underlying vector indices, and returns a vector of the results.
+   That is, applies f to successive pairs (j, a[j]) for
+   j=i,i+1,...,i+n-1, and returns #[f(i,a[i]), ..., f(i+n-1,a[i+n-1])].
+
+   [foldli f e sli] folds function f over the slice sli = (a,i,n) and
+   the underlying vector indices from left to right.  That is, computes 
+   f(i+n-1, a[i+n-1], f(..., f(i+1, a[i+1], f(i, a[i], e)) ...)).  
+
+   [foldri f e sli] folds function f over the slice sli = (a,i,n) and
+   the underlying vector indices from right to left.  That is, computes
+   f(i, a[i], f(i+1, a[i+1], ..., f(i+n-1, a[i+n-1], e) ...)).
+  
+   [collate cmp (sli1, sli2)] returns LESS, EQUAL or GREATER according
+   as sli1 precedes, equals or follows sli2 in the lexicographic
+   ordering on slices induced by the ordering cmp on elements.
+*)
diff -Nru mosml-2.01/src/mosmllib/VectorSlice.sml mosml-2.10.1/src/mosmllib/VectorSlice.sml
--- mosml-2.01/src/mosmllib/VectorSlice.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/VectorSlice.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,175 @@
+(* VectorSlice -- SML Basis Library 
+   sestoft@dina.kvl.dk 2000-10-18
+*)
+
+local
+    type 'a vector = 'a Vector.vector;
+
+    prim_val vector_ : int -> 'x -> 'a vector          = 2 "make_vect";
+    prim_val subv_   : 'a vector -> int -> 'a          = 2 "get_vect_item";
+    prim_val updatev : 'a vector -> int -> 'a -> unit  = 3 "set_vect_item";
+in
+
+type 'a slice = 'a vector * int * int
+
+(* Invariant on values (a, i, n) of type 'a slice:
+ *                  0 <= i <= i+n <= Vector.length a, 
+ * or equivalently, 0 <= i and 0 <= n and i+n <= Vector.length a.  
+ *)
+
+fun length (a, i, n) = n;
+
+fun sub((a', i', n'), i) = 
+    if i<0 orelse i >= n' then raise Subscript
+    else subv_ a' (i'+i);
+
+fun slice (a, i, len) =
+    let val alen = Vector.length a
+    in 
+	case len of 
+	    NONE   => if 0<=i andalso i<=alen then (a, i, alen - i)
+		      else raise Subscript
+	  | SOME n => if 0<=i andalso 0<=n andalso n<=alen-i then (a, i, n)
+		      else raise Subscript
+    end;
+
+fun full a = (a, 0, Vector.length a);
+
+fun subslice ((a, i, n), i', NONE) =
+    if 0<=i' andalso i'<=n then (a, i+i', n-i')
+    else raise Subscript
+  | subslice ((a, i, n), i', SOME n') =
+    if 0<=i' andalso 0<=n' andalso n'<=n-i' then (a, i+i', n')
+    else raise Subscript;
+		      
+fun base sli = sli;
+
+fun vector (a : 'a vector, i, n) = 
+    let val newvec = vector_ n () : 'a vector
+	fun copy j = 
+	    if j Vector.maxLen then raise Size 
+		     else vector_ len () : 'a vector
+        fun copyall to []                   = () (* Now: to = len *)
+          | copyall to ((v1, i1, n1)::slir) = 
+	    let fun copyv1 j = 
+		if j bool) ((a,i,n) : 'a slice) : 'a option = 
+    let val stop = i+n
+	fun lr j = 
+	    if j < stop then 
+		if p (subv_ a j) then SOME (subv_ a j) else lr (j+1)
+	    else NONE
+    in lr i end;
+
+fun exists (p : 'a -> bool) ((a,i,n) : 'a slice) : bool = 
+    let val stop = i+n
+	fun lr j = j < stop andalso (p (subv_ a j) orelse lr (j+1))
+    in lr i end;
+
+fun all (p : 'a -> bool) ((a,i,n) : 'a slice) : bool = 
+    let val stop = i+n
+	fun lr j = j >= stop orelse (p (subv_ a j) andalso lr (j+1))
+    in lr i end;
+
+fun app f (a, i, n) = 
+    let val stop = i+n
+	fun lr j = if j < stop then (f(subv_ a j); lr (j+1))
+		   else ()
+    in lr i end;
+
+fun map (f : 'a -> 'b) (a : 'a vector, i, n) = 
+    let val newvec = vector_ n () : 'b vector
+	val stop = i+n
+	fun lr j = 
+	    if j < stop then 
+		(updatev newvec (j-i) (f(subv_ a j)); lr (j+1))
+	    else 
+		()
+    in lr i; newvec end;
+
+fun foldl f e (a, i, n) = 
+    let val stop = i+n
+	fun lr j res = if j < stop then lr (j+1) (f(subv_ a j, res))
+		       else res
+    in lr i e end;
+
+fun foldr f e (a, i, n) =
+    let fun rl j res = if j >= i then rl (j-1) (f(subv_ a j, res))
+		       else res
+    in rl (i+n-1) e end;
+
+fun findi (p : int * 'a -> bool) ((a,i,n) : 'a slice) : (int * 'a) option = 
+    let val stop = i+n
+	fun lr j = 
+	    if j < stop then 
+		if p (j, subv_ a j) then SOME (j, subv_ a j) else lr (j+1)
+	    else 
+		NONE
+    in lr i end;
+
+fun appi f (a, i, n) = 
+    let val stop = i+n
+	fun lr j = 
+	    if j < stop then (f(j, subv_ a j); lr (j+1)) 
+	    else ()
+    in lr i end;
+
+fun mapi (f : int * 'a -> 'b) (a : 'a vector, i, n) = 
+    let val newvec = vector_ n () : 'b vector
+	val stop = i+n
+	fun lr j = 
+	    if j < stop then 
+		(updatev newvec (j-i) (f(j, subv_ a j)); lr (j+1))
+	    else 
+		()
+    in lr i; newvec end;
+
+fun foldli f e (a, i, n) = 
+    let val stop = i+n
+	fun lr j res = 
+	    if j < stop then lr (j+1) (f(j, subv_ a j, res))
+	    else res
+    in lr i e end;
+
+fun foldri f e (a, i, n) = 
+    let fun rl j res = 
+	    if j >= i then rl (j-1) (f(j, subv_ a j, res))
+	    else res
+    in rl (i+n-1) e end;
+
+fun collate cmp ((a1,i1,n1), (a2,i2,n2)) =
+    let val stop = if n1 < n2 then n1 else n2
+	fun h j = (* At this point a1[i1..i1+j-1] = a2[i2..i2+j-1] *)
+	    if j = stop then if      n1 < n2 then LESS
+                             else if n1 > n2 then GREATER
+                             else                 EQUAL
+	    else
+		case cmp(subv_ a1 (i1+j), subv_ a2 (i2+j)) of
+		    EQUAL => h (j+1)
+		  | res   => res
+    in h 0 end;
+
+end
diff -Nru mosml-2.01/src/mosmllib/Weak.sig mosml-2.10.1/src/mosmllib/Weak.sig
--- mosml-2.01/src/mosmllib/Weak.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Weak.sig	2014-08-28 08:47:22.000000000 +0000
@@ -46,8 +46,8 @@
    Integers, characters, words and booleans will not be deallocated by
    the garbage collector and will remain reachable forever by a weak
    pointer.  Reals, strings, tuples and other non-nullary constructors
-   may be deallocated by the garbage collector.  Constants, even
-   composite ones, will not be deallocated either.
+   may be deallocated by the garbage collector.  Compile-time constants, 
+   even composite ones, will not be deallocated either.
 
    [weak v] creates and returns a weak pointer to value v.
 
diff -Nru mosml-2.01/src/mosmllib/Word8Array.mlp mosml-2.10.1/src/mosmllib/Word8Array.mlp
--- mosml-2.01/src/mosmllib/Word8Array.mlp	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Word8Array.mlp	2014-08-28 08:47:22.000000000 +0000
@@ -1,4 +1,4 @@
-(* Word8Array -- as of 1994-12-21 *)
+(* Word8Array -- SML Basis Library, PS 1994-12-21, 2000-10-25 *)
 
 type elem   = Word8.word;
 type vector = Word8Vector.vector;
@@ -66,32 +66,43 @@
   if i < 0 orelse i >= length_ a then raise Subscript 
   else update_ a i v;
 
-fun extract (ref a, i, slicelen) =
-    let val n = case slicelen of NONE => length_ a - i | SOME n => n 
-	val newvec = if i<0 orelse n<0 orelse i+n > length_ a then
-	                     raise Subscript
-			 else
-			     vector_ n 
-    in blitav_ a i newvec 0 n; newvec end;
+fun vector (ref a) =
+    let val n = length_ a
+	val newvec = vector_ n 
+    in blitav_ a 0 newvec 0 n; newvec end;
 
-fun copy {src = ref a1: array, si=i1, len, dst = ref a2: array, di=i2} =
-    let val n = case len of NONE => length_ a1 - i1 | SOME k => k
+fun copy {src = ref a1: array, dst = ref a2: array, di=i2} =
+    let val n = length_ a1
     in
-	if n<0 orelse i1<0 orelse i1+n > length_ a1
-	       orelse i2<0 orelse i2+n > length_ a2
-	then raise Subscript
-	else blitaa_ a1 i1 a2 i2 n
+	if i2 < 0 orelse i2+n > length_ a2 then raise Subscript
+	else blitaa_ a1 0 a2 i2 n
     end
 
-fun copyVec {src = a1: vector, si=i1, len, dst = ref a2: array, di=i2} =
-    let val n = case len of NONE => lengthv_ a1 - i1 | SOME k => k
+fun copyVec {src = a1: vector, dst = ref a2: array, di=i2} =
+    let val n = lengthv_ a1
     in
-	if n<0 orelse i1<0 orelse i1+n > lengthv_ a1
-               orelse i2<0 orelse i2+n > length_ a2
-        then raise Subscript
-	else blitva_ a1 i1 a2 i2 n
+	if i2 < 0 orelse i2+n > length_ a2 then raise Subscript
+	else blitva_ a1 0 a2 i2 n
     end
 
+fun find (p : elem -> bool) (ref a) : elem option = 
+    let val stop = length_ a
+	fun lr j = 
+	    if j < stop then 
+		if p (sub_ a j) then SOME (sub_ a j) else lr (j+1)
+	    else NONE
+    in lr 0 end
+
+fun exists (p : elem -> bool) (ref a) : bool = 
+    let val stop = length_ a
+	fun lr j = j < stop andalso (p (sub_ a j) orelse lr (j+1))
+    in lr 0 end
+
+fun all (p : elem -> bool) (ref a) : bool = 
+    let val stop = length_ a
+	fun lr j = j >= stop orelse (p (sub_ a j) andalso lr (j+1))
+    in lr 0 end
+
 fun foldl f e (ref a) = 
     let val stop = length_ a
 	fun lr j res = if j < stop then lr (j+1) (f(sub_ a j, res))
@@ -115,42 +126,52 @@
 		   else ()
     in lr 0 end
 
-fun sliceend (a, i, NONE) = 
-        if i<0 orelse i>length a then raise Subscript
-	else length a
-  | sliceend (a, i, SOME n) = 
-	if i<0 orelse n<0 orelse i+n>length a then raise Subscript
-	else i+n;
-
-fun foldli f e (slice as (ref a, i, _)) = 
-    let fun loop stop =
-	    let fun lr j res = 
-		if j < stop then lr (j+1) (f(j, sub_ a j, res))
-		else res
-	    in lr i e end
-    in loop (sliceend slice) end;
-
-fun foldri f e (slice as (ref a, i, _)) = 
-    let fun loop start =
-	    let fun rl j res = 
-		    if j >= i then rl (j-1) (f(j, sub_ a j, res))
-		    else res
-	    in rl start e end;
-    in loop (sliceend slice - 1) end
-
-fun modifyi f (slice as (ref a, i, _)) = 
-    let fun loop stop =
-	    let fun lr j = 
-		if j < stop then (update_ a j (f(j, sub_ a j)); lr (j+1))
-		else ()
-	    in lr i end
-    in loop (sliceend slice) end;
-
-fun appi f (slice as (ref a, i, _)) = 
-    let fun loop stop = 
-	    let	fun lr j = 
-		    if j < stop then (f(j, sub_ a j); lr (j+1)) 
-		    else ()
-	    in lr i end
-    in loop (sliceend slice) end;
+fun findi (p : int * elem -> bool) (ref a) : (int * elem) option = 
+    let val stop = length_ a
+	fun lr j = 
+	    if j < stop then 
+		if p (j, sub_ a j) then SOME (j, sub_ a j) else lr (j+1)
+	    else NONE
+    in lr 0 end
+
+fun foldli f e (ref a) = 
+    let val stop = length_ a 
+	fun lr j res = 
+	    if j < stop then lr (j+1) (f(j, sub_ a j, res))
+	    else res
+    in lr 0 e end;
+
+fun foldri f e (ref a) = 
+    let fun rl j res = 
+	    if j >= 0 then rl (j-1) (f(j, sub_ a j, res))
+	    else res
+    in rl (length_ a - 1) e end;
+
+fun modifyi f (ref a) = 
+    let val stop = length_ a
+	fun lr j = 
+	    if j < stop then (update_ a j (f(j, sub_ a j)); lr (j+1))
+	    else ()
+    in lr 0 end;
+
+fun appi f (ref a) = 
+    let val stop = length_ a
+	fun lr j = 
+	    if j < stop then (f(j, sub_ a j); lr (j+1)) 
+	    else ()
+    in lr 0 end;
+
+fun collate cmp (ref a1, ref a2) =
+    let val n1 = length_ a1 
+	and n2 = length_ a2
+	val stop = if n1 < n2 then n1 else n2
+	fun h j = (* At this point a1[0..j-1] = a2[0..j-1] *)
+	    if j = stop then if      n1 < n2 then LESS
+                             else if n1 > n2 then GREATER
+                             else                 EQUAL
+	    else
+		case cmp(sub_ a1 j, sub_ a2 j) of
+		    EQUAL => h (j+1)
+		  | res   => res
+    in h 0 end;
 end
diff -Nru mosml-2.01/src/mosmllib/Word8Array.sig mosml-2.10.1/src/mosmllib/Word8Array.sig
--- mosml-2.01/src/mosmllib/Word8Array.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Word8Array.sig	2014-08-28 08:47:22.000000000 +0000
@@ -13,22 +13,27 @@
 val length   : array -> int
 val sub      : array * int -> elem
 val update   : array * int * elem -> unit
-val extract  : array * int * int option -> vector
+val vector   : array -> vector
 
-val copy     : {src: array,  si: int, len: int option, 
-                dst: array, di: int} -> unit
-val copyVec  : {src: vector, si: int, len: int option, 
-                dst: array, di: int} -> unit
+val copy     : {src: array,  dst: array, di: int} -> unit
+val copyVec  : {src: vector, dst: array, di: int} -> unit
+
+val find     : (elem -> bool) -> array -> elem option
+val exists   : (elem -> bool) -> array -> bool
+val all      : (elem -> bool) -> array -> bool
 
 val app      : (elem -> unit) -> array -> unit
 val foldl    : (elem * 'b -> 'b) -> 'b -> array -> 'b
 val foldr    : (elem * 'b -> 'b) -> 'b -> array -> 'b
 val modify   : (elem -> elem) -> array -> unit
 
-val appi     : (int * elem -> unit) -> array * int * int option -> unit
-val foldli   : (int * elem * 'b -> 'b) -> 'b -> array * int * int option -> 'b
-val foldri   : (int * elem * 'b -> 'b) -> 'b -> array * int * int option -> 'b
-val modifyi  : (int * elem -> elem) -> array * int * int option -> unit
+val findi    : (int * elem -> bool) -> array -> (int * elem) option
+val appi     : (int * elem -> unit) -> array -> unit
+val foldli   : (int * elem * 'b -> 'b) -> 'b -> array -> 'b
+val foldri   : (int * elem * 'b -> 'b) -> 'b -> array -> 'b
+val modifyi  : (int * elem -> elem) -> array -> unit
+
+val collate  : (elem * elem -> order) -> array * array -> order
 
 (* 
    [array] is the type of one-dimensional, mutable, zero-based
diff -Nru mosml-2.01/src/mosmllib/Word8ArraySlice.sig mosml-2.10.1/src/mosmllib/Word8ArraySlice.sig
--- mosml-2.01/src/mosmllib/Word8ArraySlice.sig	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Word8ArraySlice.sig	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,51 @@
+(* Word8ArraySlice -- SML Basis Library *)
+
+type elem = Word8.word
+type array = Word8Array.array
+type vector = Word8Vector.vector
+type vector_slice = Word8VectorSlice.slice
+
+type slice
+
+val length   : slice -> int
+val sub      : slice * int -> elem
+val update   : slice * int * elem  -> unit
+val slice    : array * int * int option -> slice
+val full     : array -> slice
+val subslice : slice * int * int option -> slice
+val base     : slice -> array * int * int
+val vector   : slice -> vector
+val copy     : {src: slice, dst: array, di: int} -> unit
+val copyVec  : {src: vector_slice, dst: array, di: int} -> unit 
+val isEmpty  : slice -> bool
+val getItem  : slice -> (elem * slice) option
+
+val find     : (elem -> bool) -> slice -> elem option
+val exists   : (elem -> bool) -> slice -> bool
+val all      : (elem -> bool) -> slice -> bool
+
+val app      : (elem -> unit) -> slice -> unit
+val foldl    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+val foldr    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+val modify   : (elem -> elem) -> slice -> unit
+
+val findi    : (int * elem -> bool) -> slice -> (int * elem) option
+val appi     : (int * elem -> unit) -> slice -> unit
+val foldli   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+val foldri   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+val modifyi  : (int * elem -> elem) -> slice -> unit
+
+val collate  : (elem * elem -> order) -> slice * slice -> order
+
+(* 
+   [slice] is the type of Word8Array slices, that is, sub-arrays of
+   Word8Array.array values.
+   The slice (a,i,n) is valid if 0 <= i <= i+n <= size s, 
+                or equivalently, 0 <= i and 0 <= n and i+n <= size s.  
+   A valid slice sli = (a,i,n) represents the sub-array a[i...i+n-1],
+   so the elements of sli are a[i], a[i+1], ..., a[i+n-1], and n is
+   the length of the slice.  Only valid slices can be constructed by
+   the functions below.
+
+   All operations are as for ArraySlice.slice.
+*)
diff -Nru mosml-2.01/src/mosmllib/Word8ArraySlice.sml mosml-2.10.1/src/mosmllib/Word8ArraySlice.sml
--- mosml-2.01/src/mosmllib/Word8ArraySlice.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Word8ArraySlice.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,210 @@
+(* Word8ArraySlice -- SML Basis Library 
+   sestoft@dina.kvl.dk 2000-10-24
+*)
+
+type elem = Word8.word
+type array = Word8Array.array
+type vector = Word8Vector.vector
+type vector_slice = Word8VectorSlice.slice
+
+local
+    prim_val magic   : 'a -> 'b                        = 1 "identity";
+
+    prim_type array_;
+
+    fun from_array (a : array)  = !(magic a) : array_;
+    prim_val vector_  : int -> vector                 = 1 "create_string";
+    prim_val sub_     : array_ -> int -> elem         = 2 "get_nth_char";
+    prim_val subv_    : vector -> int -> elem         = 2 "get_nth_char";
+    prim_val update_  : array_ -> int -> elem -> unit = 3 "set_nth_char";
+    prim_val updatev  : vector -> int -> elem -> unit = 3 "set_nth_char";
+    prim_val length_  : array_ -> int                 = 1 "string_length";
+in
+
+type slice = array * int * int
+
+(* Invariant on values (a, i, n) of type slice:
+ *                  0 <= i <= i+n <= Word8Array.length a, 
+ * or equivalently, 0 <= i and 0 <= n and i+n <= Word8Array.length a.  
+ *)
+
+fun length (a, i, n) = n;
+
+fun sub((a', i', n'), i) = 
+    if i<0 orelse i >= n' then raise Subscript
+    else sub_ (from_array a') (i'+i);
+
+fun update ((a', i', n'), i, v)  =
+    if i<0 orelse i>=n' then raise Subscript 
+    else update_ (from_array a') (i'+i) v;
+
+fun slice (a, i, len) =
+    let val alen = Word8Array.length a
+    in 
+	case len of 
+	    NONE   => if 0<=i andalso i<=alen then (a, i, alen - i)
+		      else raise Subscript
+	  | SOME n => if 0<=i andalso 0<=n andalso n<=alen-i then (a, i, n)
+		      else raise Subscript
+    end;
+
+fun full a = (a, 0, Word8Array.length a);
+
+fun subslice ((a, i, n), i', NONE) =
+    if 0<=i' andalso i'<=n then (a, i+i', n-i')
+    else raise Subscript
+  | subslice ((a, i, n), i', SOME n') =
+    if 0<=i' andalso 0<=n' andalso n'<=n-i' then (a, i+i', n')
+    else raise Subscript;
+		      
+fun base sli = sli;
+
+fun vector (a : array, i, n) = 
+    let val a = from_array a : array_ 
+	val newvec = vector_ n : vector
+	fun copy j = 
+	    if j length_ a2 then raise Subscript
+	else if i1 < i2 then		(* copy from high to low *)
+	         let fun hi2lo j = 
+		     if j >= 0 then
+			 (update_ a2 (i2+j) (sub_ a1 (i1+j)); hi2lo (j-1))
+		     else ()
+		 in hi2lo (n-1) end
+	     else                       (* i1 >= i2, copy from low to high *)
+		 let fun lo2hi j = 
+		     if j < n then
+			 (update_ a2 (i2+j) (sub_ a1 (i1+j)); lo2hi (j+1))
+		     else ()
+		 in lo2hi 0 end
+    end;
+
+fun copyVec {src : vector_slice, dst=a2: array, di=i2} =
+    let val (a1, i1, n) = Word8VectorSlice.base src
+	val a2 = from_array a2
+    in
+	if i2<0 orelse i2+n > length_ a2 then raise Subscript
+	else 
+	    let fun lo2hi j = if j < n then
+		(update_ a2 (i2+j) (subv_ a1 (i1+j)); lo2hi (j+1))
+			      else ()
+	    in lo2hi 0 end
+    end;
+
+fun isEmpty (_, _, n) = n=0;
+
+fun getItem (a, i, 0) = NONE
+  | getItem (a, i, n) = SOME(sub_ (from_array a) i, (a, i+1, n-1));
+
+fun find (p : elem -> bool) ((a,i,n) : slice) : elem option = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j = 
+	    if j < stop then 
+		if p (sub_ a j) then SOME (sub_ a j) else lr (j+1)
+	    else NONE
+    in lr i end;
+
+fun exists (p : elem -> bool) ((a,i,n) : slice) : bool = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j = j < stop andalso (p (sub_ a j) orelse lr (j+1))
+    in lr i end;
+
+fun all (p : elem -> bool) ((a,i,n) : slice) : bool = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j = j >= stop orelse (p (sub_ a j) andalso lr (j+1))
+    in lr i end;
+
+fun app f (a, i, n) = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j = if j < stop then (f(sub_ a j); lr (j+1))
+		   else ()
+    in lr i end;
+
+fun foldl f e (a, i, n) = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j res = if j < stop then lr (j+1) (f(sub_ a j, res))
+		       else res
+    in lr i e end;
+
+fun foldr f e (a, i, n) =
+    let val a = from_array a
+	fun rl j res = if j >= i then rl (j-1) (f(sub_ a j, res))
+		       else res
+    in rl (i+n-1) e end;
+
+fun modify f (a, i, n) = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j = if j < stop then (update_ a j (f(sub_ a j)); lr (j+1))
+		   else ()
+    in lr i end;
+
+fun findi (p : int * elem -> bool) ((a,i,n) : slice) : (int * elem) option = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j = 
+	    if j < stop then 
+		if p (j, sub_ a j) then SOME (j, sub_ a j) else lr (j+1)
+	    else NONE
+    in lr i end;
+
+fun appi f (a, i, n) = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j = 
+	    if j < stop then (f(j, sub_ a j); lr (j+1)) 
+	    else ()
+    in lr i end;
+
+fun foldli f e (a, i, n) = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j res = 
+	    if j < stop then lr (j+1) (f(j, sub_ a j, res))
+	    else res
+    in lr i e end;
+
+fun foldri f e (a, i, n) = 
+    let val a = from_array a
+	fun rl j res = 
+	    if j >= i then rl (j-1) (f(j, sub_ a j, res))
+	    else res
+    in rl (i+n-1) e end;
+
+fun modifyi f (a, i, n) = 
+    let val a = from_array a
+	val stop = i+n
+	fun lr j = 
+	    if j < stop then (update_ a j (f(j, sub_ a j)); lr (j+1))
+	    else ()
+    in lr i end;
+
+fun collate cmp ((a1,i1,n1), (a2,i2,n2)) =
+    let val a1 = from_array a1
+	and a2 = from_array a2
+	val stop = if n1 < n2 then n1 else n2
+	fun h j = (* At this point a1[i1..i1+j-1] = a2[i2..i2+j-1] *)
+	    if j = stop then if      n1 < n2 then LESS
+                             else if n1 > n2 then GREATER
+                             else                 EQUAL
+	    else
+		case cmp(sub_ a1 (i1+j), sub_ a2 (i2+j)) of
+		    EQUAL => h (j+1)
+		  | res   => res
+    in h 0 end;
+
+end
diff -Nru mosml-2.01/src/mosmllib/Word8.sig mosml-2.10.1/src/mosmllib/Word8.sig
--- mosml-2.01/src/mosmllib/Word8.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Word8.sig	2014-08-28 08:47:22.000000000 +0000
@@ -8,6 +8,7 @@
 val andb       : word * word -> word
 val xorb       : word * word -> word
 val notb       : word -> word
+val ~          : word -> word
 
 val <<         : word * Word.word -> word
 val >>         : word * Word.word -> word
@@ -42,6 +43,10 @@
 val toLargeIntX   : word -> int         (* with sign extension *)
 val fromLargeInt  : int -> word
 
+val toLarge   : word -> Word.word
+val toLargeX  : word -> Word.word   (* with sign extension *)
+val fromLarge : Word.word -> word
+
 val toLargeWord   : word -> Word.word
 val toLargeWordX  : word -> Word.word   (* with sign extension *)
 val fromLargeWord : Word.word -> word
@@ -58,7 +63,9 @@
 
    [xorb(w1, w2)] returns the bitwise `exclusive or' or w1 and w2.
 
-   [notb w] returns the bitwise negation of w.
+   [notb w] returns the bitwise negation (one's complement) of w.
+
+   [~ w] returns the arithmetic negation (two's complement) of w.
 
    [<<(w, k)] returns the word resulting from shifting w left by k
    bits.  The bits shifted in are zero, so this is a logical shift.
@@ -148,12 +155,16 @@
    
    [fromLargeInt i] returns the word holding the 8 least significant bits of i.
 
-   [toLargeWord w] returns the Word.word value corresponding to w.
+   [toLarge w] returns the Word.word value corresponding to w.
 
-   [toLargeWordX w] returns the Word.word value corresponding to w,
+   [toLargeX w] returns the Word.word value corresponding to w,
    with sign extension.  That is, the 8 least significant bits of the
    result are those of w, and the remaining bits are all equal to the
    most significant bit of w: its `sign bit'.
 
-   [fromLargeWord w] returns w modulo 256.
+   [fromLarge w] returns w modulo 256.
+
+   [toLargeWord w] 
+   [toLargeWordX w]
+   [fromLargeWord w] synonyms for toLarge, toLargeX and fromLarge, (deprecated)
 *)
diff -Nru mosml-2.01/src/mosmllib/Word8.sml mosml-2.10.1/src/mosmllib/Word8.sml
--- mosml-2.01/src/mosmllib/Word8.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Word8.sml	2014-08-28 08:47:22.000000000 +0000
@@ -36,17 +36,26 @@
     val fromLargeInt = fromInt
 
     prim_val toLargeWord   : word -> Word.word = 1 "identity";
-    fun toLargeWordX w = if toInt w < 128 then (* msbit = 0 *)
-	                     toLargeWord w
-			 else		       (* msbit = 1 *)
-			     toLargeWord (orb_ w (fromInt_ ~256))
-    fun fromLargeWord w = norm(largeWordToWord_ w);
+    prim_val toLarge       : word -> Word.word = 1 "identity";
+
+    fun toLargeX w = if toInt w < 128 then (* msbit = 0 *)
+	                 toLarge w
+		     else		       (* msbit = 1 *)
+			 toLarge (orb_ w (fromInt_ ~256))
+    fun fromLarge w = norm(largeWordToWord_ w);
+    
+    val toLargeWordX = toLargeX
+    val fromLargeWord = fromLarge
+
+
 
     fun orb (x, y)  = orb_ x y;
     fun andb (x, y) = andb_ x y;
     fun xorb (x, y) = xorb_ x y;
     fun notb x      = norm (xorb_ x (fromInt_ ~1)); 
 
+    val ~ = fn w => fromInt(~(toInt w)) 
+
     fun << (w, k) = 
 	if word2int k >= 8 orelse word2int k < 0 then fromInt_ 0
 	else norm (lshift_ w k);
diff -Nru mosml-2.01/src/mosmllib/Word8Vector.mlp mosml-2.10.1/src/mosmllib/Word8Vector.mlp
--- mosml-2.01/src/mosmllib/Word8Vector.mlp	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Word8Vector.mlp	2014-08-28 08:47:22.000000000 +0000
@@ -9,6 +9,7 @@
     prim_val update_ : vector -> int -> elem -> unit = 3 "set_nth_char";
     prim_val blit_   : vector -> int -> vector -> int -> int -> unit 
                                                      = 5 "blit_string";
+    prim_val magic : 'a -> 'b = 1 "identity";
 in 
 
 prim_val length : vector -> int = 1 "string_length";
@@ -44,13 +45,13 @@
   if i < 0 orelse i >= length v then raise Subscript 
   else sub_ v i;
 
-fun extract (vec, i, slicelen) = 
-    let val n = case slicelen of NONE => length vec - i | SOME n => n
-	val newvec = if i<0 orelse n<0 orelse i+n > length vec then
-	                 raise Subscript
-		     else
-			 vector_ n
-    in blit_ vec i newvec 0 n; newvec end;
+fun update (v : vector, i : int, x : elem) : vector = 
+    let val _ = if i < 0 orelse i >= length v then raise Subscript else ()
+	val stop = length v
+	val newvec = vector_ stop
+	fun lr j = if j < stop then (update_ newvec j (sub_ v j); lr (j+1))
+		   else ()
+    in lr 0; update_ newvec i x; newvec end
 
 fun concat vecs =
     let fun acc [] len       = len
@@ -63,6 +64,24 @@
 	    in blit_ v1 0 newvec to len1; copyall (to+len1) vr end
     in copyall 0 vecs; newvec end;
 
+fun find (p : elem -> bool) (a : vector) : elem option = 
+    let val stop = length a
+	fun lr j = 
+	    if j < stop then 
+		if p (sub_ a j) then SOME (sub_ a j) else lr (j+1)
+	    else NONE
+    in lr 0 end
+
+fun exists (p : elem -> bool) (a : vector) : bool = 
+    let val stop = length a
+	fun lr j = j < stop andalso (p (sub_ a j) orelse lr (j+1))
+    in lr 0 end
+
+fun all (p : elem -> bool) (a : vector) : bool = 
+    let val stop = length a
+	fun lr j = j >= stop orelse (p (sub_ a j) andalso lr (j+1))
+    in lr 0 end
+
 fun foldl f e a = 
     let	val stop = length a
 	fun lr j res = if j < stop then lr (j+1) (f(sub_ a j, res))
@@ -88,6 +107,14 @@
 		   else ()
     in lr 0; newvec end
 
+fun findi (p : int * elem -> bool) (a : vector) : (int * elem) option = 
+    let val stop = length a
+	fun lr j = 
+	    if j < stop then 
+		if p (j, sub_ a j) then SOME (j, sub_ a j) else lr (j+1)
+	    else NONE
+    in lr 0 end
+
 fun sliceend (a, i, NONE) = 
         if i<0 orelse i>length a then raise Subscript
 	else length a
@@ -95,40 +122,37 @@
 	if i<0 orelse n<0 orelse i+n>length a then raise Subscript
 	else i+n;
 
-fun foldli f e (slice as (a, i, _)) = 
-    let fun loop stop =
-	    let fun lr j res = 
-		if j < stop then lr (j+1) (f(j, sub_ a j, res))
-		else res
-	    in lr i e end
-    in loop (sliceend slice) end;
-
-fun foldri f e (slice as (a, i, _)) = 
-    let fun loop start =
-	    let fun rl j res = 
-		    if j >= i then rl (j-1) (f(j, sub_ a j, res))
-		    else res
-	    in rl start e end;
-    in loop (sliceend slice - 1) end
-
-fun appi f (slice as (a, i, _)) = 
-    let fun loop stop = 
-	    let	fun lr j = 
-		    if j < stop then (f(j, sub_ a j); lr (j+1)) 
-		    else ()
-	    in lr i end
-    in loop (sliceend slice) end;
-
-fun mapi (f : int * elem -> elem) (slice as (a : vector, i, _)) : vector = 
-    let val stop = sliceend slice
-	val newvec = vector_ (stop - i)
-	fun loop stop = 
-	    let	fun lr j = 
-		    if j < stop then 
-			(update_ newvec (j-i) (f(j, sub_ a j)); 
-			 lr (j+1)) 
-		    else ()
-	    in lr i end
-    in loop stop; newvec end;
+fun foldli f e a = 
+    let val stop = length a
+	fun lr j res = 
+	    if j < stop then lr (j+1) (f(j, sub_ a j, res))
+	    else res
+    in lr 0 e end;
+
+fun foldri f e a = 
+    let fun rl j res = 
+	if j >= 0 then rl (j-1) (f(j, sub_ a j, res))
+	else res
+    in rl (length a - 1) e end;
+
+fun appi f a = 
+    let val stop = length a 
+	fun lr j = 
+	    if j < stop then (f(j, sub_ a j); lr (j+1)) 
+	    else ()
+    in lr 0 end;
+
+fun mapi (f : int * elem -> elem) a : vector = 
+    let val stop = length a
+	val newvec = vector_ stop
+	fun lr j = 
+	    if j < stop then 
+		(update_ newvec j (f(j, sub_ a j)); 
+		 lr (j+1)) 
+	    else ()
+    in lr 0; newvec end;
+
+val collate  : (elem * elem -> order) -> vector * vector -> order 
+                                                = magic String.collate
 end
 
diff -Nru mosml-2.01/src/mosmllib/Word8Vector.sig mosml-2.10.1/src/mosmllib/Word8Vector.sig
--- mosml-2.01/src/mosmllib/Word8Vector.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Word8Vector.sig	2014-08-28 08:47:22.000000000 +0000
@@ -10,18 +10,25 @@
 
 val length   : vector -> int
 val sub      : vector * int -> elem
-val extract  : vector * int * int option -> vector
+val update   : vector * int * elem -> vector
 val concat   : vector list -> vector
 
+val find     : (elem -> bool) -> vector -> elem option
+val exists   : (elem -> bool) -> vector -> bool
+val all      : (elem -> bool) -> vector -> bool
+
 val app      : (elem -> unit) -> vector -> unit
 val map      : (elem -> elem) -> vector -> vector
 val foldl    : (elem * 'b -> 'b) -> 'b -> vector -> 'b
 val foldr    : (elem * 'b -> 'b) -> 'b -> vector -> 'b
 
-val appi     : (int * elem -> unit) -> vector * int * int option -> unit
-val mapi     : (int * elem -> elem) -> vector * int * int option -> vector
-val foldli   : (int * elem * 'b -> 'b) -> 'b -> vector*int*int option -> 'b
-val foldri   : (int * elem * 'b -> 'b) -> 'b -> vector*int*int option -> 'b
+val findi    : (int * elem -> bool) -> vector -> (int * elem) option
+val appi     : (int * elem -> unit) -> vector -> unit
+val mapi     : (int * elem -> elem) -> vector -> vector
+val foldli   : (int * elem * 'b -> 'b) -> 'b -> vector -> 'b
+val foldri   : (int * elem * 'b -> 'b) -> 'b -> vector -> 'b
+
+val collate  : (elem * elem -> order) -> vector * vector -> order
 
 (* 
    [vector] is the type of one-dimensional, immutable, zero-based
diff -Nru mosml-2.01/src/mosmllib/Word8VectorSlice.sig mosml-2.10.1/src/mosmllib/Word8VectorSlice.sig
--- mosml-2.01/src/mosmllib/Word8VectorSlice.sig	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Word8VectorSlice.sig	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,47 @@
+(* Word8VectorSlice -- SML Basis Library *)
+
+type elem = Word8.word
+type vector = Word8Vector.vector
+
+type slice
+
+val length   : slice -> int
+val sub      : slice * int -> elem
+val slice    : vector * int * int option -> slice
+val full     : vector -> slice
+val subslice : slice * int * int option -> slice
+val base     : slice -> vector * int * int
+val vector   : slice -> vector
+val concat   : slice list -> vector
+val isEmpty  : slice -> bool
+val getItem  : slice -> (elem * slice) option
+
+val find     : (elem -> bool) -> slice -> elem option
+val exists   : (elem -> bool) -> slice -> bool
+val all      : (elem -> bool) -> slice -> bool
+
+val app      : (elem -> unit) -> slice -> unit
+val map      : (elem -> elem) -> slice -> vector
+val foldl    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+val foldr    : (elem * 'b -> 'b) -> 'b -> slice -> 'b
+
+val findi    : (int * elem -> bool) -> slice -> (int * elem) option
+val appi     : (int * elem -> unit) -> slice -> unit
+val mapi     : (int * elem -> elem) -> slice -> vector
+val foldli   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+val foldri   : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
+
+val collate  : (elem * elem -> order) -> slice * slice -> order
+
+(* 
+   [slice] is the type of Word8Vector slices, that is, sub-vectors of
+   Word8Vector.vector values.
+   The slice (a,i,n) is valid if 0 <= i <= i+n <= size s, 
+                or equivalently, 0 <= i and 0 <= n and i+n <= size s.  
+   A valid slice sli = (a,i,n) represents the sub-vector a[i...i+n-1],
+   so the elements of sli are a[i], a[i+1], ..., a[i+n-1], and n is
+   the length of the slice.  Only valid slices can be constructed by
+   these functions.
+
+   All operations are as for VectorSlice.slice.
+*)
diff -Nru mosml-2.01/src/mosmllib/Word8VectorSlice.sml mosml-2.10.1/src/mosmllib/Word8VectorSlice.sml
--- mosml-2.01/src/mosmllib/Word8VectorSlice.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Word8VectorSlice.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,179 @@
+(* Word8VectorSlice -- SML Basis Library 
+   sestoft@dina.kvl.dk 2000-10-24
+*)
+
+type elem = Word8.word
+type vector = Word8Vector.vector
+
+local
+    prim_val vector_ : int -> vector                 = 1 "create_string";
+    prim_val sub_    : vector -> int -> elem         = 2 "get_nth_char";
+    prim_val update_ : vector -> int -> elem -> unit = 3 "set_nth_char";
+    prim_val blit_   : vector -> int -> vector -> int -> int -> unit 
+                                                     = 5 "blit_string";
+    prim_val magic : 'a -> 'b = 1 "identity";
+in
+
+type slice = vector * int * int
+
+(* Invariant on values (a, i, n) of type slice:
+ *                  0 <= i <= i+n <= Word8Vector.length a, 
+ * or equivalently, 0 <= i and 0 <= n and i+n <= Word8Vector.length a.  
+ *)
+
+fun length (a, i, n) = n;
+
+fun sub((a', i', n'), i) = 
+    if i<0 orelse i >= n' then raise Subscript
+    else sub_ a' (i'+i);
+
+fun slice (a, i, len) =
+    let val alen = Word8Vector.length a
+    in 
+	case len of 
+	    NONE   => if 0<=i andalso i<=alen then (a, i, alen - i)
+		      else raise Subscript
+	  | SOME n => if 0<=i andalso 0<=n andalso n<=alen-i then (a, i, n)
+		      else raise Subscript
+    end;
+
+fun full a = (a, 0, Word8Vector.length a);
+
+fun subslice ((a, i, n), i', NONE) =
+    if 0<=i' andalso i'<=n then (a, i+i', n-i')
+    else raise Subscript
+  | subslice ((a, i, n), i', SOME n') =
+    if 0<=i' andalso 0<=n' andalso n'<=n-i' then (a, i+i', n')
+    else raise Subscript;
+		      
+fun base sli = sli;
+
+fun vector (a : vector, i, n) = 
+    let val newvec = vector_ n : vector
+	fun copy j = 
+	    if j Word8Vector.maxLen then raise Size 
+		     else vector_ len : vector
+        fun copyall to []                   = () (* Now: to = len *)
+          | copyall to ((v1, i1, n1)::slir) = 
+	    let fun copyv1 j = 
+		if j bool) ((a,i,n) : slice) : elem option = 
+    let val stop = i+n
+	fun lr j = 
+	    if j < stop then 
+		if p (sub_ a j) then SOME (sub_ a j) else lr (j+1)
+	    else NONE
+    in lr i end;
+
+fun exists (p : elem -> bool) ((a,i,n) : slice) : bool = 
+    let val stop = i+n
+	fun lr j = j < stop andalso (p (sub_ a j) orelse lr (j+1))
+    in lr i end;
+
+fun all (p : elem -> bool) ((a,i,n) : slice) : bool = 
+    let val stop = i+n
+	fun lr j = j >= stop orelse (p (sub_ a j) andalso lr (j+1))
+    in lr i end;
+
+fun app f (a, i, n) = 
+    let val stop = i+n
+	fun lr j = if j < stop then (f(sub_ a j); lr (j+1))
+		   else ()
+    in lr i end;
+
+fun map (f : elem -> elem) (a : vector, i, n) : vector = 
+    let val newvec = vector_ n : vector
+	val stop = i+n
+	fun lr j = 
+	    if j < stop then 
+		(update_ newvec (j-i) (f(sub_ a j)); lr (j+1))
+	    else 
+		()
+    in lr i; newvec end;
+
+fun foldl f e (a, i, n) = 
+    let val stop = i+n
+	fun lr j res = if j < stop then lr (j+1) (f(sub_ a j, res))
+		       else res
+    in lr i e end;
+
+fun foldr f e (a, i, n) =
+    let fun rl j res = if j >= i then rl (j-1) (f(sub_ a j, res))
+		       else res
+    in rl (i+n-1) e end;
+
+fun findi (p : int * elem -> bool) ((a,i,n) : slice) : (int * elem) option = 
+    let val stop = i+n
+	fun lr j = 
+	    if j < stop then 
+		if p (j, sub_ a j) then SOME (j, sub_ a j) else lr (j+1)
+	    else 
+		NONE
+    in lr i end;
+
+fun appi f (a, i, n) = 
+    let val stop = i+n
+	fun lr j = 
+	    if j < stop then (f(j, sub_ a j); lr (j+1)) 
+	    else ()
+    in lr i end;
+
+fun mapi (f : int * elem -> elem) (a : vector, i, n) = 
+    let val newvec = vector_ n : vector
+	val stop = i+n
+	fun lr j = 
+	    if j < stop then 
+		(update_ newvec (j-i) (f(j, sub_ a j)); lr (j+1))
+	    else 
+		()
+    in lr i; newvec end;
+
+fun foldli f e (a, i, n) = 
+    let val stop = i+n
+	fun lr j res = 
+	    if j < stop then lr (j+1) (f(j, sub_ a j, res))
+	    else res
+    in lr i e end;
+
+fun foldri f e (a, i, n) = 
+    let fun rl j res = 
+	    if j >= i then rl (j-1) (f(j, sub_ a j, res))
+	    else res
+    in rl (i+n-1) e end;
+
+fun collate cmp ((a1,i1,n1), (a2,i2,n2)) =
+    let val stop = if n1 < n2 then n1 else n2
+	fun h j = (* At this point a1[i1..i1+j-1] = a2[i2..i2+j-1] *)
+	    if j = stop then if      n1 < n2 then LESS
+                             else if n1 > n2 then GREATER
+                             else                 EQUAL
+	    else
+		case cmp(sub_ a1 (i1+j), sub_ a2 (i2+j)) of
+		    EQUAL => h (j+1)
+		  | res   => res
+    in h 0 end;
+
+end
diff -Nru mosml-2.01/src/mosmllib/Word.mlp mosml-2.10.1/src/mosmllib/Word.mlp
--- mosml-2.01/src/mosmllib/Word.mlp	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Word.mlp	2014-08-28 08:47:22.000000000 +0000
@@ -1,5 +1,5 @@
 (* Word -- SML Basis Library 1994-11-01, 1995-04-06, 1995-07-12, 
-   1996-04-01, 1999-08-05 *)
+   1996-04-01, 1999-08-05, 2000-10-24 *)
 
 (* This unit relies on two's complement representation *)
 
@@ -44,11 +44,17 @@
     prim_val toLargeWordX  : word -> word = 1 "identity";
     prim_val fromLargeWord : word -> word = 1 "identity";
 
+    prim_val toLarge   : word -> word = 1 "identity";
+    prim_val toLargeX  : word -> word = 1 "identity";
+    prim_val fromLarge : word -> word = 1 "identity";
+
+
     fun orb (x, y)  = orb_ x y;
     fun andb (x, y) = andb_ x y;
     fun xorb (x, y) = xorb_ x y;
     fun notb x      = xorb_ x (fromInt ~1); 
 
+    val ~ = fn w => fromInt(~(toInt w)) 
 
     fun << (w, k) = 
 	if toInt k >= WORDSIZE orelse toInt k < 0 then fromInt 0
diff -Nru mosml-2.01/src/mosmllib/Word.sig mosml-2.10.1/src/mosmllib/Word.sig
--- mosml-2.01/src/mosmllib/Word.sig	2000-04-24 19:57:14.000000000 +0000
+++ mosml-2.10.1/src/mosmllib/Word.sig	2014-08-28 08:47:22.000000000 +0000
@@ -8,6 +8,7 @@
 val andb       : word * word -> word
 val xorb       : word * word -> word
 val notb       : word -> word
+val ~          : word -> word
 
 val <<         : word * word -> word
 val >>         : word * word -> word
@@ -38,6 +39,10 @@
 val toIntX     : word -> int            (* with sign extension *)
 val fromInt    : int -> word
 
+val toLarge    : word -> word
+val toLargeX   : word -> word        (* with sign extension *)
+val fromLarge  : word -> word
+
 val toLargeWord   : word -> word
 val toLargeWordX  : word -> word        (* with sign extension *)
 val fromLargeWord : word -> word
@@ -58,7 +63,9 @@
 
    [xorb(w1, w2)] returns the bitwise `exclusive or' or w1 and w2.
 
-   [notb w] returns the bitwise negation of w.
+   [notb w] returns the bitwise negation (one's complement) of w.
+
+   [~ w] returns the arithmetic negation (two's complement) of w.
 
    [<<(w, k)] returns the word resulting from shifting w left by k
    bits.  The bits shifted in are zero, so this is a logical shift.
@@ -134,15 +141,29 @@
       DEC     (0w)?[0-9]+
       HEX     (0wx|0wX|0x|0X)?[0-9a-fA-F]+
 
-   [toInt w] returns the (signed) integer represented by bit-pattern w.
-   [toIntX w] returns the (signed) integer represented by bit-pattern w.
-   [fromInt i] returns the word representing integer i.
+   [toInt w] returns the (non-negative) default size int represented
+   by bit-pattern w.  Raises Overflow in case w is not representable
+   as an integer.
+
+   [toIntX w] returns the (signed) default size int represented by
+   twos's complement bit-pattern w.
+
+   [fromInt i] returns the word (bit-pattern) representing integer i.
+
+   [toLargeInt w] returns the (non-negative) largest size int
+   represented by bit-pattern w.  Raises Overflow in case w is not
+   representable as an integer.
+
+   [toLargeIntX w] returns the (signed) largest size int represented
+   by two's complement bit-pattern w.  
 
-   [toLargeInt w] returns the (signed) integer represented by bit-pattern w.
-   [toLargeIntX w] returns the (signed) integer represented by bit-pattern w.
    [fromLargeInt i] returns the word representing integer i.
 
-   [toLargeWord w] returns w.
-   [toLargeWordX w] returns w.
-   [fromLargeWord w] returns w.
+   [toLarge w] returns w.
+   [toLargeX w] returns w.
+   [fromLarge w] returns w.
+
+   [toLargeWord w] returns w (deprecated).
+   [toLargeWordX w] returns w (deprecated).
+   [fromLargeWord w] returns w (deprecated).
 *)
Binary files /tmp/HAzJFmIrvn/mosml-2.01/src/mosmllnk and /tmp/A1vl5z0ZBv/mosml-2.10.1/src/mosmllnk differ
Binary files /tmp/HAzJFmIrvn/mosml-2.01/src/mosmllnk.w32 and /tmp/A1vl5z0ZBv/mosml-2.10.1/src/mosmllnk.w32 differ
diff -Nru mosml-2.01/src/mosmlpm/.cvsignore mosml-2.10.1/src/mosmlpm/.cvsignore
--- mosml-2.01/src/mosmlpm/.cvsignore	2000-07-19 15:19:15.000000000 +0000
+++ mosml-2.10.1/src/mosmlpm/.cvsignore	1970-01-01 00:00:00.000000000 +0000
@@ -1 +0,0 @@
-*.u? mosmlpm pm
diff -Nru mosml-2.01/src/mosmlpm/.gitignore mosml-2.10.1/src/mosmlpm/.gitignore
--- mosml-2.01/src/mosmlpm/.gitignore	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmlpm/.gitignore	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1 @@
+*.u? mosmlpm pm
diff -Nru mosml-2.01/src/mosmlpm/Makefile mosml-2.10.1/src/mosmlpm/Makefile
--- mosml-2.01/src/mosmlpm/Makefile	2000-07-19 15:27:24.000000000 +0000
+++ mosml-2.10.1/src/mosmlpm/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -33,4 +33,4 @@
 #	cd test; make clean
 
 install:
-	${INSTALL_DATA} mosmlpm $(LIBDIR)
+	${INSTALL_DATA} mosmlpm $(DESTDIR)$(LIBDIR)
diff -Nru mosml-2.01/src/mosmlpm/PMCompile.sml mosml-2.10.1/src/mosmlpm/PMCompile.sml
--- mosml-2.01/src/mosmlpm/PMCompile.sml	2000-07-19 21:07:38.000000000 +0000
+++ mosml-2.10.1/src/mosmlpm/PMCompile.sml	2014-08-28 08:47:22.000000000 +0000
@@ -64,7 +64,8 @@
 
 		  
     (* Functions fo manipulating context *)
-    type context = Time.time          (* the newest ui encountered *) 
+
+   type context = Time.time          (* the newest ui encountered *) 
                  * filename list list (* the set of ui files to pass to the 
                                          compiler.*)
 
@@ -192,7 +193,8 @@
 	let fun compileFile toplevel file next =
                 if isSML file
 		then
-		    let val name = OS.Path.mkAbsolute(file,path)
+		    let val name = OS.Path.mkAbsolute{path       = file, 
+                                                      relativeTo = path}
 			val options = if toplevel then ["-toplevel"]
 				      else ["-structure"]
 			fun compile file =
@@ -266,7 +268,8 @@
     
     fun findFilesBody path body accu =
 	let fun findFilesFile file body = 
-		let val name = OS.Path.mkAbsolute(file,path)
+		let val name = OS.Path.mkAbsolute{path       = file,
+                                                  relativeTo = path}
 		in  findFilesBody path body (name :: accu) 
 		end
 	in 
diff -Nru mosml-2.01/src/mosmlpm/Systemcompile.sml mosml-2.10.1/src/mosmlpm/Systemcompile.sml
--- mosml-2.01/src/mosmlpm/Systemcompile.sml	2000-07-19 15:21:59.000000000 +0000
+++ mosml-2.10.1/src/mosmlpm/Systemcompile.sml	2014-08-28 08:47:22.000000000 +0000
@@ -18,7 +18,7 @@
 	    val sargs = String.concat ("mosmlc -c " ::args)
 	in  
 	    debug [sargs] 
-	  ; Proc.system sargs = Proc.success
+	  ; Proc.isSuccess (Proc.system sargs)
 	end
 
     fun link debug options files file =
@@ -27,7 +27,7 @@
 	    val sargs = String.concat ("mosmlc -o " :: file :: " " :: args)
 	in  
 	    debug [sargs] 
-	  ; Proc.system sargs = Proc.success
+	  ; Proc.isSuccess (Proc.system sargs)
 	end
     
 end
diff -Nru mosml-2.01/src/mosmlpm/TECHNICAL mosml-2.10.1/src/mosmlpm/TECHNICAL
--- mosml-2.01/src/mosmlpm/TECHNICAL	2000-07-16 18:44:26.000000000 +0000
+++ mosml-2.10.1/src/mosmlpm/TECHNICAL	2014-08-28 08:47:22.000000000 +0000
@@ -1,7 +1,7 @@
 This is an -*- indented-text -*- document describing some of the
 technical details behind mosmlpm.
 
-Last mosdified by ken Friis Larsen  July 15, 2000.
+Last modified by Ken Friis Larsen  July 15, 2000.
 
 
 Filenames
@@ -14,7 +14,7 @@
 
 Recompilation and cut-off
 -------------------------
-We have tow cases for a .sml file:
+We have two cases for a .sml file:
 
 1. When no .sig exists:
    Then .sml sould be recompiled if 
diff -Nru mosml-2.01/src/mosmlyac/defs.h mosml-2.10.1/src/mosmlyac/defs.h
--- mosml-2.01/src/mosmlyac/defs.h	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmlyac/defs.h	2014-08-28 08:47:22.000000000 +0000
@@ -1,10 +1,19 @@
 #include 
 #include 
 #include 
+
+#include 
+#include 
+
+#if __STDC__
+#define ANSI
+#endif
+
 #ifdef ANSI
 #include 
 #endif
 
+
 #ifdef macintosh
 #include 
 #endif
@@ -418,7 +427,7 @@
 
 extern void verbose(void);
 
-/* warshell.c */
+/* warshall.c */
 
 extern void reflexive_transitive_closure(unsigned *R, int n);
 
diff -Nru mosml-2.01/src/mosmlyac/.gitignore mosml-2.10.1/src/mosmlyac/.gitignore
--- mosml-2.01/src/mosmlyac/.gitignore	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/mosmlyac/.gitignore	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,3 @@
+*.o
+/mosmlyac.exe
+mosmlyac
diff -Nru mosml-2.01/src/mosmlyac/Makefile mosml-2.10.1/src/mosmlyac/Makefile
--- mosml-2.01/src/mosmlyac/Makefile	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmlyac/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -9,16 +9,25 @@
 
 all: mosmlyac$(EXE)
 
-mosmlyac$(EXE): $(OBJS)
-	$(CC) $(CFLAGS) -o mosmlyac$(EXE) $(OBJS)
-	$(STRIP) mosmlyac$(EXE)
+mosmlyac: $(OBJS)
+	$(CC) $(CFLAGS) -o mosmlyac $(OBJS)
+	$(STRIP) mosmlyac
 
-clean:
+mosmlyac.exe: $(OBJS)
+	$(CC) $(CFLAGS) -o mosmlyac.exe $(OBJS) -mconsole
+	$(STRIP) mosmlyac.exe
+
+
+clean_obj:
 	rm -f *.o
-	rm -f mosmlyac$(EXE)
+
+clean: clean_obj
+	rm -f mosmlyac mosmlyac.exe
+
+
 
 install:
-	${INSTALL_PROGRAM} mosmlyac$(EXE) $(BINDIR)/mosmlyac$(EXE)
+	${INSTALL_PROGRAM} mosmlyac$(EXE) $(DESTDIR)$(BINDIR)/mosmlyac$(EXE)
 
 depend:
 
diff -Nru mosml-2.01/src/mosmlyac/mkpar.c mosml-2.10.1/src/mosmlyac/mkpar.c
--- mosml-2.01/src/mosmlyac/mkpar.c	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmlyac/mkpar.c	2014-08-28 08:47:22.000000000 +0000
@@ -190,10 +190,12 @@
 	if (!rules_used[i]) ++nunused;
 
     if (nunused)
+    {
 	if (nunused == 1)
 	    fprintf(stderr, "%s: 1 rule never reduced\n", myname);
 	else
 	    fprintf(stderr, "%s: %d rules never reduced\n", myname, nunused);
+    }
 }
 
 
diff -Nru mosml-2.01/src/mosmlyac/reader.c mosml-2.10.1/src/mosmlyac/reader.c
--- mosml-2.01/src/mosmlyac/reader.c	2000-04-28 09:38:45.000000000 +0000
+++ mosml-2.10.1/src/mosmlyac/reader.c	2014-08-28 08:47:22.000000000 +0000
@@ -271,6 +271,7 @@
     }
     syntax_error(lineno, line, t_cptr);
     /*NOTREACHED*/
+    return 0;
 }
 
 
@@ -1182,7 +1183,7 @@
 	expand_items();
     bpp = pitem + nitems - 1;
     *bpp-- = bp;
-    while (bpp[0] = bpp[-1]) --bpp;
+    while ((bpp[0] = bpp[-1])) --bpp;
 
     if (++nrules >= maxrules)
 	expand_rules();
@@ -1523,7 +1524,7 @@
     {
 	p = t;
 	s = bp->name;
-	while (*t++ = *s++) continue;
+	while ((*t++ = *s++)) continue;
 	FREE(bp->name);
 	bp->name = p;
     }
diff -Nru mosml-2.01/src/mosmlyac/symtab.c mosml-2.10.1/src/mosmlyac/symtab.c
--- mosml-2.01/src/mosmlyac/symtab.c	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/mosmlyac/symtab.c	2014-08-28 08:47:22.000000000 +0000
@@ -17,7 +17,7 @@
     assert(name && *name);
     s = name;
     k = *s;
-    while (c = *++s)
+    while ((c = *++s))
 	k = (31*k + c) & (TABLE_SIZE - 1);
 
     return (k);
Binary files /tmp/HAzJFmIrvn/mosml-2.01/src/notes/a.out and /tmp/A1vl5z0ZBv/mosml-2.10.1/src/notes/a.out differ
diff -Nru mosml-2.01/src/notes/dynamicexn.txt mosml-2.10.1/src/notes/dynamicexn.txt
--- mosml-2.01/src/notes/dynamicexn.txt	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/notes/dynamicexn.txt	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,381 @@
+Getting rid of static exceptions in the Moscow ML implementation
+----------------------------------------------------------------
+
+sestoft@dina.kvl.dk 1999-10-28, 1999-10-29, 2000-01-23
+
+The problem: both the runtime system and the ML bytecode need to raise
+certain built-in exceptions, which must be handlable from the bytecode
+and the interactive system.
+
+
+Current representation of exceptions
+------------------------------------
+
+A static exception is identified by a static exception stamp (or tag).
+
+A dynamic exception is represented as a special static exception
+(called smlExnEi in compiler/Match.sml) which takes as argument a pair
+containing a string ref (the exn name) and an argument (of type unit
+if the dynamic excon is nullary).
+
+
+Desirable runtime representation of an exception
+------------------------------------------------
+
+An exception name (in the sense of the Definition) is a string ref.
+
+A nullary exception value is a pair holding an exception name and () :
+unit, that is, Atom(0).
+
+A unary exception is a pair holding an exception name and the argument
+(a value).
+
+A nullary exception value matches an exception pattern if the
+exception names are equal, according to reference equality.
+
+A unary exception value matches an exception pattern if the exception
+names are equal, and the arguments match, according to reference
+equality.
+
+The referred-to string is used for printing the exception.  It may
+even be used by runtime/main.c to print the exception's string name:
+
+	printf("Uncaught exception: %s\n", String_val(Field(exn_bucket, 0)))
+
+The exception binding 
+
+	  exception A = B
+
+means that exn A prints the same as exn B.
+
+
+
+
+Possible implementations
+------------------------
+
+(1) Let the runtime system allocate the exception names and bind them
+    in global_data so that the bytecode can access them through the
+    prim_val mechanism.
+
+    There already is a mechanism for communication values between the
+    runtime system and the ML bytecode (including the interactive
+    system): globals.h, sys.c, Memory.sml, Rtvals.sml
+
+    * We'll do this.
+
+(2) Let the bytecode linker allocate these exceptions and bind them in
+    the global_data table.  
+
+
+The runtime system reads in the global_data from the bytecode file,
+then overwrites the first 19 entries of the table.  How does the
+bytecode anticipate this?  The bytecode linker sets aside the first 19
+entries of the global_data table, so that they can be safely
+overwritten by the runtime system.  This is done in the function
+Symtable.reset_linker_tables, which allocates all variables mentioned
+in Predef.predef_variables.
+
+Hence Predef compiled into the linker (mosmllnk) determines how global
+variables are linked.  Thus one can bootstrap as follows:
+
+ 1. Update the runtime system's globals.h and regenerate Predef.sml
+ 2. Using the old runtime system, recompile mosmllnk
+ 3. Using the old runtime system, use mosmllnk to relink mosmlcmp and
+    mosmllnk
+ 4. Using the new runtime system, recompile mosmllnk and mosmlcmp
+
+Careful: in Maint.sml the constant 16 is used as an offset into the
+global_data vector.  This abuse is necessary because the prim_val
+mechanism gives read access only to the globals.  Better do a
+conservative extension of the globals table.
+
+What exceptions must be raisable from the runtime system (fail.h)?
+
+Used by the runtime system (+), not used by the runtime system, but
+elsewhere (*), and those not used at all (-):
+
++ #define OUT_OF_MEMORY_EXN 0     /* "exc","Out_of_memory",1 */
++ #define SYS_ERROR_EXN 1         /* "sys","Sys_error",1 */
++ #define FAILURE_EXN 2           /* "exc","Failure",3 */
++ #define INVALID_EXN 3           /* "exc","Invalid_argument",2 */
++ #define END_OF_FILE_EXN 4       /* "io","End_of_file",1 */
+- #define ZERO_DIVIDE_EXN 5       /* "int","Division_by_zero",1 */
++ #define BREAK_EXN 6             /* "sys","Break",2 */
++ #define NOT_FOUND_EXN 7         /* "exc","Not_found",4 */
+- #define UNIX_ERROR_EXN 8        /* "unix","Unix_error",1 */
++ #define GRAPHIC_FAILURE_EXN 9   /* "graphics","Graphic_failure",1 */
+- #define PARSE_FAILURE_EXN 10    /* "stream","Parse_failure",1 */
+
+/* Additional predefined exceptions for Moscow ML */
+
+- #define SMLEXN_EXCEPTION 11     /* "general","Exception",1 */
+* #define SMLEXN_BIND      12     /* "general","Bind",2 */
++ #define SMLEXN_CHR       13     /* "general","Chr",3 */
++ #define SMLEXN_DIV       14     /* "general","Div",4 */
++ #define SMLEXN_DOMAIN    15     /* "general","Domain",5 */
+* #define SMLEXN_MATCH     16     /* "general","Match",6 */
++ #define SMLEXN_ORD       17     /* "general","Ord",7 */
++ #define SMLEXN_OVF       18     /* "general","Overflow",8 */
+
+
+How to create the exceptions in the runtime system?
+
+Allocation of the strings may cause the garbage collector to run, but
+global_data is always in the old (shared) generation, whether
+allocated by intern_val() or by realloc_global().  Hence there's no
+need to register the global_data pointer.  Better put the refs in the
+old heap so they don't move (they'll never be deallocated anyway).
+
+value mkexnname(char* name) {
+  value ref;
+  Push_roots(r, 1);
+  r[0] = copy_string(name);
+  ref = alloc_shr(1, Reference_tag);
+  modify(&Field(ref, 0), r[0]);
+  Pop_roots();
+  return ref;
+}
+
+in globals.h:
+
+#define SYS__EXN_MEMORY     19   /* "sys","exn_memory" */
+#define SYS__EXN_ARGUMENT   20   /* "sys","exn_argument" */
+#define SYS__EXN_GRAPHIC    21   /* "sys","exn_graphic" */
+#define SYS__EXN_SYSERR     22   /* "sys","exn_syserr" */
+#define SYS__EXN_FAIL       23   /* "sys","exn_fail" */
+#define SYS__EXN_SIZE       24   /* "sys","exn_size" */
+#define SYS__EXN_INTERRUPT  25   /* "sys","exn_interrupt" */
+#define SYS__EXN_SUBSCRIPT  26   /* "sys","exn_subscript" */
+#define SYS__EXN_CHR        27   /* "sys","exn_chr" */
+#define SYS__EXN_DIV        28   /* "sys","exn_div" */
+#define SYS__EXN_DOMAIN     29   /* "sys","exn_domain" */
+#define SYS__EXN_ORD        30   /* "sys","exn_ord" */
+#define SYS__EXN_OVERFLOW   31   /* "sys","exn_overflow" */
+#define SYS__EXN_BIND       32   /* "sys","exn_bind" */
+#define SYS__EXN_MATCH      33   /* "sys","exn_match" */
+
+#define SYS__FIRST_EXN 19
+#define SYS__LAST_EXN 33
+
+in sys_init:
+
+char* globalexn[] = { 
+       "Out_of_memory",
+       "Invalid_argument",
+       "Graphic_failure",
+       "SysErr",
+       "Fail",
+       "Size",
+       "Interrupt",
+       "Subscript",
+       "Chr",
+       "Div",
+       "Domain",
+       "Ord",
+       "Overflow" }
+
+for (i = SYS__FIRST_EXN; i <= SYS__LAST_EXN ; i++) {
+   value exn = mkexn(globalexn[i - SYS__FIRST_EXN]);
+   modify(&Field(global_data, i), exn);
+}
+
+
+Also in the new system, exn_bucket should hold the exception value (a
+2-tuple), and fail.mlraise should take as argument an exception value.
+
+The actual raising of a nullary run-time exception, such as Overflow,
+should be done as follows:
+
+raiseprimitive0(SYS__EXN_OVERFLOW);
+
+void raiseprimitive0(int exnindex) {
+  value exn = alloc(1, 0);
+  modify(&Field(exn, 0), Field(global_data, SYS__EXN_OVERFLOW));
+  mlraise(exn);
+}
+
+The actual raising of a unary run-time exception, such as Fail, should
+be done as follows:
+
+raiseprimitive1(SYS__EXN_FAIL, copy_string("uf"));
+
+void raiseprimitive1(int exnindex, value arg) {
+  value exn;
+  Push_roots(r, 1);
+  r[0] = arg;
+  exn = alloc(1, 0);
+  modify(&Field(exn, 0), Field(global_data, SYS__EXN_OVERFLOW));
+  modify(&Field(exn, 1), r[0]);
+  Pop_roots();
+  mlraise(exn);
+}
+
+
+Match compilation:
+
+A nullary exception pattern is translated to an EXNAME pattern, which
+in turn is translated to a reference comparison.
+
+A unary exception pattern is translated to a pair of an EXNAME pattern
+and a pattern for the argument.
+
+This is done by the simplifyPat function; EXNILpat and EXCONSpat can
+be disregarded in the rest of the program.
+
+
+Outstanding problems:
+
+* What if allocation fails before the exceptions have been allocated?
+  How then report out_of_memory and similar exceptions in main.c?
+
++ [Ken] What if a signal (Interrupt) is received before the exceptions
+  have been allocated?  Because in_blocking_section is initialized to
+  0, the signal will not be handled before the bytecode interpreter
+  has been started.
+
+
+Bootstrapping the system:
+
+The original 1.44 program versions are camlrunm0, mosmllnk0,
+mosmlcmp0, mosmllib0, mosmllex0.
+
+1. Modify runtime sources to use the new exception representation;
+   modify the compiler sources to use the new exception
+   representation.
+
+2. Recompile the runtime system to obtain camlrunm1
+
+3. Generate a fresh Predef.sml file (from runtime/globals.h)
+
+4. Recompile and link the compiler (using camlrunm0, mosmlcmp0,
+   mosmllnk0, mosmllib0) to obtain mosmlcmp1.  This compiler will
+   compile programs to use the new exception representation, but will
+   itself need to be executed using camlrunm0.
+
+5. Recompile and link the linker (using camlrunm0, mosmlcmp0, and
+   mosmllnk0) to obtain mosmllnk1.  This linker will link programs to
+   use the new exception representation, but will itself need to be
+   executed using camlrunm0.
+
+6. Recompile the libraries in mosmllib (using camlrunm0, mosmlcmp1) to
+   obtain mosmllib1.
+
+7. Recompile and link the compiler (using camlrunm0, mosmlcmp1,
+   mosmllnk1, mosmllib1) to obtain mosmlcmp2.  This compiler will
+   compile programs to use the new exception representation, and will
+   itself need to be executed using camlrunm1.
+
+8. Recompile and link the linker (using camlrunm0, mosmlcmp1,
+   mosmllnk1, mosmllib1) to obtain mosmllnk2.  This linker will link
+   programs to use the new exception representation, and will itself
+   need to be executed using camlrunm1.
+
+9. Recompile and link the lexer generator (using camlrunm1, mosmlcmp2,
+   and mosmllnk2) to obtain mosmllex1.  This lexer generator will need
+   to be executed using camlrunm1.
+
+9. Using camlrunm1, mosmlcmp2, mosmlcmp2, mosmllib1, mosmllex1,
+   recompile everything.
+
+------------------------------------------------------------
+
+2000-01-21
+
+In 144 an excon is static if #exconTag(!ei) is SOME sexcon, where
+sexcon = (qualid, stamp) is a static excon, and stamp is the stamp of
+the static exception within the unit specified by qualid.
+
+
+Suggested approach: 
+
+1. Make the compiler generate dynamic exceptions only, but retain
+   the static exception machinery.
+
+2. The predefined (global) exceptions are simply bound as globalvars
+   instead of localvars.  They could be declared in Smlperv by a
+   mechanism similar to Smltop.sml_initial_VE, which is processed
+   twice in Smltop to build uVarEnv and uTyEnv of General,
+   respectively.  Actually, General.Io is already added this way.
+
+   The dynamic semantics of an exception should be to access an
+   appropriate global:
+
+   Perhaps just replace the exConInfo field by exConAccess, which, for
+   Fail might be
+      SOME (Lprim (Pget_global { qual = "sys", id = ["exn_fail"] }))
+
+
+   The global dynenv should be set using Symtable.reset_linker_tables
+   (for linking) and Rtvals.loadGlobalDynEnv (for the interactive
+   top-level).  It is enough to specify the names in
+   Predef.predef_variables, which is generated automatically (by a
+   script) from runtime/globals.h
+
+
+3. 
+
+Undo the translation from END_OF_FILE_EXN to exn Size in see
+src/compiler/Smlexc.sml */
+
+
+How to raise INTERRUPT in the bytecode interpreter?
+
+A BREAK exn value must be created and put into the global_vars or
+similar.  Let's put it into the globals as well.
+
+In fact we need to do the same for SMLEXN_OVF, SMLEXN_DIV, SML_EXN_DOMAIN
+
+
+
+The pervasize exceptions are those defined in runtime/globals.h and
+hence compiler/Predef.
+
+Dynamic semantics (namely, exn name bindings) for pervasive excons.
+For each, we list its name in the global_vars table and its arity (0
+or 1).  This is used in Smlperv.
+
+
+val predefExceptions = [
+  ("Out_of_memory",    ("exn_memory",    0, sc_exn)),
+  ("Invalid_argument", ("exn_argument",  0, sc_exn)),
+  ("Graphic",          ("exn_graphic",   1, sc_str_exn)),
+  ("SysErr",           ("exn_syserr",    1, 
+                        trivial_scheme (type_arrow type_of_syserror_exn 
+                                        type_exn))),
+  ("Fail",             ("exn_fail",      1, sc_str_exn)),
+  ("Size",             ("exn_size",      0, sc_exn)),
+  ("Interrupt",        ("exn_interrupt", 0, sc_exn)),
+  ("Subscript",        ("exn_subscript", 0, sc_exn)),
+  ("Chr",              ("exn_chr",       0, sc_exn)),
+  ("Div",              ("exn_div",       0, sc_exn)),
+  ("Domain",           ("exn_domain",    0, sc_exn)),
+  ("Ord",              ("exn_ord",       0, sc_exn)),
+  ("Overflow",         ("exn_overflow",  0, sc_exn)),
+  ("Bind",             ("exn_bind",      0, sc_exn)),
+  ("Match",            ("exn_match",     0, sc_exn))
+];
+
+In Smlperv, do
+
+fun mkEi arity =
+  let val ei = mkExConInfo() in
+    setExConArity ei arity;
+    (* ps: setExConTag ei (SOME (q, 0)); *)
+    ei
+  end;
+
+val () =
+  app (fn (id, arity, sc) => 
+          let val sc = { qualid={qual="General", id=[id]}, 
+			 info=(sc, EXNname(mkEi arity)) }
+	  in Hasht.insert (#uVarEnv unit_General) id sc end)
+       predefExceptions)
+
+
+Raising Bind and Match, in Front.sml:
+
+val bindExn  = Lprim(Pget_global { qual = "General", id = ["exn_bind"] });
+val matchExn = Lprim(Pget_global { qual = "General", id = ["exn_match"] });
+val bindRaiser  = Lprim(Praise, [bindExn]);
+val matchRaiser = Lprim(Praise, [matchExn]);
diff -Nru mosml-2.01/src/notes/largematch.sml mosml-2.10.1/src/notes/largematch.sml
--- mosml-2.01/src/notes/largematch.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/notes/largematch.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,302 @@
+val actions = fn x =>
+case x of  
+  101 => 101
+| 102 => 102
+| 103 => 103
+| 104 => 104
+| 105 => 105
+| 106 => 106
+| 107 => 107
+| 108 => 108
+| 109 => 109
+| 110 => 110
+| 111 => 111
+| 112 => 112
+| 113 => 113
+| 114 => 114
+| 115 => 115
+| 116 => 116
+| 117 => 117
+| 118 => 118
+| 119 => 119
+| 120 => 120
+| 121 => 121
+| 122 => 122
+| 123 => 123
+| 124 => 124
+| 125 => 125
+| 126 => 126
+| 127 => 127
+| 128 => 128
+| 129 => 129
+| 130 => 130
+| 131 => 131
+| 132 => 132
+| 133 => 133
+| 134 => 134
+| 135 => 135
+| 136 => 136
+| 137 => 137
+| 138 => 138
+| 139 => 139
+| 140 => 140
+| 141 => 141
+| 142 => 142
+| 143 => 143
+| 144 => 144
+| 145 => 145
+| 146 => 146
+| 147 => 147
+| 148 => 148
+| 149 => 149
+| 150 => 150
+| 151 => 151
+| 152 => 152
+| 153 => 153
+| 154 => 154
+| 155 => 155
+| 156 => 156
+| 157 => 157
+| 158 => 158
+| 159 => 159
+| 160 => 160
+| 161 => 161
+| 162 => 162
+| 163 => 163
+| 164 => 164
+| 165 => 165
+| 166 => 166
+| 167 => 167
+| 168 => 168
+| 169 => 169
+| 170 => 170
+| 171 => 171
+| 172 => 172
+| 173 => 173
+| 174 => 174
+| 175 => 175
+| 176 => 176
+| 177 => 177
+| 178 => 178
+| 179 => 179
+| 180 => 180
+| 181 => 181
+| 182 => 182
+| 183 => 183
+| 184 => 184
+| 185 => 185
+| 186 => 186
+| 187 => 187
+| 188 => 188
+| 189 => 189
+| 190 => 190
+| 191 => 191
+| 192 => 192
+| 193 => 193
+| 194 => 194
+| 195 => 195
+| 196 => 196
+| 197 => 197
+| 198 => 198
+| 199 => 199
+| 200 => 200
+| 201 => 201
+| 202 => 202
+| 203 => 203
+| 204 => 204
+| 205 => 205
+| 206 => 206
+| 207 => 207
+| 208 => 208
+| 209 => 209
+| 210 => 210
+| 211 => 211
+| 212 => 212
+| 213 => 213
+| 214 => 214
+| 215 => 215
+| 216 => 216
+| 217 => 217
+| 218 => 218
+| 219 => 219
+| 220 => 220
+| 221 => 221
+| 222 => 222
+| 223 => 223
+| 224 => 224
+| 225 => 225
+| 226 => 226
+| 227 => 227
+| 228 => 228
+| 229 => 229
+| 230 => 230
+| 231 => 231
+| 232 => 232
+| 233 => 233
+| 234 => 234
+| 235 => 235
+| 236 => 236
+| 237 => 237
+| 238 => 238
+| 239 => 239
+| 240 => 240
+| 241 => 241
+| 242 => 242
+| 243 => 243
+| 244 => 244
+| 245 => 245
+| 246 => 246
+| 247 => 247
+| 248 => 248
+| 249 => 249
+| 250 => 250
+| 251 => 251
+| 252 => 252
+| 253 => 253
+| 254 => 254
+| 255 => 255
+| 256 => 256
+| 257 => 257
+| 258 => 258
+| 259 => 259
+| 260 => 260
+| 261 => 261
+| 262 => 262
+| 263 => 263
+| 264 => 264
+| 265 => 265
+| 266 => 266
+| 267 => 267
+| 268 => 268
+| 269 => 269
+| 270 => 270
+| 271 => 271
+| 272 => 272
+| 273 => 273
+| 274 => 274
+| 275 => 275
+| 276 => 276
+| 277 => 277
+| 278 => 278
+| 279 => 279
+| 280 => 280
+| 281 => 281
+| 282 => 282
+| 283 => 283
+| 284 => 284
+| 285 => 285
+| 286 => 286
+| 287 => 287
+| 288 => 288
+| 289 => 289
+| 290 => 290
+| 291 => 291
+| 292 => 292
+| 293 => 293
+| 294 => 294
+| 295 => 295
+| 296 => 296
+| 297 => 297
+| 298 => 298
+| 299 => 299
+| 300 => 300
+| 301 => 301
+| 302 => 302
+| 303 => 303
+| 304 => 304
+| 305 => 305
+| 306 => 306
+| 307 => 307
+| 308 => 308
+| 309 => 309
+| 310 => 310
+| 311 => 311
+| 312 => 312
+| 313 => 313
+| 314 => 314
+| 315 => 315
+| 316 => 316
+| 317 => 317
+| 318 => 318
+| 319 => 319
+| 320 => 320
+| 321 => 321
+| 322 => 322
+| 323 => 323
+| 324 => 324
+| 325 => 325
+| 326 => 326
+| 327 => 327
+| 328 => 328
+| 329 => 329
+| 330 => 330
+| 331 => 331
+| 332 => 332
+| 333 => 333
+| 334 => 334
+| 335 => 335
+| 336 => 336
+| 337 => 337
+| 338 => 338
+| 339 => 339
+| 340 => 340
+| 341 => 341
+| 342 => 342
+| 343 => 343
+| 344 => 344
+| 345 => 345
+| 346 => 346
+| 347 => 347
+| 348 => 348
+| 349 => 349
+| 350 => 350
+| 351 => 351
+| 352 => 352
+| 353 => 353
+| 354 => 354
+| 355 => 355
+| 356 => 356
+| 357 => 357
+| 358 => 358
+| 359 => 359
+| 360 => 360
+| 361 => 361
+| 362 => 362
+| 363 => 363
+| 364 => 364
+| 365 => 365
+| 366 => 366
+| 367 => 367
+| 368 => 368
+| 369 => 369
+| 370 => 370
+| 371 => 371
+| 372 => 372
+| 373 => 373
+| 374 => 374
+| 375 => 375
+| 376 => 376
+| 377 => 377
+| 378 => 378
+| 379 => 379
+| 380 => 380
+| 381 => 381
+| 382 => 382
+| 383 => 383
+| 384 => 384
+| 385 => 385
+| 386 => 386
+| 387 => 387
+| 388 => 388
+| 389 => 389
+| 390 => 390
+| 391 => 391
+| 392 => 392
+| 393 => 393
+| 394 => 394
+| 395 => 395
+| 396 => 396
+| 397 => 397
+| 398 => 398
+| 399 => 399
+;
diff -Nru mosml-2.01/src/notes/longjump.sml mosml-2.10.1/src/notes/longjump.sml
--- mosml-2.01/src/notes/longjump.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/notes/longjump.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,4590 @@
+fun f1 x = 
+    if x > 0 then
+	let fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+fun g y = 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + 
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y + y
+	    + y + y + y + y + y + y + y + y + y + y + y + y + y + y +
+	    y + y + y + y + y + y + y + y + y + y + y + y + y + y
+
+	in g x end
+    else
+	~x
diff -Nru mosml-2.01/src/notes/macosx-log mosml-2.10.1/src/notes/macosx-log
--- mosml-2.01/src/notes/macosx-log	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/notes/macosx-log	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,199 @@
+Compiling CVS mosml on swallow 2002-04-07
+-----------------------------------------
+
+Makefile.inc:
+
+gcc -> cc
+
+remove dynlib.c:
+
+#ADDPRIMS=dynlib.c
+#ADDOBJS=dynlib.o
+#ADDRUNLIBS=-ldl
+#ADDRUNCFLAGS=
+#ADDDYNLIBCFLAGS=
+
+
+Preprocessor complains, then automatically switches to -traditional or
+whatever.
+
+
+~/bin is on PATH, but the shell needs a rehash to be able to find
+newly installed programs there.
+
+
+mosmllib/test failures:
+
+filesys:
+
+test6e 
+  -- succeeds, should fail?
+
+test6f
+  -- succeeds, should fail?
+
+test8d
+  -- succeeds, should fail? --- boils down to test6e
+
+test8h
+  -- succeeds, should fail? --- boils down to test6f
+
+
+Dynamic linking
+---------------
+
+man 3 dyld:
+
+DYLD(3)                                                   DYLD(3)
+
+
+
+NAME
+       dyld - low level programatic interface to the dynamic link
+       editor
+
+SYNOPSIS
+       #include 
+       unsigned long _dyld_present(void);
+       unsigned long _dyld_image_count(void);
+       struct mach_header *_dyld_get_image_header(
+            unsigned long image_index);
+       unsigned long _dyld_get_image_vmaddr_slide(
+            unsigned long image_index);
+       char *_dyld_get_image_name(
+            unsigned long image_index);
+       void _dyld_lookup_and_bind(
+            char *symbol_name,
+            unsigned long *address,
+            void **module);
+       void _dyld_lookup_and_bind_with_hint(
+            char *symbol_name,
+            const char *library_name_hint,
+            unsigned long *address,
+            void **module);
+       void _dyld_lookup_and_bind_fully(
+            char *symbol_name,
+            unsigned long *address,
+            void **module);
+       enum bool _dyld_bind_fully_image_containing_address(
+            unsigned long *address);
+       enum bool _dyld_image_containing_address(
+            unsigned long address);
+       enum bool _dyld_launched_prebound(void);
+       int _dyld_func_lookup(
+            char *dyld_func_name,
+            unsigned long *address);
+       extern void _dyld_bind_objc_module(
+            void *objc_module);
+       extern void _dyld_get_objc_module_sect_for_module(
+            NSModule module,
+            void **objc_module,
+            unsigned long *size);
+       extern void _dyld_lookup_and_bind_objc(
+            const char *symbol_name,
+            unsigned long *address,
+            void **module);
+       extern void _dyld_moninit(
+            void (*monaddition)(char *lowpc, char *highpc));
+
+       extern void _dyld_register_func_for_add_image(
+            void (*func)(struct mach_header *mh, unsigned long vmaddr_slide));
+       extern void _dyld_register_func_for_remove_image(
+            void (*func)(struct mach_header *mh, unsigned long vmaddr_slide));
+       extern void _dyld_register_func_for_link_module(
+            void (*func)(NSModule module));
+
+DESCRIPTION
+       These routines are the low level programatic interface  to
+       the dynamic link editor.
+
+       _dyld_present  returns  non-zero  if the dynamic linker is
+       being used in the program and  zero  otherwise.   If  this
+       returns  zero  this  rest of these functions should not be
+       called and most likely crash the program if called.
+
+       _dyld_image_count returns the  current  number  of  images
+       mapped in by the dynamic link editor.
+
+       _dyld_get_image_header  returns  the  mach  header  of the
+       image indexed by image_index.  If image_index  is  out  of
+       range NULL is returned.
+
+       _dyld_get_image_vmaddr_slide  returns  the virtural memory
+       address slide amount of the image indexed by  image_index.
+       If image_index is out of range zero is returned.
+
+       _dyld_get_image_name returns the name of the image indexed
+       by image_index.  If image_index is out of  range  NULL  is
+       returned.
+
+       _dyld_lookup_and_bind  looks  up the symbol_name and binds
+       it into the program.  It indirectly  returns  the  address
+       and and a pointer to the module that defined the symbol.
+
+       _dyld_lookup_and_bind_with_hint    is    the    same    as
+       _dyld_lookup_and_bind but the library_name_hint  parameter
+       provides  a hint as to where to start the lookup in a pre-
+       bound program.  The library_name_hint parameter is matched
+       up with the actual library install names with strstr(3).
+
+       _dyld_lookup_and_bind_fully  looks  up the symbol_name and
+       binds it and all of its references into the  program.   It
+       indirectly  returns  the  address and and a pointer to the
+       module that defined the symbol.
+
+       _dyld_bind_fully_image_containing_address fully binds  the
+       image  containing  the specified address.  It returns TRUE
+       if the address is contained in a loaded  image  and  FALSE
+       otherwise.
+
+       _dyld_image_containing_address  It  returns  TRUE  if  the
+       address is contained an image dyld loaded and FALSE other-
+       wise.
+
+       _dyld_launched_prebound  returns  TRUE  if the program was
+       launched using the prebound state and FALSE otherwise.
+
+       _dyld_func_lookup is passed a name, dyld_func_name,  of  a
+       dynamic  link  editor  function and returns the address of
+       the function indirectly.  It returns non-zero if the func-
+       tion is found and zero otherwise.
+
+       _dyld_bind_objc_module is passed a pointer to something in
+       an (__OBJC,__module) section and causes the module that is
+       associated with that address to be bound.
+
+       _dyld_get_objc_module_sect_for_module  is  passed a module
+       and sets a pointer to the  (__OBJC,__module)  section  and
+       its size for the specified module.
+
+       _dyld_lookup_and_bind_objc()     is     the     same    as
+       _dyld_lookup_and_bind() but does  not  update  the  symbol
+       pointers  if  the symbol is in a bound module.  The reason
+       for    this    is    that    an    objc    symbol     like
+       .objc_class_name_Object is never used by a symbol pointer.
+       Since this is done a lot by the objc runtime and  updating
+       symbol pointers is not cheep it should not be done.
+
+       _dyld_moninit is called from the profiling runtime routine
+       moninit(3) to cause the dyld loaded code to  be  profiled.
+       It  is  passed a pointer to the the profiling runtime rou-
+       tine monaddtion(3) to be called after an  image  had  been
+       mapped in.
+
+       _dyld_register_func_for_add_image  registers the specified
+       function to be called when a new image is added (a  bundle
+       or  a  dynamic  shared library) to the program.  When this
+       function is first registered it is  called  for  once  for
+       each image that is currently part of the program.
+
+       _dyld_register_func_for_remove_image  registers the speci-
+       fied function to be called when an  image  is  removed  (a
+       bundle  or  a  dynamic  shared  library) from the program.
+       _dyld_register_func_for_link_module registers  the  speci-
+       fied function to be called when a module is bound into the
+       program.  When this function is  first  registered  it  is
+       called  for  once  for each module that is currently bound
+       into the program.
+
+Apple Computer, Inc.    November 22, 2000                 DYLD(3)
diff -Nru mosml-2.01/src/notes/manycons.sml mosml-2.10.1/src/notes/manycons.sml
--- mosml-2.01/src/notes/manycons.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/notes/manycons.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,2831 @@
+(* First, a number of bogus declarations *)
+
+type info = unit;
+type scon = unit
+type longid = unit
+type tycon = unit
+type longtycon = unit
+type longstrid = unit
+type id = unit
+type funid = unit
+type strid = unit
+type sigid = unit
+
+datatype 'a op_opt = OP_OPT of 'a * bool
+datatype 'a WithInfo = WITH_INFO of info * 'a
+
+  datatype atexp =
+	SCONatexp of info * scon |         
+	IDENTatexp of info * longid op_opt |
+	RECORDatexp of info * exprow option |
+	LETatexp of info * dec * exp |
+	PARatexp of info * exp
+
+  and opid = OPID of longid * bool
+
+  and exprow =
+	EXPROW of info * lab * exp * exprow option
+
+  and exp =
+	ATEXPexp of info * atexp |
+	APPexp of info * exp * atexp |
+	TYPEDexp of info * exp * ty |
+	HANDLEexp of info * exp * match |
+        RAISEexp of info * exp |
+	FNexp of info * match |
+	UNRES_INFIXexp of info * atexp list
+
+  and match =
+        MATCH of info * mrule * match option
+
+  and mrule =
+        MRULE of info * pat * exp
+
+  and dec = 
+	VALdec of info * tyvar list * valbind |
+	UNRES_FUNdec of info * tyvar list * FValBind |
+	TYPEdec of info * typbind |
+	DATATYPEdec of info * datbind |
+	DATATYPE_REPLICATIONdec of info * tycon * longtycon |
+	ABSTYPEdec of info * datbind * dec |
+	EXCEPTIONdec of info * exbind |
+	LOCALdec of info * dec * dec |
+	OPENdec of info * longstrid WithInfo list |
+	SEQdec of info * dec * dec |
+	INFIXdec of info * int option * id list |
+	INFIXRdec of info * int option * id list |
+	NONFIXdec of info * id list |
+	EMPTYdec of info
+
+  and valbind =
+	PLAINvalbind of info * pat * exp * valbind option |
+	RECvalbind of info * valbind
+
+  and FValBind = FVALBIND of info * FClause * FValBind option
+  and FClause = FCLAUSE of info * atpat list * ty option * exp * FClause option
+
+  and typbind =
+        TYPBIND of info * tyvar list * tycon * ty * typbind option
+
+  and datbind =
+        DATBIND of info * tyvar list * tycon * conbind * datbind option
+
+  and conbind =
+        CONBIND of info * id op_opt * ty option * conbind option
+
+  and exbind =
+        EXBIND of info * id op_opt * ty option * exbind option |
+        EXEQUAL of info * id op_opt * longid op_opt * exbind option
+
+  and atpat =
+        WILDCARDatpat of info |
+	SCONatpat of info * scon |
+	LONGIDatpat of info * longid op_opt |
+	RECORDatpat of info * patrow option |
+	PARatpat of info * pat
+
+  and patrow =
+        DOTDOTDOT of info |
+        PATROW of info * lab * pat * patrow option
+
+  and pat =
+        ATPATpat of info * atpat |
+        CONSpat of info * longid op_opt * atpat |
+        TYPEDpat of info * pat * ty |
+        LAYEREDpat of info * id op_opt * ty option * pat |
+	UNRES_INFIXpat of info * atpat list
+
+  and ty =
+        TYVARty of info * tyvar |
+        RECORDty of info * tyrow option |
+        CONty of info * ty list * longtycon |
+        FNty of info * ty * ty |
+        PARty of info * ty
+
+  and tyrow =
+        TYROW of info * lab * ty * tyrow option
+
+    datatype strexp =
+      STRUCTstrexp of info * strdec |
+      LONGSTRIDstrexp of info * longstrid |
+      TRANSPARENT_CONSTRAINTstrexp of info * strexp * sigexp |
+      OPAQUE_CONSTRAINTstrexp of info * strexp * sigexp |
+      APPstrexp of info * funid * strexp |
+      LETstrexp of info * strdec * strexp
+
+    and strdec =
+      DECstrdec of info * dec |
+      STRUCTUREstrdec of info * strbind |
+      LOCALstrdec of info * strdec * strdec |
+      EMPTYstrdec of info |
+      SEQstrdec of info * strdec * strdec
+
+    and strbind =
+      STRBIND of info * strid * strexp * strbind option
+
+    and sigexp =
+      SIGsigexp of info * spec |
+      SIGIDsigexp of info * sigid |
+      WHERE_TYPEsigexp of info * sigexp * tyvar list * longtycon * ty
+
+
+    and sigdec =
+      SIGNATUREsigdec of info * sigbind
+
+    and sigbind =
+      SIGBIND of info * sigid * sigexp * sigbind option
+
+			    (* Figure 7 *)
+
+    and spec =
+      VALspec of info * valdesc |
+      TYPEspec of info * typdesc |
+      EQTYPEspec of info * typdesc |
+      DATATYPEspec of info * datdesc |
+      DATATYPE_REPLICATIONspec of info * tycon * longtycon |
+      EXCEPTIONspec of info * exdesc |
+      STRUCTUREspec of info * strdesc |
+      INCLUDEspec of info * sigexp |
+      SHARING_TYPEspec of info * spec * longtycon WithInfo list |
+      SHARINGspec of info * spec * longstrid WithInfo list |
+      EMPTYspec of info |
+      SEQspec of info * spec * spec
+
+    and valdesc =
+      VALDESC of info * id * ty * valdesc option
+
+    and typdesc =
+      TYPDESC of info * tyvar list * tycon * typdesc option
+
+    and datdesc =
+      DATDESC of info * tyvar list * tycon * condesc * datdesc option
+
+    and condesc =
+      CONDESC of info * id * ty option * condesc option
+
+    and exdesc =
+      EXDESC of info * id * ty option * exdesc option
+
+    and strdesc =
+      STRDESC of info * strid * sigexp * strdesc option
+
+			    (* Figure 8 *)
+
+    and fundec =
+      FUNCTORfundec of info * funbind
+
+    and funbind =
+      FUNBIND of info * funid * strid * sigexp * strexp * funbind option
+
+    and topdec =
+      STRtopdec of info * strdec * topdec option |
+      SIGtopdec of info * sigdec * topdec option |
+      FUNtopdec of info * fundec * topdec option 
+
+fun mk_IdentLab _ = let fun loop () = loop () in loop () end;
+fun mk_IntegerLab _ = let fun loop () = loop () in loop () end;
+fun PP _ = let fun loop () = loop () in loop () end;
+fun topdecOfExp _ = let fun loop () = loop () in loop () end;
+fun rightmost _ = let fun loop () = loop () in loop () end;
+fun mk_FunId _ = let fun loop () = loop () in loop () end;
+
+
+type pos = int;
+
+structure MlyValue = 
+struct
+datatype svalue = VOID | ntVOID of unit ->  unit
+ | TYVAR of unit ->  (string) | ID of unit ->  (string)
+ | STRING of unit ->  (string) | REAL of unit ->  (string option)
+ | WORD of unit ->  (int option) | DIGIT of unit ->  (int)
+ | HEXINTEGER of unit ->  (int option)
+ | DECNEGINTEGER of unit ->  (int option)
+ | DECPOSINTEGER of unit ->  (int option)
+ | QUAL_STAR of unit ->  (string list)
+ | QUAL_ID of unit ->  (string list) | Char of unit ->  (int)
+ | Integer of unit ->  (int) | DecPosInteger of unit ->  (int)
+ | Label of unit ->  (lab)
+ | LongOpEqIdent of unit ->  (string list op_opt)
+ | LongOpIdent of unit ->  (string list op_opt)
+ | LongIdent of unit ->  (string list)
+ | LongTypeIdent of unit ->  (string list)
+ | TypeIdent of unit ->  (string) | EqIdent of unit ->  (string)
+ | OpIdent of unit ->  (string op_opt) | Ident of unit ->  (string)
+ | OneDec_sans_LOCAL of unit ->  (dec) | OneDec of unit ->  (dec)
+ | DIGIT_opt of unit ->  (int option)
+ | LongTypeIdentEq_seq2 of unit ->  (string list WithInfo list)
+ | LongIdentEq_seq2 of unit ->  (string list WithInfo list)
+ | LongIdent_seq1 of unit ->  (string list WithInfo list)
+ | EqIdent_seq1 of unit ->  (string list)
+ | Ident_seq2 of unit ->  (string WithInfo list)
+ | NonEmptyDec of unit ->  (dec)
+ | OneDec_or_SEMICOLON of unit ->  (dec option)
+ | TyComma_seq2 of unit ->  (ty list)
+ | TyVarComma_seq1 of unit ->  (tyvar list)
+ | TyVarSeq1 of unit ->  (tyvar list)
+ | ExpSemicolon_seq2 of unit ->  (exp list)
+ | AtPat_seq1 of unit ->  (atpat list)
+ | AtPat_seq2 of unit ->  (atpat list)
+ | AtExp_seq1 of unit ->  (atexp list)
+ | PatComma_seq2 of unit ->  (pat list)
+ | PatComma_seq1 of unit ->  (pat list)
+ | PatComma_seq0 of unit ->  (pat list)
+ | ExpComma_seq2 of unit ->  (exp list)
+ | ExpComma_seq1 of unit ->  (exp list)
+ | ExpComma_seq0 of unit ->  (exp list)
+ | OfTy_opt of unit ->  (ty option)
+ | CommaTyRow_opt of unit ->  (tyrow option)
+ | TyRow_opt of unit ->  (tyrow option)
+ | ColonTy_seq1 of unit ->  ( ( ty * pos )  list)
+ | ColonTy_opt of unit ->  (ty option)
+ | CommaPatRow_opt of unit ->  (patrow option)
+ | AsPat_opt of unit ->  (pat option)
+ | PatRow_opt of unit ->  (patrow option)
+ | ExpRow_opt of unit ->  (exprow option)
+ | AndExBind_opt of unit ->  (exbind option)
+ | BarMatch_opt of unit ->  (match option)
+ | BarConBind_opt of unit ->  (conbind option)
+ | AndDatBind_opt of unit ->  (datbind option)
+ | AndTypBind_opt of unit ->  (typbind option)
+ | BarFClause_opt of unit ->  (FClause option)
+ | AndFValBind_opt of unit ->  (FValBind option)
+ | AndFnValBind_opt of unit ->  (valbind option)
+ | AndValBind_opt of unit ->  (valbind option)
+ | CommaExpRow_opt of unit ->  (exprow option)
+ | FClause of unit ->  (FClause) | AtExp of unit ->  (atexp)
+ | ExpRow of unit ->  (exprow) | Match_ of unit ->  (match)
+ | Exp_ of unit ->  (exp) | MRule of unit ->  (mrule)
+ | Dec of unit ->  (dec) | FValBind of unit ->  (FValBind)
+ | FnValBind of unit ->  (valbind) | ValBind of unit ->  (valbind)
+ | TypBind of unit ->  (typbind)
+ | DatBind_nonzero_arity of unit ->  (datbind)
+ | DatBind_zero_arity of unit ->  (datbind)
+ | DatBind of unit ->  (datbind) | ConBind of unit ->  (conbind)
+ | ExBind of unit ->  (exbind) | AtPat of unit ->  (atpat)
+ | PatRow of unit ->  (patrow) | Pat of unit ->  (pat)
+ | SCon of unit ->  (scon) | TyVarSeq of unit ->  (tyvar list)
+ | AtomicTy of unit ->  (ty) | Ty_sans_STAR of unit ->  (ty)
+ | TupleTy of unit ->  (ty list) | Ty of unit ->  (ty)
+ | TyRow of unit ->  (tyrow)
+ | AndWhereDesc_opt of unit ->  ( ( pos * sigexp -> sigexp )  option)
+ | WhereDesc of unit ->  (pos*sigexp -> sigexp)
+ | NonEmptyStrDec of unit ->  (strdec)
+ | OneStrDec_or_SEMICOLON of unit ->  (strdec option)
+ | NonEmptySpec' of unit ->  (spec)
+ | Spec_sans_SHARING of unit ->  (spec)
+ | NonEmptySpec of unit ->  (spec)
+ | OneSpec_or_SEMICOLON of unit ->  (spec option)
+ | SEMICOLON_opt of unit ->  (unit)
+ | AndValDesc_opt of unit ->  (valdesc option)
+ | TypAbbreviationAND_seq1 of unit ->  ( ( tyvar list * tycon * ty * info * info )  list)
+ | AndTypDesc_opt of unit ->  (typdesc option)
+ | AndDatDesc_opt of unit ->  (datdesc option)
+ | BarConDesc_opt of unit ->  (condesc option)
+ | AndExDesc_opt of unit ->  (exdesc option)
+ | AndStrDesc_opt of unit ->  (strdesc option)
+ | AndSigBind_opt of unit ->  (sigbind option)
+ | AndStrBind_opt of unit ->  (strbind option)
+ | AndFunBind_opt of unit ->  (funbind option)
+ | SigExp_constraint_maybe of unit ->  (pos -> strexp -> strexp)
+ | SigExp_constraint of unit ->  (pos -> strexp -> strexp)
+ | StrExp of unit ->  (strexp) | StrDec of unit ->  (strdec)
+ | StrBind of unit ->  (strbind) | SigExp of unit ->  (sigexp)
+ | SigBind of unit ->  (sigbind) | OneSpec of unit ->  (spec)
+ | Spec of unit ->  (spec) | ValDesc of unit ->  (valdesc)
+ | TypAbbreviation of unit ->  (tyvar list*tycon*ty*info*info)
+ | TypDesc of unit ->  (typdesc)
+ | DatDesc_nonzero_arity of unit ->  (datdesc)
+ | DatDesc_zero_arity of unit ->  (datdesc)
+ | DatDesc of unit ->  (datdesc) | ConDesc of unit ->  (condesc)
+ | ExDesc of unit ->  (exdesc) | StrDesc of unit ->  (strdesc)
+ | FunBind of unit ->  (funbind) | OneStrDec of unit ->  (strdec)
+ | FunDec of unit ->  (fundec)
+ | StrDec_sans_SEMICOLON of unit ->  (strdec)
+ | SigDec of unit ->  (sigdec)
+ | TopDec_opt of unit ->  (topdec option)
+ | TopDec_ of unit ->  (topdec) | TopDec of unit ->  (topdec)
+end
+
+
+structure LrTable = struct
+   datatype t = NT of int
+end
+
+structure Actions =
+struct 
+exception mlyAction of int
+
+
+(* cvr: begin *)
+local in
+val actions = 
+fn (i392,defaultPos,stack,
+    (())) =>
+case (i392,stack)
+of (0,(_,(MlyValue.ID ID1,ID1left,ID1right))::rest671) => let val 
+result=MlyValue.Ident(fn _ => let val ID as ID1=ID1 ()
+ in ( ID ) end
+)
+ in (LrTable.NT 113,(result,ID1left,ID1right),rest671) end
+| (1,(_,(_,STAR1left,STAR1right))::rest671) => let val result=
+MlyValue.Ident(fn _ => ( "*" ))
+ in (LrTable.NT 113,(result,STAR1left,STAR1right),rest671) end
+| (2,(_,(MlyValue.Ident Ident1,Ident1left,Ident1right))::rest671) => 
+let val result=MlyValue.OpIdent(fn _ => let val Ident as Ident1=Ident1
+ ()
+ in ( OP_OPT(Ident, false) ) end
+)
+ in (LrTable.NT 114,(result,Ident1left,Ident1right),rest671) end
+| (3,(_,(MlyValue.Ident Ident1,_,Ident1right))::(_,(_,OP1left,_))::
+rest671) => let val result=MlyValue.OpIdent(fn _ => let val Ident as 
+Ident1=Ident1 ()
+ in ( OP_OPT(Ident, true) ) end
+)
+ in (LrTable.NT 114,(result,OP1left,Ident1right),rest671) end
+| (4,(_,(MlyValue.Ident Ident1,Ident1left,Ident1right))::rest671) => 
+let val result=MlyValue.EqIdent(fn _ => let val Ident as Ident1=Ident1
+ ()
+ in ( Ident ) end
+)
+ in (LrTable.NT 115,(result,Ident1left,Ident1right),rest671) end
+| (5,(_,(_,EQUALS1left,EQUALS1right))::rest671) => let val result=
+MlyValue.EqIdent(fn _ => ( "=" ))
+ in (LrTable.NT 115,(result,EQUALS1left,EQUALS1right),rest671) end
+| (6,(_,(MlyValue.ID ID1,ID1left,ID1right))::rest671) => let val 
+result=MlyValue.TypeIdent(fn _ => let val ID as ID1=ID1 ()
+ in ( ID ) end
+)
+ in (LrTable.NT 116,(result,ID1left,ID1right),rest671) end
+| (7,(_,(MlyValue.TypeIdent TypeIdent1,TypeIdent1left,TypeIdent1right)
+)::rest671) => let val result=MlyValue.LongTypeIdent(fn _ => let val 
+TypeIdent as TypeIdent1=TypeIdent1 ()
+ in ( [TypeIdent] ) end
+)
+ in (LrTable.NT 117,(result,TypeIdent1left,TypeIdent1right),rest671)
+ end
+| (8,(_,(MlyValue.QUAL_ID QUAL_ID1,QUAL_ID1left,QUAL_ID1right))::
+rest671) => let val result=MlyValue.LongTypeIdent(fn _ => let val 
+QUAL_ID as QUAL_ID1=QUAL_ID1 ()
+ in ( QUAL_ID ) end
+)
+ in (LrTable.NT 117,(result,QUAL_ID1left,QUAL_ID1right),rest671) end
+| (9,(_,(MlyValue.Ident Ident1,Ident1left,Ident1right))::rest671) => 
+let val result=MlyValue.LongIdent(fn _ => let val Ident as Ident1=
+Ident1 ()
+ in ( [Ident] ) end
+)
+ in (LrTable.NT 118,(result,Ident1left,Ident1right),rest671) end
+| (10,(_,(MlyValue.QUAL_ID QUAL_ID1,QUAL_ID1left,QUAL_ID1right))::
+rest671) => let val result=MlyValue.LongIdent(fn _ => let val QUAL_ID
+ as QUAL_ID1=QUAL_ID1 ()
+ in ( QUAL_ID ) end
+)
+ in (LrTable.NT 118,(result,QUAL_ID1left,QUAL_ID1right),rest671) end
+| (11,(_,(MlyValue.QUAL_STAR QUAL_STAR1,QUAL_STAR1left,QUAL_STAR1right
+))::rest671) => let val result=MlyValue.LongIdent(fn _ => let val 
+QUAL_STAR as QUAL_STAR1=QUAL_STAR1 ()
+ in ( QUAL_STAR ) end
+)
+ in (LrTable.NT 118,(result,QUAL_STAR1left,QUAL_STAR1right),rest671)
+ end
+| (12,(_,(MlyValue.LongIdent LongIdent1,LongIdent1left,LongIdent1right
+))::rest671) => let val result=MlyValue.LongOpIdent(fn _ => let val 
+LongIdent as LongIdent1=LongIdent1 ()
+ in ( OP_OPT(LongIdent, false) ) end
+)
+ in (LrTable.NT 119,(result,LongIdent1left,LongIdent1right),rest671)
+ end
+| (13,(_,(MlyValue.LongIdent LongIdent1,_,LongIdent1right))::(_,(_,
+OP1left,_))::rest671) => let val result=MlyValue.LongOpIdent(fn _ => 
+let val LongIdent as LongIdent1=LongIdent1 ()
+ in ( OP_OPT(LongIdent, true) ) end
+)
+ in (LrTable.NT 119,(result,OP1left,LongIdent1right),rest671) end
+| (14,(_,(MlyValue.LongOpIdent LongOpIdent1,LongOpIdent1left,
+LongOpIdent1right))::rest671) => let val result=MlyValue.LongOpEqIdent
+(fn _ => let val LongOpIdent as LongOpIdent1=LongOpIdent1 ()
+ in ( LongOpIdent ) end
+)
+ in (LrTable.NT 120,(result,LongOpIdent1left,LongOpIdent1right),
+rest671) end
+| (15,(_,(_,EQUALS1left,EQUALS1right))::rest671) => let val result=
+MlyValue.LongOpEqIdent(fn _ => ( OP_OPT(["="], false) ))
+ in (LrTable.NT 120,(result,EQUALS1left,EQUALS1right),rest671) end
+| (16,(_,(_,_,EQUALS1right))::(_,(_,OP1left,_))::rest671) => let val 
+result=MlyValue.LongOpEqIdent(fn _ => ( OP_OPT(["="], true) ))
+ in (LrTable.NT 120,(result,OP1left,EQUALS1right),rest671) end
+| (17,(_,(MlyValue.DIGIT DIGIT1,DIGIT1left,DIGIT1right))::rest671) => 
+let val result=MlyValue.DIGIT_opt(fn _ => let val DIGIT as DIGIT1=
+DIGIT1 ()
+ in ( SOME DIGIT ) end
+)
+ in (LrTable.NT 110,(result,DIGIT1left,DIGIT1right),rest671) end
+| (18,rest671) => let val result=MlyValue.DIGIT_opt(fn _ => ( NONE ))
+ in (LrTable.NT 110,(result,defaultPos,defaultPos),rest671) end
+| (19,(_,(MlyValue.DECPOSINTEGER DECPOSINTEGER1,DECPOSINTEGERleft as 
+DECPOSINTEGER1left,DECPOSINTEGER1right))::rest671) => let val result=
+MlyValue.DecPosInteger(fn _ => let val DECPOSINTEGER as DECPOSINTEGER1
+=DECPOSINTEGER1 ()
+ in (
+ (* raise_lexical_error_if_none *)
+			    DECPOSINTEGERleft; DECPOSINTEGER; raise Fail "bogus")
+ end
+)
+ in (LrTable.NT 122,(result,DECPOSINTEGER1left,DECPOSINTEGER1right),
+rest671) end
+| (20,(_,(MlyValue.DIGIT DIGIT1,DIGIT1left,DIGIT1right))::rest671) => 
+let val result=MlyValue.DecPosInteger(fn _ => let val DIGIT as DIGIT1=
+DIGIT1 ()
+ in ( DIGIT ) end
+)
+ in (LrTable.NT 122,(result,DIGIT1left,DIGIT1right),rest671) end
+| (21,(_,(MlyValue.Ident Ident1,Ident1left,Ident1right))::rest671) => 
+let val result=MlyValue.Label(fn _ => let val Ident as Ident1=Ident1 
+()
+ in ( mk_IdentLab Ident ) end
+)
+ in (LrTable.NT 121,(result,Ident1left,Ident1right),rest671) end
+| (22,(_,(MlyValue.DecPosInteger DecPosInteger1,DecPosInteger1left,
+DecPosInteger1right))::rest671) => let val result=MlyValue.Label(fn _
+ => let val DecPosInteger as DecPosInteger1=DecPosInteger1 ()
+ in ( mk_IntegerLab DecPosInteger ) end
+)
+ in (LrTable.NT 121,(result,DecPosInteger1left,DecPosInteger1right),
+rest671) end
+| (23,(_,(MlyValue.Ident_seq2 Ident_seq21,_,Ident_seq21right))::(_,(
+MlyValue.Ident Ident1,Identleft as Ident1left,Identright))::rest671)
+ => let val result=MlyValue.Ident_seq2(fn _ => let val Ident as Ident1
+=Ident1 ()
+val Ident_seq2 as Ident_seq21=Ident_seq21 ()
+ in (
+ WITH_INFO(PP Identleft Identright, Ident)
+                          :: Ident_seq2
+                        
+) end
+)
+ in (LrTable.NT 105,(result,Ident1left,Ident_seq21right),rest671) end
+| (24,(_,(MlyValue.Ident Ident2,Ident2left,Ident2right))::(_,(
+MlyValue.Ident Ident1,Ident1left,Ident1right))::rest671) => let val 
+result=MlyValue.Ident_seq2(fn _ => let val Ident1=Ident1 ()
+val Ident2=Ident2 ()
+ in (
+ [WITH_INFO(PP Ident1left Ident1right, Ident1),
+			   WITH_INFO(PP Ident2left Ident2right, Ident2)] 
+) end
+)
+ in (LrTable.NT 105,(result,Ident1left,Ident2right),rest671) end
+| (25,(_,(MlyValue.EqIdent_seq1 EqIdent_seq11,_,EqIdent_seq11right))::
+(_,(MlyValue.EqIdent EqIdent1,EqIdent1left,_))::rest671) => let val 
+result=MlyValue.EqIdent_seq1(fn _ => let val EqIdent as EqIdent1=
+EqIdent1 ()
+val EqIdent_seq1 as EqIdent_seq11=EqIdent_seq11 ()
+ in ( EqIdent :: EqIdent_seq1 ) end
+)
+ in (LrTable.NT 106,(result,EqIdent1left,EqIdent_seq11right),rest671)
+ end
+| (26,(_,(MlyValue.EqIdent EqIdent1,EqIdent1left,EqIdent1right))::
+rest671) => let val result=MlyValue.EqIdent_seq1(fn _ => let val 
+EqIdent as EqIdent1=EqIdent1 ()
+ in ( [EqIdent] ) end
+)
+ in (LrTable.NT 106,(result,EqIdent1left,EqIdent1right),rest671) end
+| (27,(_,(MlyValue.LongIdent_seq1 LongIdent_seq11,_,
+LongIdent_seq11right))::(_,(MlyValue.LongIdent LongIdent1,
+LongIdentleft as LongIdent1left,LongIdentright))::rest671) => let val 
+result=MlyValue.LongIdent_seq1(fn _ => let val LongIdent as LongIdent1
+=LongIdent1 ()
+val LongIdent_seq1 as LongIdent_seq11=LongIdent_seq11 ()
+ in (
+ WITH_INFO(PP LongIdentleft LongIdentright,
+                                    LongIdent
+                                   ) :: LongIdent_seq1
+                        
+) end
+)
+ in (LrTable.NT 107,(result,LongIdent1left,LongIdent_seq11right),
+rest671) end
+| (28,(_,(MlyValue.LongIdent LongIdent1,LongIdentleft as 
+LongIdent1left,LongIdentright as LongIdent1right))::rest671) => let 
+val result=MlyValue.LongIdent_seq1(fn _ => let val LongIdent as 
+LongIdent1=LongIdent1 ()
+ in (
+ [WITH_INFO(PP LongIdentleft LongIdentright,
+                                     LongIdent
+                                    )
+                          ]
+                        
+) end
+)
+ in (LrTable.NT 107,(result,LongIdent1left,LongIdent1right),rest671)
+ end
+| (29,(_,(MlyValue.LongIdentEq_seq2 LongIdentEq_seq21,_,
+LongIdentEq_seq21right))::_::(_,(MlyValue.LongIdent LongIdent1,
+LongIdentleft as LongIdent1left,LongIdentright))::rest671) => let val 
+result=MlyValue.LongIdentEq_seq2(fn _ => let val LongIdent as 
+LongIdent1=LongIdent1 ()
+val LongIdentEq_seq2 as LongIdentEq_seq21=LongIdentEq_seq21 ()
+ in (
+ WITH_INFO(PP LongIdentleft LongIdentright, LongIdent)
+                          :: LongIdentEq_seq2
+                        
+) end
+)
+ in (LrTable.NT 108,(result,LongIdent1left,LongIdentEq_seq21right),
+rest671) end
+| (30,(_,(MlyValue.LongIdent LongIdent2,LongIdent2left,LongIdent2right
+))::_::(_,(MlyValue.LongIdent LongIdent1,LongIdent1left,
+LongIdent1right))::rest671) => let val result=
+MlyValue.LongIdentEq_seq2(fn _ => let val LongIdent1=LongIdent1 ()
+val LongIdent2=LongIdent2 ()
+ in (
+ [WITH_INFO(PP LongIdent1left LongIdent1right,
+                                     LongIdent1
+                                    ),
+                           WITH_INFO(PP LongIdent2left LongIdent2right,
+                                     LongIdent2
+                                    )
+                          ]
+                        
+) end
+)
+ in (LrTable.NT 108,(result,LongIdent1left,LongIdent2right),rest671)
+ end
+| (31,(_,(MlyValue.LongTypeIdentEq_seq2 LongTypeIdentEq_seq21,_,
+LongTypeIdentEq_seq21right))::_::(_,(MlyValue.LongTypeIdent 
+LongTypeIdent1,LongTypeIdentleft as LongTypeIdent1left,
+LongTypeIdentright))::rest671) => let val result=
+MlyValue.LongTypeIdentEq_seq2(fn _ => let val LongTypeIdent as 
+LongTypeIdent1=LongTypeIdent1 ()
+val LongTypeIdentEq_seq2 as LongTypeIdentEq_seq21=
+LongTypeIdentEq_seq21 ()
+ in (
+ WITH_INFO(PP LongTypeIdentleft LongTypeIdentright,
+                                    LongTypeIdent
+                                   )
+                          :: LongTypeIdentEq_seq2
+                        
+) end
+)
+ in (LrTable.NT 109,(result,LongTypeIdent1left,
+LongTypeIdentEq_seq21right),rest671) end
+| (32,(_,(MlyValue.LongTypeIdent LongTypeIdent2,LongTypeIdent2left,
+LongTypeIdent2right))::_::(_,(MlyValue.LongTypeIdent LongTypeIdent1,
+LongTypeIdent1left,LongTypeIdent1right))::rest671) => let val result=
+MlyValue.LongTypeIdentEq_seq2(fn _ => let val LongTypeIdent1=
+LongTypeIdent1 ()
+val LongTypeIdent2=LongTypeIdent2 ()
+ in (
+ [WITH_INFO(PP LongTypeIdent1left LongTypeIdent1right,
+                                     LongTypeIdent1
+                                    ),
+                           WITH_INFO(PP LongTypeIdent2left LongTypeIdent2right,
+                                     LongTypeIdent2
+                                    )
+                          ]
+                        
+) end
+)
+ in (LrTable.NT 109,(result,LongTypeIdent1left,LongTypeIdent2right),
+rest671) end
+| (33,(_,(MlyValue.TopDec_ TopDec_1,TopDec_1left,TopDec_1right))::
+rest671) => let val result=MlyValue.TopDec(fn _ => let val TopDec_ as 
+TopDec_1=TopDec_1 ()
+ in ( TopDec_ ) end
+)
+ in (LrTable.NT 0,(result,TopDec_1left,TopDec_1right),rest671) end
+| (34,(_,(MlyValue.Exp_ Exp_1,Exp_1left,Exp_1right))::rest671) => let 
+val result=MlyValue.TopDec(fn _ => let val Exp_ as Exp_1=Exp_1 ()
+ in ( topdecOfExp Exp_ ) end
+)
+ in (LrTable.NT 0,(result,Exp_1left,Exp_1right),rest671) end
+| (35,rest671) => let val result=MlyValue.TopDec(fn _ => (
+ STRtopdec(PP defaultPos defaultPos,
+				    EMPTYstrdec(PP defaultPos defaultPos), NONE) 
+))
+ in (LrTable.NT 0,(result,defaultPos,defaultPos),rest671) end
+| (36,(_,(MlyValue.TopDec_opt TopDec_opt1,_,TopDec_opt1right))::(_,(
+MlyValue.OneStrDec OneStrDec1,OneStrDecleft as OneStrDec1left,_))::
+rest671) => let val result=MlyValue.TopDec_(fn _ => let val OneStrDec
+ as OneStrDec1=OneStrDec1 ()
+val TopDec_opt as TopDec_opt1=TopDec_opt1 ()
+ in (
+ STRtopdec (PP OneStrDecleft
+				       (rightmost  OneStrDec
+				                   TopDec_opt),
+				     OneStrDec, TopDec_opt) 
+) end
+)
+ in (LrTable.NT 1,(result,OneStrDec1left,TopDec_opt1right),rest671)
+ end
+| (37,(_,(MlyValue.TopDec_opt TopDec_opt1,_,TopDec_opt1right))::(_,(
+MlyValue.SigDec SigDec1,SigDecleft as SigDec1left,_))::rest671) => 
+let val result=MlyValue.TopDec_(fn _ => let val SigDec as SigDec1=
+SigDec1 ()
+val TopDec_opt as TopDec_opt1=TopDec_opt1 ()
+ in (
+ SIGtopdec (PP SigDecleft
+				       (rightmost  SigDec
+				                   TopDec_opt),
+				     SigDec, TopDec_opt) 
+) end
+)
+ in (LrTable.NT 1,(result,SigDec1left,TopDec_opt1right),rest671) end
+| (38,(_,(MlyValue.TopDec_opt TopDec_opt1,_,TopDec_opt1right))::(_,(
+MlyValue.FunDec FunDec1,FunDecleft as FunDec1left,_))::rest671) => 
+let val result=MlyValue.TopDec_(fn _ => let val FunDec as FunDec1=
+FunDec1 ()
+val TopDec_opt as TopDec_opt1=TopDec_opt1 ()
+ in (
+ FUNtopdec (PP FunDecleft
+				       (rightmost  FunDec
+				                   TopDec_opt),
+				     FunDec, TopDec_opt) 
+) end
+)
+ in (LrTable.NT 1,(result,FunDec1left,TopDec_opt1right),rest671) end
+| (39,(_,(MlyValue.TopDec_ TopDec_1,TopDec_1left,TopDec_1right))::
+rest671) => let val result=MlyValue.TopDec_opt(fn _ => let val TopDec_
+ as TopDec_1=TopDec_1 ()
+ in ( SOME TopDec_ ) end
+)
+ in (LrTable.NT 2,(result,TopDec_1left,TopDec_1right),rest671) end
+| (40,rest671) => let val result=MlyValue.TopDec_opt(fn _ => ( NONE ))
+ in (LrTable.NT 2,(result,defaultPos,defaultPos),rest671) end
+| (41,(_,(MlyValue.AndFunBind_opt AndFunBind_opt1,_,
+AndFunBind_opt1right))::(_,(MlyValue.StrExp StrExp1,_,StrExpright))::_
+::(_,(MlyValue.SigExp_constraint_maybe SigExp_constraint_maybe1,
+SigExp_constraint_maybeleft,_))::_::(_,(MlyValue.SigExp SigExp1,_,_))
+::_::(_,(MlyValue.Ident Ident2,_,_))::_::(_,(MlyValue.Ident Ident1,
+Ident1left,_))::rest671) => let val result=MlyValue.FunBind(fn _ => 
+let val Ident1=Ident1 ()
+val Ident2=Ident2 ()
+val SigExp as SigExp1=SigExp1 ()
+val SigExp_constraint_maybe as SigExp_constraint_maybe1=
+SigExp_constraint_maybe1 ()
+val StrExp as StrExp1=StrExp1 ()
+val AndFunBind_opt as AndFunBind_opt1=AndFunBind_opt1 ()
+ in (
+ let val i_body = PP SigExp_constraint_maybeleft StrExpright
+                              val empty_strdec = EMPTYstrdec (PP defaultPos defaultPos)
+                          in 
+                             FUNBIND (PP Ident1left
+				     (rightmost  StrExp
+				                 AndFunBind_opt),
+                                   mk_FunId Ident1, mk_StrId Ident2, SigExp,
+                                   LETstrexp(i_body, empty_strdec,
+                                             SigExp_constraint_maybe SigExp_constraint_maybeleft StrExp), 
+                                   AndFunBind_opt)
+                          end 
+) end
+)
+ in (LrTable.NT 7,(result,Ident1left,AndFunBind_opt1right),rest671)
+ end
+| (42,(_,(MlyValue.AndFunBind_opt AndFunBind_opt1,_,
+AndFunBind_opt1right))::(_,(MlyValue.StrExp StrExp1,_,StrExpright))::_
+::(_,(MlyValue.SigExp_constraint_maybe SigExp_constraint_maybe1,
+SigExp_constraint_maybeleft,_))::_::(_,(MlyValue.Spec Spec1,_,_))::_::
+(_,(MlyValue.Ident Ident1,Ident1left,_))::rest671) => let val result=
+MlyValue.FunBind(fn _ => let val Ident as Ident1=Ident1 ()
+val Spec as Spec1=Spec1 ()
+val SigExp_constraint_maybe as SigExp_constraint_maybe1=
+SigExp_constraint_maybe1 ()
+val StrExp as StrExp1=StrExp1 ()
+val AndFunBind_opt as AndFunBind_opt1=AndFunBind_opt1 ()
+ in (
+ let val strid_nu = inventStrId ()
+			      val i_body = PP SigExp_constraint_maybeleft StrExpright
+			      val i_spec =  Spec
+                          in FUNBIND
+			       (PP Ident1left
+				  (rightmost  StrExp
+				              AndFunBind_opt),
+				mk_FunId Ident, strid_nu,
+				SIGsigexp (i_spec, Spec),
+				LETstrexp
+				  (i_body,
+				   DECstrdec
+				     (i_spec,
+				      OPENdec (i_spec,
+					       [WITH_INFO (i_spec, longStrIdOfStrId strid_nu)])),
+				   SigExp_constraint_maybe SigExp_constraint_maybeleft StrExp),
+				AndFunBind_opt)
+                          end 
+) end
+)
+ in (LrTable.NT 7,(result,Ident1left,AndFunBind_opt1right),rest671)
+ end
+| (43,(_,(MlyValue.SigExp_constraint SigExp_constraint1,
+SigExp_constraint1left,SigExp_constraint1right))::rest671) => let val 
+result=MlyValue.SigExp_constraint_maybe(fn _ => let val 
+SigExp_constraint as SigExp_constraint1=SigExp_constraint1 ()
+ in ( SigExp_constraint ) end
+)
+ in (LrTable.NT 25,(result,SigExp_constraint1left,
+SigExp_constraint1right),rest671) end
+| (44,rest671) => let val result=MlyValue.SigExp_constraint_maybe(fn _
+ => ( (fn _ => fn strexp => strexp) ))
+ in (LrTable.NT 25,(result,defaultPos,defaultPos),rest671) end
+| (45,(_,(MlyValue.SigExp SigExp1,_,SigExpright as SigExp1right))::(_,
+(_,COLON1left,_))::rest671) => let val result=
+MlyValue.SigExp_constraint(fn _ => let val SigExp as SigExp1=SigExp1 
+()
+ in (
+ (fn leftpos => fn strexp => 
+			   TRANSPARENT_CONSTRAINTstrexp
+			     (PP leftpos SigExpright, strexp, SigExp)) 
+) end
+)
+ in (LrTable.NT 24,(result,COLON1left,SigExp1right),rest671) end
+| (46,(_,(MlyValue.SigExp SigExp1,_,SigExpright as SigExp1right))::(_,
+(_,COLONGREATER1left,_))::rest671) => let val result=
+MlyValue.SigExp_constraint(fn _ => let val SigExp as SigExp1=SigExp1 
+()
+ in (
+ (fn leftpos => fn strexp => 
+			   OPAQUE_CONSTRAINTstrexp
+			     (PP leftpos SigExpright, strexp, SigExp)) 
+) end
+)
+ in (LrTable.NT 24,(result,COLONGREATER1left,SigExp1right),rest671)
+ end
+| (47,(_,(MlyValue.FunBind FunBind1,_,FunBind1right))::(_,(_,AND1left,
+_))::rest671) => let val result=MlyValue.AndFunBind_opt(fn _ => let 
+val FunBind as FunBind1=FunBind1 ()
+ in ( SOME FunBind ) end
+)
+ in (LrTable.NT 26,(result,AND1left,FunBind1right),rest671) end
+| (48,rest671) => let val result=MlyValue.AndFunBind_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 26,(result,defaultPos,defaultPos),rest671) end
+| (49,(_,(MlyValue.FunBind FunBind1,_,FunBind1right))::(_,(_,
+FUNCTORleft as FUNCTOR1left,_))::rest671) => let val result=
+MlyValue.FunDec(fn _ => let val FunBind as FunBind1=FunBind1 ()
+ in (
+ FUNCTORfundec (PP FUNCTORleft (right (info_on_funbind FunBind)),
+					 FunBind) 
+) end
+)
+ in (LrTable.NT 5,(result,FUNCTOR1left,FunBind1right),rest671) end
+| (50,(_,(MlyValue.AndStrDesc_opt AndStrDesc_opt1,_,
+AndStrDesc_opt1right))::(_,(MlyValue.SigExp SigExp1,_,_))::_::(_,(
+MlyValue.Ident Ident1,Identleft as Ident1left,_))::rest671) => let 
+val result=MlyValue.StrDesc(fn _ => let val Ident as Ident1=Ident1 ()
+val SigExp as SigExp1=SigExp1 ()
+val AndStrDesc_opt as AndStrDesc_opt1=AndStrDesc_opt1 ()
+ in (
+ STRDESC (PP Identleft
+				     (rightmost info_on_sigexp SigExp
+				                info_on_strdesc AndStrDesc_opt),
+				   mk_StrId Ident, SigExp, AndStrDesc_opt) 
+) end
+)
+ in (LrTable.NT 8,(result,Ident1left,AndStrDesc_opt1right),rest671)
+ end
+| (51,(_,(MlyValue.StrDesc StrDesc1,_,StrDesc1right))::(_,(_,AND1left,
+_))::rest671) => let val result=MlyValue.AndStrDesc_opt(fn _ => let 
+val StrDesc as StrDesc1=StrDesc1 ()
+ in ( SOME StrDesc ) end
+)
+ in (LrTable.NT 29,(result,AND1left,StrDesc1right),rest671) end
+| (52,rest671) => let val result=MlyValue.AndStrDesc_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 29,(result,defaultPos,defaultPos),rest671) end
+| (53,(_,(MlyValue.AndExDesc_opt AndExDesc_opt1,_,AndExDesc_opt1right)
+)::(_,(MlyValue.OfTy_opt OfTy_opt1,_,_))::(_,(MlyValue.Ident Ident1,
+Identleft as Ident1left,Identright))::rest671) => let val result=
+MlyValue.ExDesc(fn _ => let val Ident as Ident1=Ident1 ()
+val OfTy_opt as OfTy_opt1=OfTy_opt1 ()
+val AndExDesc_opt as AndExDesc_opt1=AndExDesc_opt1 ()
+ in (
+ EXDESC (PP Identleft
+				    (rightmost_of_three  Identright
+				                get_info_ty OfTy_opt
+						info_on_exdesc AndExDesc_opt),
+				  mk_Id Ident, OfTy_opt, AndExDesc_opt) 
+) end
+)
+ in (LrTable.NT 9,(result,Ident1left,AndExDesc_opt1right),rest671) end
+| (54,(_,(MlyValue.ExDesc ExDesc1,_,ExDesc1right))::(_,(_,AND1left,_))
+::rest671) => let val result=MlyValue.AndExDesc_opt(fn _ => let val 
+ExDesc as ExDesc1=ExDesc1 ()
+ in ( SOME ExDesc ) end
+)
+ in (LrTable.NT 30,(result,AND1left,ExDesc1right),rest671) end
+| (55,rest671) => let val result=MlyValue.AndExDesc_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 30,(result,defaultPos,defaultPos),rest671) end
+| (56,(_,(MlyValue.BarConDesc_opt BarConDesc_opt1,_,
+BarConDesc_opt1right))::(_,(MlyValue.OfTy_opt OfTy_opt1,_,_))::(_,(
+MlyValue.OpIdent OpIdent1,OpIdentleft as OpIdent1left,OpIdentright))::
+rest671) => let val result=MlyValue.ConDesc(fn _ => let val OpIdent
+ as OpIdent1=OpIdent1 ()
+val OfTy_opt as OfTy_opt1=OfTy_opt1 ()
+val BarConDesc_opt as BarConDesc_opt1=BarConDesc_opt1 ()
+ in (
+ let val OP_OPT (id, _) = OpIdent
+                          in CONDESC
+			       (PP OpIdentleft
+				  (rightmost_of_three OpIdentright
+				              get_info_ty OfTy_opt
+					      info_on_condesc BarConDesc_opt), 
+				mk_Id id, OfTy_opt, BarConDesc_opt)
+                          end 
+) end
+)
+ in (LrTable.NT 10,(result,OpIdent1left,BarConDesc_opt1right),rest671)
+ end
+| (57,(_,(MlyValue.ConDesc ConDesc1,_,ConDesc1right))::(_,(_,BAR1left,
+_))::rest671) => let val result=MlyValue.BarConDesc_opt(fn _ => let 
+val ConDesc as ConDesc1=ConDesc1 ()
+ in ( SOME ConDesc ) end
+)
+ in (LrTable.NT 31,(result,BAR1left,ConDesc1right),rest671) end
+| (58,rest671) => let val result=MlyValue.BarConDesc_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 31,(result,defaultPos,defaultPos),rest671) end
+| (59,(_,(MlyValue.AndDatDesc_opt AndDatDesc_opt1,_,
+AndDatDesc_opt1right))::(_,(MlyValue.ConDesc ConDesc1,_,_))::_::(_,(
+MlyValue.TypeIdent TypeIdent1,_,_))::(_,(MlyValue.TyVarSeq TyVarSeq1,
+TyVarSeqleft as TyVarSeq1left,_))::rest671) => let val result=
+MlyValue.DatDesc(fn _ => let val TyVarSeq as TyVarSeq1=TyVarSeq1 ()
+val TypeIdent as TypeIdent1=TypeIdent1 ()
+val ConDesc as ConDesc1=ConDesc1 ()
+val AndDatDesc_opt as AndDatDesc_opt1=AndDatDesc_opt1 ()
+ in (
+ DATDESC (PP TyVarSeqleft
+				     (rightmost info_on_condesc ConDesc
+				                info_on_datdesc AndDatDesc_opt),
+				   TyVarSeq, mk_TyCon TypeIdent,
+				   ConDesc, AndDatDesc_opt) 
+) end
+)
+ in (LrTable.NT 11,(result,TyVarSeq1left,AndDatDesc_opt1right),rest671
+) end
+| (60,(_,(MlyValue.AndDatDesc_opt AndDatDesc_opt1,_,
+AndDatDesc_opt1right))::(_,(MlyValue.ConDesc ConDesc1,_,_))::_::(_,(
+MlyValue.TypeIdent TypeIdent1,TypeIdentleft as TypeIdent1left,_))::
+rest671) => let val result=MlyValue.DatDesc_zero_arity(fn _ => let 
+val TypeIdent as TypeIdent1=TypeIdent1 ()
+val ConDesc as ConDesc1=ConDesc1 ()
+val AndDatDesc_opt as AndDatDesc_opt1=AndDatDesc_opt1 ()
+ in (
+ DATDESC (PP TypeIdentleft
+				     (rightmost info_on_condesc ConDesc
+				                info_on_datdesc AndDatDesc_opt),
+				   [], mk_TyCon TypeIdent,
+				   ConDesc, AndDatDesc_opt) 
+) end
+)
+ in (LrTable.NT 12,(result,TypeIdent1left,AndDatDesc_opt1right),
+rest671) end
+| (61,(_,(MlyValue.AndDatDesc_opt AndDatDesc_opt1,_,
+AndDatDesc_opt1right))::(_,(MlyValue.ConDesc ConDesc1,_,_))::_::(_,(
+MlyValue.TypeIdent TypeIdent1,_,_))::(_,(MlyValue.TyVarSeq1 TyVarSeq11
+,TyVarSeq1left as TyVarSeq11left,_))::rest671) => let val result=
+MlyValue.DatDesc_nonzero_arity(fn _ => let val TyVarSeq1 as TyVarSeq11
+=TyVarSeq11 ()
+val TypeIdent as TypeIdent1=TypeIdent1 ()
+val ConDesc as ConDesc1=ConDesc1 ()
+val AndDatDesc_opt as AndDatDesc_opt1=AndDatDesc_opt1 ()
+ in (
+ DATDESC (PP TyVarSeq1left
+				     (rightmost info_on_condesc ConDesc
+				                info_on_datdesc AndDatDesc_opt),
+				   TyVarSeq1, mk_TyCon TypeIdent,
+				   ConDesc, AndDatDesc_opt) 
+) end
+)
+ in (LrTable.NT 13,(result,TyVarSeq11left,AndDatDesc_opt1right),
+rest671) end
+| (62,(_,(MlyValue.DatDesc DatDesc1,_,DatDesc1right))::(_,(_,AND1left,
+_))::rest671) => let val result=MlyValue.AndDatDesc_opt(fn _ => let 
+val DatDesc as DatDesc1=DatDesc1 ()
+ in ( SOME DatDesc ) end
+)
+ in (LrTable.NT 32,(result,AND1left,DatDesc1right),rest671) end
+| (63,rest671) => let val result=MlyValue.AndDatDesc_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 32,(result,defaultPos,defaultPos),rest671) end
+| (64,(_,(MlyValue.AndTypDesc_opt AndTypDesc_opt1,_,
+AndTypDesc_opt1right))::(_,(MlyValue.TypeIdent TypeIdent1,_,
+TypeIdentright))::(_,(MlyValue.TyVarSeq TyVarSeq1,TyVarSeqleft as 
+TyVarSeq1left,_))::rest671) => let val result=MlyValue.TypDesc(fn _
+ => let val TyVarSeq as TyVarSeq1=TyVarSeq1 ()
+val TypeIdent as TypeIdent1=TypeIdent1 ()
+val AndTypDesc_opt as AndTypDesc_opt1=AndTypDesc_opt1 ()
+ in (
+ TYPDESC (PP TyVarSeqleft
+				     (rightmost' TypeIdentright info_on_typdesc AndTypDesc_opt),
+				   TyVarSeq, mk_TyCon TypeIdent, AndTypDesc_opt) 
+) end
+)
+ in (LrTable.NT 14,(result,TyVarSeq1left,AndTypDesc_opt1right),rest671
+) end
+| (65,(_,(MlyValue.TypDesc TypDesc1,_,TypDesc1right))::(_,(_,AND1left,
+_))::rest671) => let val result=MlyValue.AndTypDesc_opt(fn _ => let 
+val TypDesc as TypDesc1=TypDesc1 ()
+ in ( SOME TypDesc ) end
+)
+ in (LrTable.NT 33,(result,AND1left,TypDesc1right),rest671) end
+| (66,rest671) => let val result=MlyValue.AndTypDesc_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 33,(result,defaultPos,defaultPos),rest671) end
+| (67,(_,(MlyValue.TypAbbreviationAND_seq1 TypAbbreviationAND_seq11,_,
+TypAbbreviationAND_seq11right))::_::(_,(MlyValue.TypAbbreviation 
+TypAbbreviation1,TypAbbreviation1left,_))::rest671) => let val result=
+MlyValue.TypAbbreviationAND_seq1(fn _ => let val TypAbbreviation as 
+TypAbbreviation1=TypAbbreviation1 ()
+val TypAbbreviationAND_seq1 as TypAbbreviationAND_seq11=
+TypAbbreviationAND_seq11 ()
+ in ( TypAbbreviation :: TypAbbreviationAND_seq1 ) end
+)
+ in (LrTable.NT 34,(result,TypAbbreviation1left,
+TypAbbreviationAND_seq11right),rest671) end
+| (68,(_,(MlyValue.TypAbbreviation TypAbbreviation1,
+TypAbbreviation1left,TypAbbreviation1right))::rest671) => let val 
+result=MlyValue.TypAbbreviationAND_seq1(fn _ => let val 
+TypAbbreviation as TypAbbreviation1=TypAbbreviation1 ()
+ in ( [TypAbbreviation] ) end
+)
+ in (LrTable.NT 34,(result,TypAbbreviation1left,TypAbbreviation1right)
+,rest671) end
+| (69,(_,(MlyValue.Ty Ty1,_,Tyright as Ty1right))::_::(_,(
+MlyValue.TypeIdent TypeIdent1,_,TypeIdentright))::(_,(
+MlyValue.TyVarSeq TyVarSeq1,TyVarSeqleft as TyVarSeq1left,_))::rest671
+) => let val result=MlyValue.TypAbbreviation(fn _ => let val TyVarSeq
+ as TyVarSeq1=TyVarSeq1 ()
+val TypeIdent as TypeIdent1=TypeIdent1 ()
+val Ty as Ty1=Ty1 ()
+ in (
+ (TyVarSeq, mk_TyCon TypeIdent, Ty,
+			   PP TyVarSeqleft Tyright, PP TyVarSeqleft TypeIdentright) 
+) end
+)
+ in (LrTable.NT 15,(result,TyVarSeq1left,Ty1right),rest671) end
+| (70,(_,(MlyValue.AndValDesc_opt AndValDesc_opt1,_,
+AndValDesc_opt1right))::(_,(MlyValue.Ty Ty1,_,Tyright))::_::(_,(
+MlyValue.EqIdent EqIdent1,EqIdentleft as EqIdent1left,_))::rest671)
+ => let val result=MlyValue.ValDesc(fn _ => let val EqIdent as 
+EqIdent1=EqIdent1 ()
+val Ty as Ty1=Ty1 ()
+val AndValDesc_opt as AndValDesc_opt1=AndValDesc_opt1 ()
+ in (
+ VALDESC (PP EqIdentleft
+				     (rightmost' Tyright info_on_valdesc AndValDesc_opt),
+				   mk_Id EqIdent, Ty, AndValDesc_opt) 
+) end
+)
+ in (LrTable.NT 16,(result,EqIdent1left,AndValDesc_opt1right),rest671)
+ end
+| (71,(_,(MlyValue.ValDesc ValDesc1,_,ValDesc1right))::(_,(_,AND1left,
+_))::rest671) => let val result=MlyValue.AndValDesc_opt(fn _ => let 
+val ValDesc as ValDesc1=ValDesc1 ()
+ in ( SOME ValDesc ) end
+)
+ in (LrTable.NT 35,(result,AND1left,ValDesc1right),rest671) end
+| (72,rest671) => let val result=MlyValue.AndValDesc_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 35,(result,defaultPos,defaultPos),rest671) end
+| (73,(_,(MlyValue.ValDesc ValDesc1,_,ValDesc1right))::(_,(_,VALleft
+ as VAL1left,_))::rest671) => let val result=MlyValue.OneSpec(fn _ => 
+let val ValDesc as ValDesc1=ValDesc1 ()
+ in (
+ VALspec (PP VALleft (right (info_on_valdesc ValDesc)),
+				   ValDesc) 
+) end
+)
+ in (LrTable.NT 18,(result,VAL1left,ValDesc1right),rest671) end
+| (74,(_,(MlyValue.TypDesc TypDesc1,_,TypDesc1right))::(_,(_,TYPEleft
+ as TYPE1left,_))::rest671) => let val result=MlyValue.OneSpec(fn _
+ => let val TypDesc as TypDesc1=TypDesc1 ()
+ in (
+ TYPEspec (PP TYPEleft (right (info_on_typdesc TypDesc)),
+				    TypDesc) 
+) end
+)
+ in (LrTable.NT 18,(result,TYPE1left,TypDesc1right),rest671) end
+| (75,(_,(MlyValue.TypDesc TypDesc1,_,TypDesc1right))::(_,(_,
+EQTYPEleft as EQTYPE1left,_))::rest671) => let val result=
+MlyValue.OneSpec(fn _ => let val TypDesc as TypDesc1=TypDesc1 ()
+ in (
+ EQTYPEspec (PP EQTYPEleft (right (info_on_typdesc TypDesc)),
+				      TypDesc) 
+) end
+)
+ in (LrTable.NT 18,(result,EQTYPE1left,TypDesc1right),rest671) end
+| (76,(_,(MlyValue.DatDesc_zero_arity DatDesc_zero_arity1,_,
+DatDesc_zero_arity1right))::(_,(_,DATATYPEleft as DATATYPE1left,_))::
+rest671) => let val result=MlyValue.OneSpec(fn _ => let val 
+DatDesc_zero_arity as DatDesc_zero_arity1=DatDesc_zero_arity1 ()
+ in (
+ DATATYPEspec (PP DATATYPEleft
+					  (right (info_on_datdesc DatDesc_zero_arity)),
+				        DatDesc_zero_arity) 
+) end
+)
+ in (LrTable.NT 18,(result,DATATYPE1left,DatDesc_zero_arity1right),
+rest671) end
+| (77,(_,(MlyValue.DatDesc_nonzero_arity DatDesc_nonzero_arity1,_,
+DatDesc_nonzero_arity1right))::(_,(_,DATATYPEleft as DATATYPE1left,_))
+::rest671) => let val result=MlyValue.OneSpec(fn _ => let val 
+DatDesc_nonzero_arity as DatDesc_nonzero_arity1=DatDesc_nonzero_arity1
+ ()
+ in (
+ DATATYPEspec (PP DATATYPEleft
+					  (right (info_on_datdesc DatDesc_nonzero_arity)),
+					DatDesc_nonzero_arity) 
+) end
+)
+ in (LrTable.NT 18,(result,DATATYPE1left,DatDesc_nonzero_arity1right),
+rest671) end
+| (78,(_,(MlyValue.LongTypeIdent LongTypeIdent1,_,LongTypeIdentright
+ as LongTypeIdent1right))::_::_::(_,(MlyValue.TypeIdent TypeIdent1,_,_
+))::(_,(_,DATATYPE1left,_))::rest671) => let val result=
+MlyValue.OneSpec(fn _ => let val TypeIdent as TypeIdent1=TypeIdent1 ()
+val LongTypeIdent as LongTypeIdent1=LongTypeIdent1 ()
+ in (
+ DATATYPE_REPLICATIONspec
+			    (PP DATATYPE1left LongTypeIdentright,
+			     mk_TyCon TypeIdent, mk_LongTyCon LongTypeIdent) 
+) end
+)
+ in (LrTable.NT 18,(result,DATATYPE1left,LongTypeIdent1right),rest671)
+ end
+| (79,(_,(MlyValue.ExDesc ExDesc1,_,ExDesc1right))::(_,(_,
+EXCEPTIONleft as EXCEPTION1left,_))::rest671) => let val result=
+MlyValue.OneSpec(fn _ => let val ExDesc as ExDesc1=ExDesc1 ()
+ in (
+ EXCEPTIONspec (PP EXCEPTIONleft (right (info_on_exdesc ExDesc)),
+					 ExDesc) 
+) end
+)
+ in (LrTable.NT 18,(result,EXCEPTION1left,ExDesc1right),rest671) end
+| (80,(_,(MlyValue.StrDesc StrDesc1,_,StrDesc1right))::(_,(_,
+STRUCTUREleft as STRUCTURE1left,_))::rest671) => let val result=
+MlyValue.OneSpec(fn _ => let val StrDesc as StrDesc1=StrDesc1 ()
+ in (
+ STRUCTUREspec (PP STRUCTUREleft (right (info_on_strdesc StrDesc)),
+					 StrDesc) 
+) end
+)
+ in (LrTable.NT 18,(result,STRUCTURE1left,StrDesc1right),rest671) end
+| (81,(_,(MlyValue.SigExp SigExp1,_,SigExpright as SigExp1right))::(_,
+(_,INCLUDEleft as INCLUDE1left,_))::rest671) => let val result=
+MlyValue.OneSpec(fn _ => let val SigExp as SigExp1=SigExp1 ()
+ in ( INCLUDEspec (PP INCLUDEleft SigExpright, SigExp) ) end
+)
+ in (LrTable.NT 18,(result,INCLUDE1left,SigExp1right),rest671) end
+| (82,(_,(MlyValue.TypAbbreviationAND_seq1 TypAbbreviationAND_seq11,_,
+TypAbbreviationAND_seq11right))::(_,(_,TYPE1left,_))::rest671) => let 
+val result=MlyValue.OneSpec(fn _ => let val TypAbbreviationAND_seq1
+ as TypAbbreviationAND_seq11=TypAbbreviationAND_seq11 ()
+ in (
+ fold_specs_to_spec
+			    (map rewrite_type_abbreviation_spec TypAbbreviationAND_seq1) 
+) end
+)
+ in (LrTable.NT 18,(result,TYPE1left,TypAbbreviationAND_seq11right),
+rest671) end
+| (83,(_,(MlyValue.Ident_seq2 Ident_seq21,_,Ident_seq21right))::(_,(_,
+INCLUDE1left,_))::rest671) => let val result=MlyValue.OneSpec(fn _ => 
+let val Ident_seq2 as Ident_seq21=Ident_seq21 ()
+ in (
+ fold_specs_to_spec
+			    (map (fn WITH_INFO (i, Ident) =>
+				      (i, INCLUDEspec (i, SIGIDsigexp (i, mk_SigId Ident))))
+			       Ident_seq2) 
+) end
+)
+ in (LrTable.NT 18,(result,INCLUDE1left,Ident_seq21right),rest671) end
+| (84,(_,(MlyValue.OneSpec OneSpec1,_,OneSpec1right))::(_,(
+MlyValue.Spec Spec1,Specleft as Spec1left,_))::rest671) => let val 
+result=MlyValue.Spec(fn _ => let val Spec as Spec1=Spec1 ()
+val OneSpec as OneSpec1=OneSpec1 ()
+ in (
+ composeSpec (PP Specleft (right (info_on_spec OneSpec)),
+				       Spec, OneSpec) 
+) end
+)
+ in (LrTable.NT 17,(result,Spec1left,OneSpec1right),rest671) end
+| (85,(_,(MlyValue.LongTypeIdentEq_seq2 LongTypeIdentEq_seq21,_,
+LongTypeIdentEq_seq2right as LongTypeIdentEq_seq21right))::_::_::(_,(
+MlyValue.Spec Spec1,Specleft as Spec1left,_))::rest671) => let val 
+result=MlyValue.Spec(fn _ => let val Spec as Spec1=Spec1 ()
+val LongTypeIdentEq_seq2 as LongTypeIdentEq_seq21=
+LongTypeIdentEq_seq21 ()
+ in (
+ SHARING_TYPEspec (PP Specleft LongTypeIdentEq_seq2right,
+					    Spec,
+					    wi_Convert mk_LongTyCon LongTypeIdentEq_seq2) 
+) end
+)
+ in (LrTable.NT 17,(result,Spec1left,LongTypeIdentEq_seq21right),
+rest671) end
+| (86,(_,(MlyValue.LongIdentEq_seq2 LongIdentEq_seq21,_,
+LongIdentEq_seq2right as LongIdentEq_seq21right))::_::(_,(
+MlyValue.Spec Spec1,Specleft as Spec1left,_))::rest671) => let val 
+result=MlyValue.Spec(fn _ => let val Spec as Spec1=Spec1 ()
+val LongIdentEq_seq2 as LongIdentEq_seq21=LongIdentEq_seq21 ()
+ in (
+ SHARINGspec (PP Specleft LongIdentEq_seq2right,
+				       Spec, wi_Convert mk_LongStrId LongIdentEq_seq2) 
+) end
+)
+ in (LrTable.NT 17,(result,Spec1left,LongIdentEq_seq21right),rest671)
+ end
+| (87,(_,(_,_,SEMICOLON1right))::(_,(MlyValue.Spec Spec1,Spec1left,_))
+::rest671) => let val result=MlyValue.Spec(fn _ => let val Spec as 
+Spec1=Spec1 ()
+ in ( Spec ) end
+)
+ in (LrTable.NT 17,(result,Spec1left,SEMICOLON1right),rest671) end
+| (88,rest671) => let val result=MlyValue.Spec(fn _ => (
+ EMPTYspec (PP defaultPos defaultPos) ))
+ in (LrTable.NT 17,(result,defaultPos,defaultPos),rest671) end
+| (89,(_,(_,_,ENDright as END1right))::(_,(MlyValue.StrDec StrDec1,_,_
+))::(_,(_,STRUCTleft as STRUCT1left,_))::rest671) => let val result=
+MlyValue.StrExp(fn _ => let val StrDec as StrDec1=StrDec1 ()
+ in ( STRUCTstrexp (PP STRUCTleft ENDright, StrDec) ) end
+)
+ in (LrTable.NT 23,(result,STRUCT1left,END1right),rest671) end
+| (90,(_,(MlyValue.LongIdent LongIdent1,LongIdentleft as 
+LongIdent1left,LongIdentright as LongIdent1right))::rest671) => let 
+val result=MlyValue.StrExp(fn _ => let val LongIdent as LongIdent1=
+LongIdent1 ()
+ in (
+ LONGSTRIDstrexp (PP LongIdentleft LongIdentright,
+					   mk_LongStrId LongIdent) 
+) end
+)
+ in (LrTable.NT 23,(result,LongIdent1left,LongIdent1right),rest671)
+ end
+| (91,(_,(MlyValue.SigExp_constraint SigExp_constraint1,_,
+SigExp_constraint1right))::(_,(MlyValue.StrExp StrExp1,StrExpleft as 
+StrExp1left,_))::rest671) => let val result=MlyValue.StrExp(fn _ => 
+let val StrExp as StrExp1=StrExp1 ()
+val SigExp_constraint as SigExp_constraint1=SigExp_constraint1 ()
+ in ( SigExp_constraint StrExpleft StrExp ) end
+)
+ in (LrTable.NT 23,(result,StrExp1left,SigExp_constraint1right),
+rest671) end
+| (92,(_,(_,_,RPARENright as RPAREN1right))::(_,(MlyValue.StrExp 
+StrExp1,_,_))::_::(_,(MlyValue.Ident Ident1,Identleft as Ident1left,_)
+)::rest671) => let val result=MlyValue.StrExp(fn _ => let val Ident
+ as Ident1=Ident1 ()
+val StrExp as StrExp1=StrExp1 ()
+ in (
+ APPstrexp (PP Identleft RPARENright,
+				     mk_FunId Ident, StrExp) 
+) end
+)
+ in (LrTable.NT 23,(result,Ident1left,RPAREN1right),rest671) end
+| (93,(_,(_,_,ENDright as END1right))::(_,(MlyValue.StrExp StrExp1,_,_
+))::_::(_,(MlyValue.StrDec StrDec1,_,_))::(_,(_,LETleft as LET1left,_)
+)::rest671) => let val result=MlyValue.StrExp(fn _ => let val StrDec
+ as StrDec1=StrDec1 ()
+val StrExp as StrExp1=StrExp1 ()
+ in ( LETstrexp (PP LETleft ENDright, StrDec, StrExp) ) end
+)
+ in (LrTable.NT 23,(result,LET1left,END1right),rest671) end
+| (94,(_,(_,_,RPARENright as RPAREN1right))::(_,(MlyValue.StrDec 
+StrDec1,StrDecleft,_))::_::(_,(MlyValue.Ident Ident1,Identleft as 
+Ident1left,_))::rest671) => let val result=MlyValue.StrExp(fn _ => 
+let val Ident as Ident1=Ident1 ()
+val StrDec as StrDec1=StrDec1 ()
+ in (
+ APPstrexp (PP Identleft RPARENright, mk_FunId Ident,
+				     STRUCTstrexp
+				       (PP StrDecleft (right (info_on_strdec StrDec)),
+					StrDec)) 
+) end
+)
+ in (LrTable.NT 23,(result,Ident1left,RPAREN1right),rest671) end
+| (95,(_,(MlyValue.OneStrDec_or_SEMICOLON OneStrDec_or_SEMICOLON1,_,
+OneStrDec_or_SEMICOLON1right))::(_,(MlyValue.NonEmptyStrDec 
+NonEmptyStrDec1,NonEmptyStrDecleft as NonEmptyStrDec1left,_))::rest671
+) => let val result=MlyValue.NonEmptyStrDec(fn _ => let val 
+NonEmptyStrDec as NonEmptyStrDec1=NonEmptyStrDec1 ()
+val OneStrDec_or_SEMICOLON as OneStrDec_or_SEMICOLON1=
+OneStrDec_or_SEMICOLON1 ()
+ in (
+ (case OneStrDec_or_SEMICOLON of
+			     SOME strdec =>
+			       composeStrDec (PP NonEmptyStrDecleft
+					        (right (info_on_strdec strdec)),
+					      NonEmptyStrDec, strdec)
+			   | NONE =>
+			       NonEmptyStrDec) 
+) end
+)
+ in (LrTable.NT 42,(result,NonEmptyStrDec1left,
+OneStrDec_or_SEMICOLON1right),rest671) end
+| (96,(_,(MlyValue.OneStrDec_or_SEMICOLON OneStrDec_or_SEMICOLON1,
+OneStrDec_or_SEMICOLON1left,OneStrDec_or_SEMICOLON1right))::rest671)
+ => let val result=MlyValue.NonEmptyStrDec(fn _ => let val 
+OneStrDec_or_SEMICOLON as OneStrDec_or_SEMICOLON1=
+OneStrDec_or_SEMICOLON1 ()
+ in (
+ (case OneStrDec_or_SEMICOLON of
+			     SOME strdec => strdec
+			   | NONE => EMPTYstrdec (PP defaultPos defaultPos)) 
+) end
+)
+ in (LrTable.NT 42,(result,OneStrDec_or_SEMICOLON1left,
+OneStrDec_or_SEMICOLON1right),rest671) end
+| (97,(_,(MlyValue.NonEmptyStrDec NonEmptyStrDec1,NonEmptyStrDec1left,
+NonEmptyStrDec1right))::rest671) => let val result=MlyValue.StrDec(fn 
+_ => let val NonEmptyStrDec as NonEmptyStrDec1=NonEmptyStrDec1 ()
+ in ( NonEmptyStrDec ) end
+)
+ in (LrTable.NT 22,(result,NonEmptyStrDec1left,NonEmptyStrDec1right),
+rest671) end
+| (98,rest671) => let val result=MlyValue.StrDec(fn _ => (
+ EMPTYstrdec (PP defaultPos defaultPos) ))
+ in (LrTable.NT 22,(result,defaultPos,defaultPos),rest671) end
+| (99,(_,(MlyValue.OneStrDec OneStrDec1,OneStrDec1left,OneStrDec1right
+))::rest671) => let val result=MlyValue.OneStrDec_or_SEMICOLON(fn _
+ => let val OneStrDec as OneStrDec1=OneStrDec1 ()
+ in ( SOME OneStrDec ) end
+)
+ in (LrTable.NT 41,(result,OneStrDec1left,OneStrDec1right),rest671)
+ end
+| (100,(_,(_,SEMICOLON1left,SEMICOLON1right))::rest671) => let val 
+result=MlyValue.OneStrDec_or_SEMICOLON(fn _ => ( NONE ))
+ in (LrTable.NT 41,(result,SEMICOLON1left,SEMICOLON1right),rest671)
+ end
+| (101,(_,(MlyValue.OneDec_sans_LOCAL OneDec_sans_LOCAL1,
+OneDec_sans_LOCALleft as OneDec_sans_LOCAL1left,
+OneDec_sans_LOCAL1right))::rest671) => let val result=
+MlyValue.OneStrDec(fn _ => let val OneDec_sans_LOCAL as 
+OneDec_sans_LOCAL1=OneDec_sans_LOCAL1 ()
+ in (
+ DECstrdec (PP OneDec_sans_LOCALleft
+                                        (right (get_info_dec OneDec_sans_LOCAL)),
+                                     OneDec_sans_LOCAL) 
+) end
+)
+ in (LrTable.NT 6,(result,OneDec_sans_LOCAL1left,
+OneDec_sans_LOCAL1right),rest671) end
+| (102,(_,(MlyValue.StrBind StrBind1,_,StrBind1right))::(_,(_,
+STRUCTUREleft as STRUCTURE1left,_))::rest671) => let val result=
+MlyValue.OneStrDec(fn _ => let val StrBind as StrBind1=StrBind1 ()
+ in (
+ STRUCTUREstrdec (PP STRUCTUREleft
+					     (right (info_on_strbind StrBind)),
+					   StrBind) 
+) end
+)
+ in (LrTable.NT 6,(result,STRUCTURE1left,StrBind1right),rest671) end
+| (103,(_,(_,_,ENDright as END1right))::(_,(MlyValue.StrDec StrDec2,_,
+_))::_::(_,(MlyValue.StrDec StrDec1,_,_))::(_,(_,LOCALleft as 
+LOCAL1left,_))::rest671) => let val result=MlyValue.OneStrDec(fn _ => 
+let val StrDec1=StrDec1 ()
+val StrDec2=StrDec2 ()
+ in ( LOCALstrdec (PP LOCALleft ENDright, StrDec1, StrDec2) ) end
+)
+ in (LrTable.NT 6,(result,LOCAL1left,END1right),rest671) end
+| (104,(_,(MlyValue.AndStrBind_opt AndStrBind_opt1,_,
+AndStrBind_opt1right))::(_,(MlyValue.StrExp StrExp1,_,_))::_::(_,(
+MlyValue.SigExp_constraint_maybe SigExp_constraint_maybe1,
+SigExp_constraint_maybeleft,_))::(_,(MlyValue.Ident Ident1,Identleft
+ as Ident1left,_))::rest671) => let val result=MlyValue.StrBind(fn _
+ => let val Ident as Ident1=Ident1 ()
+val SigExp_constraint_maybe as SigExp_constraint_maybe1=
+SigExp_constraint_maybe1 ()
+val StrExp as StrExp1=StrExp1 ()
+val AndStrBind_opt as AndStrBind_opt1=AndStrBind_opt1 ()
+ in (
+ STRBIND (PP Identleft
+				     (rightmost info_on_strexp StrExp
+				                info_on_strbind AndStrBind_opt), 
+				   mk_StrId Ident, SigExp_constraint_maybe SigExp_constraint_maybeleft StrExp, 
+				   AndStrBind_opt) 
+) end
+)
+ in (LrTable.NT 21,(result,Ident1left,AndStrBind_opt1right),rest671)
+ end
+| (105,(_,(MlyValue.StrBind StrBind1,_,StrBind1right))::(_,(_,AND1left
+,_))::rest671) => let val result=MlyValue.AndStrBind_opt(fn _ => let 
+val StrBind as StrBind1=StrBind1 ()
+ in ( SOME StrBind ) end
+)
+ in (LrTable.NT 27,(result,AND1left,StrBind1right),rest671) end
+| (106,rest671) => let val result=MlyValue.AndStrBind_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 27,(result,defaultPos,defaultPos),rest671) end
+| (107,(_,(_,_,ENDright as END1right))::(_,(MlyValue.Spec Spec1,_,_))
+::(_,(_,SIGleft as SIG1left,_))::rest671) => let val result=
+MlyValue.SigExp(fn _ => let val Spec as Spec1=Spec1 ()
+ in ( SIGsigexp (PP SIGleft ENDright, Spec) ) end
+)
+ in (LrTable.NT 20,(result,SIG1left,END1right),rest671) end
+| (108,(_,(MlyValue.Ident Ident1,Identleft as Ident1left,Identright
+ as Ident1right))::rest671) => let val result=MlyValue.SigExp(fn _ => 
+let val Ident as Ident1=Ident1 ()
+ in ( SIGIDsigexp (PP Identleft Identright, mk_SigId Ident) ) end
+)
+ in (LrTable.NT 20,(result,Ident1left,Ident1right),rest671) end
+| (109,(_,(MlyValue.WhereDesc WhereDesc1,_,WhereDesc1right))::_::(_,(
+MlyValue.SigExp SigExp1,SigExpleft as SigExp1left,_))::rest671) => 
+let val result=MlyValue.SigExp(fn _ => let val SigExp as SigExp1=
+SigExp1 ()
+val WhereDesc as WhereDesc1=WhereDesc1 ()
+ in ( WhereDesc(SigExpleft,SigExp) ) end
+)
+ in (LrTable.NT 20,(result,SigExp1left,WhereDesc1right),rest671) end
+| (110,(_,(MlyValue.AndWhereDesc_opt AndWhereDesc_opt1,_,
+AndWhereDesc_opt1right))::(_,(MlyValue.Ty Ty1,_,Tyright))::_::(_,(
+MlyValue.LongTypeIdent LongTypeIdent1,_,_))::(_,(MlyValue.TyVarSeq 
+TyVarSeq1,_,_))::(_,(_,TYPE1left,_))::rest671) => let val result=
+MlyValue.WhereDesc(fn _ => let val TyVarSeq as TyVarSeq1=TyVarSeq1 ()
+val LongTypeIdent as LongTypeIdent1=LongTypeIdent1 ()
+val Ty as Ty1=Ty1 ()
+val AndWhereDesc_opt as AndWhereDesc_opt1=AndWhereDesc_opt1 ()
+ in (
+ fn (sigexpleft,sigexp) =>
+                             case AndWhereDesc_opt
+                               of SOME f => f (sigexpleft, WHERE_TYPEsigexp (PP sigexpleft Tyright,
+					                                     sigexp, TyVarSeq,
+					                                     mk_LongTyCon LongTypeIdent, Ty))
+                                | NONE => WHERE_TYPEsigexp (PP sigexpleft Tyright,
+					                    sigexp, TyVarSeq,
+					                    mk_LongTyCon LongTypeIdent, Ty) 
+) end
+)
+ in (LrTable.NT 43,(result,TYPE1left,AndWhereDesc_opt1right),rest671)
+ end
+| (111,(_,(MlyValue.WhereDesc WhereDesc1,_,WhereDesc1right))::(_,(_,
+AND1left,_))::rest671) => let val result=MlyValue.AndWhereDesc_opt(fn 
+_ => let val WhereDesc as WhereDesc1=WhereDesc1 ()
+ in ( SOME WhereDesc ) end
+)
+ in (LrTable.NT 44,(result,AND1left,WhereDesc1right),rest671) end
+| (112,rest671) => let val result=MlyValue.AndWhereDesc_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 44,(result,defaultPos,defaultPos),rest671) end
+| (113,(_,(MlyValue.SigBind SigBind1,_,SigBind1right))::(_,(_,
+SIGNATUREleft as SIGNATURE1left,_))::rest671) => let val result=
+MlyValue.SigDec(fn _ => let val SigBind as SigBind1=SigBind1 ()
+ in (
+ SIGNATUREsigdec
+			    (PP SIGNATUREleft (right (info_on_sigbind SigBind)),
+			     SigBind) 
+) end
+)
+ in (LrTable.NT 3,(result,SIGNATURE1left,SigBind1right),rest671) end
+| (114,(_,(MlyValue.AndSigBind_opt AndSigBind_opt1,_,
+AndSigBind_opt1right))::(_,(MlyValue.SigExp SigExp1,_,_))::_::(_,(
+MlyValue.Ident Ident1,Identleft as Ident1left,_))::rest671) => let 
+val result=MlyValue.SigBind(fn _ => let val Ident as Ident1=Ident1 ()
+val SigExp as SigExp1=SigExp1 ()
+val AndSigBind_opt as AndSigBind_opt1=AndSigBind_opt1 ()
+ in (
+ SIGBIND (PP Identleft
+				     (rightmost info_on_sigexp SigExp
+				                info_on_sigbind AndSigBind_opt),
+                                   mk_SigId Ident, SigExp, AndSigBind_opt) 
+) end
+)
+ in (LrTable.NT 19,(result,Ident1left,AndSigBind_opt1right),rest671)
+ end
+| (115,(_,(MlyValue.SigBind SigBind1,_,SigBind1right))::(_,(_,AND1left
+,_))::rest671) => let val result=MlyValue.AndSigBind_opt(fn _ => let 
+val SigBind as SigBind1=SigBind1 ()
+ in ( SOME SigBind ) end
+)
+ in (LrTable.NT 28,(result,AND1left,SigBind1right),rest671) end
+| (116,rest671) => let val result=MlyValue.AndSigBind_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 28,(result,defaultPos,defaultPos),rest671) end
+| (117,(_,(MlyValue.SCon SCon1,SConleft as SCon1left,SConright as 
+SCon1right))::rest671) => let val result=MlyValue.AtExp(fn _ => let 
+val SCon as SCon1=SCon1 ()
+ in ( SCONatexp (PP SConleft SConright, SCon) ) end
+)
+ in (LrTable.NT 69,(result,SCon1left,SCon1right),rest671) end
+| (118,(_,(MlyValue.LongOpEqIdent LongOpEqIdent1,LongOpEqIdentleft as 
+LongOpEqIdent1left,LongOpEqIdentright as LongOpEqIdent1right))::
+rest671) => let val result=MlyValue.AtExp(fn _ => let val 
+LongOpEqIdent as LongOpEqIdent1=LongOpEqIdent1 ()
+ in (
+ let val OP_OPT (id, withOp) = LongOpEqIdent
+                          in
+			    IDENTatexp (PP LongOpEqIdentleft LongOpEqIdentright,
+					OP_OPT (mk_LongId id, withOp))
+                          end 
+) end
+)
+ in (LrTable.NT 69,(result,LongOpEqIdent1left,LongOpEqIdent1right),
+rest671) end
+| (119,(_,(_,_,RBRACEright as RBRACE1right))::(_,(MlyValue.ExpRow_opt 
+ExpRow_opt1,_,_))::(_,(_,LBRACEleft as LBRACE1left,_))::rest671) => 
+let val result=MlyValue.AtExp(fn _ => let val ExpRow_opt as 
+ExpRow_opt1=ExpRow_opt1 ()
+ in ( RECORDatexp (PP LBRACEleft RBRACEright, ExpRow_opt) ) end
+)
+ in (LrTable.NT 69,(result,LBRACE1left,RBRACE1right),rest671) end
+| (120,(_,(_,_,ENDright as END1right))::(_,(MlyValue.Exp_ Exp_1,_,_))
+::_::(_,(MlyValue.Dec Dec1,_,_))::(_,(_,LETleft as LET1left,_))::
+rest671) => let val result=MlyValue.AtExp(fn _ => let val Dec as Dec1=
+Dec1 ()
+val Exp_ as Exp_1=Exp_1 ()
+ in ( LETatexp (PP LETleft ENDright, Dec, Exp_) ) end
+)
+ in (LrTable.NT 69,(result,LET1left,END1right),rest671) end
+| (121,(_,(_,_,RPARENright as RPAREN1right))::(_,(MlyValue.Exp_ Exp_1,
+_,_))::(_,(_,LPARENleft as LPAREN1left,_))::rest671) => let val result
+=MlyValue.AtExp(fn _ => let val Exp_ as Exp_1=Exp_1 ()
+ in ( PARatexp (PP LPARENleft RPARENright, Exp_) ) end
+)
+ in (LrTable.NT 69,(result,LPAREN1left,RPAREN1right),rest671) end
+| (122,(_,(_,_,RPARENright as RPAREN1right))::(_,(_,LPARENleft as 
+LPAREN1left,_))::rest671) => let val result=MlyValue.AtExp(fn _ => (
+ RECORDatexp (PP LPARENleft RPARENright, NONE) ))
+ in (LrTable.NT 69,(result,LPAREN1left,RPAREN1right),rest671) end
+| (123,(_,(_,_,RPARENright as RPAREN1right))::(_,(
+MlyValue.ExpComma_seq2 ExpComma_seq21,_,_))::(_,(_,LPARENleft as 
+LPAREN1left,_))::rest671) => let val result=MlyValue.AtExp(fn _ => 
+let val ExpComma_seq2 as ExpComma_seq21=ExpComma_seq21 ()
+ in ( tuple_atexp_with_info (PP LPARENleft RPARENright) ExpComma_seq2 
+) end
+)
+ in (LrTable.NT 69,(result,LPAREN1left,RPAREN1right),rest671) end
+| (124,(_,(MlyValue.Label Label1,_,Labelright as Label1right))::(_,(_,
+HASHleft as HASH1left,_))::rest671) => let val result=MlyValue.AtExp(
+fn _ => let val Label as Label1=Label1 ()
+ in ( hash (PP HASHleft Labelright) Label ) end
+)
+ in (LrTable.NT 69,(result,HASH1left,Label1right),rest671) end
+| (125,(_,(_,_,RPARENright as RPAREN1right))::(_,(
+MlyValue.ExpSemicolon_seq2 ExpSemicolon_seq21,_,_))::(_,(_,LPARENleft
+ as LPAREN1left,_))::rest671) => let val result=MlyValue.AtExp(fn _
+ => let val ExpSemicolon_seq2 as ExpSemicolon_seq21=ExpSemicolon_seq21
+ ()
+ in (
+ PARatexp (PP LPARENleft RPARENright,
+                                   sequenceExp ExpSemicolon_seq2) 
+) end
+)
+ in (LrTable.NT 69,(result,LPAREN1left,RPAREN1right),rest671) end
+| (126,(_,(_,_,ENDright as END1right))::(_,(MlyValue.ExpSemicolon_seq2
+ ExpSemicolon_seq21,_,_))::_::(_,(MlyValue.Dec Dec1,_,_))::(_,(_,
+LETleft as LET1left,_))::rest671) => let val result=MlyValue.AtExp(fn 
+_ => let val Dec as Dec1=Dec1 ()
+val ExpSemicolon_seq2 as ExpSemicolon_seq21=ExpSemicolon_seq21 ()
+ in (
+ LETatexp (PP LETleft ENDright,
+				    Dec, sequenceExp ExpSemicolon_seq2) 
+) end
+)
+ in (LrTable.NT 69,(result,LET1left,END1right),rest671) end
+| (127,(_,(_,_,RBRACKETright as RBRACKET1right))::(_,(
+MlyValue.ExpComma_seq0 ExpComma_seq01,_,_))::(_,(_,LBRACKETleft as 
+LBRACKET1left,_))::rest671) => let val result=MlyValue.AtExp(fn _ => 
+let val ExpComma_seq0 as ExpComma_seq01=ExpComma_seq01 ()
+ in ( list_atexp (PP LBRACKETleft RBRACKETright) ExpComma_seq0 ) end
+)
+ in (LrTable.NT 69,(result,LBRACKET1left,RBRACKET1right),rest671) end
+| (128,(_,(MlyValue.AtExp_seq1 AtExp_seq11,_,AtExp_seq11right))::(_,(
+MlyValue.AtExp AtExp1,AtExp1left,_))::rest671) => let val result=
+MlyValue.AtExp_seq1(fn _ => let val AtExp as AtExp1=AtExp1 ()
+val AtExp_seq1 as AtExp_seq11=AtExp_seq11 ()
+ in ( AtExp :: AtExp_seq1 ) end
+)
+ in (LrTable.NT 96,(result,AtExp1left,AtExp_seq11right),rest671) end
+| (129,(_,(MlyValue.AtExp AtExp1,AtExp1left,AtExp1right))::rest671)
+ => let val result=MlyValue.AtExp_seq1(fn _ => let val AtExp as AtExp1
+=AtExp1 ()
+ in ( [AtExp] ) end
+)
+ in (LrTable.NT 96,(result,AtExp1left,AtExp1right),rest671) end
+| (130,(_,(MlyValue.CommaExpRow_opt CommaExpRow_opt1,_,
+CommaExpRow_opt1right))::(_,(MlyValue.Exp_ Exp_1,_,_))::_::(_,(
+MlyValue.Label Label1,Labelleft as Label1left,_))::rest671) => let 
+val result=MlyValue.ExpRow(fn _ => let val Label as Label1=Label1 ()
+val Exp_ as Exp_1=Exp_1 ()
+val CommaExpRow_opt as CommaExpRow_opt1=CommaExpRow_opt1 ()
+ in (
+ EXPROW (PP Labelleft
+				    (rightmost get_info_exp Exp_
+				               get_info_exprow CommaExpRow_opt),
+				  Label, Exp_, CommaExpRow_opt) 
+) end
+)
+ in (LrTable.NT 68,(result,Label1left,CommaExpRow_opt1right),rest671)
+ end
+| (131,(_,(MlyValue.ExpRow ExpRow1,ExpRow1left,ExpRow1right))::rest671
+) => let val result=MlyValue.ExpRow_opt(fn _ => let val ExpRow as 
+ExpRow1=ExpRow1 ()
+ in ( SOME ExpRow ) end
+)
+ in (LrTable.NT 81,(result,ExpRow1left,ExpRow1right),rest671) end
+| (132,rest671) => let val result=MlyValue.ExpRow_opt(fn _ => ( NONE )
+)
+ in (LrTable.NT 81,(result,defaultPos,defaultPos),rest671) end
+| (133,(_,(MlyValue.ExpRow ExpRow1,_,ExpRow1right))::(_,(_,COMMA1left,
+_))::rest671) => let val result=MlyValue.CommaExpRow_opt(fn _ => let 
+val ExpRow as ExpRow1=ExpRow1 ()
+ in ( SOME ExpRow ) end
+)
+ in (LrTable.NT 71,(result,COMMA1left,ExpRow1right),rest671) end
+| (134,rest671) => let val result=MlyValue.CommaExpRow_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 71,(result,defaultPos,defaultPos),rest671) end
+| (135,(_,(MlyValue.ExpComma_seq1 ExpComma_seq11,ExpComma_seq11left,
+ExpComma_seq11right))::rest671) => let val result=
+MlyValue.ExpComma_seq0(fn _ => let val ExpComma_seq1 as ExpComma_seq11
+=ExpComma_seq11 ()
+ in ( ExpComma_seq1 ) end
+)
+ in (LrTable.NT 90,(result,ExpComma_seq11left,ExpComma_seq11right),
+rest671) end
+| (136,rest671) => let val result=MlyValue.ExpComma_seq0(fn _ => (
+ nil ))
+ in (LrTable.NT 90,(result,defaultPos,defaultPos),rest671) end
+| (137,(_,(MlyValue.ExpComma_seq1 ExpComma_seq11,_,ExpComma_seq11right
+))::_::(_,(MlyValue.Exp_ Exp_1,Exp_1left,_))::rest671) => let val 
+result=MlyValue.ExpComma_seq1(fn _ => let val Exp_ as Exp_1=Exp_1 ()
+val ExpComma_seq1 as ExpComma_seq11=ExpComma_seq11 ()
+ in ( Exp_ :: ExpComma_seq1 ) end
+)
+ in (LrTable.NT 91,(result,Exp_1left,ExpComma_seq11right),rest671) end
+| (138,(_,(MlyValue.Exp_ Exp_1,Exp_1left,Exp_1right))::rest671) => 
+let val result=MlyValue.ExpComma_seq1(fn _ => let val Exp_ as Exp_1=
+Exp_1 ()
+ in ( [Exp_] ) end
+)
+ in (LrTable.NT 91,(result,Exp_1left,Exp_1right),rest671) end
+| (139,(_,(MlyValue.ExpComma_seq1 ExpComma_seq11,_,ExpComma_seq11right
+))::_::(_,(MlyValue.Exp_ Exp_1,Exp_1left,_))::rest671) => let val 
+result=MlyValue.ExpComma_seq2(fn _ => let val Exp_ as Exp_1=Exp_1 ()
+val ExpComma_seq1 as ExpComma_seq11=ExpComma_seq11 ()
+ in ( Exp_ :: ExpComma_seq1 ) end
+)
+ in (LrTable.NT 92,(result,Exp_1left,ExpComma_seq11right),rest671) end
+| (140,(_,(MlyValue.ExpSemicolon_seq2 ExpSemicolon_seq21,_,
+ExpSemicolon_seq21right))::_::(_,(MlyValue.Exp_ Exp_1,Exp_1left,_))::
+rest671) => let val result=MlyValue.ExpSemicolon_seq2(fn _ => let val 
+Exp_ as Exp_1=Exp_1 ()
+val ExpSemicolon_seq2 as ExpSemicolon_seq21=ExpSemicolon_seq21 ()
+ in ( Exp_ :: ExpSemicolon_seq2) end
+)
+ in (LrTable.NT 99,(result,Exp_1left,ExpSemicolon_seq21right),rest671)
+ end
+| (141,(_,(MlyValue.Exp_ Exp_2,_,Exp_2right))::_::(_,(MlyValue.Exp_ 
+Exp_1,Exp_1left,_))::rest671) => let val result=
+MlyValue.ExpSemicolon_seq2(fn _ => let val Exp_1=Exp_1 ()
+val Exp_2=Exp_2 ()
+ in ( [Exp_1, Exp_2] ) end
+)
+ in (LrTable.NT 99,(result,Exp_1left,Exp_2right),rest671) end
+| (142,(_,(MlyValue.AtExp_seq1 AtExp_seq11,AtExp_seq1left as 
+AtExp_seq11left,AtExp_seq1right as AtExp_seq11right))::rest671) => 
+let val result=MlyValue.Exp_(fn _ => let val AtExp_seq1 as AtExp_seq11
+=AtExp_seq11 ()
+ in ( UNRES_INFIXexp (PP AtExp_seq1left AtExp_seq1right, AtExp_seq1) )
+ end
+)
+ in (LrTable.NT 66,(result,AtExp_seq11left,AtExp_seq11right),rest671)
+ end
+| (143,(_,(MlyValue.Ty Ty1,_,Tyright as Ty1right))::_::(_,(
+MlyValue.Exp_ Exp_1,Exp_left as Exp_1left,_))::rest671) => let val 
+result=MlyValue.Exp_(fn _ => let val Exp_ as Exp_1=Exp_1 ()
+val Ty as Ty1=Ty1 ()
+ in ( TYPEDexp (PP Exp_left Tyright, Exp_, Ty) ) end
+)
+ in (LrTable.NT 66,(result,Exp_1left,Ty1right),rest671) end
+| (144,(_,(MlyValue.Match_ Match_1,_,Match_1right))::_::(_,(
+MlyValue.Exp_ Exp_1,Exp_left as Exp_1left,_))::rest671) => let val 
+result=MlyValue.Exp_(fn _ => let val Exp_ as Exp_1=Exp_1 ()
+val Match_ as Match_1=Match_1 ()
+ in (
+ HANDLEexp (PP Exp_left (right (get_info_match Match_)),
+				     Exp_, Match_) 
+) end
+)
+ in (LrTable.NT 66,(result,Exp_1left,Match_1right),rest671) end
+| (145,(_,(MlyValue.Exp_ Exp_1,_,Exp_1right))::(_,(_,RAISEleft as 
+RAISE1left,_))::rest671) => let val result=MlyValue.Exp_(fn _ => let 
+val Exp_ as Exp_1=Exp_1 ()
+ in ( RAISEexp (PP RAISEleft (right (get_info_exp Exp_)), Exp_) ) end
+)
+ in (LrTable.NT 66,(result,RAISE1left,Exp_1right),rest671) end
+| (146,(_,(MlyValue.Match_ Match_1,_,Match_1right))::(_,(_,FNleft as 
+FN1left,_))::rest671) => let val result=MlyValue.Exp_(fn _ => let val 
+Match_ as Match_1=Match_1 ()
+ in ( FNexp (PP FNleft (right (get_info_match Match_)), Match_) ) end
+)
+ in (LrTable.NT 66,(result,FN1left,Match_1right),rest671) end
+| (147,(_,(MlyValue.Match_ Match_1,_,Match_1right))::_::(_,(
+MlyValue.Exp_ Exp_1,_,_))::(_,(_,CASEleft as CASE1left,_))::rest671)
+ => let val result=MlyValue.Exp_(fn _ => let val Exp_ as Exp_1=Exp_1 
+()
+val Match_ as Match_1=Match_1 ()
+ in (
+ case_exp (PP CASEleft (right (get_info_match Match_)))
+			    (Exp_, Match_) 
+) end
+)
+ in (LrTable.NT 66,(result,CASE1left,Match_1right),rest671) end
+| (148,(_,(MlyValue.Exp_ Exp_3,_,Exp_3right))::_::(_,(MlyValue.Exp_ 
+Exp_2,_,_))::_::(_,(MlyValue.Exp_ Exp_1,_,_))::(_,(_,IFleft as IF1left
+,_))::rest671) => let val result=MlyValue.Exp_(fn _ => let val Exp_1=
+Exp_1 ()
+val Exp_2=Exp_2 ()
+val Exp_3=Exp_3 ()
+ in (
+ if_then_else_exp (PP IFleft (right (get_info_exp Exp_3)))
+			    (Exp_1, Exp_2, Exp_3) 
+) end
+)
+ in (LrTable.NT 66,(result,IF1left,Exp_3right),rest671) end
+| (149,(_,(MlyValue.Exp_ Exp_2,_,Exp_2right))::_::(_,(MlyValue.Exp_ 
+Exp_1,Exp_1left,_))::rest671) => let val result=MlyValue.Exp_(fn _ => 
+let val Exp_1=Exp_1 ()
+val Exp_2=Exp_2 ()
+ in (
+ let val info = PP Exp_1left (right (get_info_exp Exp_2))
+			  in
+			    if_then_else_exp info (Exp_1, exp_true info, Exp_2)
+			  end 
+) end
+)
+ in (LrTable.NT 66,(result,Exp_1left,Exp_2right),rest671) end
+| (150,(_,(MlyValue.Exp_ Exp_2,_,Exp_2right))::_::(_,(MlyValue.Exp_ 
+Exp_1,Exp_1left,_))::rest671) => let val result=MlyValue.Exp_(fn _ => 
+let val Exp_1=Exp_1 ()
+val Exp_2=Exp_2 ()
+ in (
+ let val info = PP Exp_1left (right (get_info_exp Exp_2))
+			  in
+			    if_then_else_exp info (Exp_1, Exp_2, exp_false info)
+			  end 
+) end
+)
+ in (LrTable.NT 66,(result,Exp_1left,Exp_2right),rest671) end
+| (151,(_,(MlyValue.Exp_ Exp_2,_,Exp_2right))::_::(_,(MlyValue.Exp_ 
+Exp_1,_,_))::(_,(_,WHILEleft as WHILE1left,_))::rest671) => let val 
+result=MlyValue.Exp_(fn _ => let val Exp_1=Exp_1 ()
+val Exp_2=Exp_2 ()
+ in (
+ while_exp (PP WHILEleft (right (get_info_exp Exp_2)))
+			    (Exp_1, Exp_2) 
+) end
+)
+ in (LrTable.NT 66,(result,WHILE1left,Exp_2right),rest671) end
+| (152,(_,(MlyValue.BarMatch_opt BarMatch_opt1,_,BarMatch_opt1right))
+::(_,(MlyValue.MRule MRule1,MRuleleft as MRule1left,_))::rest671) => 
+let val result=MlyValue.Match_(fn _ => let val MRule as MRule1=MRule1 
+()
+val BarMatch_opt as BarMatch_opt1=BarMatch_opt1 ()
+ in (
+ MATCH (PP MRuleleft
+				   (rightmost get_info_mrule MRule
+				              get_info_match BarMatch_opt), 
+				 MRule, BarMatch_opt) 
+) end
+)
+ in (LrTable.NT 67,(result,MRule1left,BarMatch_opt1right),rest671) end
+| (153,(_,(MlyValue.Match_ Match_1,_,Match_1right))::(_,(_,BAR1left,_)
+)::rest671) => let val result=MlyValue.BarMatch_opt(fn _ => let val 
+Match_ as Match_1=Match_1 ()
+ in ( SOME Match_ ) end
+)
+ in (LrTable.NT 79,(result,BAR1left,Match_1right),rest671) end
+| (154,rest671) => let val result=MlyValue.BarMatch_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 79,(result,defaultPos,defaultPos),rest671) end
+| (155,(_,(MlyValue.Exp_ Exp_1,_,Exp_1right))::_::(_,(MlyValue.Pat 
+Pat1,Patleft as Pat1left,_))::rest671) => let val result=
+MlyValue.MRule(fn _ => let val Pat as Pat1=Pat1 ()
+val Exp_ as Exp_1=Exp_1 ()
+ in ( MRULE (PP Patleft (right (get_info_exp Exp_)), Pat, Exp_) ) end
+)
+ in (LrTable.NT 65,(result,Pat1left,Exp_1right),rest671) end
+| (156,(_,(MlyValue.ValBind ValBind1,_,ValBind1right))::(_,(_,VALleft
+ as VAL1left,_))::rest671) => let val result=
+MlyValue.OneDec_sans_LOCAL(fn _ => let val ValBind as ValBind1=
+ValBind1 ()
+ in (
+ VALdec (PP VALleft (right (get_info_valbind ValBind)),
+				  [], ValBind) 
+) end
+)
+ in (LrTable.NT 112,(result,VAL1left,ValBind1right),rest671) end
+| (157,(_,(MlyValue.ValBind ValBind1,_,ValBind1right))::(_,(
+MlyValue.TyVarSeq1 TyVarSeq11,_,_))::(_,(_,VALleft as VAL1left,_))::
+rest671) => let val result=MlyValue.OneDec_sans_LOCAL(fn _ => let val 
+TyVarSeq1 as TyVarSeq11=TyVarSeq11 ()
+val ValBind as ValBind1=ValBind1 ()
+ in (
+ VALdec (PP VALleft (right (get_info_valbind ValBind)),
+				  TyVarSeq1, ValBind) 
+) end
+)
+ in (LrTable.NT 112,(result,VAL1left,ValBind1right),rest671) end
+| (158,(_,(MlyValue.TypBind TypBind1,_,TypBind1right))::(_,(_,TYPEleft
+ as TYPE1left,_))::rest671) => let val result=
+MlyValue.OneDec_sans_LOCAL(fn _ => let val TypBind as TypBind1=
+TypBind1 ()
+ in (
+ TYPEdec (PP TYPEleft (right (get_info_typbind TypBind)),
+				   TypBind) 
+) end
+)
+ in (LrTable.NT 112,(result,TYPE1left,TypBind1right),rest671) end
+| (159,(_,(MlyValue.DatBind_zero_arity DatBind_zero_arity1,_,
+DatBind_zero_arity1right))::(_,(_,DATATYPEleft as DATATYPE1left,_))::
+rest671) => let val result=MlyValue.OneDec_sans_LOCAL(fn _ => let val 
+DatBind_zero_arity as DatBind_zero_arity1=DatBind_zero_arity1 ()
+ in (
+ DATATYPEdec (PP DATATYPEleft
+				         (right (get_info_datbind DatBind_zero_arity)),
+				       DatBind_zero_arity) 
+) end
+)
+ in (LrTable.NT 112,(result,DATATYPE1left,DatBind_zero_arity1right),
+rest671) end
+| (160,(_,(MlyValue.DatBind_nonzero_arity DatBind_nonzero_arity1,_,
+DatBind_nonzero_arity1right))::(_,(_,DATATYPEleft as DATATYPE1left,_))
+::rest671) => let val result=MlyValue.OneDec_sans_LOCAL(fn _ => let 
+val DatBind_nonzero_arity as DatBind_nonzero_arity1=
+DatBind_nonzero_arity1 ()
+ in (
+ DATATYPEdec(PP DATATYPEleft
+				        (right (get_info_datbind DatBind_nonzero_arity)),
+				      DatBind_nonzero_arity) 
+) end
+)
+ in (LrTable.NT 112,(result,DATATYPE1left,DatBind_nonzero_arity1right)
+,rest671) end
+| (161,(_,(MlyValue.LongTypeIdent LongTypeIdent1,_,LongTypeIdentright
+ as LongTypeIdent1right))::_::_::(_,(MlyValue.TypeIdent TypeIdent1,_,_
+))::(_,(_,DATATYPE1left,_))::rest671) => let val result=
+MlyValue.OneDec_sans_LOCAL(fn _ => let val TypeIdent as TypeIdent1=
+TypeIdent1 ()
+val LongTypeIdent as LongTypeIdent1=LongTypeIdent1 ()
+ in (
+ DATATYPE_REPLICATIONdec
+			    (PP DATATYPE1left LongTypeIdentright,
+			     mk_TyCon TypeIdent, mk_LongTyCon LongTypeIdent) 
+) end
+)
+ in (LrTable.NT 112,(result,DATATYPE1left,LongTypeIdent1right),rest671
+) end
+| (162,(_,(_,_,ENDright as END1right))::(_,(MlyValue.Dec Dec1,_,_))::_
+::(_,(MlyValue.DatBind DatBind1,_,_))::(_,(_,ABSTYPEleft as 
+ABSTYPE1left,_))::rest671) => let val result=
+MlyValue.OneDec_sans_LOCAL(fn _ => let val DatBind as DatBind1=
+DatBind1 ()
+val Dec as Dec1=Dec1 ()
+ in ( ABSTYPEdec (PP ABSTYPEleft ENDright, DatBind, Dec) ) end
+)
+ in (LrTable.NT 112,(result,ABSTYPE1left,END1right),rest671) end
+| (163,(_,(MlyValue.ExBind ExBind1,_,ExBind1right))::(_,(_,
+EXCEPTIONleft as EXCEPTION1left,_))::rest671) => let val result=
+MlyValue.OneDec_sans_LOCAL(fn _ => let val ExBind as ExBind1=ExBind1 
+()
+ in (
+ EXCEPTIONdec (PP EXCEPTIONleft
+					  (right (get_info_exbind ExBind)),
+					ExBind) 
+) end
+)
+ in (LrTable.NT 112,(result,EXCEPTION1left,ExBind1right),rest671) end
+| (164,(_,(MlyValue.LongIdent_seq1 LongIdent_seq11,_,
+LongIdent_seq1right as LongIdent_seq11right))::(_,(_,OPENleft as 
+OPEN1left,_))::rest671) => let val result=MlyValue.OneDec_sans_LOCAL(
+fn _ => let val LongIdent_seq1 as LongIdent_seq11=LongIdent_seq11 ()
+ in (
+ OPENdec (PP OPENleft LongIdent_seq1right,
+				   wi_Convert mk_LongStrId LongIdent_seq1) 
+) end
+)
+ in (LrTable.NT 112,(result,OPEN1left,LongIdent_seq11right),rest671)
+ end
+| (165,(_,(MlyValue.EqIdent_seq1 EqIdent_seq11,_,EqIdent_seq1right as 
+EqIdent_seq11right))::(_,(MlyValue.DIGIT_opt DIGIT_opt1,_,_))::(_,(_,
+INFIXleft as INFIX1left,_))::rest671) => let val result=
+MlyValue.OneDec_sans_LOCAL(fn _ => let val DIGIT_opt as DIGIT_opt1=
+DIGIT_opt1 ()
+val EqIdent_seq1 as EqIdent_seq11=EqIdent_seq11 ()
+ in (
+ INFIXdec (PP INFIXleft EqIdent_seq1right,
+				    DIGIT_opt, map mk_Id EqIdent_seq1) 
+) end
+)
+ in (LrTable.NT 112,(result,INFIX1left,EqIdent_seq11right),rest671)
+ end
+| (166,(_,(MlyValue.EqIdent_seq1 EqIdent_seq11,_,EqIdent_seq1right as 
+EqIdent_seq11right))::(_,(MlyValue.DIGIT_opt DIGIT_opt1,_,_))::(_,(_,
+INFIXRleft as INFIXR1left,_))::rest671) => let val result=
+MlyValue.OneDec_sans_LOCAL(fn _ => let val DIGIT_opt as DIGIT_opt1=
+DIGIT_opt1 ()
+val EqIdent_seq1 as EqIdent_seq11=EqIdent_seq11 ()
+ in (
+ INFIXRdec (PP INFIXRleft EqIdent_seq1right,
+				     DIGIT_opt, map mk_Id EqIdent_seq1) 
+) end
+)
+ in (LrTable.NT 112,(result,INFIXR1left,EqIdent_seq11right),rest671)
+ end
+| (167,(_,(MlyValue.EqIdent_seq1 EqIdent_seq11,_,EqIdent_seq1right as 
+EqIdent_seq11right))::(_,(_,NONFIXleft as NONFIX1left,_))::rest671)
+ => let val result=MlyValue.OneDec_sans_LOCAL(fn _ => let val 
+EqIdent_seq1 as EqIdent_seq11=EqIdent_seq11 ()
+ in (
+ NONFIXdec (PP NONFIXleft EqIdent_seq1right,
+				     map mk_Id EqIdent_seq1) 
+) end
+)
+ in (LrTable.NT 112,(result,NONFIX1left,EqIdent_seq11right),rest671)
+ end
+| (168,(_,(MlyValue.TypBind TypBind1,_,TypBind1right))::_::(_,(
+MlyValue.DatBind_zero_arity DatBind_zero_arity1,_,_))::(_,(_,
+DATATYPEleft as DATATYPE1left,_))::rest671) => let val result=
+MlyValue.OneDec_sans_LOCAL(fn _ => let val DatBind_zero_arity as 
+DatBind_zero_arity1=DatBind_zero_arity1 ()
+val TypBind as TypBind1=TypBind1 ()
+ in (
+ let val db = rewriteDatBind (DatBind_zero_arity, TypBind)
+                          in
+                            SEQdec (PP DATATYPEleft (right (get_info_typbind TypBind)),
+				    DATATYPEdec
+				      (get_info_datbind DatBind_zero_arity, db),
+				    TYPEdec (get_info_typbind TypBind, TypBind))
+                          end 
+) end
+)
+ in (LrTable.NT 112,(result,DATATYPE1left,TypBind1right),rest671) end
+| (169,(_,(MlyValue.TypBind TypBind1,_,TypBind1right))::_::(_,(
+MlyValue.DatBind_nonzero_arity DatBind_nonzero_arity1,_,_))::(_,(_,
+DATATYPEleft as DATATYPE1left,_))::rest671) => let val result=
+MlyValue.OneDec_sans_LOCAL(fn _ => let val DatBind_nonzero_arity as 
+DatBind_nonzero_arity1=DatBind_nonzero_arity1 ()
+val TypBind as TypBind1=TypBind1 ()
+ in (
+ let val db = rewriteDatBind (DatBind_nonzero_arity, TypBind)
+                          in
+                            SEQdec (PP DATATYPEleft (right (get_info_typbind TypBind)),
+				    DATATYPEdec
+				      (get_info_datbind DatBind_nonzero_arity, db),
+				    TYPEdec (get_info_typbind TypBind, TypBind))
+                          end 
+) end
+)
+ in (LrTable.NT 112,(result,DATATYPE1left,TypBind1right),rest671) end
+| (170,(_,(_,_,ENDright as END1right))::(_,(MlyValue.Dec Dec1,_,_))::_
+::(_,(MlyValue.TypBind TypBind1,TypBindleft,_))::_::(_,(
+MlyValue.DatBind DatBind1,_,_))::(_,(_,ABSTYPEleft as ABSTYPE1left,_))
+::rest671) => let val result=MlyValue.OneDec_sans_LOCAL(fn _ => let 
+val DatBind as DatBind1=DatBind1 ()
+val TypBind as TypBind1=TypBind1 ()
+val Dec as Dec1=Dec1 ()
+ in (
+ let val db = rewriteDatBind (DatBind, TypBind)
+                          in
+                            ABSTYPEdec
+			      (PP ABSTYPEleft ENDright, db,
+			       SEQdec (PP TypBindleft (right (get_info_dec Dec)),
+				       TYPEdec (get_info_typbind TypBind, TypBind),
+				       Dec))
+                          end 
+) end
+)
+ in (LrTable.NT 112,(result,ABSTYPE1left,END1right),rest671) end
+| (171,(_,(MlyValue.FValBind FValBind1,_,FValBind1right))::(_,(_,
+FUNleft as FUN1left,_))::rest671) => let val result=
+MlyValue.OneDec_sans_LOCAL(fn _ => let val FValBind as FValBind1=
+FValBind1 ()
+ in (
+ UNRES_FUNdec (PP FUNleft (right (get_info_FValBind FValBind)),
+					[], FValBind) 
+) end
+)
+ in (LrTable.NT 112,(result,FUN1left,FValBind1right),rest671) end
+| (172,(_,(MlyValue.FValBind FValBind1,_,FValBind1right))::(_,(
+MlyValue.TyVarSeq1 TyVarSeq11,_,_))::(_,(_,FUNleft as FUN1left,_))::
+rest671) => let val result=MlyValue.OneDec_sans_LOCAL(fn _ => let val 
+TyVarSeq1 as TyVarSeq11=TyVarSeq11 ()
+val FValBind as FValBind1=FValBind1 ()
+ in (
+ UNRES_FUNdec (PP FUNleft (right (get_info_FValBind FValBind)),
+					TyVarSeq1, FValBind) 
+) end
+)
+ in (LrTable.NT 112,(result,FUN1left,FValBind1right),rest671) end
+| (173,(_,(_,_,ENDright as END1right))::(_,(MlyValue.Dec Dec2,_,_))::_
+::(_,(MlyValue.Dec Dec1,_,_))::(_,(_,LOCALleft as LOCAL1left,_))::
+rest671) => let val result=MlyValue.OneDec(fn _ => let val Dec1=Dec1 
+()
+val Dec2=Dec2 ()
+ in ( LOCALdec (PP LOCALleft ENDright, Dec1, Dec2) ) end
+)
+ in (LrTable.NT 111,(result,LOCAL1left,END1right),rest671) end
+| (174,(_,(MlyValue.OneDec_sans_LOCAL OneDec_sans_LOCAL1,
+OneDec_sans_LOCAL1left,OneDec_sans_LOCAL1right))::rest671) => let val 
+result=MlyValue.OneDec(fn _ => let val OneDec_sans_LOCAL as 
+OneDec_sans_LOCAL1=OneDec_sans_LOCAL1 ()
+ in ( OneDec_sans_LOCAL ) end
+)
+ in (LrTable.NT 111,(result,OneDec_sans_LOCAL1left,
+OneDec_sans_LOCAL1right),rest671) end
+| (175,(_,(MlyValue.OneDec OneDec1,OneDec1left,OneDec1right))::rest671
+) => let val result=MlyValue.OneDec_or_SEMICOLON(fn _ => let val 
+OneDec as OneDec1=OneDec1 ()
+ in ( SOME OneDec ) end
+)
+ in (LrTable.NT 103,(result,OneDec1left,OneDec1right),rest671) end
+| (176,(_,(_,SEMICOLON1left,SEMICOLON1right))::rest671) => let val 
+result=MlyValue.OneDec_or_SEMICOLON(fn _ => ( NONE ))
+ in (LrTable.NT 103,(result,SEMICOLON1left,SEMICOLON1right),rest671)
+ end
+| (177,(_,(MlyValue.OneDec_or_SEMICOLON OneDec_or_SEMICOLON1,_,
+OneDec_or_SEMICOLON1right))::(_,(MlyValue.NonEmptyDec NonEmptyDec1,
+NonEmptyDecleft as NonEmptyDec1left,_))::rest671) => let val result=
+MlyValue.NonEmptyDec(fn _ => let val NonEmptyDec as NonEmptyDec1=
+NonEmptyDec1 ()
+val OneDec_or_SEMICOLON as OneDec_or_SEMICOLON1=OneDec_or_SEMICOLON1 
+()
+ in (
+ (case OneDec_or_SEMICOLON of
+			     SOME dec =>
+			       composeDec (PP NonEmptyDecleft
+					     (right (get_info_dec dec)),
+					   NonEmptyDec, dec)
+			   | NONE => NonEmptyDec) 
+) end
+)
+ in (LrTable.NT 104,(result,NonEmptyDec1left,OneDec_or_SEMICOLON1right
+),rest671) end
+| (178,(_,(MlyValue.OneDec_or_SEMICOLON OneDec_or_SEMICOLON1,
+OneDec_or_SEMICOLON1left,OneDec_or_SEMICOLON1right))::rest671) => let 
+val result=MlyValue.NonEmptyDec(fn _ => let val OneDec_or_SEMICOLON
+ as OneDec_or_SEMICOLON1=OneDec_or_SEMICOLON1 ()
+ in (
+ (case OneDec_or_SEMICOLON of
+			     SOME dec => dec
+			   | NONE => EMPTYdec (PP defaultPos defaultPos)) 
+) end
+)
+ in (LrTable.NT 104,(result,OneDec_or_SEMICOLON1left,
+OneDec_or_SEMICOLON1right),rest671) end
+| (179,(_,(MlyValue.NonEmptyDec NonEmptyDec1,NonEmptyDec1left,
+NonEmptyDec1right))::rest671) => let val result=MlyValue.Dec(fn _ => 
+let val NonEmptyDec as NonEmptyDec1=NonEmptyDec1 ()
+ in ( NonEmptyDec ) end
+)
+ in (LrTable.NT 64,(result,NonEmptyDec1left,NonEmptyDec1right),rest671
+) end
+| (180,rest671) => let val result=MlyValue.Dec(fn _ => (
+ EMPTYdec (PP defaultPos defaultPos) ))
+ in (LrTable.NT 64,(result,defaultPos,defaultPos),rest671) end
+| (181,(_,(MlyValue.AndValBind_opt AndValBind_opt1,_,
+AndValBind_opt1right))::(_,(MlyValue.Exp_ Exp_1,_,_))::_::(_,(
+MlyValue.Pat Pat1,Patleft as Pat1left,_))::rest671) => let val result=
+MlyValue.ValBind(fn _ => let val Pat as Pat1=Pat1 ()
+val Exp_ as Exp_1=Exp_1 ()
+val AndValBind_opt as AndValBind_opt1=AndValBind_opt1 ()
+ in (
+ PLAINvalbind (PP Patleft
+					  (rightmost get_info_exp Exp_
+					             get_info_valbind AndValBind_opt), 
+					Pat, Exp_, AndValBind_opt) 
+) end
+)
+ in (LrTable.NT 61,(result,Pat1left,AndValBind_opt1right),rest671) end
+| (182,(_,(MlyValue.FnValBind FnValBind1,_,FnValBind1right))::(_,(_,
+RECleft as REC1left,_))::rest671) => let val result=MlyValue.ValBind(
+fn _ => let val FnValBind as FnValBind1=FnValBind1 ()
+ in (
+ RECvalbind (PP RECleft
+				        (right (get_info_valbind FnValBind)),
+				      FnValBind) 
+) end
+)
+ in (LrTable.NT 61,(result,REC1left,FnValBind1right),rest671) end
+| (183,(_,(MlyValue.ValBind ValBind1,_,ValBind1right))::(_,(_,AND1left
+,_))::rest671) => let val result=MlyValue.AndValBind_opt(fn _ => let 
+val ValBind as ValBind1=ValBind1 ()
+ in ( SOME ValBind ) end
+)
+ in (LrTable.NT 72,(result,AND1left,ValBind1right),rest671) end
+| (184,rest671) => let val result=MlyValue.AndValBind_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 72,(result,defaultPos,defaultPos),rest671) end
+| (185,(_,(MlyValue.AndFnValBind_opt AndFnValBind_opt1,_,
+AndFnValBind_opt1right))::(_,(MlyValue.Match_ Match_1,_,_))::(_,(_,
+FNleft,_))::_::(_,(MlyValue.Pat Pat1,Patleft as Pat1left,_))::rest671)
+ => let val result=MlyValue.FnValBind(fn _ => let val Pat as Pat1=Pat1
+ ()
+val Match_ as Match_1=Match_1 ()
+val AndFnValBind_opt as AndFnValBind_opt1=AndFnValBind_opt1 ()
+ in (
+ PLAINvalbind
+			    (PP Patleft
+			       (rightmost get_info_match Match_
+				          get_info_valbind AndFnValBind_opt),
+			       Pat,
+			       FNexp (PP FNleft (right (get_info_match Match_)), Match_),
+			       AndFnValBind_opt) 
+) end
+)
+ in (LrTable.NT 62,(result,Pat1left,AndFnValBind_opt1right),rest671)
+ end
+| (186,(_,(MlyValue.AndFnValBind_opt AndFnValBind_opt1,_,
+AndFnValBind_opt1right))::(_,(MlyValue.ColonTy_seq1 ColonTy_seq11,_,
+ColonTy_seq1right))::(_,(_,_,RPARENright))::(_,(MlyValue.Match_ 
+Match_1,_,_))::(_,(_,FNleft,_))::(_,(_,LPARENleft,_))::_::(_,(
+MlyValue.Pat Pat1,Patleft as Pat1left,_))::rest671) => let val result=
+MlyValue.FnValBind(fn _ => let val Pat as Pat1=Pat1 ()
+val Match_ as Match_1=Match_1 ()
+val ColonTy_seq1 as ColonTy_seq11=ColonTy_seq11 ()
+val AndFnValBind_opt as AndFnValBind_opt1=AndFnValBind_opt1 ()
+ in (
+ let
+                            val fnExp =
+			          FNexp (PP FNleft (right (get_info_match Match_)), Match_)
+                            val parAtexp =
+                                  PARatexp (PP LPARENleft RPARENright, fnExp)
+                            val atexpExp =
+                                  ATEXPexp (PP LPARENleft RPARENright, parAtexp)
+
+                            fun attachTypes (e, nil) = e
+                              | attachTypes (e, (ty, p) :: rest) =
+                                  attachTypes (TYPEDexp (PP FNleft p, e, ty), rest)
+                          in
+                            PLAINvalbind (PP Patleft
+					    (rightmost' ColonTy_seq1right
+					                get_info_valbind AndFnValBind_opt),
+					  Pat,
+					  attachTypes (atexpExp, ColonTy_seq1),
+					  AndFnValBind_opt)
+                          end 
+) end
+)
+ in (LrTable.NT 62,(result,Pat1left,AndFnValBind_opt1right),rest671)
+ end
+| (187,(_,(MlyValue.FnValBind FnValBind1,_,FnValBind1right))::(_,(_,
+RECleft as REC1left,_))::rest671) => let val result=MlyValue.FnValBind
+(fn _ => let val FnValBind as FnValBind1=FnValBind1 ()
+ in (
+ RECvalbind (PP RECleft
+				        (right (get_info_valbind FnValBind)),
+				      FnValBind) 
+) end
+)
+ in (LrTable.NT 62,(result,REC1left,FnValBind1right),rest671) end
+| (188,(_,(MlyValue.ColonTy_seq1 ColonTy_seq11,_,ColonTy_seq11right))
+::(_,(MlyValue.Ty Ty1,_,Tyright))::(_,(_,COLON1left,_))::rest671) => 
+let val result=MlyValue.ColonTy_seq1(fn _ => let val Ty as Ty1=Ty1 ()
+val ColonTy_seq1 as ColonTy_seq11=ColonTy_seq11 ()
+ in ( (Ty, Tyright) :: ColonTy_seq1 ) end
+)
+ in (LrTable.NT 86,(result,COLON1left,ColonTy_seq11right),rest671) end
+| (189,(_,(MlyValue.Ty Ty1,_,Tyright as Ty1right))::(_,(_,COLON1left,_
+))::rest671) => let val result=MlyValue.ColonTy_seq1(fn _ => let val 
+Ty as Ty1=Ty1 ()
+ in ( [(Ty, Tyright)] ) end
+)
+ in (LrTable.NT 86,(result,COLON1left,Ty1right),rest671) end
+| (190,(_,(MlyValue.FnValBind FnValBind1,_,FnValBind1right))::(_,(_,
+AND1left,_))::rest671) => let val result=MlyValue.AndFnValBind_opt(fn 
+_ => let val FnValBind as FnValBind1=FnValBind1 ()
+ in ( SOME FnValBind ) end
+)
+ in (LrTable.NT 73,(result,AND1left,FnValBind1right),rest671) end
+| (191,rest671) => let val result=MlyValue.AndFnValBind_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 73,(result,defaultPos,defaultPos),rest671) end
+| (192,(_,(MlyValue.AndTypBind_opt AndTypBind_opt1,_,
+AndTypBind_opt1right))::(_,(MlyValue.Ty Ty1,_,_))::_::(_,(
+MlyValue.TypeIdent TypeIdent1,_,_))::(_,(MlyValue.TyVarSeq TyVarSeq1,
+TyVarSeqleft as TyVarSeq1left,_))::rest671) => let val result=
+MlyValue.TypBind(fn _ => let val TyVarSeq as TyVarSeq1=TyVarSeq1 ()
+val TypeIdent as TypeIdent1=TypeIdent1 ()
+val Ty as Ty1=Ty1 ()
+val AndTypBind_opt as AndTypBind_opt1=AndTypBind_opt1 ()
+ in (
+ TYPBIND (PP TyVarSeqleft
+				     (rightmost get_info_ty Ty
+				                get_info_typbind AndTypBind_opt),
+				   TyVarSeq, mk_TyCon TypeIdent, Ty, AndTypBind_opt) 
+) end
+)
+ in (LrTable.NT 60,(result,TyVarSeq1left,AndTypBind_opt1right),rest671
+) end
+| (193,(_,(MlyValue.TypBind TypBind1,_,TypBind1right))::(_,(_,AND1left
+,_))::rest671) => let val result=MlyValue.AndTypBind_opt(fn _ => let 
+val TypBind as TypBind1=TypBind1 ()
+ in ( SOME TypBind ) end
+)
+ in (LrTable.NT 76,(result,AND1left,TypBind1right),rest671) end
+| (194,rest671) => let val result=MlyValue.AndTypBind_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 76,(result,defaultPos,defaultPos),rest671) end
+| (195,(_,(MlyValue.AndDatBind_opt AndDatBind_opt1,_,
+AndDatBind_opt1right))::(_,(MlyValue.ConBind ConBind1,_,_))::_::(_,(
+MlyValue.TypeIdent TypeIdent1,_,_))::(_,(MlyValue.TyVarSeq TyVarSeq1,
+TyVarSeqleft as TyVarSeq1left,_))::rest671) => let val result=
+MlyValue.DatBind(fn _ => let val TyVarSeq as TyVarSeq1=TyVarSeq1 ()
+val TypeIdent as TypeIdent1=TypeIdent1 ()
+val ConBind as ConBind1=ConBind1 ()
+val AndDatBind_opt as AndDatBind_opt1=AndDatBind_opt1 ()
+ in (
+ DATBIND (PP TyVarSeqleft
+				     (rightmost get_info_conbind ConBind
+				                get_info_datbind AndDatBind_opt),
+				   TyVarSeq, mk_TyCon TypeIdent,
+				   ConBind, AndDatBind_opt) 
+) end
+)
+ in (LrTable.NT 57,(result,TyVarSeq1left,AndDatBind_opt1right),rest671
+) end
+| (196,(_,(MlyValue.AndDatBind_opt AndDatBind_opt1,_,
+AndDatBind_opt1right))::(_,(MlyValue.ConBind ConBind1,_,_))::_::(_,(
+MlyValue.TypeIdent TypeIdent1,TypeIdentleft as TypeIdent1left,_))::
+rest671) => let val result=MlyValue.DatBind_zero_arity(fn _ => let 
+val TypeIdent as TypeIdent1=TypeIdent1 ()
+val ConBind as ConBind1=ConBind1 ()
+val AndDatBind_opt as AndDatBind_opt1=AndDatBind_opt1 ()
+ in (
+ DATBIND (PP TypeIdentleft
+				     (rightmost get_info_conbind ConBind
+				                get_info_datbind AndDatBind_opt),
+				   [], mk_TyCon TypeIdent,
+				   ConBind, AndDatBind_opt) 
+) end
+)
+ in (LrTable.NT 58,(result,TypeIdent1left,AndDatBind_opt1right),
+rest671) end
+| (197,(_,(MlyValue.AndDatBind_opt AndDatBind_opt1,_,
+AndDatBind_opt1right))::(_,(MlyValue.ConBind ConBind1,_,_))::_::(_,(
+MlyValue.TypeIdent TypeIdent1,_,_))::(_,(MlyValue.TyVarSeq1 TyVarSeq11
+,TyVarSeq1left as TyVarSeq11left,_))::rest671) => let val result=
+MlyValue.DatBind_nonzero_arity(fn _ => let val TyVarSeq1 as TyVarSeq11
+=TyVarSeq11 ()
+val TypeIdent as TypeIdent1=TypeIdent1 ()
+val ConBind as ConBind1=ConBind1 ()
+val AndDatBind_opt as AndDatBind_opt1=AndDatBind_opt1 ()
+ in (
+ DATBIND (PP TyVarSeq1left
+				     (rightmost get_info_conbind ConBind
+				                get_info_datbind AndDatBind_opt),
+				   TyVarSeq1, mk_TyCon TypeIdent,
+				   ConBind, AndDatBind_opt) 
+) end
+)
+ in (LrTable.NT 59,(result,TyVarSeq11left,AndDatBind_opt1right),
+rest671) end
+| (198,(_,(MlyValue.DatBind DatBind1,_,DatBind1right))::(_,(_,AND1left
+,_))::rest671) => let val result=MlyValue.AndDatBind_opt(fn _ => let 
+val DatBind as DatBind1=DatBind1 ()
+ in ( SOME DatBind ) end
+)
+ in (LrTable.NT 77,(result,AND1left,DatBind1right),rest671) end
+| (199,rest671) => let val result=MlyValue.AndDatBind_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 77,(result,defaultPos,defaultPos),rest671) end
+| (200,(_,(MlyValue.BarConBind_opt BarConBind_opt1,_,
+BarConBind_opt1right))::(_,(MlyValue.OfTy_opt OfTy_opt1,_,_))::(_,(
+MlyValue.OpIdent OpIdent1,OpIdentleft as OpIdent1left,OpIdentright))::
+rest671) => let val result=MlyValue.ConBind(fn _ => let val OpIdent
+ as OpIdent1=OpIdent1 ()
+val OfTy_opt as OfTy_opt1=OfTy_opt1 ()
+val BarConBind_opt as BarConBind_opt1=BarConBind_opt1 ()
+ in (
+ let val OP_OPT (id, withOp) = OpIdent
+                          in
+                            CONBIND (PP OpIdentleft
+				       (rightmost_of_three OpIdentright
+					  get_info_ty OfTy_opt
+					  get_info_conbind BarConBind_opt),
+				     OP_OPT (mk_Id id, withOp),
+				     OfTy_opt, BarConBind_opt)
+                          end 
+) end
+)
+ in (LrTable.NT 56,(result,OpIdent1left,BarConBind_opt1right),rest671)
+ end
+| (201,(_,(MlyValue.ConBind ConBind1,_,ConBind1right))::(_,(_,BAR1left
+,_))::rest671) => let val result=MlyValue.BarConBind_opt(fn _ => let 
+val ConBind as ConBind1=ConBind1 ()
+ in ( SOME ConBind ) end
+)
+ in (LrTable.NT 78,(result,BAR1left,ConBind1right),rest671) end
+| (202,rest671) => let val result=MlyValue.BarConBind_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 78,(result,defaultPos,defaultPos),rest671) end
+| (203,(_,(MlyValue.AndExBind_opt AndExBind_opt1,_,AndExBind_opt1right
+))::(_,(MlyValue.OfTy_opt OfTy_opt1,_,_))::(_,(MlyValue.OpIdent 
+OpIdent1,OpIdentleft as OpIdent1left,OpIdentright))::rest671) => let 
+val result=MlyValue.ExBind(fn _ => let val OpIdent as OpIdent1=
+OpIdent1 ()
+val OfTy_opt as OfTy_opt1=OfTy_opt1 ()
+val AndExBind_opt as AndExBind_opt1=AndExBind_opt1 ()
+ in (
+ let val OP_OPT (id, withOp) = OpIdent
+                          in
+                            EXBIND (PP OpIdentleft
+				      (rightmost_of_three OpIdentright
+					  get_info_ty OfTy_opt
+					  get_info_exbind AndExBind_opt),
+				    OP_OPT (mk_Id id, withOp),
+				    OfTy_opt, AndExBind_opt)
+                          end 
+) end
+)
+ in (LrTable.NT 55,(result,OpIdent1left,AndExBind_opt1right),rest671)
+ end
+| (204,(_,(MlyValue.AndExBind_opt AndExBind_opt1,_,AndExBind_opt1right
+))::(_,(MlyValue.LongOpEqIdent LongOpEqIdent1,_,LongOpEqIdentright))::
+_::(_,(MlyValue.OpIdent OpIdent1,OpIdentleft as OpIdent1left,_))::
+rest671) => let val result=MlyValue.ExBind(fn _ => let val OpIdent as 
+OpIdent1=OpIdent1 ()
+val LongOpEqIdent as LongOpEqIdent1=LongOpEqIdent1 ()
+val AndExBind_opt as AndExBind_opt1=AndExBind_opt1 ()
+ in (
+ let val OP_OPT (id1, withOp1) = OpIdent
+			      val OP_OPT (id2, withOp2) = LongOpEqIdent
+                          in
+                            EXEQUAL (PP OpIdentleft
+				       (rightmost' LongOpEqIdentright
+					  get_info_exbind AndExBind_opt), 
+				     OP_OPT (mk_Id id1, withOp1),
+				     OP_OPT (mk_LongId id2, withOp2),
+				     AndExBind_opt)
+                          end 
+) end
+)
+ in (LrTable.NT 55,(result,OpIdent1left,AndExBind_opt1right),rest671)
+ end
+| (205,(_,(MlyValue.ExBind ExBind1,_,ExBind1right))::(_,(_,AND1left,_)
+)::rest671) => let val result=MlyValue.AndExBind_opt(fn _ => let val 
+ExBind as ExBind1=ExBind1 ()
+ in ( SOME ExBind ) end
+)
+ in (LrTable.NT 80,(result,AND1left,ExBind1right),rest671) end
+| (206,rest671) => let val result=MlyValue.AndExBind_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 80,(result,defaultPos,defaultPos),rest671) end
+| (207,(_,(MlyValue.AndFValBind_opt AndFValBind_opt1,_,
+AndFValBind_opt1right))::(_,(MlyValue.FClause FClause1,FClauseleft as 
+FClause1left,_))::rest671) => let val result=MlyValue.FValBind(fn _
+ => let val FClause as FClause1=FClause1 ()
+val AndFValBind_opt as AndFValBind_opt1=AndFValBind_opt1 ()
+ in (
+ FVALBIND (PP FClauseleft
+				      (rightmost get_info_FClause FClause
+				                 get_info_FValBind AndFValBind_opt),
+				    FClause, AndFValBind_opt) 
+) end
+)
+ in (LrTable.NT 63,(result,FClause1left,AndFValBind_opt1right),rest671
+) end
+| (208,(_,(MlyValue.FValBind FValBind1,_,FValBind1right))::(_,(_,
+AND1left,_))::rest671) => let val result=MlyValue.AndFValBind_opt(fn _
+ => let val FValBind as FValBind1=FValBind1 ()
+ in ( SOME FValBind ) end
+)
+ in (LrTable.NT 74,(result,AND1left,FValBind1right),rest671) end
+| (209,rest671) => let val result=MlyValue.AndFValBind_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 74,(result,defaultPos,defaultPos),rest671) end
+| (210,(_,(MlyValue.BarFClause_opt BarFClause_opt1,_,
+BarFClause_opt1right))::(_,(MlyValue.Exp_ Exp_1,_,_))::_::(_,(
+MlyValue.ColonTy_opt ColonTy_opt1,_,_))::(_,(MlyValue.AtPat_seq1 
+AtPat_seq11,AtPat_seq1left as AtPat_seq11left,_))::rest671) => let 
+val result=MlyValue.FClause(fn _ => let val AtPat_seq1 as AtPat_seq11=
+AtPat_seq11 ()
+val ColonTy_opt as ColonTy_opt1=ColonTy_opt1 ()
+val Exp_ as Exp_1=Exp_1 ()
+val BarFClause_opt as BarFClause_opt1=BarFClause_opt1 ()
+ in (
+ FCLAUSE (PP AtPat_seq1left
+				     (rightmost get_info_exp Exp_
+				                get_info_FClause BarFClause_opt),
+				   AtPat_seq1, ColonTy_opt,
+				   Exp_, BarFClause_opt) 
+) end
+)
+ in (LrTable.NT 70,(result,AtPat_seq11left,BarFClause_opt1right),
+rest671) end
+| (211,(_,(MlyValue.FClause FClause1,_,FClause1right))::(_,(_,BAR1left
+,_))::rest671) => let val result=MlyValue.BarFClause_opt(fn _ => let 
+val FClause as FClause1=FClause1 ()
+ in ( SOME FClause ) end
+)
+ in (LrTable.NT 75,(result,BAR1left,FClause1right),rest671) end
+| (212,rest671) => let val result=MlyValue.BarFClause_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 75,(result,defaultPos,defaultPos),rest671) end
+| (213,(_,(MlyValue.AtPat_seq1 AtPat_seq11,_,AtPat_seq11right))::(_,(
+MlyValue.AtPat AtPat1,AtPat1left,_))::rest671) => let val result=
+MlyValue.AtPat_seq2(fn _ => let val AtPat as AtPat1=AtPat1 ()
+val AtPat_seq1 as AtPat_seq11=AtPat_seq11 ()
+ in ( AtPat :: AtPat_seq1 ) end
+)
+ in (LrTable.NT 97,(result,AtPat1left,AtPat_seq11right),rest671) end
+| (214,(_,(MlyValue.AtPat_seq1 AtPat_seq11,_,AtPat_seq11right))::(_,(
+MlyValue.AtPat AtPat1,AtPat1left,_))::rest671) => let val result=
+MlyValue.AtPat_seq1(fn _ => let val AtPat as AtPat1=AtPat1 ()
+val AtPat_seq1 as AtPat_seq11=AtPat_seq11 ()
+ in ( AtPat :: AtPat_seq1 ) end
+)
+ in (LrTable.NT 98,(result,AtPat1left,AtPat_seq11right),rest671) end
+| (215,(_,(MlyValue.AtPat AtPat1,AtPat1left,AtPat1right))::rest671)
+ => let val result=MlyValue.AtPat_seq1(fn _ => let val AtPat as AtPat1
+=AtPat1 ()
+ in ( [AtPat] ) end
+)
+ in (LrTable.NT 98,(result,AtPat1left,AtPat1right),rest671) end
+| (216,(_,(MlyValue.Ty Ty1,_,Ty1right))::(_,(_,COLON1left,_))::rest671
+) => let val result=MlyValue.ColonTy_opt(fn _ => let val Ty as Ty1=Ty1
+ ()
+ in ( SOME Ty ) end
+)
+ in (LrTable.NT 85,(result,COLON1left,Ty1right),rest671) end
+| (217,rest671) => let val result=MlyValue.ColonTy_opt(fn _ => ( NONE 
+))
+ in (LrTable.NT 85,(result,defaultPos,defaultPos),rest671) end
+| (218,(_,(MlyValue.Ty Ty1,_,Ty1right))::(_,(_,OF1left,_))::rest671)
+ => let val result=MlyValue.OfTy_opt(fn _ => let val Ty as Ty1=Ty1 ()
+ in ( SOME Ty ) end
+)
+ in (LrTable.NT 89,(result,OF1left,Ty1right),rest671) end
+| (219,rest671) => let val result=MlyValue.OfTy_opt(fn _ => ( NONE ))
+ in (LrTable.NT 89,(result,defaultPos,defaultPos),rest671) end
+| (220,(_,(_,UNDERBARleft as UNDERBAR1left,UNDERBARright as 
+UNDERBAR1right))::rest671) => let val result=MlyValue.AtPat(fn _ => (
+ WILDCARDatpat (PP UNDERBARleft UNDERBARright) ))
+ in (LrTable.NT 54,(result,UNDERBAR1left,UNDERBAR1right),rest671) end
+| (221,(_,(MlyValue.SCon SCon1,SConleft as SCon1left,SConright as 
+SCon1right))::rest671) => let val result=MlyValue.AtPat(fn _ => let 
+val SCon as SCon1=SCon1 ()
+ in ( SCONatpat (PP SConleft SConright, SCon) ) end
+)
+ in (LrTable.NT 54,(result,SCon1left,SCon1right),rest671) end
+| (222,(_,(MlyValue.LongOpIdent LongOpIdent1,LongOpIdentleft as 
+LongOpIdent1left,LongOpIdentright as LongOpIdent1right))::rest671) => 
+let val result=MlyValue.AtPat(fn _ => let val LongOpIdent as 
+LongOpIdent1=LongOpIdent1 ()
+ in (
+ let val OP_OPT (id, withOp) = LongOpIdent
+                          in
+                            LONGIDatpat (PP LongOpIdentleft LongOpIdentright,
+					 OP_OPT (mk_LongId id, withOp))
+                          end 
+) end
+)
+ in (LrTable.NT 54,(result,LongOpIdent1left,LongOpIdent1right),rest671
+) end
+| (223,(_,(_,_,EQUALSright as EQUALS1right))::(_,(_,OPleft as OP1left,
+_))::rest671) => let val result=MlyValue.AtPat(fn _ => (
+ LONGIDatpat (PP OPleft EQUALSright,
+				       OP_OPT (mk_LongId ["="], true)) 
+))
+ in (LrTable.NT 54,(result,OP1left,EQUALS1right),rest671) end
+| (224,(_,(_,_,RBRACEright as RBRACE1right))::(_,(MlyValue.PatRow_opt 
+PatRow_opt1,_,_))::(_,(_,LBRACEleft as LBRACE1left,_))::rest671) => 
+let val result=MlyValue.AtPat(fn _ => let val PatRow_opt as 
+PatRow_opt1=PatRow_opt1 ()
+ in ( RECORDatpat (PP LBRACEleft RBRACEright, PatRow_opt) ) end
+)
+ in (LrTable.NT 54,(result,LBRACE1left,RBRACE1right),rest671) end
+| (225,(_,(_,_,RPARENright as RPAREN1right))::(_,(MlyValue.Pat Pat1,_,
+_))::(_,(_,LPARENleft as LPAREN1left,_))::rest671) => let val result=
+MlyValue.AtPat(fn _ => let val Pat as Pat1=Pat1 ()
+ in ( PARatpat (PP LPARENleft RPARENright, Pat) ) end
+)
+ in (LrTable.NT 54,(result,LPAREN1left,RPAREN1right),rest671) end
+| (226,(_,(_,_,RPARENright as RPAREN1right))::(_,(_,LPARENleft as 
+LPAREN1left,_))::rest671) => let val result=MlyValue.AtPat(fn _ => (
+ RECORDatpat (PP LPARENleft RPARENright, NONE) ))
+ in (LrTable.NT 54,(result,LPAREN1left,RPAREN1right),rest671) end
+| (227,(_,(_,_,RPARENright as RPAREN1right))::(_,(
+MlyValue.PatComma_seq2 PatComma_seq21,_,_))::(_,(_,LPARENleft as 
+LPAREN1left,_))::rest671) => let val result=MlyValue.AtPat(fn _ => 
+let val PatComma_seq2 as PatComma_seq21=PatComma_seq21 ()
+ in ( tuple_atpat_with_info (PP LPARENleft RPARENright) PatComma_seq2 
+) end
+)
+ in (LrTable.NT 54,(result,LPAREN1left,RPAREN1right),rest671) end
+| (228,(_,(_,_,RBRACKETright as RBRACKET1right))::(_,(
+MlyValue.PatComma_seq0 PatComma_seq01,_,_))::(_,(_,LBRACKETleft as 
+LBRACKET1left,_))::rest671) => let val result=MlyValue.AtPat(fn _ => 
+let val PatComma_seq0 as PatComma_seq01=PatComma_seq01 ()
+ in ( list_atpat (PP LBRACKETleft RBRACKETright) PatComma_seq0 ) end
+)
+ in (LrTable.NT 54,(result,LBRACKET1left,RBRACKET1right),rest671) end
+| (229,(_,(MlyValue.PatRow PatRow1,PatRow1left,PatRow1right))::rest671
+) => let val result=MlyValue.PatRow_opt(fn _ => let val PatRow as 
+PatRow1=PatRow1 ()
+ in ( SOME PatRow ) end
+)
+ in (LrTable.NT 82,(result,PatRow1left,PatRow1right),rest671) end
+| (230,rest671) => let val result=MlyValue.PatRow_opt(fn _ => ( NONE )
+)
+ in (LrTable.NT 82,(result,defaultPos,defaultPos),rest671) end
+| (231,(_,(_,DOTDOTDOTleft as DOTDOTDOT1left,DOTDOTDOTright as 
+DOTDOTDOT1right))::rest671) => let val result=MlyValue.PatRow(fn _ => 
+( DecGrammar.DOTDOTDOT (PP DOTDOTDOTleft DOTDOTDOTright) ))
+ in (LrTable.NT 53,(result,DOTDOTDOT1left,DOTDOTDOT1right),rest671)
+ end
+| (232,(_,(MlyValue.CommaPatRow_opt CommaPatRow_opt1,_,
+CommaPatRow_opt1right))::(_,(MlyValue.Pat Pat1,_,_))::_::(_,(
+MlyValue.Label Label1,Labelleft as Label1left,_))::rest671) => let 
+val result=MlyValue.PatRow(fn _ => let val Label as Label1=Label1 ()
+val Pat as Pat1=Pat1 ()
+val CommaPatRow_opt as CommaPatRow_opt1=CommaPatRow_opt1 ()
+ in (
+ PATROW (PP Labelleft
+				    (rightmost get_info_pat Pat
+				               get_info_patrow CommaPatRow_opt),
+				  Label, Pat, CommaPatRow_opt) 
+) end
+)
+ in (LrTable.NT 53,(result,Label1left,CommaPatRow_opt1right),rest671)
+ end
+| (233,(_,(MlyValue.CommaPatRow_opt CommaPatRow_opt1,_,
+CommaPatRow_opt1right))::(_,(MlyValue.AsPat_opt AsPat_opt1,_,_))::(_,(
+MlyValue.ColonTy_opt ColonTy_opt1,_,_))::(_,(MlyValue.Ident Ident1,
+Identleft as Ident1left,Identright))::rest671) => let val result=
+MlyValue.PatRow(fn _ => let val Ident as Ident1=Ident1 ()
+val ColonTy_opt as ColonTy_opt1=ColonTy_opt1 ()
+val AsPat_opt as AsPat_opt1=AsPat_opt1 ()
+val CommaPatRow_opt as CommaPatRow_opt1=CommaPatRow_opt1 ()
+ in (
+ PATROW
+			    (PP Identleft
+			       (rightmost_of_four Identright
+				  get_info_ty ColonTy_opt
+				  get_info_pat AsPat_opt
+				  get_info_patrow CommaPatRow_opt),
+			     mk_IdentLab Ident,
+			     let
+			       val info_ident = PP Identleft Identright
+			       val idPat =
+				     ATPATpat
+				       (info_ident,
+					LONGIDatpat
+					  (info_ident, OP_OPT (mk_LongId [Ident], false)))
+			     in
+			       case (ColonTy_opt, AsPat_opt) of
+				 (_, SOME pat) =>
+				   LAYEREDpat (PP Identleft (right (get_info_pat pat)),
+					       OP_OPT (mk_Id Ident, false),
+					       ColonTy_opt, pat)
+			       | (SOME ty, NONE) =>
+				   TYPEDpat (PP Identleft (right (get_info_ty ty)),
+					     idPat, ty)
+			       | (NONE, NONE) => idPat
+			     end,
+			     CommaPatRow_opt) 
+) end
+)
+ in (LrTable.NT 53,(result,Ident1left,CommaPatRow_opt1right),rest671)
+ end
+| (234,(_,(MlyValue.Pat Pat1,_,Pat1right))::(_,(_,AS1left,_))::rest671
+) => let val result=MlyValue.AsPat_opt(fn _ => let val Pat as Pat1=
+Pat1 ()
+ in ( SOME Pat ) end
+)
+ in (LrTable.NT 83,(result,AS1left,Pat1right),rest671) end
+| (235,rest671) => let val result=MlyValue.AsPat_opt(fn _ => ( NONE ))
+ in (LrTable.NT 83,(result,defaultPos,defaultPos),rest671) end
+| (236,(_,(MlyValue.PatRow PatRow1,_,PatRow1right))::(_,(_,COMMA1left,
+_))::rest671) => let val result=MlyValue.CommaPatRow_opt(fn _ => let 
+val PatRow as PatRow1=PatRow1 ()
+ in ( SOME PatRow ) end
+)
+ in (LrTable.NT 84,(result,COMMA1left,PatRow1right),rest671) end
+| (237,rest671) => let val result=MlyValue.CommaPatRow_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 84,(result,defaultPos,defaultPos),rest671) end
+| (238,(_,(MlyValue.PatComma_seq1 PatComma_seq11,PatComma_seq11left,
+PatComma_seq11right))::rest671) => let val result=
+MlyValue.PatComma_seq0(fn _ => let val PatComma_seq1 as PatComma_seq11
+=PatComma_seq11 ()
+ in ( PatComma_seq1 ) end
+)
+ in (LrTable.NT 93,(result,PatComma_seq11left,PatComma_seq11right),
+rest671) end
+| (239,rest671) => let val result=MlyValue.PatComma_seq0(fn _ => (
+ nil ))
+ in (LrTable.NT 93,(result,defaultPos,defaultPos),rest671) end
+| (240,(_,(MlyValue.PatComma_seq1 PatComma_seq11,_,PatComma_seq11right
+))::_::(_,(MlyValue.Pat Pat1,Pat1left,_))::rest671) => let val result=
+MlyValue.PatComma_seq1(fn _ => let val Pat as Pat1=Pat1 ()
+val PatComma_seq1 as PatComma_seq11=PatComma_seq11 ()
+ in ( Pat :: PatComma_seq1 ) end
+)
+ in (LrTable.NT 94,(result,Pat1left,PatComma_seq11right),rest671) end
+| (241,(_,(MlyValue.Pat Pat1,Pat1left,Pat1right))::rest671) => let 
+val result=MlyValue.PatComma_seq1(fn _ => let val Pat as Pat1=Pat1 ()
+ in ( [Pat] ) end
+)
+ in (LrTable.NT 94,(result,Pat1left,Pat1right),rest671) end
+| (242,(_,(MlyValue.PatComma_seq1 PatComma_seq11,_,PatComma_seq11right
+))::_::(_,(MlyValue.Pat Pat1,Pat1left,_))::rest671) => let val result=
+MlyValue.PatComma_seq2(fn _ => let val Pat as Pat1=Pat1 ()
+val PatComma_seq1 as PatComma_seq11=PatComma_seq11 ()
+ in ( Pat :: PatComma_seq1 ) end
+)
+ in (LrTable.NT 95,(result,Pat1left,PatComma_seq11right),rest671) end
+| (243,(_,(MlyValue.AtPat AtPat1,AtPat1left,AtPat1right))::rest671)
+ => let val result=MlyValue.Pat(fn _ => let val AtPat as AtPat1=AtPat1
+ ()
+ in ( ATPATpat (get_info_atpat AtPat, AtPat) ) end
+)
+ in (LrTable.NT 52,(result,AtPat1left,AtPat1right),rest671) end
+| (244,(_,(MlyValue.AtPat_seq2 AtPat_seq21,AtPat_seq2left as 
+AtPat_seq21left,AtPat_seq2right as AtPat_seq21right))::rest671) => 
+let val result=MlyValue.Pat(fn _ => let val AtPat_seq2 as AtPat_seq21=
+AtPat_seq21 ()
+ in (
+ UNRES_INFIXpat (PP AtPat_seq2left AtPat_seq2right,
+					  AtPat_seq2) 
+) end
+)
+ in (LrTable.NT 52,(result,AtPat_seq21left,AtPat_seq21right),rest671)
+ end
+| (245,(_,(MlyValue.Ty Ty1,_,Tyright as Ty1right))::_::(_,(
+MlyValue.Pat Pat1,Patleft as Pat1left,_))::rest671) => let val result=
+MlyValue.Pat(fn _ => let val Pat as Pat1=Pat1 ()
+val Ty as Ty1=Ty1 ()
+ in ( TYPEDpat (PP Patleft Tyright, Pat, Ty) ) end
+)
+ in (LrTable.NT 52,(result,Pat1left,Ty1right),rest671) end
+| (246,(_,(MlyValue.Pat Pat2,_,Pat2right))::_::(_,(MlyValue.Pat Pat1,
+Pat1left,_))::rest671) => let val result=MlyValue.Pat(fn _ => let val 
+Pat1=Pat1 ()
+val Pat2=Pat2 ()
+ in ( layeredPat (PP Pat1left Pat2right, Pat1, Pat2) ) end
+)
+ in (LrTable.NT 52,(result,Pat1left,Pat2right),rest671) end
+| (247,(_,(MlyValue.Ty Ty1,_,Tyright as Ty1right))::_::(_,(
+MlyValue.TupleTy TupleTy1,TupleTyleft as TupleTy1left,_))::rest671)
+ => let val result=MlyValue.Ty(fn _ => let val TupleTy as TupleTy1=
+TupleTy1 ()
+val Ty as Ty1=Ty1 ()
+ in (
+ FNty (PP TupleTyleft Tyright,
+				(case TupleTy of
+				   [t] => t
+				 | ts => tuple_type (PP TupleTyleft Tyright) ts),
+				Ty) 
+) end
+)
+ in (LrTable.NT 46,(result,TupleTy1left,Ty1right),rest671) end
+| (248,(_,(MlyValue.TupleTy TupleTy1,TupleTyleft as TupleTy1left,
+TupleTyright as TupleTy1right))::rest671) => let val result=
+MlyValue.Ty(fn _ => let val TupleTy as TupleTy1=TupleTy1 ()
+ in (
+ (case TupleTy of
+			     [t] => t
+			   | ts => tuple_type (PP TupleTyleft TupleTyright) ts) 
+) end
+)
+ in (LrTable.NT 46,(result,TupleTy1left,TupleTy1right),rest671) end
+| (249,(_,(MlyValue.Ty_sans_STAR Ty_sans_STAR1,Ty_sans_STAR1left,
+Ty_sans_STAR1right))::rest671) => let val result=MlyValue.TupleTy(fn _
+ => let val Ty_sans_STAR as Ty_sans_STAR1=Ty_sans_STAR1 ()
+ in ( [Ty_sans_STAR] ) end
+)
+ in (LrTable.NT 47,(result,Ty_sans_STAR1left,Ty_sans_STAR1right),
+rest671) end
+| (250,(_,(MlyValue.TupleTy TupleTy1,_,TupleTy1right))::_::(_,(
+MlyValue.Ty_sans_STAR Ty_sans_STAR1,Ty_sans_STAR1left,_))::rest671)
+ => let val result=MlyValue.TupleTy(fn _ => let val Ty_sans_STAR as 
+Ty_sans_STAR1=Ty_sans_STAR1 ()
+val TupleTy as TupleTy1=TupleTy1 ()
+ in ( Ty_sans_STAR :: TupleTy ) end
+)
+ in (LrTable.NT 47,(result,Ty_sans_STAR1left,TupleTy1right),rest671)
+ end
+| (251,(_,(MlyValue.LongTypeIdent LongTypeIdent1,_,LongTypeIdentright
+ as LongTypeIdent1right))::_::(_,(MlyValue.TyComma_seq2 TyComma_seq21,
+_,_))::(_,(_,LPARENleft as LPAREN1left,_))::rest671) => let val result
+=MlyValue.Ty_sans_STAR(fn _ => let val TyComma_seq2 as TyComma_seq21=
+TyComma_seq21 ()
+val LongTypeIdent as LongTypeIdent1=LongTypeIdent1 ()
+ in (
+ CONty (PP LPARENleft LongTypeIdentright,
+				 TyComma_seq2, mk_LongTyCon LongTypeIdent) 
+) end
+)
+ in (LrTable.NT 48,(result,LPAREN1left,LongTypeIdent1right),rest671)
+ end
+| (252,(_,(MlyValue.LongTypeIdent LongTypeIdent1,_,LongTypeIdentright
+ as LongTypeIdent1right))::(_,(MlyValue.Ty_sans_STAR Ty_sans_STAR1,
+Ty_sans_STARleft as Ty_sans_STAR1left,_))::rest671) => let val result=
+MlyValue.Ty_sans_STAR(fn _ => let val Ty_sans_STAR as Ty_sans_STAR1=
+Ty_sans_STAR1 ()
+val LongTypeIdent as LongTypeIdent1=LongTypeIdent1 ()
+ in (
+ CONty (PP Ty_sans_STARleft LongTypeIdentright,
+				 [Ty_sans_STAR], mk_LongTyCon LongTypeIdent) 
+) end
+)
+ in (LrTable.NT 48,(result,Ty_sans_STAR1left,LongTypeIdent1right),
+rest671) end
+| (253,(_,(MlyValue.AtomicTy AtomicTy1,AtomicTy1left,AtomicTy1right))
+::rest671) => let val result=MlyValue.Ty_sans_STAR(fn _ => let val 
+AtomicTy as AtomicTy1=AtomicTy1 ()
+ in ( AtomicTy ) end
+)
+ in (LrTable.NT 48,(result,AtomicTy1left,AtomicTy1right),rest671) end
+| (254,(_,(MlyValue.TyComma_seq2 TyComma_seq21,_,TyComma_seq21right))
+::_::(_,(MlyValue.Ty Ty1,Ty1left,_))::rest671) => let val result=
+MlyValue.TyComma_seq2(fn _ => let val Ty as Ty1=Ty1 ()
+val TyComma_seq2 as TyComma_seq21=TyComma_seq21 ()
+ in ( Ty :: TyComma_seq2 ) end
+)
+ in (LrTable.NT 102,(result,Ty1left,TyComma_seq21right),rest671) end
+| (255,(_,(MlyValue.Ty Ty2,_,Ty2right))::_::(_,(MlyValue.Ty Ty1,
+Ty1left,_))::rest671) => let val result=MlyValue.TyComma_seq2(fn _ => 
+let val Ty1=Ty1 ()
+val Ty2=Ty2 ()
+ in ( [Ty1, Ty2] ) end
+)
+ in (LrTable.NT 102,(result,Ty1left,Ty2right),rest671) end
+| (256,(_,(MlyValue.LongTypeIdent LongTypeIdent1,LongTypeIdentleft as 
+LongTypeIdent1left,LongTypeIdentright as LongTypeIdent1right))::
+rest671) => let val result=MlyValue.AtomicTy(fn _ => let val 
+LongTypeIdent as LongTypeIdent1=LongTypeIdent1 ()
+ in (
+ CONty (PP LongTypeIdentleft LongTypeIdentright,
+				 [], mk_LongTyCon LongTypeIdent) 
+) end
+)
+ in (LrTable.NT 49,(result,LongTypeIdent1left,LongTypeIdent1right),
+rest671) end
+| (257,(_,(MlyValue.TYVAR TYVAR1,TYVARleft as TYVAR1left,TYVARright
+ as TYVAR1right))::rest671) => let val result=MlyValue.AtomicTy(fn _
+ => let val TYVAR as TYVAR1=TYVAR1 ()
+ in ( TYVARty(PP TYVARleft TYVARright, mk_TyVar TYVAR) ) end
+)
+ in (LrTable.NT 49,(result,TYVAR1left,TYVAR1right),rest671) end
+| (258,(_,(_,_,RBRACEright as RBRACE1right))::(_,(MlyValue.TyRow_opt 
+TyRow_opt1,_,_))::(_,(_,LBRACEleft as LBRACE1left,_))::rest671) => 
+let val result=MlyValue.AtomicTy(fn _ => let val TyRow_opt as 
+TyRow_opt1=TyRow_opt1 ()
+ in ( RECORDty (PP LBRACEleft RBRACEright, TyRow_opt) ) end
+)
+ in (LrTable.NT 49,(result,LBRACE1left,RBRACE1right),rest671) end
+| (259,(_,(_,_,RPARENright as RPAREN1right))::(_,(MlyValue.Ty Ty1,_,_)
+)::(_,(_,LPARENleft as LPAREN1left,_))::rest671) => let val result=
+MlyValue.AtomicTy(fn _ => let val Ty as Ty1=Ty1 ()
+ in ( PARty (PP LPARENleft RPARENright, Ty) ) end
+)
+ in (LrTable.NT 49,(result,LPAREN1left,RPAREN1right),rest671) end
+| (260,(_,(MlyValue.TyRow TyRow1,TyRow1left,TyRow1right))::rest671)
+ => let val result=MlyValue.TyRow_opt(fn _ => let val TyRow as TyRow1=
+TyRow1 ()
+ in ( SOME TyRow ) end
+)
+ in (LrTable.NT 87,(result,TyRow1left,TyRow1right),rest671) end
+| (261,rest671) => let val result=MlyValue.TyRow_opt(fn _ => ( NONE ))
+ in (LrTable.NT 87,(result,defaultPos,defaultPos),rest671) end
+| (262,(_,(MlyValue.CommaTyRow_opt CommaTyRow_opt1,_,
+CommaTyRow_opt1right))::(_,(MlyValue.Ty Ty1,_,_))::_::(_,(
+MlyValue.Label Label1,Labelleft as Label1left,_))::rest671) => let 
+val result=MlyValue.TyRow(fn _ => let val Label as Label1=Label1 ()
+val Ty as Ty1=Ty1 ()
+val CommaTyRow_opt as CommaTyRow_opt1=CommaTyRow_opt1 ()
+ in (
+ TYROW (PP Labelleft
+				   (rightmost get_info_ty Ty
+				              get_info_tyrow CommaTyRow_opt),
+				 Label, Ty, CommaTyRow_opt) 
+) end
+)
+ in (LrTable.NT 45,(result,Label1left,CommaTyRow_opt1right),rest671)
+ end
+| (263,(_,(MlyValue.TyRow TyRow1,_,TyRow1right))::(_,(_,COMMA1left,_))
+::rest671) => let val result=MlyValue.CommaTyRow_opt(fn _ => let val 
+TyRow as TyRow1=TyRow1 ()
+ in ( SOME TyRow ) end
+)
+ in (LrTable.NT 88,(result,COMMA1left,TyRow1right),rest671) end
+| (264,rest671) => let val result=MlyValue.CommaTyRow_opt(fn _ => (
+ NONE ))
+ in (LrTable.NT 88,(result,defaultPos,defaultPos),rest671) end
+| (265,(_,(MlyValue.DECPOSINTEGER DECPOSINTEGER1,DECPOSINTEGERleft as 
+DECPOSINTEGER1left,DECPOSINTEGER1right))::rest671) => let val result=
+MlyValue.Integer(fn _ => let val DECPOSINTEGER as DECPOSINTEGER1=
+DECPOSINTEGER1 ()
+ in (
+ raise_lexical_error_if_none
+			    DECPOSINTEGERleft DECPOSINTEGER )
+ end
+)
+ in (LrTable.NT 123,(result,DECPOSINTEGER1left,DECPOSINTEGER1right),
+rest671) end
+| (266,(_,(MlyValue.DECNEGINTEGER DECNEGINTEGER1,DECNEGINTEGERleft as 
+DECNEGINTEGER1left,DECNEGINTEGER1right))::rest671) => let val result=
+MlyValue.Integer(fn _ => let val DECNEGINTEGER as DECNEGINTEGER1=
+DECNEGINTEGER1 ()
+ in (
+ raise_lexical_error_if_none
+			    DECNEGINTEGERleft DECNEGINTEGER )
+ end
+)
+ in (LrTable.NT 123,(result,DECNEGINTEGER1left,DECNEGINTEGER1right),
+rest671) end
+| (267,(_,(MlyValue.HEXINTEGER HEXINTEGER1,HEXINTEGERleft as 
+HEXINTEGER1left,HEXINTEGER1right))::rest671) => let val result=
+MlyValue.Integer(fn _ => let val HEXINTEGER as HEXINTEGER1=HEXINTEGER1
+ ()
+ in ( raise_lexical_error_if_none
+			    HEXINTEGERleft HEXINTEGER )
+ end
+)
+ in (LrTable.NT 123,(result,HEXINTEGER1left,HEXINTEGER1right),rest671)
+ end
+| (268,(_,(MlyValue.DIGIT DIGIT1,DIGIT1left,DIGIT1right))::rest671)
+ => let val result=MlyValue.Integer(fn _ => let val DIGIT as DIGIT1=
+DIGIT1 ()
+ in ( DIGIT ) end
+)
+ in (LrTable.NT 123,(result,DIGIT1left,DIGIT1right),rest671) end
+| (269,(_,(MlyValue.STRING STRING1,STRINGleft,STRING1right))::(_,(_,
+HASH1left,_))::rest671) => let val result=MlyValue.Char(fn _ => let 
+val STRING as STRING1=STRING1 ()
+ in (
+ case explode STRING
+                            of [c] => ord c
+                             | _ => raise LEXICAL_ERROR (STRINGleft, "string must have length 1") 
+) end
+)
+ in (LrTable.NT 124,(result,HASH1left,STRING1right),rest671) end
+| (270,(_,(MlyValue.Integer Integer1,Integer1left,Integer1right))::
+rest671) => let val result=MlyValue.SCon(fn _ => let val Integer as 
+Integer1=Integer1 ()
+ in ( mk_IntSCon Integer ) end
+)
+ in (LrTable.NT 51,(result,Integer1left,Integer1right),rest671) end
+| (271,(_,(MlyValue.WORD WORD1,WORDleft as WORD1left,WORD1right))::
+rest671) => let val result=MlyValue.SCon(fn _ => let val WORD as WORD1
+=WORD1 ()
+ in ( mk_WordSCon (raise_lexical_error_if_none WORDleft WORD) ) end
+)
+ in (LrTable.NT 51,(result,WORD1left,WORD1right),rest671) end
+| (272,(_,(MlyValue.STRING STRING1,STRING1left,STRING1right))::rest671
+) => let val result=MlyValue.SCon(fn _ => let val STRING as STRING1=
+STRING1 ()
+ in ( mk_StringSCon STRING ) end
+)
+ in (LrTable.NT 51,(result,STRING1left,STRING1right),rest671) end
+| (273,(_,(MlyValue.Char Char1,Char1left,Char1right))::rest671) => 
+let val result=MlyValue.SCon(fn _ => let val Char as Char1=Char1 ()
+ in ( mk_CharSCon Char ) end
+)
+ in (LrTable.NT 51,(result,Char1left,Char1right),rest671) end
+| (274,(_,(MlyValue.REAL REAL1,REALleft as REAL1left,REAL1right))::
+rest671) => let val result=MlyValue.SCon(fn _ => let val REAL as REAL1
+=REAL1 ()
+ in ( mk_RealSCon (raise_lexical_error_if_none REALleft REAL) ) end
+)
+ in (LrTable.NT 51,(result,REAL1left,REAL1right),rest671) end
+| (275,(_,(MlyValue.TyVarSeq1 TyVarSeq11,TyVarSeq11left,
+TyVarSeq11right))::rest671) => let val result=MlyValue.TyVarSeq(fn _
+ => let val TyVarSeq1 as TyVarSeq11=TyVarSeq11 ()
+ in ( TyVarSeq1 ) end
+)
+ in (LrTable.NT 50,(result,TyVarSeq11left,TyVarSeq11right),rest671)
+ end
+| (276,rest671) => let val result=MlyValue.TyVarSeq(fn _ => ( [] ))
+ in (LrTable.NT 50,(result,defaultPos,defaultPos),rest671) end
+| (277,(_,(MlyValue.TYVAR TYVAR1,TYVAR1left,TYVAR1right))::rest671)
+ => let val result=MlyValue.TyVarSeq1(fn _ => let val TYVAR as TYVAR1=
+TYVAR1 ()
+ in ( [mk_TyVar TYVAR] ) end
+)
+ in (LrTable.NT 100,(result,TYVAR1left,TYVAR1right),rest671) end
+| (278,(_,(_,_,RPAREN1right))::(_,(MlyValue.TyVarComma_seq1 
+TyVarComma_seq11,_,_))::(_,(_,LPAREN1left,_))::rest671) => let val 
+result=MlyValue.TyVarSeq1(fn _ => let val TyVarComma_seq1 as 
+TyVarComma_seq11=TyVarComma_seq11 ()
+ in ( TyVarComma_seq1 ) end
+)
+ in (LrTable.NT 100,(result,LPAREN1left,RPAREN1right),rest671) end
+| (279,(_,(MlyValue.TyVarComma_seq1 TyVarComma_seq11,_,
+TyVarComma_seq11right))::_::(_,(MlyValue.TYVAR TYVAR1,TYVAR1left,_))::
+rest671) => let val result=MlyValue.TyVarComma_seq1(fn _ => let val 
+TYVAR as TYVAR1=TYVAR1 ()
+val TyVarComma_seq1 as TyVarComma_seq11=TyVarComma_seq11 ()
+ in ( mk_TyVar TYVAR :: TyVarComma_seq1 ) end
+)
+ in (LrTable.NT 101,(result,TYVAR1left,TyVarComma_seq11right),rest671)
+ end
+| (280,(_,(MlyValue.TYVAR TYVAR1,TYVAR1left,TYVAR1right))::rest671)
+ => let val result=MlyValue.TyVarComma_seq1(fn _ => let val TYVAR as 
+TYVAR1=TYVAR1 ()
+ in ( [mk_TyVar TYVAR] ) end
+)
+ in (LrTable.NT 101,(result,TYVAR1left,TYVAR1right),rest671) end
+| _ => raise (mlyAction i392)
+end
+(* cvr: end *)
+end
diff -Nru mosml-2.01/src/notes/manylocals.sml mosml-2.10.1/src/notes/manylocals.sml
--- mosml-2.01/src/notes/manylocals.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/notes/manylocals.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,303 @@
+fun f x = 
+    let 
+val x100 = x
+val x101 = 1 + x100
+val x102 = 1 + x101
+val x103 = 1 + x102
+val x104 = 1 + x103
+val x105 = 1 + x104
+val x106 = 1 + x105
+val x107 = 1 + x106
+val x108 = 1 + x107
+val x109 = 1 + x108
+val x110 = 1 + x109
+val x111 = 1 + x110
+val x112 = 1 + x111
+val x113 = 1 + x112
+val x114 = 1 + x113
+val x115 = 1 + x114
+val x116 = 1 + x115
+val x117 = 1 + x116
+val x118 = 1 + x117
+val x119 = 1 + x118
+val x120 = 1 + x119
+val x121 = 1 + x120
+val x122 = 1 + x121
+val x123 = 1 + x122
+val x124 = 1 + x123
+val x125 = 1 + x124
+val x126 = 1 + x125
+val x127 = 1 + x126
+val x128 = 1 + x127
+val x129 = 1 + x128
+val x130 = 1 + x129
+val x131 = 1 + x130
+val x132 = 1 + x131
+val x133 = 1 + x132
+val x134 = 1 + x133
+val x135 = 1 + x134
+val x136 = 1 + x135
+val x137 = 1 + x136
+val x138 = 1 + x137
+val x139 = 1 + x138
+val x140 = 1 + x139
+val x141 = 1 + x140
+val x142 = 1 + x141
+val x143 = 1 + x142
+val x144 = 1 + x143
+val x145 = 1 + x144
+val x146 = 1 + x145
+val x147 = 1 + x146
+val x148 = 1 + x147
+val x149 = 1 + x148
+val x150 = 1 + x149
+val x151 = 1 + x150
+val x152 = 1 + x151
+val x153 = 1 + x152
+val x154 = 1 + x153
+val x155 = 1 + x154
+val x156 = 1 + x155
+val x157 = 1 + x156
+val x158 = 1 + x157
+val x159 = 1 + x158
+val x160 = 1 + x159
+val x161 = 1 + x160
+val x162 = 1 + x161
+val x163 = 1 + x162
+val x164 = 1 + x163
+val x165 = 1 + x164
+val x166 = 1 + x165
+val x167 = 1 + x166
+val x168 = 1 + x167
+val x169 = 1 + x168
+val x170 = 1 + x169
+val x171 = 1 + x170
+val x172 = 1 + x171
+val x173 = 1 + x172
+val x174 = 1 + x173
+val x175 = 1 + x174
+val x176 = 1 + x175
+val x177 = 1 + x176
+val x178 = 1 + x177
+val x179 = 1 + x178
+val x180 = 1 + x179
+val x181 = 1 + x180
+val x182 = 1 + x181
+val x183 = 1 + x182
+val x184 = 1 + x183
+val x185 = 1 + x184
+val x186 = 1 + x185
+val x187 = 1 + x186
+val x188 = 1 + x187
+val x189 = 1 + x188
+val x190 = 1 + x189
+val x191 = 1 + x190
+val x192 = 1 + x191
+val x193 = 1 + x192
+val x194 = 1 + x193
+val x195 = 1 + x194
+val x196 = 1 + x195
+val x197 = 1 + x196
+val x198 = 1 + x197
+val x199 = 1 + x198
+val x200 = 1 + x199
+val x201 = 1 + x200
+val x202 = 1 + x201
+val x203 = 1 + x202
+val x204 = 1 + x203
+val x205 = 1 + x204
+val x206 = 1 + x205
+val x207 = 1 + x206
+val x208 = 1 + x207
+val x209 = 1 + x208
+val x210 = 1 + x209
+val x211 = 1 + x210
+val x212 = 1 + x211
+val x213 = 1 + x212
+val x214 = 1 + x213
+val x215 = 1 + x214
+val x216 = 1 + x215
+val x217 = 1 + x216
+val x218 = 1 + x217
+val x219 = 1 + x218
+val x220 = 1 + x219
+val x221 = 1 + x220
+val x222 = 1 + x221
+val x223 = 1 + x222
+val x224 = 1 + x223
+val x225 = 1 + x224
+val x226 = 1 + x225
+val x227 = 1 + x226
+val x228 = 1 + x227
+val x229 = 1 + x228
+val x230 = 1 + x229
+val x231 = 1 + x230
+val x232 = 1 + x231
+val x233 = 1 + x232
+val x234 = 1 + x233
+val x235 = 1 + x234
+val x236 = 1 + x235
+val x237 = 1 + x236
+val x238 = 1 + x237
+val x239 = 1 + x238
+val x240 = 1 + x239
+val x241 = 1 + x240
+val x242 = 1 + x241
+val x243 = 1 + x242
+val x244 = 1 + x243
+val x245 = 1 + x244
+val x246 = 1 + x245
+val x247 = 1 + x246
+val x248 = 1 + x247
+val x249 = 1 + x248
+val x250 = 1 + x249
+val x251 = 1 + x250
+val x252 = 1 + x251
+val x253 = 1 + x252
+val x254 = 1 + x253
+val x255 = 1 + x254
+val x256 = 1 + x255
+val x257 = 1 + x256
+val x258 = 1 + x257
+val x259 = 1 + x258
+val x260 = 1 + x259
+val x261 = 1 + x260
+val x262 = 1 + x261
+val x263 = 1 + x262
+val x264 = 1 + x263
+val x265 = 1 + x264
+val x266 = 1 + x265
+val x267 = 1 + x266
+val x268 = 1 + x267
+val x269 = 1 + x268
+val x270 = 1 + x269
+val x271 = 1 + x270
+val x272 = 1 + x271
+val x273 = 1 + x272
+val x274 = 1 + x273
+val x275 = 1 + x274
+val x276 = 1 + x275
+val x277 = 1 + x276
+val x278 = 1 + x277
+val x279 = 1 + x278
+val x280 = 1 + x279
+val x281 = 1 + x280
+val x282 = 1 + x281
+val x283 = 1 + x282
+val x284 = 1 + x283
+val x285 = 1 + x284
+val x286 = 1 + x285
+val x287 = 1 + x286
+val x288 = 1 + x287
+val x289 = 1 + x288
+val x290 = 1 + x289
+val x291 = 1 + x290
+val x292 = 1 + x291
+val x293 = 1 + x292
+val x294 = 1 + x293
+val x295 = 1 + x294
+val x296 = 1 + x295
+val x297 = 1 + x296
+val x298 = 1 + x297
+val x299 = 1 + x298
+val x300 = 1 + x299
+val x301 = 1 + x300
+val x302 = 1 + x301
+val x303 = 1 + x302
+val x304 = 1 + x303
+val x305 = 1 + x304
+val x306 = 1 + x305
+val x307 = 1 + x306
+val x308 = 1 + x307
+val x309 = 1 + x308
+val x310 = 1 + x309
+val x311 = 1 + x310
+val x312 = 1 + x311
+val x313 = 1 + x312
+val x314 = 1 + x313
+val x315 = 1 + x314
+val x316 = 1 + x315
+val x317 = 1 + x316
+val x318 = 1 + x317
+val x319 = 1 + x318
+val x320 = 1 + x319
+val x321 = 1 + x320
+val x322 = 1 + x321
+val x323 = 1 + x322
+val x324 = 1 + x323
+val x325 = 1 + x324
+val x326 = 1 + x325
+val x327 = 1 + x326
+val x328 = 1 + x327
+val x329 = 1 + x328
+val x330 = 1 + x329
+val x331 = 1 + x330
+val x332 = 1 + x331
+val x333 = 1 + x332
+val x334 = 1 + x333
+val x335 = 1 + x334
+val x336 = 1 + x335
+val x337 = 1 + x336
+val x338 = 1 + x337
+val x339 = 1 + x338
+val x340 = 1 + x339
+val x341 = 1 + x340
+val x342 = 1 + x341
+val x343 = 1 + x342
+val x344 = 1 + x343
+val x345 = 1 + x344
+val x346 = 1 + x345
+val x347 = 1 + x346
+val x348 = 1 + x347
+val x349 = 1 + x348
+val x350 = 1 + x349
+val x351 = 1 + x350
+val x352 = 1 + x351
+val x353 = 1 + x352
+val x354 = 1 + x353
+val x355 = 1 + x354
+val x356 = 1 + x355
+val x357 = 1 + x356
+val x358 = 1 + x357
+val x359 = 1 + x358
+val x360 = 1 + x359
+val x361 = 1 + x360
+val x362 = 1 + x361
+val x363 = 1 + x362
+val x364 = 1 + x363
+val x365 = 1 + x364
+val x366 = 1 + x365
+val x367 = 1 + x366
+val x368 = 1 + x367
+val x369 = 1 + x368
+val x370 = 1 + x369
+val x371 = 1 + x370
+val x372 = 1 + x371
+val x373 = 1 + x372
+val x374 = 1 + x373
+val x375 = 1 + x374
+val x376 = 1 + x375
+val x377 = 1 + x376
+val x378 = 1 + x377
+val x379 = 1 + x378
+val x380 = 1 + x379
+val x381 = 1 + x380
+val x382 = 1 + x381
+val x383 = 1 + x382
+val x384 = 1 + x383
+val x385 = 1 + x384
+val x386 = 1 + x385
+val x387 = 1 + x386
+val x388 = 1 + x387
+val x389 = 1 + x388
+val x390 = 1 + x389
+val x391 = 1 + x390
+val x392 = 1 + x391
+val x393 = 1 + x392
+val x394 = 1 + x393
+val x395 = 1 + x394
+val x396 = 1 + x395
+val x397 = 1 + x396
+val x398 = 1 + x397
+val x399 = 1 + x398
+in x399 end
diff -Nru mosml-2.01/src/notes/mosml2 mosml-2.10.1/src/notes/mosml2
--- mosml-2.01/src/notes/mosml2	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/notes/mosml2	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,96 @@
+2000-01-17:
+
+(1) Extending localvars to 64K
+
+* compiler/Emitcode:
+
+Split checkAccessIndex into checkAccessIndex8 and checkAccessIndex16.
+
+16 bit: 
+
+Kaccess/ACCESS, Kenvacc/ENVACC, Kassign/ASSIGN, Kpop/POP,
+Kreturn/RETURN, Kprim Pdummy/DUMMY, Kpush :: Kaccess/PUSHACC,
+PUSHENVACC,
+
+Add checks to: Kgetfield, Ksetfield
+
+Remains 8 bit:
+
+Kapply, Kgrab, 
+
+Mixed 8 and 16 bit:
+
+Kappterm/APPTERM, APPTERM1-4, PUSH_GETGLOBAL_APPTERM1-4,
+PUSH_ENV1_APPTERM1-4
+
+
+* runtime/interp.c:
+
+Replace: u8pci with u16pc and pc+=SHORT
+
+DUMMY: Alloc_small OK, since 65KW=256KB = minimum young heap
+
+Shorts are output LSB first:
+
+static opcode_t byte_callback1_code[] = { ACC1, APPLY1, POP, 1, 0, STOP };
+static opcode_t byte_callback2_code[] = { ACC2, APPLY2, POP, 1, 0, STOP };
+static opcode_t byte_callback3_code[] = { ACC3, APPLY3, POP, 1, 0, STOP };
+#define CALLBACK_CODE_LEN 6
+
+* runtime/expand.c:
+
+ACCESS etc.
+
+
+
+(2) Extending jumps to +-2G
+
+* runtime/expand.c:
+
+    Affected instructions:
+
++    Instruct(PUSH_RETADDR): 
++    Instruct(PUSHTRAP):
++    Instruct(BRANCH):
++    Instruct(BRANCHIF):
++    Instruct(BRANCHIFNOT):
++    Instruct(POPBRANCHIFNOT):
++    Instruct(BRANCHIFEQ):
++    Instruct(BRANCHIFNEQ):
++    Instruct(BRANCHIFLT):
++    Instruct(BRANCHIFGT):
++    Instruct(BRANCHIFLE):
++    Instruct(BRANCHIFGE):
++    Instruct(BRANCHINTERVAL):
++    Instruct(BRANCHIFNEQTAG):
++    Instruct(SWITCH):
++    Instruct(CLOSURE):
++    Instruct(CLOSREC):
+
+
+
+
+
+* runtime/interp.c:
+
+#define JUMPSWITCHINDEX(pc, accu) (bytecode_t)(pc + s16(pc + accu - 1))
+-->
+#define JUMPSWITCHINDEX(pc, accu) (bytecode_t)(pc + s32(pc + accu - 1))
+
+JUMPTGT(s16pc) 
+-->
+JUMPTGT(s32pc) 
+
+
+In all the negative cases of branches:
+
+pc += SHORT;
+-->
+pc += LONG;
+
+
+* compiler/Labels.sml:
+
+In out_label_with_orig:
+
+out_short --> out_long (three times)
diff -Nru mosml-2.01/src/notes/mosml.net.txt mosml-2.10.1/src/notes/mosml.net.txt
--- mosml-2.01/src/notes/mosml.net.txt	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/notes/mosml.net.txt	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,46 @@
+The implementation of Moscow ML's interactive system
+
+ * Structures used only to implement the interactive system:
+
+    Predef.sml
+
+      Allocation of the first 39 slots of the global_data array,
+      corresponding to the runtime system's runtime/globals.h, from
+      which the Predef.sml source file is generated automatically.
+
+      The purpose is to enable interaction between the SML code of the
+      interactive system and the (C code of the) runtime system.
+
+      The values are formally bound in structure General, but since
+      the names are not all in the compile-time environment exposed by
+      the interactive system, they are not all accessible to the
+      programmer.
+
+    Prim_c.sml 
+
+      An array of the names of the C primitives in the runtime system
+
+    Symtable.sml 
+
+    Patch.sml 
+
+    Tr_const.sml
+
+    Rtvals.sml 
+
+    Load_phr.sml 
+ 
+    Exec_phr.sml 
+
+    Smltop.sml 
+
+    Maint.sml
+
+
+ * The built-in structure Meta is available in the interactive system
+   only.  Its values are defined in compiler/Smltop.sml.  They are
+   mostly hooks to SML functions used to implement the interactive
+   system itself.  In mosml.net these names could be bound at
+   load-time (or resolved at every use) using reflection.
+
+ * 
diff -Nru mosml-2.01/src/notes/mosmlrpm mosml-2.10.1/src/notes/mosmlrpm
--- mosml-2.01/src/notes/mosmlrpm	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/notes/mosmlrpm	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,123 @@
+From jl@itu.dk Thu Oct 21 16:37:54 1999
+Date: Fri, 15 Oct 1999 19:05:06 +0200
+From: Jakob Lichtenberg 
+To: Peter Sestoft 
+Subject: Mosml RPM
+
+Peter,
+
+Jeg skulle bruge mosml'en, så jeg har selv bygget en rpm baseret på din
+src distribution.  Den kan findes på:
+
+http://spectra.itu.dk/itu/RedHat/RPMS/mosml-1.44-3.i386.rpm 
+
+(Efter kl. 9 i aften hvor cd'en bliver opdateret)
+
+Det interessante er den spec fil jeg fik lavet.  Den har jeg vedlagt
+hvis du selv vil lege videre.  Bemærk post-install og uninstall
+scripts...
+
+Mine problemer er:
+* Jeg ved ikke hvilke *.h filer jeg skal tage med.  Jeg har derfor taget
+en STOR bunke.
+* Jeg orker ikke at patche alle dynlibs Makefilerne.  Derfor har jeg KUN
+taget mgdbm med.  Blot for at demonstrere hvordan det kan gøres.
+
+- Jakob
+
+HER ER SPEC FILEN mosml.spec:
+----------------------------------------------------
+Distribution: IT University of Copenhagen
+Vendor: IT University of Copenhagen
+Packager: Jakob Lichtenberg 
+URL: http://www.itu.dk/people/jl/
+Summary:  Moscow ML
+Name: mosml
+Version: 1.44
+Release: 3
+Source: ftp://ftp.dina.kvl.dk/pub/mosml/mos14src.tar.gz 
+Copyright: GPL
+Group: Development/Languages
+%description
+Moscow ML version 1.44
+
+Moscow ML provides a light-weight implementation of Core Standard ML,
+a strict functional language widely used in teaching and research.
+
+It is based on the Caml Light system, which gives fast compilation and
+modest storage consumption.
+Moscow ML provides a light-weight implementation of Core Standard ML,
+a strict functional language widely used in teaching and research.
+
+It is based on the Caml Light system, which gives fast compilation and
+modest storage consumption.
+
+This RPM is the standard distribution compiled with GDBM support.
+
+Missing: MySQL, Postgres, IntInf, mgd, ... compilation
+
+%prep
+%setup -n mosml
+
+cd src
+sed s/"\${HOME}"/"\/usr\/local"/ tmp ; mv -f tmp
+Makefile.inc
+cd dynlibs
+cd mgdbm
+sed s/"\${HOME}\/c\/gdbm-1.7.3"/"\/usr\/lib"/ tmp ; mv -f tmp
+Makefile
+
+
+%build
+cd src
+make clean
+make world
+
+cd dynlibs
+cd mgdbm
+make
+
+%install
+cd src
+make install
+mkdirhier /usr/local/mosml/include
+mkdirhier /usr/local/mosml/config
+cp -a runtime/*.h /usr/local/mosml/include
+cp -a config/*.h /usr/local/mosml/config
+
+cd dynlibs
+cd mgdbm
+make install
+
+ln -sf /usr/local/mosml/bin/camlrunm  /usr/local/bin
+ln -sf /usr/local/mosml/bin/mosml     /usr/local/bin
+ln -sf /usr/local/mosml/bin/mosmlc    /usr/local/bin
+ln -sf /usr/local/mosml/bin/mosmllex  /usr/local/bin
+ln -sf /usr/local/mosml/bin/mosmlyac  /usr/local/bin
+ln -sf /usr/local/mosml/bin/libmgdbm.so /usr/lib
+#ln -sf /usr/local/mosml/bin/libmmysql.so /usr/lib
+#ln -sf /usr/local/mosml/bin/libmpq.so /usr/lib
+#ln -sf /usr/local/mosml/bin/libmregex.so /usr/lib
+#ln -sf /usr/local/mosml/bin/libmsocket.so /usr/lib
+#ln -sf /usr/local/mosml/bin/libmgd.so /usr/lib
+
+%post
+/sbin/ldconfig
+
+%postun
+/sbin/ldconfig
+
+%files
+/usr/local/mosml
+/usr/local/bin/camlrunm
+/usr/local/bin/mosml
+/usr/local/bin/mosmlc
+/usr/local/bin/mosmllex
+/usr/local/bin/mosmlyac
+/usr/lib/libmgdbm.so
+#/usr/lib/libmmysql.so
+#/usr/lib/libmpq.so
+#/usr/lib/libmregex.so
+#/usr/lib/libmsocket.so
+
+%doc README install.txt roadmap doc/*
diff -Nru mosml-2.01/src/notes/print.sml mosml-2.10.1/src/notes/print.sml
--- mosml-2.01/src/notes/print.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/notes/print.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,46 @@
+(* 2000-01-18 *)
+
+val _ = TextIO.print "Hello\n"; 
+
+(* 
+ Symptom: PUSH_GETGLOBAL_APPTERMi gave a segmentation violation in the 
+          threaded runtime.
+ Cause: wrong address translation while threading
+ Fix:   runtime/expand.c function buildrealmap
+*)
+
+fun f1 a = (TextIO.print "Hello\n"; 255)
+
+fun loop x f1 y = 1 + f1 ();
+
+val _ = loop () f1 () : int;
+
+
+(* 
+ Symptom: CLOSURE and CLOSREC gave a segmentation violation in the 
+          unthreaded runtime
+ Cause: interpreted signed 30-bit ints as signed 31-bit ints
+ Fix:  compiler/Buffcode.sml out_long rightshift signed
+*)
+
+fun h y = let fun f x = x in 1 + f y end
+
+val _ = h 10;
+
+
+
+(* 
+ Symptom: SWITCH gave a segmentation violation
+ Cause: wrong JUMPSWITCHTABLE: multiplied by 2, not 4
+ Fix:  runtime/interp.c
+*)
+
+datatype t = A | B | C | D | E
+
+fun f A = 1 
+  | f B = 2
+  | f C = 3
+  | f D = 4
+  | f E = 5;
+
+val _ = f D; 
diff -Nru mosml-2.01/src/notes/skowron-bug.sml mosml-2.10.1/src/notes/skowron-bug.sml
--- mosml-2.01/src/notes/skowron-bug.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/notes/skowron-bug.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,240 @@
+(* From ss181292@zodiac.mimuw.edu.pl Tue Jan 15 15:12:02 2002
+Date: Wed, 26 Dec 2001 12:55:26 +0100
+From: "[iso-8859-2] Stanis³aw Skowron" 
+To: roman@keldysh.ru, Claudio.Russo@cl.cam.ac.uk, sestoft@dina.kvl.dk
+Subject: BUG report
+
+    [ The following text is in the "iso-8859-2" character set. ]
+    [ Your display is set for the "iso-8859-1" character set.  ]
+    [ Some characters may be displayed incorrectly. ]
+
+                            Stanislaw Skowron
+                            student of MIM departament, Warsaw
+University
+                            ul. Slowicza 12
+                            05-807 Podkowa Lesna
+                            POLAND
+                            ss181292@zodiac.mimuw.edu.pl
+
+                            December 26, 2001
+
+
+Sergei Romanenko (roman@keldysh.ru)
+Keldysh Institute of Applied Mathematics,
+Russian Academy of Sciences
+
+Claudio V. Russo (Claudio.Russo@cl.cam.ac.uk),
+University of Cambridge.
+
+Peter Sestoft (sestoft@dina.kvl.dk),
+Department of Mathematics and Physics,
+Royal Veterinary and Agricultural University
+
+
+Bug report
+When using Your "Moscow ML" I've encountered one bug. It's connected
+with pseudo-polimorphic results of application and fact, it's treated,
+in one
+particular case, as real polymorphic value. The consequence is
+Segmentation
+fault.
+I've prepared a script that generates the Segmentation fault error. The
+important places are commented.
+I'm using "Moscow ML version 2.00 (June 2000)" under Linux platform.
+    [ Part 2: "Attached Text" ]
+
+    [ The following text is in the "iso-8859-2" character set. ]
+    [ Your display is set for the "iso-8859-1" character set.  ]
+    [ Some characters may be displayed incorrectly. ]
+
+*)
+
+(* signature of partial order with type of elements `t' and
+   relation `lessthan' *)
+signature ORDER=
+	sig
+		type t
+		val lessthan:t->t->bool
+	end
+;
+
+
+(* signature of functional dictionary with type of keys `keyt' *)
+signature DICTIONARY=
+	sig
+		type keyt
+		type 'a dictt
+
+		exception EMPTY
+		val add:'a dictt->keyt->'a->'a dictt
+		val rm:'a dictt->keyt->'a dictt
+		val at:'a dictt->keyt->'a
+		val empty:'a dictt
+		val iskey:'a dictt->keyt->bool
+		val to_list:'a dictt->(keyt*'a) list
+		val from_list:(keyt*'a) list->'a dictt
+	end
+;
+
+
+(* signature of imperative dictionary with type of elements `key' *)
+signature IMPDICT =
+	sig
+		type key
+		type 'a dict
+		exception NOTFOUND
+		val empty : unit -> 'a dict
+		val add : 'a dict -> key -> 'a -> unit
+		val mem : 'a dict -> key -> bool
+		val find : 'a dict -> key -> 'a
+		val remove : 'a dict -> key -> unit
+		val from_list: (key*'a) list -> 'a dict
+		val to_list: 'a dict -> (key*'a) list
+		val copy : 'a dict -> 'a dict
+	end
+;
+
+
+(* partial order on strings *)
+structure STRING:ORDER=
+	struct
+		type t = string
+		fun lessthan s1 s2 = (String.compare (s1, s2))=LESS
+	end
+;
+
+
+(* BST implementation of functional dictionary *)
+functor BSTDict(O:ORDER):DICTIONARY=
+	struct
+		type keyt = O.t
+		datatype 'a dictt =
+			NIL | NODE of ('a dictt)*(keyt*'a)*('a dictt)
+
+		exception EMPTY;
+		exception UNIMPLEMENTED;
+
+		fun add NIL k v = NODE (NIL, (k, v), NIL)
+		  | add (NODE (ld, (nk, nv), pd)) k v =
+		  	if (O.lessthan k nk)
+			then NODE (add ld k v, (nk, nv), pd)
+			else if (O.lessthan nk k)
+				then NODE (ld, (nk, nv), add pd k v)
+				else NODE (ld, (k, v), pd);
+		fun appright NIL d = d
+		  | appright (NODE (ld, (k, v), pd)) d =
+		  	NODE (ld, (k, v), appright pd d)
+		;
+		fun rm NIL k = raise EMPTY
+		  | rm (NODE (ld, (nk, nv), pd)) k=
+		  	if (O.lessthan k nk)
+			then NODE ((rm ld k) handle EMPTY=> ld, (nk, nv), pd)
+			else if (O.lessthan nk k)
+				then NODE (pd, (nk, nv), (rm pd k)
+							handle EMPTY=>pd)
+				else
+			let val NODE (lld, (lk, lv), lpd) = ld
+			in NODE (lld, (lk, lv), appright lpd pd) end
+		;
+		fun at NIL k = raise EMPTY
+		  | at (NODE (ld, (nk, nv), pd)) k =
+		  	if (O.lessthan k nk)
+			then at ld k
+			else if (O.lessthan nk k)
+				then at pd k
+				else nv
+		;
+		val empty = NIL;
+		fun iskey NIL k = false
+		  | iskey (NODE (ld, (nk, nv), pd)) k =
+		  	if (O.lessthan k nk)
+			then iskey ld k
+			else if (O.lessthan nk k)
+				then iskey pd k
+				else true
+		;
+
+		fun to_list' NIL og = og
+		  | to_list' (NODE (ld, (k, v), pd)) og =
+			(to_list' ld ((k, v)::(to_list' pd og)))
+		;
+		fun to_list l = to_list' l [];
+		fun from_list [] = empty
+		  | from_list ((k,v)::t) = add (from_list t) k v
+		;
+	end
+;
+
+
+(* functor converting functional dictionary into imperative dictionary *)
+functor fun2imp(D:DICTIONARY):IMPDICT=
+	struct
+		type key = D.keyt
+		type 'a dict = ('a D.dictt) ref
+		exception NOTFOUND
+		fun empty () = ref D.empty
+		fun add d k v = d:=D.add (!d) k v
+		fun mem d k = D.iskey (!d) k
+		fun find d k = D.at (!d) k
+		fun remove d k = d:=D.rm (!d) k
+		fun from_list l = ref (D.from_list l)
+		fun to_list d = D.to_list (!d)
+		fun copy d = ref (!d)
+	end
+;
+
+
+(* functor converting imperative dictionary into functional dictionary *)
+functor imp2fun(D:IMPDICT):DICTIONARY=
+	struct
+		type keyt = D.key
+		type 'a dictt = 'a D.dict
+		exception EMPTY
+
+		fun add d k v =
+			let val new = D.copy d
+			in D.add new k v; new end
+		fun rm d k =
+			let val new = D.copy d
+			in D.remove new k; new end
+		fun at d k = D.find d k
+		val empty = D.empty ()
+
+(* WARNING: `D.empty ()' is NOT truely polimorphic value,
+            while it should be ! *)
+
+		fun iskey d k = D.mem d k
+		fun to_list d = D.to_list d
+		fun from_list l = D.from_list l
+	end
+;
+
+
+
+structure STR = BSTDict(STRING);
+(* functional dictionary with type of keys `string' *)
+
+structure ISTR = fun2imp(STR);
+(* imperative dictionary with type of keys `string' *)
+
+structure STR' = imp2fun(ISTR);
+(* functional dictionary based on previous one *)
+
+
+(* because we know that values of our functional dictionary
+   from STR' structure are in fact values of imperative dictionary
+   from ISTR structure, we can write something like that *)
+
+ISTR.add STR'.empty "int" 1;
+
+(* but now the real value of STR'.empty loses its polymorphism !!!
+   in signature it is still polymorphic *)
+
+
+(* so we can write something like that *)
+
+STR'.add STR'.empty "str" "str";
+
+(* witch causes `Segmentation fault'
+   because STR'.empty is in fact `int dictt',
+   but it is considered to be `'a dictt' *)
diff -Nru mosml-2.01/src/notes/TODO mosml-2.10.1/src/notes/TODO
--- mosml-2.01/src/notes/TODO	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/notes/TODO	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,2108 @@
+2000-01-18:
+
++ The amlazy file Data.sml containing a structure called Data: parse
+  as AnonStruct, then resolve in the compiler
+
+* Avoid shift/reduce and reduce/reduce conflicts in the parser.
+
++ Documentation: 
+
+  - manual
+  - syntax
+
++ Emitcode: switch larger than 256 ?  OK because the switch
+  compilation in Back breaks switches into chunks of size < 256
+
++ Kit: It is functor Parse in k42.sml that causes trouble --- even
+  when actions in k32.sml is commented out.  Functor Parse is declared
+  in k35.sml.  More precisely, the application of functor GrammarUtils
+  inside the Parse functor in k35.sml:
+
+    structure GrammarUtils =
+      GrammarUtils (structure TopdecGrammar = TopdecGrammar
+		    structure LexBasics = LexBasics
+		    structure ParseInfo = ParseInfo
+		    structure Report = Report
+		    structure PrettyPrint = PrettyPrint
+		    structure Crash = Crash
+		      )
+  Functor GrammarUtils is declared in k32.sml.
+ 
+  Problem: open of local decs.
+
++ Back.sml -- array size 65000 -> 4000 (used only for the locals of 
+  the init code)
+
++ Size of mosmllex and mosmllnk: avoid linking in Types
+
++ exnName and exnMessage -> runtime
+
+  prim_val exnname : exn -> string = 1 "sml_exnname";
+
+  prim_val exnMessage : exn -> string = 1 "sml_exnmessage";
+
++ Add documentation to General.fke
+
++ Implement sharing of literals (strings, reals, etc) as globals cf
+  the hol98 and cholera problems: Updated Patch and Reloc and Code_dec
+  and Link.
+
++ Cleanup of the dynlibs; moved stable structures to src/mosmllib
+
++ Fix mgd dynlib to use new GD package and PNG format.
+
++ Fix mosmllib/test/Makefile to create sym- and hardlinks as needed
+
++ Fix errormessage in compiler/Emitcode
+
++ Fix printing of overloaded ops to distinguish num, numtxt etc
+
+* Fix exn tag access under lambda in Match.sml
+
+* In general, compile better code for accessing subvalues in matches.
+  However, should never evaluate accesses that aren't needed (safe but
+  unnecessarily slow). The matching function may return an `envelope'
+  of let-bindings?
+
++ Include runtime system *.h files in distribution (for the sake of
+  user-written C code and dynlibs)
+
+* Perhaps fix mgdbm to use new GDBM?
+
++ Inexhaustive and redundant excon matches -- why not reported correctly?
+  Because EExn carries IdInfo as argument, and that includes the location 
+  of the identifier.  Of course no two identifier occurrences have the same 
+  location.  How fix it?  Translate the exnname accesses early, and
+  compare the access paths (the lambda code): equal access paths must
+  produce equal string refs...
+
+* Add an Odbc interface to unixODBC.
+  Later; possibly Thomas Iversen, DIKU/KVL.
+
++ .h files in mosml/include
+
++ make dynlibs/* refer to mosml/include
+
++ move .so files from mosml/bin to mosml/lib
+
++ strange bug in dynlibs/interface/ for Solaris.  Crashes.  Fails
+  test7, because it doesn't pass the fifth argument (a boolean)
+  correctly.  test 7 works if the number of arguments is reduced to 4.
+  test10 fails as well, why?  NON-BUG.  A symbolic link had been
+  extended by recursive file copying.
+
++ Non-blocking IO in TextIO.  input calls fast_input, which is
+  io.input in the runtime.  It calls getblock, which may call
+  really_read if necessary to obtain data not in the buffer; and
+  really_read calls Unix read.  This will raise sys_error in case Unix
+  read fails (cannot obtain any data).
+
+  Two solutions: (1) handle the SysError (and check that it is
+  EAGAIN), or (2) add an extra parameter to really_read so that it
+  avoids raising the SysError.
+
+  (1) is inefficient, 
+
+  (2) may be done as follows: Add a new boolean parameter `nonblocking' to
+  really_read.  If it is true, then use fcntl to change to
+  non-blocking (and back), and if read fails, return -1 instead of
+  raising sys_error.
+
+  void nonblocking_mode(int fd, int nonblocking) {
+    int retcode = fcntl(fd, F_GETFL);
+    if (retcode != -1) {
+      if (blocking) 
+        retcode = fcntl(fd, F_SETFL, retcode | O_NONBLOCK);
+      else
+        retcode = fcntl(fd, F_SETFL, retcode & (~O_NONBLOCK));
+    }
+    if (retcode == -1)
+      failwith("set_blocking_io");
+  }
+
+  static int really_read(int fd, char * p, unsigned n, int nonblocking) {
+    if (nonblocking)
+      nonblocking_mode(fd, TRUE);		/* set non-blocking   */
+
+    ...
+
+    leave_blocking_section();
+    if (nonblocking) {
+      nonblocking_mode(fd, FALSE);		/* unset non-blocking */
+      if (retcode == -1 && errno != EAGAIN)
+        sys_error(NULL);
+    } else if (retcode == -1)
+        sys_error(NULL);
+    return retcode;
+  }
+
+  Function input_scan_line must call really_read with nonblocking = false.
+
+  Add a new parameter nonblocking to getblock.  It must be passed on
+  to really_read.  Getblock must check whether really_read returns
+  -1, which should be treated the same as 0, except that it does not mean 
+  end of file:
+
+int getblock(struct channel * channel, char * p, unsigned n, 
+   int nonblocking)
+{
+  unsigned m, l;
+
+  m = channel->max - channel->curr;
+  if (n <= m) {
+    bcopy(channel->curr, p, n);
+    channel->curr += n;
+    return n;
+  } else if (m > 0) {
+    bcopy(channel->curr, p, m);
+    channel->curr += m;
+    return m;
+  } else if (n < IO_BUFFER_SIZE) {
+    l = really_read(channel->fd, channel->buff, IO_BUFFER_SIZE, nonblocking);
+    if (l == -1) /* Non-blocking read returned no data */ 
+      return -1;
+    else {
+      channel->offset += l;
+      channel->max = channel->buff + l;
+      if (n > l) n = l;
+      bcopy(channel->buff, p, n);
+      channel->curr = channel->buff + n;
+      return n;
+    }
+  } else {
+    channel->curr = channel->buff;
+    channel->max = channel->buff;
+    l = really_read(channel->fd, p, n, nonblocking);
+    if (l == -1)	/* Non-blocking read returned no data */ 
+      return -1;
+    else {
+      channel->offset += l;
+      return l;
+    }
+  }
+}
+
+Function input will just call getblock with non-blocking = FALSE:
+
+value input(value channel, value buff, value start, value length) /* ML */
+{
+  return Val_long(getblock((struct channel *) channel,
+                           &Byte(buff, Long_val(start)),
+                           (unsigned) Long_val(length),
+	                   /* nonblocking = */ FALSE));
+}
+
+
+
+Make really_getblock call getblock with nonblocking=FALSE:
+
+int really_getblock(struct channel * chan, char * p, unsigned long n)
+{
+  unsigned r;
+  while (n > 0) {
+    r = (unsigned)getblock(chan, p, (unsigned) n, /* nonblocking = */ FALSE);
+    if (r == 0) return 0;
+    p += r;
+    n -= r;
+  }
+  return 1;
+}
+
+
+  Add a new function input_nonblocking, which will call getblock with
+  nonblocking=TRUE.  Returns NONE if getblock returns -1, otherwise 
+  returns SOME 
+
+value input_nonblocking(value channel, value buff, value start, value length) /* ML */
+{ int n = getblock((struct channel *) channel,
+                   &Byte(buff, Long_val(start)),
+                   (unsigned) Long_val(length),
+	           /* nonblocking = */ TRUE));
+  if (n == -1)		/* Non-blocking read returned no data */ 
+    return Val_NONE;
+  else {
+    value res = alloc(1, SOMEtag);
+    Field(res, 0) = Val_long(n);
+    return res;
+  }
+}
+
+  
+* 2000-03-15 Ken: Parametre til lexer-funktioner
+
+  rule comment depth = parse ...
+
+  for at kunne lave en rent funktionel lexing af indlejrede kommentarer.
+
++ 2000-03-28: Add a parser combinator module called Parse.
+  Reimplement to use NONE/SOME instead of exceptions.  
+
+  Add a formatting (unparsing) module called Format, using Olivier's
+  ideas but avoiding repeated string concatenation (e.g. using a
+  wseq-like structure) and having also a prsep style
+  iterator-with-separator plus an prmap style iterator.
+
+  May 2000: Decided to create mosml/example/parsercomb instead, as the
+  parser combinator stuff seems too volatile.
+
++ Meta.fke;  remove Meta.system
+
++ Meta.fke; documentation
+
++ Lexing.sig
+
++ Parsing.sig
+
++ mosmllib/README
+
++ TextIO.scanStream -- get rid of cs? -- no: cannot
+
+* Should gc time be subtracted from sys time?  (Timer, Mosml)
+
+* Non-blocking IO should have a function canInput : int -> SOME int instead.
+
+http://www.dina.kvl.dk/~sestoft/sml/imperative-io.html#IMPERATIVE_IO:SIG:SPEC
+
++ 2000-04-26: Michael Norrish: this crashes mosml 1.44 (and 1.99):
+
+datatype 'a result =
+    FIRST of 'a
+  | SECOND of 'a;
+val zz = case FIRST() of
+    FIRST _ => ()
+  | _ => ();     
+
+while this works:
+
+val z = case SECOND() of
+    FIRST _ => ()
+  | _ => ();
+
+compiler/Rtvals.sml function prSeq; decode_obj thinks zz is a record
+of length 1.  Why?  Has nothing to do with the polymorphism of result.
+
+And really, the *representation* of the result is wrong; here zz
+evaluates to false:
+
+datatype result =
+    FIRST of int
+  | SECOND of int;
+val zz = () = (case FIRST 1 of
+    FIRST _ => ()
+  | _ => ());     
+
+The generated lambda code looks OK:
+
+(prim (set_global Top.zz/3) 
+	(prim (ccall2 sml_equal) (BLOCK 0:1 ) 
+	      let (BLOCK 0:2 1) in 
+	          ((switch:2 var:0 of 
+	              0:2 : (BLOCK 0:1 )) 
+	            statichandle (BLOCK 0:1 )) 
+              end))
+
+But the Kcode is wrong:
+
+(BLOCK 0:1 ); 
+push; 
+(BLOCK 0:2 1); 
+push; 
+access 0; 
+strictbranchifnot 1; 
+branch 2; 
+label 2; (BLOCK 0:1 ); 
+label 1; pop 1; 
+ccall2 sml_equal;
+set_global Top.zz/1
+
+Problem: the returned value is the argument of FIRST (which is a block
+of length 1 in this case): nothing is pushed between strictbranchifnot
+1 and branch 2.  Probably we forget to generate code to put unit in
+the accumulator???  Back.sml line 721, optimization for the case where
+the else-branch is a constunit ().  In that case, then other branches
+are () too (but may have side effects).
+
+The problem is caused by an optimization in the compiler backend, file
+compiler/Back.sml line 721.  If you want to get rid of it, uncomment
+this code:
+
+         (* if ifnot = Lconst constUnit
+            then let val (lbl, C1) = labelCode C
+                 in Kstrictbranchifnot lbl :: compexp sz dp ifso C1 end
+            else *)
+
+I'm afraid I introduced this optimization in 1997.  The reasoning was
+that if some branch of a switch evaluates to () : unit, then all
+branches do, and they are evaluated only for their side effects.  Not
+so.  
+
++ 2000-04-26: Constructor ordering.  Constructors should be sorted
+alphabetically so that the ordering in datatype declarations doesn't
+matter.  That is, this should elaborate:
+
+     signature SIG = 
+     sig
+	 datatype 'a t = Bt | Ct of int
+	 datatype 'a u = Cu of int | Bu 
+     end
+
+     structure S: SIG = 
+     struct
+	 datatype 'a t = Ct of int | Bt
+	 datatype 'a u = Bu | Cu of int
+     end
+
+     structure G : sig datatype order = EQUAL | GREATER | LESS end = General;
+     structure G : sig datatype order = GREATER | EQUAL | LESS end = General;
+
+   - should reorder the pervasive datatypes (order and frag) in Types.sml:
+
+and infoEQUAL = mkSML "EQUAL"
+  { conArity=0,   conIsGreedy=false,   conTag=0,   conSpan=3,
+    conType=sc_order }
+and infoGREATER = mkSML "GREATER"
+  { conArity=0,   conIsGreedy=false,   conTag=1,   conSpan=3,
+    conType=sc_order }
+and infoLESS = mkSML "LESS"
+  { conArity=0,   conIsGreedy=false,   conTag=2,   conSpan=3,
+    conType=sc_order }
+and infoANTIQUOTE = mkSML "ANTIQUOTE"
+  { conArity=1,   conIsGreedy=false,   conTag=0,   conSpan=2,
+    conType= scheme_1u (fn a =>
+      type_arrow a (type_frag a)) }
+and infoQUOTE = mkSML "QUOTE"
+  { conArity=1,   conIsGreedy=false,   conTag=1,   conSpan=2,
+    conType= scheme_1u (fn a =>
+      type_arrow type_string (type_frag a)) }
+
+val initial_order_CE = ConEnv [infoEQUAL, infoGREATER, infoLESS];
+val initial_frag_CE = ConEnv [infoANTIQUOTE, infoQUOTE];
+
+   - fix the corresponding extraction code in Smlperv.sml:
+
+val [infoFalse, infoTrue] = deConEnv initial_bool_CE
+and [infoNil, infoCons]   = deConEnv initial_list_CE   (* NOTE: NOT sorted *)
+and [infoNONE, infoSOME]  = deConEnv initial_option_CE
+and [infoEQUAL, infoGREATER, infoLESS] = deConEnv initial_order_CE
+and [infoANTIQUOTE, infoQUOTE] = deConEnv initial_frag_CE
+
+   - do we need to change only the conTag fields, or also the
+     initial_frag_CE etc (as above)?  Better order both.
+
+   - the bool and option datatypes are sorted already
+
+   - we do *not* fix the list datatype, since the constructors
+     nil and :: may not be respecified or redeclared.
+
+   - there is no corresponding runtime system code
+
+   - should reorder the constructors in mosmllib:
+
+	open_flag: BasicIO, BinIO, Nonstdio, TextIO
+        and runtime/sys.c variable sys_open_flags
+
+	dbresultstatus: Mysql, Postgres
+        and dynlibs/mmysql/mmysql.c function db_resultstatus
+        and dynlibs/mpq/mpq.c  
+
+	parserInput and parserOutput: Parsing
+        and the macroes START, TOKEN_READ, ... in parsing.c
+
+   - mosmlyac must sort the tokens (the token datatype), because the 
+     token tags are used as indexes into the parsetable, in parsing.c 
+     line 97. 
+
+   - dynlibs/interface/smlside.sml and cside.c: datatype t
+
+   - sort constructors in declarations as well as specifications:
+     uncomment line 1865 in Elab.sml, function elabDatBind (this takes 
+     care of declarations as well as specifications).  
+
+   - loading of libraries crashes because hashtables
+     (Hasht) are used to represent signatures, and the mosmllib stuff 
+     was compiled with one constructor ordering in Hasht, and are loaded 
+     with another ordering.
+
+   - Sort tokens in the parsers generated by mosmlyac.  Strangely, hand-
+     sorting the tokens in compiler/Parser.grm makes mosmlcmp shorter
+     by 1 K.  Should do the same to lex/Grammar.grm of course.  How
+     make mosmlyac sort tokens?  Tokens are stored in the same
+     (hashed, linked) symbol table as other grammar symbols.  The tag
+     of a token is used only as an index into the table yytransl, it
+     seems (parsing.c line 97).  Hence it suffices to (1) sort the  
+     tokens (by symbol_value) and their adapt the indexes (symbol_value). 
+
+   - constructor sorting affects user programs that use 
+     Nonstdio.{input_value, output_value}, string_mlval, mlval_string, 
+     and hence Polygdbm
+
+Bootstrapping:
+
+(1) Modify the core mosmllib .sml files and recompile.  The new
+compiler must be run with a new runtime system.  
+(2) Recompile with new compiler and runtime system.  Binaries should be 
+identical.
+(3) Fix Types and Smlperv.  Does not affect runtime.  Bootstrap.
+(4) Enable constructor sorting, reorder Hasht.bucket constructors, 
+sort tokens in grammar specifications.
+(5) Fix Mysql, Postgres, and their C code.
+(6) Fix dynlibs/interface
+
++ Check that it compiles with Solaris, HP-UX, Linux/Alpha, ...
+
++ Change version to 2.00 (June 2000)
+
++ Make -quietdec more quiet; drop the welcome greeting.
+
+* Size of .ui files: sharing?
+
++ Problem compiling on LinuxPPC
+
+2000-07-01:
+
++ (Don't do, this is a gcc macro extension)
+ 
+  There is no snprintf on HPUX (it is a GNU-libc-extension),
+  so I said in mosml.h
+
+#define snprintf(dest, n, format, args...) sprintf(dest, format , ##
+args)
+
+   (all on a single line, the space before the last comma is
+   necessary).
+   This works with gcc (var-arg macros are another GNU extension,
+   but in the compiler, which is what I have).
+   I don't know whether mosml.h is a good place to put this line,
+   but this file is just included by those *.c who use snprintf.
+   Maybe the config stuff should check for it's existence
+   (or even provide an implementation for people with crippled
+   libcs).
+
++  src/doc/helpsigs/Makefile redefines MOSMLHOME, overriding
+   a possibly different value from src/Makefile.inc.
+
++  install.txt says in (8) to look for dynlib stuff in (4),
+   but this is in (5). I think the upper items were renumbered
+   without incrementing the reference.
+   [Not a mistake, but unclarity]
+
+2000-08-07: 
+
+* Binarymap (and Binaryset etc) based on Doug's Bin234map.
+  Should admit interval queries a la sml/besked/Datemap:
+
+   datatype 'key interval =
+       All
+     | From of 'key
+     | To of 'key
+     | FromTo of 'key * 'key
+
+   val getAll : ('key, 'a) dict * 'key interval -> ('key * 'a) list
+
+  such that  getAll dict All  is  equivalent to  listItems dict.
+
+  The complexity of getAll dict intv should be O(log(N) + M) where N
+  is the number of items in the dict, and M is the number of items in
+  the answer.
+
+  Also useful:
+
+  val getMin : ('key, 'a) dict * 'key interval -> ('key * 'a) option
+  val getMax : ('key, 'a) dict * 'key interval -> ('key * 'a) option
+
+  which return the element with the least (resp. the largest) key in
+  the interval, if any.  Thus
+
+  getMin dict intv = (SOME (List.hd (getAll dict intv)) handle Empty => NONE
+  getMax dict intv = (SOME (List.last (getAll dict intv)) handle Empty => NONE
+
+  But the complexity of getMin dict intv and getMax dict intv should
+  be O(log(N)) where N is the number of items in the dict.
+
+  Also useful: a general lookup/insert/update/delete function 
+   val peekMap : ('key, 'a) dict * 'key * ('a option -> 'a option) -> unit
+  such that 
+
+	peekMap(d, k, f) computes res = f(SOME v) if k is in dict with
+        value v, and computes res = f(NONE) otherwise.  Subsequently, if 
+	res = SOME r, it inserts/updates k in dict to r, and if res = NONE, 
+	removes k from dict.
+
+* Httpclient module
+
+* Inet name queries etc
+
+* 2000-08-10 #line comments for machine-generated mosml code:
+
+--------------------------------------------------
+From: Norman Ramsey 
+
+I wonder if there's any chance of supporting some form of #line numbering.
+Objective Caml supports the C style, i.e., 
+
+# 27 "bits.nw"
+
+ 
+Here is the style we have used in STandard ML of New Jersey:
+
+(*#line 182 "mlscheme.nw"*)type name = string
+type 'value simplemap = (name * 'value ref) list
+val emptyMap : 'a simplemap = []
+
+
+I'd be delighted if there were some way to get one of these
+conventions, or a similar convention, into Moscow ML.
+Do let me know what you think.
+--------------------------------------------------
+
+One way to implement this (2000-08-11): Maintain a table of the source
+positions (byte offsets) at which #line directives occur (could be a
+dynamic array; the positions would automatically be sorted increasing
+and thus be suitable for binary search).  Whenever a message with
+start and end locations xL and xR is to be emitted, look up the most
+recent #line directive at or preceding xL.  Scan the source file until
+xL, then reset the line counter to the line number indicated by that
+#line directive and set the filename, then continue as usual.  This
+ignores any #line directives between xL and xR.
+
+The lexer should recognize the special comments of form 
+(*#line n... "x..."*) 
+where n... is a non-negative decimal number, x... is a string of
+characters (in which an occurrence of *) is taken to be part of the
+file name, presumably?).  In SML/NJ nothing can separate the terminal
+quote (") and the asterisk (*) in the closing comment bracket.
+
+?1 Must a #line directive appear at the very beginning of a line?  In
+   SML/NJ: yes (but this makes lexing 
+
+?2 Should a #line directive inside a comment be ignored?  In SML/NJ: yes.
+
+* IntInt.int should be an equality type
+
+* mosmlyac generates non-sml compliant signatures (local in end)
+
+* 2000-09-22 Jeremy Dawson:
+
+- datatype thing = / of int * int ;
+datatype thing = / of int * int
+- infix / ; 
+infix /
+- 1 / 2;
+val it = 1 / 2 : thing
+
+I find the SML/NJ output easier.
+Would it be worth considering for MosML?
+
+
+* 2000-09-22 Jeremy Dawson:
+
+The command 
+mosmlc -c a.sml b.sml c.sml d.sml e.sml f.sml g.sml h.sml i.sml j.sml
+compiles all these files, in such a way that
+load "j" ; 
+loads all the others even though it doesn't depend on them.
+Is there a reason for this?
+If so, could the fact be mentioned in the documentation?
+(At present, when load "x" can cause behaviour that bears no relation
+to anything in x.sml or any other unit that x depends on,
+which is very difficult to diagnose).
+
+* 2000-10-04 Jakob Lichtenberg:
+
+Output fra mosmlc -standalone kan ikke meningsfuldt strippes, idet
+strip fjerner al bytekoden, saa kun camlrunm bliver tilbage!
+
+Find ud af hvordan ELF-formatet er opbygget, og saet stoerrelsen
+korrekt, saa strip ikke mutilerer den linkede fil.  See GNU binutils in info.
+
+Maaske 
+	objcopy --add-section BYTECODE= camlrunm mosmlout
+
+Nej, duer ikke, for der ligger noget indeksinformation i enden af en
+ELF fil...
+
+Maaske der findes en C-funktion til at laese et navngivet segment fra
+en linket fil, f.eks. et segment kaldet BYTECODE.
+
+size -A mlsexe kan fortaelle hvor store de enkelte sektioner er.
+
+* 2000-10-20:  SML Basis Library 
+
++ zillions of changes already made
++ Word8Array, CharArray   -- remove and simplify
++ Word8Vector, CharVector -- remove and simplify
++ test/vector.sml -- many missing cases
++ Word8ArraySlice, CharArraySlice -- add
++ Word8VectorSlice, CharVectorSlice -- add
++ Negative Time values -- how?  Use reals, represent time as 
+  whole number of microseconds since the epoch (possibly negative).  
+  This gives exact times in a range of 2^52 = 4.503.599.627.370.496, 
+  that is, microsecond resolution from 1828 till 2112.
+* Extended date offset range?
++ ~ (ones-complement) in Word, Word8
++ Timer -- do not include GC time, add new function
++ Process.status not equality type
+* Unix structure -- various changes
+
+
++ 2000-10-20: Mosml library
+
+Further unify Mysql and Postgres signatures; must match a common Db
+signature.
+
+* 2000-10-31: Stephen T Weeks (comp.lang.ml)
+Date: 30 Oct 2000 15:17:52 GMT
+
+There's definitely some differences amongst SML implementations
+regarding type specifications in signatures.  Consider the following
+two programs.
+
+(* program 1 *)
+signature S =
+   sig
+      type t
+      and u = int
+   end
+
+(* program 2 *)
+signature S =
+   sig
+      type t = int
+      and u = t
+   end
+
+According to the Definition (pages 14, 35 (rule 80), and 59 (figure
+19)), program 1 should be rejected as a syntax error and program 2
+should be accepted (because of the expansion explained in the previous
+post.  Here's a comparison of five different SML implementations on
+the two programs.
+
+The Definition		reject	accept
+
+ML Kit Version 3	reject	accept
+MLton 20000906		accept	reject
+Moscow ML 2.00		reject	reject
+Poly/ML 4.0		accept	reject
+SML/NJ 110.0.6		accept	accept
+SML/NJ 110.29		accept	accept
+
+As you can see, all four possibilities are achieved.
+
+Of the five compilers, only the ML Kit gets both programs right,
+Moscow ML and SML/NJ get one right (and disagree with each other), and
+MLton and PolyML get both wrong.
+
++ Exception Option should be available in the top-level by default.
+  Should go in src/compiler/Smlperv.sml and in runtime/globals.h
+  Fixed Jan 2001.
+
+* 2001-02-16: Dynamic linking under MacOS X.  See man ld, man dyld.
+
+  cc -dynamiclib?
+
+  #include 
+  
+  Documentation/DeveloperTools/Compiler
+
+  man 3 dyld
+
++ 2001-02-27: Ken: Jeg mener at foelgende funktion er hale rekursiv,
+men Mosml er ikke enig med mig (den oversaetter iht det rekursive kald
+til fitting til et apply):
+
+--------
+fun fitting [] left          = true
+  | fitting (s :: rest) left = 
+    left >= 0 andalso
+    (case s of
+         "\n" => true
+       | _    => fitting rest (left - size s))
+--------
+(og ligeledes med orelse)
+
+Ã…rsag: I kodegenereringen for Landalso og Lorelse i Back.sml mangler
+der det tilfælde hvor oversættelsestids-continuation starter med
+Klabel :: Kreturn _ :: ... 
+
+Fixed by updating addPop to handle the case where C is Klabel :: Kreturn.
+
+* 2001-04-02: Streamline the (Basis Library) test cases so that they
+  can be effectively used also by the ML Kit.
+
+  Avoid inclusion by `use'.  Instead open Testaux and open other
+  needed structures.  Batch compile the test files, and load them to
+  produce the test output.  Rename check' to check, and give it
+  one more argument: a string indicating the name of the test.
+
+* 2001-05-11: Ken 
+
+  I've made a new mosml windows installer it is available from:
+        http://www.it.edu/~kfl/tmp/mosml-setup-2_00.exe
+ 
+ I've tested it on my laptop with windows 2000 where it seems to work
+ fine, and I would like if you could help me testing it like last time.  
+
++ 2001-05-22: Date: 21 May 2001 14:28:31 +0200
+              From: Martin Elsman 
+Subject: Int overflow
+
+Hej Peter,
+
+Jeg har modificeret koden til scanning og formattering af små
+heltalskonstanter således at Overflow ikke forekommer, som i følgende
+session:
+
+  mael@daffy> mosml -P full
+  Moscow ML version 2.00 (June 2000)
+  Enter `quit();' to quit.
+  - Int.fmt StringCvt.DEC (valOf Int.minInt);
+  ! Uncaught exception: 
+  ! Overflow
+  - Int.fmt StringCvt.BIN (valOf Int.minInt);
+  ! Uncaught exception: 
+  ! Overflow
+  - Int.fromString "~1073741824";
+  ! Uncaught exception: 
+  ! Overflow
+  - 
+
+Funktionen conv i strukturen Int ændres til:
+
+  fun conv radix i =
+    if SOME i = minInt then          (* Be careful not to Overflow *)
+      let fun tag s1 s2 = if precision = SOME 31 then s1 else s2
+      in case radix
+	   of 2 => tag "~1000000000000000000000000000000" "~10000000000000000000000000000000"
+	    | 8 => tag "~10000000000" "~20000000000"
+	    | 10 => tag "~1073741824" "~2147483648"
+	    | 16 => tag "~40000000" "~80000000"
+	    | _ => raise Fail "conv"
+      end
+    else
+      let fun h 0 res = res
+	    | h n res = h (n div radix) (prhex (n mod radix) :: res)
+	  fun tostr n = h (n div radix) [prhex (n mod radix)]
+      in implode (if i < 0 then #"~" :: tostr (~i) else tostr i) 
+      end
+
+Funktionen dig1 i strukturen Int ændres til:
+
+    fun dig1 sgn NONE = NONE
+      | dig1 sgn (SOME (c, rest)) =
+      let fun digr (res:int) next_val src =
+	case getc src
+	  of NONE => SOME (res, src)
+	   | SOME (c, rest) => if isDigit c then digr (next_val(factor, res, hexval c)) next_val rest
+			       else SOME (res, src)
+	  val next_val =
+	    if sgn = 1 then fn (factor, res, hv) => factor * res + hv
+	    else fn (factor, res, hv) => factor * res - hv
+      in if isDigit c then digr (sgn * hexval c) next_val rest else NONE 
+      end
+
+
+ * 2001-05-15: the binaries for MacOS X [Version 2.00 for Macintosh
+PPC with MacOS X (without dynamic libraries)] and they fail with the
+following error:
+ 
+matt@mec30:~/Downloads/mosml/bin $ ./mosml
+./mosml: no such file or directory: /Users/lcp/mosml/bin/camlrunm [11]
+                                                
+ * 2001-05-25: From: Konrad Slind 
+
+Surprised I was, when a student sent me this, in contradiction of
+something I said in a supervision:
+ 
+    Moscow ML version 2.00 (June 2000)
+    Enter `quit();' to quit.
+    - fun f g g = g;
+    > val ('a, 'b) f = fn : 'a -> 'b -> 'b
+ 
+[Presumably wrong according to the Definition's appendix on derived
+forms]
+
+ * 2001-05-17: jeremy@discus.anu.edu.au
+
+ON page 8, (sec 3.4), under description of loadPath,
+it says (2nd sentence)
+This variable affects the load, loadOne and use functions.
+ 
+It seems from my experiments that it also affects the
+compile, compileStructure and compileToplevel functions.      
+
+
+ * 2001-05-25: Ken Friis Larsen 
+ 
+I've found a small bug in mosml's handling of signatures.  This should
+be correct SML:
+ 
+signature COL = sig type elem type col end
+signature INTCOL1 = COL where type col = int list
+                       where type elem = int
+signature INTCOL2 = COL where type elem = int
+                        where type col = int list
+signature INTERM = COL where type elem = int
+signature INTCOL3 = INTERM where type col = int list    
+
+ * 2000-06-05: Henning Makholm:
+
+Could future versions of mosmlyac please take a consistent stance
+about whether they support rules without actions? The current one
+glefully processes the grammar file without error, but produces a
+parser that raises Fail when it tries to reduce the actionless rule.
+ 
+If the nonterminal has a type definition, mosmlyac warns that the
+default action produces an undefined value - in reality the default
+action (used in the definition of yyact in the generated gode) throws
+an exception. If the nonterminal does not have a type defintion
+(as in the typescript below), no warning at all is produced - but
+the default action still throws an exception...   
+
+$ cat foo.grm
+%{
+%}
+  %token FOO
+  %type  S
+  %start S
+%%
+  S : T { 42 } ; T : FOO ;
+%%
+$ cat bar.sml
+val _ = foo.S (fn _ => foo.FOO) (Lexing.createLexerString "")
+$ mosmlyac -v foo.grm
+$ mosmlc foo.sig foo.sml bar.sml
+
+* 2001-06-08:jeremy@discus.anu.edu.au   
+
+Last year I emailed you about what turns out to be a related
+problem - I'd assumed that
+mosmlc -c A.sml B.sml C.sml
+would do the same as
+mosmlc -c A.sml
+mosmlc -c B.sml
+mosmlc -c C.sml
+but in fact fake dependencies were introduced there also.    
+I wonder if this issue warrants a mention in the documentation.
+
+* 2001-06-11: Michael Norrish    
+
+The system-administrators here dislike the fact that the mosml2.0 RPM
+ 
+  "installs files into /usr/bin and /usr/mosml and is not
+  relocatable."
+ 
+Rather than use this, they then installed the binary version, without
+then setting things up as per the instructions, and what they've
+installed doesn't work well.
+ 
+Also, the instructions at
+ 
+  ftp://ftp.dina.kvl.dk/pub/mosml/install-linux.txt
+ 
+don't say anything about the symbolic link at /lib/camlrunm,
+which seems to be used when linking.                 
+
+[The latter is an RPM-problem / Peter]
+
+* 2001-06-21: Martin Elsman 
+
+Det ser ud som om Moscow ML ikke binder Option og Span som exception
+konstruktører på top-niveau, som foreskrevet i
+ 
+  http://www.dina.kvl.dk/%7Esestoft/sml/top-level-chapter.html
+
+* 2001-07-17:  Stephen Weeks 
+ 
+Mosml accepts the following program.  It should report an error because x is
+bound twice in the same valbind.
+ 
+val x = 13
+and rec x = fn () => ()     
+
+* 2001-08-02: PS to check up on Buffer.{sig, sml} from Ken.
+
+* 2001-08-02: PS to check up on Ken's red-black tree implementation.
+              Compare with Doug's 2-3-4 maps.
+  2001-10-15:
+ 
+   Add interval operations (done, but not tested).
+   Add hash codes.
+   Ensure reasonable naming schemes, short names:
+
+    Rbset, Rbmap		functional (persistent)
+    Hashset, Hashmap		imperative
+
+   Create an SML version of the nfa-to-dfa conversion procedure, using
+   a hashmap of treesets etc.
+
+  Bugs found:
+   isSubset was wrong for empty first arg and non-empty second arg
+
+* 2001-08-14: Michael Norrish, email
+
+  There doesn't seem to be any nice way of finding the key of a
+  Binary map that maps to the least value (say the range is int).
+  
+* 2001-10-18: Michael Norrish: 
+
+  * enable call to system prettyprinter from installed prettyprinters,
+
+    This is best done by introducing a pseudopolymorphic function 
+
+	Meta.fmtVal : 'a -> (ppstream -> unit) -> unit
+ 
+    that takes as argument a value and a ppstream and prints on that, 
+    exactly as Rtvals.prVal (which implements printVal) already does.
+
+    The most sensible thing would be to pass the PP.ppstream to prVal
+    and all its helpers, and replace msgString etc from Mixture with
+    appropriate function calls.  This is a bit tedious but perfectly
+    doable.
+
+  * prettyprint infix constructors as infix
+
+    This should be done in the very last branch of prVal, checking for
+    arity = 2 and using Units.pervasiveInfixBasis to look up the
+    fixity of the constructor.  I wonder whether the prior logic in
+    prVal would handle right-associative operators correctly?  If it
+    doesn't, that just means there will be excess parentheses in some
+    cases.  The prior precedece logic of prVal would need to be fixed
+    to fit the precendece actually use in SML.
+
+* 2001-10-29 Don Sanella:
+
+> According to the Moscow ML library documentation, various functions
+> in TextIO may raise the exception Io.Io.  According to the SML Basic
+> Library that is supposed to be IO.Io.  There appears to be a library
+> module called IO, since    load "IO"    doesn't complain, and it
+> contains an exception IO.Io, but there is no section about the IO
+> module in the Moscow ML library documentation.
+   
+* 2001-10-29 Michael Norrish:
+
+It would be very nice to have a time-out function available.
+Something like
+ 
+  timeout : time -> ('a -> 'b) -> 'a -> 'b
+ 
+which raises an exception if the time allotted expires.
+ 
+This would make proof strategies that combined black-box components a
+positive pleasure to write.  It would need to work both interactively
+and in compiled code.
+ 
+Also, it would be nice to have the magic (involving prim_val) that
+makes the Interrupt exception "work" in executables (i.e., catches       
+Ctl-C) properly documented.
+ 
+Currently I just copy
+ 
+  prim_val catch_interrupt : bool -> unit = 1 "sys_catch_break";
+  val _ = catch_interrupt true;
+ 
+from file to file without understanding what I'm doing.       
+
+* 2001-11-05 Nils Andersen: integer Overflow when computing ~32768*32768.
+
+* 2001-11-05 Konrad Slind: Is Splaymap.transform tail-recursive?  No.
+  Is the problem that the trees get very unbalanced?  Probably.
+
+* 2001-11-13: Delete Closure_wosize from mlvalues.h and from signals.h
+  (where an empty `env' is allocated; strictly speaking an
+  always-ignored () : unit, which is a mistake).
+
+* 2001 December: List of bugs compiled by Claudio and Peter at MSR:
+
+  * local_dec bug (level error)
+
+  * structure mode dec bug (level error)
+
+  * win32 mosmlc bugs
+
+  * local type projections grammar bug (int   )
+
+  * non-linear patterns  fun f a a = ...  should be forbidden
+
+  * Stephen Weeks type spec 
+
+  * incompleteness for recursive structures
+
+  * sig elaboration performance
+
+  * type explosion, datatypes copied
+
+  * MacOS X dynlib
+
+  * maps and sets in libraries
+
+  * parsing of numbers in scan (?)
+
+  * SML Basis Library (check updates)
+
+  * test cases, share with ML Kit and SML.NET as far as possible
+
+  * dynlib `examples' to be integrated with rest of mosml
+
+  * PM?
+
+  * Doug's mosmle?
+
+  * parser combinators to lib, plus an actual example use
+
+  * Windows installer (Jakob Lichtenberg or .msi? or ?)
+
+  * document or fix Dawson bug (*.ui)
+
+* 2001-12-17: Mosmlcgi and Mosmlcookie suggestions from Hans Molin.
+
+* 2001-12-26: Stanislaw Skowron, see skowron-bug.sml: excess
+  polymorphism leads to segmentation fault.
+
+* 2002-01-15: Binarymap desiderata.  
+
+  * Benchmark Ken's red-black vs Doug's 234-trees.
+ 
+  * Konrad wants a way to map a map to something else by a function f,
+    while preserving the key order.  A function such as 
+      remap : ('a -> 'c) * ('b -> 'd) -> ('a,'b)dict -> ('c,'d)dict 
+    which must be applied only to functions f that satisfy
+      compare1 k1 k2 = compare2 (f k1) (f k2)
+    where compare1 : 'a * 'a -> order and compare2 : 'b * 'b -> order
+    This should be done in linear time, not using inserts all over the 
+    place again.
+
+  * Ken suggests: The new key ('c) might depend on the data ('b).
+    Actually the type should be:
+ 
+        val genmap : ('c * 'c -> order) -> ('a * 'b -> 'c * 'd)
+                                        -> ('a,'b)dict -> ('c,'d)dict
+ 
+    because we need the new compare function to construct the result
+    dist.  If I should implement genmap for RB trees then I'd first
+    genrate a list of the mapped elements, check that the list is
+    sorted and then use fromSortedList.  But then I can be over
+    defensive in my (SML) programming.
+
+
+* 2002-02-22: Ordered map desiderata: From: Michael Norrish
+
+ 
+The various map datatype implementations in the mosml library should
+include a function to update a value at a particular key.  This would
+then save a traversal of the tree  (well, not in the case of Splay
+maps I guess).
+ 
+  val fupdate : ('a,'b) dict -> ('b -> 'b) -> 'a -> ('a,'b)dict
+ 
+This sort of thing is useful when maintaining a map of counts, where
+you want to be incrementing values all over the place.
+ 
+The most efficient alternative at the moment would seem to be a
+hashtable of references.
+
+* 2002-02-26: David.Richerby@cl.cam.ac.uk       
+
+I found the following in Moscow ML version 2.00 on a RedHat 7.1
+machine while trying to fix a broken program.  Consider the following,
+where [^D] on the sixth line indicates that I pressed ctrl-D at that
+point rather than return.
+ 
+$ mosml
+Moscow ML version 2.00 (June 2000)
+Enter `quit();' to quit.
+- fun app (f: int->int) x = f x;
+> val app = fn : (int -> int) -> int -> int
+- fun bug f x y = (app (app f x)) y;[^D]! Toplevel input:
+! fun bug f x y = (app (app f x)) y;
+!                       ^^^^^^^^^^^^
+! Type clash: expression of type
+!   int
+! cannot have type
+!   int -> int
+- quit();
+
+sestoft: The abstract syntax tree is annotated with source code
+positions which are used when reporting errors.  Somehow the end of
+the subtree (app f x) is wrong.  Probably this is due to some mistake
+in mosml/src/mosmllib/Parsing.sml or (more likely) in
+mosml/src/runtime/parsing.c.  I'll investigate.
+ 
+I've never encountered the problem myself, possibly because emacs
+always appends a newline at the end of source code files when saved.
+
+* 2002-04-08: MacOS X on swallow.al.cl.cam.ac.uk
+
+Compiler is cc, not gcc.
+
+Added option -traditional-cpp to CC.
+
+Added option -S to strip.
+
+~/bin is on PATH, but the shell needs a rehash to be able to find
+newly installed programs there.
+
+The mosmllib/test/filesys.sml tests test6e test6f test8d test8h fail
+because realpath and fullpath are too intelligent on MacOS X.  Changed
+the tests to accept the results.
+
+Dynamic linking is done using the dlcompat package from
+http://sourceforge.net/projects/fink/ which appears to be preinstalled
+in /sw/include and /sw/lib (but undocumented); it gives an interface
+similar to dlopen from Solaris/Linux.  
+
+Notes:
+
+ + If camlrunm is stripped, the symbols defined in it are not linkable.
+
+ + Files that are to be linked dynamically must be linked
+   using cc, not ld, otherwise symbol dyld_stub_binding_helper is
+   missing.
+
+ + The compiler (or linker?) inserts an underscore in front of
+   symbols it attempts to look up.  Wonderful.  This has been fixed by
+   a MacOS X specific version of dlsym() in runtime/dynlib.c.  We
+   recognize MacOS X as #if defined(__APPLE__) && defined(__MACH__)
+   and hope this is adequate.
+
+Now the crypt, interface, munix, mregex, msocket, mgdbm examples work.
+The remaining examples mgd mpq intinf mmysql require extra software.
+Callbacks work as well.
+
+* 2002-05-11: From slind@cs.utah.edu Sat May 11 03:59:14 2002
+
+  This is a rushed note about some things I have on my MoscowML wish
+list. Just thought I'd scribble them down before I forgot:
+
+  1. A type of SML abstract syntax trees, with a parser that produces
+     them.
+
+  2. An evaluator for such ASTs (something like NJSML's eval_string, or
+     whatever it's called). Something like
+
+      evalAST : AST -> unit
+
+     that wouldn't return values, but would evaluate the argument (in
+     the current environment) and update the current environment.
+
+  3. The left margin on the prettyprinter sometimes gets way too far
+     over on the page. I remember fixing the NJSML prettyprinter to
+     automatically reset the left margin once it got past 2/3 of the
+     width of the page.
+
+For 1,2 the motivation is that HOL is a collection of libraries sitting
+on top of ML. One of those libraries lets me define (total) logical
+functions that look like ML programs (with pattern matching, etc). I'd
+like to be able to generate ML code for these within a session. I have a
+hack using references and writing to files and calling "use", but that
+of course only works interatively. Hmm, I've got to go now, but will try
+to write more coherently tomorrow.
+
+2002-07-25: The Postgres interface now works with PostgreSQL 7.2
+provided databases are created with LATIN1 or another 8-bit encoding,
+and recognizes the int8 type (returned by COUNT).
+
+* 2002-08-19: Kenneth MacKenzie 
+ 
+Hi Kenneth (Peter),
+ 
+Oh dear, that's an embarrassing grammatical bug. I do remember wondering if
+the absence of parentheses for signatures would bite me sometime, but I didn't
+look hard enough for counter-examples.
+ 
+Yes, I do have some pull with the implementors (technically, I'm still one of
+them, but I never seem to find the time and I haven't pulled my weight for a
+long while.)
+ 
+About the error message, I think its supposed to read that the type of the
+expression is found to be bool, but expected to be int from the context. I      can't remember if the compiler order them consistently or not.
+I'm forwarding the message to Peter too, for the record.
+ 
+-c
+ 
+-----Original Message-----
+From: Kenneth MacKenzie [mailto:kwxm@dcs.ed.ac.uk]
+Sent: 19 August 2002 14:58
+To: Claudio Russo
+Subject: Moscow ML
+ 
+Hi Claudio,
+   I just remembered that when you were up here I was complaining
+  about some problem I'd had with the Moscow ML syntax.  Here's the
+problem.
+ 
+Suppose you have
+ 
+   signature S = sig type t val x:t end;
+ 
+Then you can have the opaque functor signature
+ 
+   signature FSIG = functor (A: S where type t = int) -> S;
+ 
+and Moscow ML accepts it without complaining.  However,  if you
+attempt to make this into a transparent signature
+ 
+   signature FSIG' = functor A: S where type t = int -> S;
+ 
+then you get a syntax error,  presumably because the parser thinks
+that you're trying to refer to a type t = (int->S).  I wasn't able to           find any way of getting round this (and by now I've forgotten whether
+it makes any sense to have type constraints in a transparent
+signature).  It's not a huge problem,  but it does seem that using
+presence/absence of parentheses to denote different types of
+signatures means that you can't use parentheses to make sure that
+things have the correct precedence.
+ 
+By the way,  do you have any influence with writers of Moscow ML?
+I've found Moscow ML to be really useful,  but the messages that you
+get for type errors are really frustrating.  If you type
+ 
+   fun f x = x+1; f true;
+ 
+then you get
+ 
+! Toplevel input:
+! f true;
+!   ^^^^                                                                       ! Type clash: expression of type
+!   bool
+! cannot have type
+!   int
+ 
+The message is fairly easy to understand in this case, but for more
+complicated type errors I always find that I can't remember which type
+is the one that was expected.  It would be a lot easier if it said
+"expected expression of type int, but found expression of type bool",
+or something similar.
+ 
+* 2002-08-29: From Joe Hurd 
+
+   I've just been to TPHOLs, where I discussed with Carl Witty the issue
+   of minimizing space usage during execution of ML. He came up with
+   (what seemed to me) a rather good idea, so thought I'd pass it on.
+
+   The idea is that if you compare the following two terms for equality
+
+   CON subterm1 = CON subterm2
+
+   and the test succeeds, then it's fine to swing the pointer from
+   subterm1 to subterm2 (correcting the reference counts as you do it).
+   subterm1 might then be left with no references, allowing it to be
+   garbage collected. Refinements that suggest themselves are swinging
+   the pointer from the least-referenced object to the most-referenced,
+   or favouring objects living in more permanent generations with respect
+   to the garbage collector.
+
+   Over time, this may well shrink the heap size to its optimal size,
+   with only a small overhead on each nontrivial successful equality
+   test.
+
+   Has this been tried before? Can you see any flaws with the scheme?
+
+This could be implemented in sml_equal_aux, in the default (block of
+references) case.  When two referred-to values *p1 and *p2 are found
+to be equal but not identical (*p1 != *p2), and both point into the
+young or old heap, we can assign one to the other:
+	*p2 = *p1
+or 
+   	*p1 = *p2
+
+If both p1 and p2 point into the old heap, make both point to the
+object with the lowest address (case p1 < p2 resp. p2 < p1 above).  
+This never creates a new reference from the old heap to the young one.
+
+If one (say p1) points into the young heap and one (say p2) points
+into the old heap, replace the young reference with the old one:
+	*p1 = *p2 
+This never creates a new reference from the old heap to the young one.
+
+If both p1 and p2 point into the young heap, then:
+  - if one block (say v1) is in the young heap and one (say v2) is in the 
+	old heap, update the young heap block 
+	*p1 = *p2
+    (this avoids creating a reference from old heap to the young one)
+  - otherwise (both v1 and v2 are in the young heap, or both are in
+	the old heap)
+	then make both point to least addr.
+    (if both are in the young heap, then obviously this does not
+    create a reference from the old heap; if both are in the old heap 
+    then both references p1 and p2 must be in the ref table already).
+
+The scenario we want to avoid: p1 and p2 point into the young heap and
+p2 < p1 so we want to assign *p1 = *p2.  But v1 is in the old heap and
+v2 in the young heap.  Then the assignment *p1 = *p2 would create a
+new reference from the old heap to the young one.
+
+The garbage collector's invariants must be maintained.  If the garbage
+collector is in the mark phase, and the pointed-to block (*p2
+resp. *p1 above) is in the old heap, then it must be darkened.  In
+principle, this is necessary only if the containing block (v2
+resp. v1) is grey or black.
+
+comp w old share 19.920s  ui+uo 4275878 total  
+
+comp w young+old share    ui+uo 4275750 total  
+lib  w young+old share    ui+uo 1622111 total 
+
+comp w/o share 20.530s    ui+uo 4280650 total 
+lib  w/o share            ui+uo 1622471 total 
+
+
+test10 w young+old share 
+                 User: 1028.260  System: 6.040  GC: 882.780 59388 KB
+
+test10 w/o share User: 1048.470  System: 1.090  GC: 904.220 59736 KB
+	         User: 1029.400  System: 0.900  GC: 884.230  
+
+2003-02-20: Doubleword double alignment constraint on Solaris/gcc3.2
+were not correctly detected by config/auto-aux/dblalign.c, leading to
+crashes (Andreas Jonasson, Gothenburg).  
+
+The dblalign.c script must be compiled with option -O2 to behave like
+the production system, and has been made more complicated to provoke
+gcc-3.2 to fail.
+
+* 2003-02-26
+
+Random.newgenseed 0.0
+ 
+creates a generator which causes Random.random to always return 0.0
+
+----------------------------------------------------------------------
+
+* 2004-01-12: Time trouble.  
+
+In Moscow ML 2.00 time is represented as a pair of ints.  This
+representation was carefully offset by -(2^30) so that it would work
+until year 2038 despite the fact that ints are 31 bit only.  (The
+unreleased CVS version of Moscow ML uses reals to represent time,
+giving microsecond resolution until 2112 and millisecond resolution or
+better until year 143970).
+
+But the Moscow ML 2.00 implementation was not careful enough, it turns
+out.  After January 10, 2004, the number of seconds since January 1,
+1970 exceeds 2^30:
+
+- Date.toString(Date.fromTimeUniv(Time.fromReal(Math.pow(2.0, 30.0)-1.0)));
+> val it = "Sat Jan 10 13:37:03 2004" : string
+
+This causes two problems:
+
+(1) On all 32-bit platforms (except Moscow ML.Net) Time.toSeconds will
+raise Overflow.  This is unavoidable.  Use Time.toReal instead (this
+gives fractional seconds).
+
+(2) Under Moscow ML 2.00 for Windows, loading the Timer structure (or
+invoking Moscow ML with mosml -P full, which loads the Timer
+structure), will fail.  The reason is that function getrutime in
+mosml/src/runtime/mosml.c takes both usr time and real time from the
+system time, but neglects to apply the -(2^30) offset:
+
+  Field (res, 2) = Val_long (t.time);
+  Field (res, 3) = Val_long (((long) t.millitm) * 1000);
+  Field (res, 4) = Val_long (t.time);
+  Field (res, 5) = Val_long (((long) t.millitm) * 1000);
+
+This code ought to be fixed as follows:
+
+  Field (res, 2) = Val_long (t.time + TIMEBASE);
+  Field (res, 3) = Val_long (((long) t.millitm) * 1000);
+  Field (res, 4) = Val_long (t.time + TIMEBASE);
+  Field (res, 5) = Val_long (((long) t.millitm) * 1000);
+
+(3) Under CVS mosml, Time.fromReal(Math.pow(2.0, 30.0)) raises
+Overflow in fromReal because trunc is applied to the number of seconds
+>= 2^30.  Under 2.00 it does not.  
+
+Easily fixed by not doing any truncation in Time.fromReal.
+
+(4) Under CVS mosml Random.newgen() fails because of computations on
+time.  Moscow ML 2.00 works (actually, the surprise is that it worked
+before 10 Jan 2004).  
+
+Fixed by dividing the number of microseconds by 10^7 rather than 10^6
+before applying trunc; this works until year 2310.
+
+(5) Under Moscow ML 2.00, Time.toString(Time.now()) raises Overflow
+after 10 Jan 2004 (under CVS mosml it does not).  
+
+Fixed by using basically the same code as in CVS mosml:
+    fun fmt p t =
+	Real.fmt (StringCvt.FIX (SOME (if p > 0 then p else 0))) (toReal t)
+
+This changes the behaviour of fmt for negative p, but that's mandated
+by the new Basis spec anyway.
+
+(6) Under Moscow ML 2.00, Time.now() + Time.fromReal 0.0 raises Overflow.
+
+This has been fixed by performing the computation in reals and convert
+to integers afterwards.  Not very pretty:
+
+    val op + = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
+	let val usecs = usec1 + usec2 in
+	    {sec  = trunc(real sec1 - real timebase 
+			  + real sec2 + real(usecs div 1000000)),
+	     usec = usecs mod 1000000}
+	end 
+
+
+The good news is that under Moscow ML 2.00 as well as CVS mosml,
+Date.toString(Date.fromTimeUniv(Time.now())) works correctly.
+
+----------------------------------------------------------------------
+
+* 2004-03-08: Norman Ramsey
+
+Subject: parsing bug in Moscow ML 2.00?
+Date: Thu, 26 Feb 2004 14:36:13 -0500 (EST)
+From: nr@eecs.harvard.edu (Norman Ramsey)
+
+Peter,
+
+I'm not sure if this is a known bug.  Moscow ML rejects a signature
+that is modified with a second `where type' clause.  I believe multiple
+`where type' clauses are permitted for the nonterminal `sigexp' in the
+Definition, and the file is accepted by SML of New Jersey and by MLton.
+I'd welcome a patch.
+
+
+Norman
+
+: nr@labrador 654 ; mosml                 
+Moscow ML version 2.00 (June 2000)
+Enter `quit();' to quit.
+- 
+: nr@labrador 655 ; mosmlc -toplevel -c /tmp/bad.sml
+File "/tmp/bad.sml", line 6, characters 41-45:
+! functor F(S : S where type t = int where type u = bool) = struct
+!                                          ^^^^
+! Syntax error.
+: nr@labrador 656 ; cat /tmp/bad.sml
+signature S = sig
+  type t
+  type u
+end
+
+functor F(S : S where type t = int where type u = bool) = struct
+  fun f (x:S.u) = if x then 3 else (4:S.t)
+end
+: nr@labrador 657 ;
+
+--- 
+
+Indeed your example should compile according to the definition.  It
+does not in Moscow ML 2.00 and 2.01 because of a Moscow ML language
+extension that permits longtycons to have a where clause.  This causes
+a shift/reduce conflict in the parser that is resolved in the wrong
+way.  I thought I could fix it with associativity and precedence
+declarations, but it's a little harder than expected.
+
+But here's a (non-pretty) fix: put parentheses around your longtycons,
+as in
+
+  functor F(S : S where type t = (int) where type u = (bool)) = struct end
+
+This is legal SML syntax and so should be acceptable to SML/NJ and
+MLton, and it prevents mosml 2.00 from thinking that the `where type
+u' belongs to `int'.
+
+---
+
+517: shift/reduce conflict (shift 478, reduce 324) on WHERE
+state 517
+	ModExp : ModExp COLONGT SigExp .  (324)
+	SigExp : SigExp . WHERE WhereType  (342)
+
+	WHERE  shift 478
+	ABSTYPE  reduce 324
+	AND  reduce 324
+
+Here we would like it to reduce rather than shift on WHERE.  Thus it
+might be possible to fix this by making WHERE left-associative and
+give it a sufficiently high precedence.  However, that might
+jeopardize WHERE in connection with functor signatures.
+
+Tried this but failed:
+
+/* %left COLON COLONGT */
+/* %left     WHERE */
+
++ 2004-05-24: Thu, 20 May 2004 22:34:41 +0200 Andrzej Wasowski
+   
+
+structure C = struct
+        datatype 'a t1 = T1 of 'a * 'a t2 list
+             and 'a t2 = T2 of 'a t1 list
+
+        fun f (T1 (a,ls)) = T1 (a, map g ls)
+        and g (T2 ls    ) = T2 (map f ls   )
+end
+
+
+structure B = struct
+        structure D = C
+end
+
+Fails with complaint about non-generalized type variable.  Claudio: my
+suspicion is that the problem is due to the inferred type schemes for
+f and g having a shared bound type variable, (generalization doesn't
+rename the bound variables) which subsequently could confuse the
+renaming code that assumes all bound variables are distinct.  
+
+Changed closeValBindVE in Elab.sml to copy the type scheme before
+closing the valbind.
+
+
++ 2004-07-26: From David Greaves 
+
+There is a bug in mosml sockets implementation that means that only 16
+byte of a received UDP datagram are passed up to the user.
+
+The bug is in the foreign function msocket_recvfrom in 
+src/dynlibs/msocket/msocket.c:
+
+/* ML type: sock_ -> Word8Vector.vector -> int -> int -> int -> int * addr */
+EXTERNML value msocket_recvfrom(value sock, value buff, value offset, ...
+  ...
+
+  ret = recvfrom(Sock_val(sock), &Byte(buff, Long_val(offset)), 
+                 Int_val(size),
+                 Int_val(flags), &addr.sockaddr_gen, &len);
+  ...
+
+    res = alloc_tuple(2);
+    modify(&Field(res, 0), Val_int(len));     <------ ERROR!!!!
+    modify(&Field(res, 1), roots[0]);
+
+  ...
+ 
+  return res;
+}
+
+The faulty line should read:
+
+  modify(&Field(res, 0), Val_int(ret));    
+
+
+2004-11-02: Andrzej W:
+
+This looks like a bug in the parser of Moscow ML:
+
+signature A = sig type a type b end
+                      where type a = int
+                      where type b = int
+
+(*
+wasowski@klimt scope--reachability--0-SOURCE $ mosml ,test.sml
+Moscow ML version 2.01 (January 2004)
+Enter `quit();' to quit.
+[opening file ",test.sml"]
+File ",test.sml", line 4, characters 14-18:
+!                     where type b = int end
+!                           ^^^^
+! Syntax error.
+[closing file ",test.sml"]
+-
+*)
+
+
+The above code parses both in SML/NJ and MLTon. Also the definition
+(p.13, sigexp) seems to allow multiple where clauses.
+
+This error in the parser has been noted also by Norman Ramsey, see
+2004-03-08.
+
+
+* 2005-05-23: From: varming@itu.dk
+To: Peter Sestoft 
+Subject: The Standard ML Basis Library Manual inconsistency
+
+Someone permuted the argument to packString.
+
+The type of Byte.packString in the manual:
+Word8Array.array * int * substring -> unit
+
+and in mosml and the kit:
+val it = fn : substring * array * int -> unit
+
+
++ 2005-06-25:
+Date: Sat, 25 Jun 2005 15:18:42 +0000
+From: Rob Arthan 
+Subject: Problem with antiquotation in Moscow ML
+
+It isn't any great problem to me, but I noticed playing around with quotations
+and antiquotations that (illegal) input like `a b c ^42` makes Moscow ML
+hang. Here's a transcript:
+
+    - `a b c ^(42)`; (* OK *)
+    - `a b c ^42`; (* illegal: "42" is not an identifier, hangs ... *)
+[Control+C typed here]
+
+PS fixed Lexer.lex by replacing:
+
+  | _
+      { 
+        lexingMode := QUOTElm;   
+        lexError "ill-formed antiquotation" lexbuf 
+
+      }
+
+with 
+
+  | _
+      { 
+        skipString "ill-formed antiquotation" SkipQuotation lexbuf
+      }
+
+
++ 2005-06-28: Extending the globals offset from 16 to 32 bits.
+
+Currently, 
+
+GETGLOBAL, SETGLOBAL, PUSH_GETGLOBAL, PUSH_GETGLOBAL_APPLY[1-4]: 
+ 16-bit --> 32-bit arg
+
+PUSH_GETGLOBAL_APPTERM[1-4]:
+ 16-bit + 16-bit --> 16-bit + 32-bit
+
+compiler/Emitcode.sml
+
+ No changes.
+
+compiler/Reloc.sml
+
+ + slot_for_literal, slot_for_get_global and slot_for_set_global should
+   out_long instead of out_short
+
+compiler/Patch.sml
+
+ + patch_object should patch_long (new function) for literals and globals
+
+runtime/interp.c:
+
+ + In byte_raise_break_exn, two more 0's, at the end (little-endian) or
+   the beginning (big-endian).
+
+ + Increase RAISE_CODE_LEN to 6
+
+ + In GETGLOBAL, SETGLOBAL, PUSH_GETGLOBAL_APPLY[1-4], etc:
+   u16pc -> u32pc and += SHORT -> += LONG
+
+ + In PUSH_GETGLOBAL_APPTERM1 (only), second occurrence of u16pc -> u32pc. 
+
+runtime/fixcode.c:
+
+ + In fixup_endianness, more GETGLOBAL etc and SETGLOBAL to the
+   MAKEBLOCK group of instructions.
+
+ + Need a new category: one two-byte and one four-byte argument, for
+   PUSH_GETGLOBAL_APPLY[1-4]
+	
+runtime/expand.c:
+
+ + Move GETGLOBAL, SETGLOBAL, PUSH_GETGLOBAL_APPLY[1-4] to the MAKEBLOCK
+   group of instructions.
+
+ + Change the PUSH_GETGLOBAL_APPTERM[1-4] instructions to use u32pc for
+   the second arg, and LONG instead of SHORT
+
+* 2005-10-19: Fritz Henglein 
+
+Under MosML 2.01 (Windows XP) sker der at
+
+Date.date {year = 1970, month = Date.Jan, day = 1, hour = 0, minute = 0,
+second = 0, offset = NONE};
+
+får MosML til at gå ned.  Det sker øjensynligt for de (og kun de?!)
+datoer, der ligger den 1. januar 1970 f'ør kl. 1:00, altså
+1.1.1970 fra kl. 0:00:00 til 0:59:59.
+
+> Det lyder som den rigtige diagnose. Men hvorfor fungerer det øjensynligt for
+> datoer i 1969? (Er det, fordi de bliver håndteret særskilt i MosML?)
+
+Ja, forklaringen er denne betingelse:
+
+    if year < 1970 orelse year > 2037 then date1
+            else
+                case offset of
+                    NONE   =>
+                        tmozToDate (getlocaltime_ (mktime_ (dateToTmoz date1)))
+                                   offset
+                  | SOME t => date1
+
+som forsøger at gøre alle tilpas ved at normalisere datoen (med ugedag
+osv) hvis den falder inden for et interval hvor det et plausibelt at
+det kan lade sig gøre.  På Win XP er der så 1 time hvor det ikke
+virker; det må vi vist forsøge at håndtere i C-koden.
+
+* 2005-11-09 Discussion with Ken 
+  Moscow ML future:
+
+   - Moscow ML.NET:
+     Ken has resurrected mosml.net and integrated into CVS version.
+     Some build problems remain.
+     Should remain in sync in the future.
+     Should check in somehow into mosml2.0 CVS.
+     Make mosml.net the main branch?  
+       Pro: 32 bit int, no sync needed, thread support, .Net libs, 
+            simple FFI, potential MS funding, F# collaboration, 
+            new research (sep comp on .Net w speed), easier MSR contrib, 
+            ...
+       Con: lockin (but: Mono), redo libraries (MuDDy, mGTK, msql, intinf), 
+            performance, memory consumption, ...
+     Milestone  0: Makefile from NJK so Ken can build
+     Milestone  1: integration with current CVS mosml
+     Milestone  2: simplify build process (stay w csc and gnu make)
+     Milestone  3: build with mono 
+     Milestone  4: integrate library source files (#ifdef)
+     Milestone  5: design joint libraries (files, io)
+     More ...
+     Milestone 10: only one compiler with options: mosmlc -net *.sml
+     How to integrate the two libraries and the two backends etc?
+       --> #ifdef?
+       
+   - Support for MLB files:
+     Similar to PM files
+     - Need mosmlc option to specify target: 
+         mosmlc A.sml -toplevel -targetprefix _1A
+       when compiling "local A.sml in C.sml end".
+       Ken to implement this option.
+       (Or, more ambitiously, create packages of .ui and .uo files)
+     - Need mosmlb tool to read .mlb files and call mosmlc.
+
+   - Next release, what is needed
+
+     Release 2.02 (mini-release): Date 
+     - Library up to date
+       Ken to organize lib BL status investigation 
+       (w Michael N, Henning, Claudio)
+     - Various bug fixes and small embellishments
+     - Option -targetprefix
+     - mosmlb (Ken)
+
+     Release 2.10:
+     - Many more bug fixes
+       - 
+     - Requests for new functionality (this file)
+       - 
+     
+     
+   - Collaboration ML Kit and mlton
+     Especially Basis Library io and .mlb files.
+
+
+2006-06-25 Michael Norrish intern.c exception "too big" 
+
+sestoft@jones:~/tmp$ ll trace0910Theory.uo
+40024 -rw-r--r--  1 sestoft sestoft 40938033 Jun 22 07:55 trace0910Theory.uo
+sestoft@jones:~/tmp$ md5sum trace0910Theory.uo
+2bed6ce5b00498b93da8f5c6d0c819c2  trace0910Theory.uo
+
+load "trace0910Theory.uo";
+
+Stop = 6247533 (from Smltop.sml) = 00 5f 54 6d
+code_len = 6247529 (from Smltop.sml)
+wosize = 8672622 (from intern.c)
+! Uncaught exception:
+! Fail  "intern: structure too big #2"
+
+The claimed size of the data structure is 8672622 * 4 B = 34690488
+
+Added to the code size, that gives 40938021 B, which doesn't leave
+enough space for the header and the metadata at the end of the file.
+Not to mention that there are several (short) strings in the file.
+
+
+hd trace0910Theory.uo:
+
+00000000  00 5f 54 6d 6a 00 00 00  00 5d 05 13 00 00 00 6a  |._Tmj....].....j|
+
+005f5460  00 00 6c 00 00 00 00 03  05 00 00 00 48 84 95 a6  |..l.........H...|
+005f5470  ba 00 84 55 6f 00 17 00  00 02 00 00 00 1c 00 00  |...Uo...........|
+005f5480  00 24 00 00 00 30 00 00  00 4c 00 00 00 fa 07 00  |.$...0...L......|
+005f5490  00 58 00 00 00 01 0b 00  00 64 00 00 00 78 00 00  |.X.......d...x..|
+005f54a0  00 fd 1b 00 00 4e 31 6c  5a 49 44 58 7a 2b 54 75  |.....N1lZIDXz+Tu|
+
+@005f546d = 8495a6ba = 1000 0100 1001 0101 1010 0110 1011 1010 
+@005f5471 = 0084556f = 8672623 (dec) which whsize.
+
+The object we're looking for has type compiled_unit_tables and is a
+record of size 5.
+
+A wosize of 5 should give a header of this form (in bin):
+
+00000000 00000000 000101xx 00000000 where xx = 11 is a Black header
+
+and in hex
+
+00 00 17 00 
+
+
+
+ * Date: Tue, 14 Mar 2006 17:09:58 -0700
+   From: Konrad Slind 
+   Subject: FYI Moscow ML on Tiger
+
+I just spent a little time getting Moscow ML to build on Tiger. Not
+sure that I've got it completely sussed wrt dynamic libraries, but
+the following over-rides in src/Makefile.inc of the Moscow ML
+distribution helped in getting the basic executable to compile:
+
+     CC=gcc-3.3
+     LD=gcc-3.3 -flat_namespace
+     STRIP=echo
+
+In src/runtime/Makefile, you also need to add -lSystemStubs to BASELIBS:
+
+    BASELIBS=-lm -lSystemStubs
+
+If you get better info than the above results of my blundering about,
+let me know!
+
+ * Date: Sun, 20 Aug 2006 15:09:54 +0100
+   From: Ian Grant 
+
+Here is a tiny patch to allow the mosml 2.01 msocket library to compile under 
+GCC4 which no-longer allows a cast in an lvalue (see 
+http://gcc.gnu.org/gcc-3.4/changes.html "The cast-as-lvalue extension has 
+been removed for C++ and deprecated for C and Objective-C.") . I have tested 
+this with the simple client/server test in that directory, so I know it has 
+run at least once :-) The #ifdef macintosh branch of the Sock_val define 
+could probably be merged with this change as it most likely came about for 
+the same reason.
+
+Yours sincerely
+Ian Grant
+
+--- src/dynlibs/msocket/msocket.c.orig  2000-01-21 10:07:13.000000000 +0000
++++ src/dynlibs/msocket/msocket.c       2006-08-20 14:35:06.000000000 +0100
+@@ -70,6 +70,7 @@
+ #else
+ #define Sock_val(x) ((int) Field(x,0))
+ #endif
++#define Sock_lval(x) (Field(x,0))
+ 
+ /* Decomposition of addr values: */
+ #define Size_addrval(a)   Field(a, 0)
+@@ -111,7 +112,7 @@
+ /* ML return type: sock_ */
+ static value newsocket(int sock) {
+   value result = alloc(1, Abstract_tag);
+-  Sock_val(result) = sock;
++  Sock_lval(result) = sock;
+   return result;
+ }
+ 
++ Problem building on Fedora, Gentoo and SUSE 64 bit
+
+2007-10-17: This is due to problems with certain versions of malloc(),
+which alternatively allocate memory for the camlrunm heap in very high
+addresses using mmap() or in very low addresses using brk().  
+
+This span requires a huge page_table (14 GB or so), which it would be
+silly to allocate.
+
+The problem can be avoided by either forcing high memory allocation
+using this environment variable:
+
+   export MALLOC_MMAP_THRESHOLD_=0
+
+or by using forcing low memory allocation using this environment
+variable:
+
+   export MALLOC_MMAP_MAX_=0
+
+There may be performance implications of either of these choices.  The
+latter one would limit usable mosml memory to at most 3 GB, I think,
+whereas the former one has been experimentally tested to allow mosml
+to use more than 4 GB.
+
+Also note that these environment variables affect *all* programs that
+use malloc() and hence may have mysterious side effects.
+
+A better solution is to use 
+
+   export MALLOC_MMAP_MAX_=0
+
+in the shell only when building Moscow ML, and then use a shell script
+that sets one of these variables, in the new shell only, when invoking
+mosml, mosmlc and mosmllex.  This way it will not affect any other programs.  
+
+The long term solution is to add yet another #ifdef to the runtime
+source, and use mmap() and munmap() instead of malloc() and free() on
+64-bit architectures.
+
+
++ 2008-03-05: Mail from Tom Ridge, Cambridge: glibc 2.7 is a problem.  Diagnosed on 
+virtual machine (ssh -p 2222 -l itu localhost) thanks to Kenneth Ahn Jensen.
+
+From
+http://www.gnu.org/software/libtool/manual/libc/Malloc-Tunable-Parameters.html
+and  we have
+
+/* mallopt options that actually do something */
+#define M_TRIM_THRESHOLD    -1
+#define M_TOP_PAD           -2
+#define M_MMAP_THRESHOLD    -3
+#define M_MMAP_MAX          -4
+#define M_CHECK_ACTION      -5
+
+/* General SVID/XPG interface to tunable parameters. */
+extern int mallopt __MALLOC_P ((int __param, int __val));
+
+That is, one could initially call 
+
+	mallopt(M_MMAP_MAX, 0);
+
+to make sure that there is no allocation using mmap().
+
+The right place to do this is in mosml/src/runtime/gc_ctrl.c function
+init_gc; a version gc_ctrl.c.new with the required edits has been made
+and has been tested with glibc 2.7 on a 32 bit machine and on a 64 bit
+machine.
+
+
+2008-11-19 Unsafe type inference
+
+Date: Wed, 19 Nov 2008 10:10:53 +0000
+From: Claudio Russo 
+
+Carsten (Varming) has discovered a type inference bug in Mosml which
+allows violations of the value restriction.
+
+Here’s his original code. Warning: the presence/absence of semicolons
+between declarations is significant!
+
+
+(* GOOD ML PROGRAM *)
+
+fun new () = let val r = ref NONE
+in ((fn t => fn () => r := SOME t), fn f => (r := NONE ; f() : unit ; valOf (!r)))
+
+end (* no semicolon here is significant! *)
+
+(* BAD NON-ML PROGRAM *)
+
+val bad = let val r = ref NONE
+in ((fn t => fn () => r := SOME t), fn f => (r := NONE ; f() : unit ; valOf (!r)))
+end;
+
+val (a,b) = bad; (*a, b are polymorphic not monomorphic as they should be...*)
+
+val z = a 1;
+
+val y = #1 bad "1";
+
+val yy = #2 bad y;
+
+(* val crash = #2 bad z; *)
+
+And here’s a smaller repro:
+
+(* smaller repro *)
+
+(* compare *)
+
+val y = ref []; val z_ok = y;
+
+(* z_ok correctly not polymorphic *)
+
+(* with *)
+
+val x = () val y = ref []; val z_wrong = y;
+
+(* z_wrong incorrectly polymorphic *)
+
+Notice that in the smaller repro, the only difference is that y is
+declared in a compound declaration. I
+
+It's just a hunch but what I think this boils down to is a levels bug.
+Perhaps the current type var level is being incremented in the nested
+declaration, but then reverted at the semicolon, leading to incorrect
+generalization at z_wrong.
+
+I always regret not having gone for a purely functional implementation of
+type inference....
+
+For now, it might be good to add this email to the bugs list (wherever
+that lives) or just check it in somewhere in the repository.
+
+Claudio adds: I've had a quick look at the mosmlnet source (all I
+have) and it does indeed look like the binding level is reset to zero
+at each topdec, so variables generated with a higher level, but not
+generalized in the previous dec, will get generalized in a subsequent
+one. I think a fix might be to reset the binding levels of all new
+type variables in the object of the current dec to zero before
+proceeding.
+
+There may be even be handle to those variables somewhere handy but I
+can't recall just now.
+
+
+2008-12-25:  From: Claudio Russo 
+
+I?ve been told of yet another bug, this one thankfully a little more
+obscure ? can you add it to the list? This one came up in the authors?
+response to a referee report on recursive modules...
+
+
+> Moscow ML's type checker aborts
+> signaling "Internal error: elabRecSigExp", given the recursive
+> signature below:
+
+signature REC =
+  rec (Z: sig functor F : functor X : sig type t end -> sig type t end
+               structure M : sig type t end
+          end)
+  sig
+    functor F : functor X :  sig type t end 
+                             -> 
+                             sig datatype t = A of Y.t where Y = Z.F(Z.M) end
+    structure M : sig type t end
+end
+
+2009-03-15: From ian.grant@cl.cam.ac.uk Tue Dec 23 17:21:46 2008
+
+Thanks for you help on the Moscow ML build issue. I have fixed the  
+MacPorts mosml package and added a new one mosml-dynlibs with all the  
+dynlibs except the big databases (mysql and postgres.)
+
+I submitted the changes to the MacPorts people: http://trac.macports.org/ticket/17659 
+  and we just have to wait for someone to apply them. I'll let you  
+know when it happens.
+
+As regards the existence of this directory. I think it is there  
+because the file config.h is originally from the runtime subdirectory  
+where it uses
+
+#include "../config/m.h"
+#include "../config/s.h"
+
+to get at the auto-generated files. So when config.h is copied into  
+$MOSMLHOME/include it needs the symbolic link to work. I got around it  
+in the MacPorts build by adding an LSB switch which I turn on when  
+building dynlibs after the initial mosml install.
+
+--- ../mosml.orig/include/config.h      2004-01-19 15:02:21.000000000  
++0000
++++ ./include/config.h  2008-12-03 11:39:56.000000000 +0000
+@@ -2,7 +2,7 @@
+  #define _config_
+
+
+-#if defined(__MWERKS__) || defined(THINK_C)
++#if defined(__MWERKS__) || defined(THINK_C) || defined(LSB)
+  #include "m.h"
+  #include "s.h"
+  #else
+
+>> I am trying to fix the Mac Ports Moscow ML package to use dynamic  
+>> libraries. These all build and work well on Mac OS X now.
+
+>> The problem is that the config -> include symlink is complicating  
+>> matters. Standard use of namespace means that we can't install  
+>> headers, binaries etc in $MOSMLHOME e.g. /usr/mosml/ 
+>> {bin,include,config} etc, rather we must install under /usr/bin, / 
+>> usr/lib, /usr/include/mosml etc. This makes the symbolic link that  
+>> was $MOSMLHOME/config -> $MOSMLHOME/include awkward. I am trying to  
+>> remove all references to the $MOSMLHOME/config subdirectory but  
+>> they keep popping up again. Do you recall what is the reason for  
+>> separating config and include directories in the first place?
diff -Nru mosml-2.01/src/notes/TODO.ken mosml-2.10.1/src/notes/TODO.ken
--- mosml-2.01/src/notes/TODO.ken	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/notes/TODO.ken	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,32 @@
+Random notes from Ken's brain on the future of Mosml -*- indented-text -*-
+==========================================================================
+(legend: * means think about, + means completed, - means droped)
+
+
+2000-05-08:
+-----------
+ * Port to new O'Caml runtime to clearify license issues
+ 
+ * Investigate what needs to be done so as ml-{lex,yacc} can be used
+   with mosml 2.0
+
+ * Talk to Peter and Claudio about why mosml{,c} are shell-scripts
+   instead of plain mosml program.  The shell scripts are causing
+   problems with rpm.  
+ 
+   What is the O'Caml solution?
+
+ * Look at IO from the SML Basis Lib (SBL).  And Port it to mosml.
+
+ * Document which parts of SBL mosml implements, which parts mosml
+   does *not* implements, and where we diverge.
+
+ * Document PM and go over the current design (throw away the current
+   implementation and make a new more robust implementation)
+
+ * Write article to Dr. Dobbs or Linux Journal about SML and mosml in
+   Particular.
+
+ * Write a hackers tutorial to put on the Web.
+
+ * Make x86 native compiler (maybe just by translating .uo files)
diff -Nru mosml-2.01/src/notes/ud mosml-2.10.1/src/notes/ud
--- mosml-2.01/src/notes/ud	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/notes/ud	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,300 @@
+  
+val x101 = 101
+val x102 = 102
+val x103 = 103
+val x104 = 104
+val x105 = 105
+val x106 = 106
+val x107 = 107
+val x108 = 108
+val x109 = 109
+val x110 = 110
+val x111 = 111
+val x112 = 112
+val x113 = 113
+val x114 = 114
+val x115 = 115
+val x116 = 116
+val x117 = 117
+val x118 = 118
+val x119 = 119
+val x120 = 120
+val x121 = 121
+val x122 = 122
+val x123 = 123
+val x124 = 124
+val x125 = 125
+val x126 = 126
+val x127 = 127
+val x128 = 128
+val x129 = 129
+val x130 = 130
+val x131 = 131
+val x132 = 132
+val x133 = 133
+val x134 = 134
+val x135 = 135
+val x136 = 136
+val x137 = 137
+val x138 = 138
+val x139 = 139
+val x140 = 140
+val x141 = 141
+val x142 = 142
+val x143 = 143
+val x144 = 144
+val x145 = 145
+val x146 = 146
+val x147 = 147
+val x148 = 148
+val x149 = 149
+val x150 = 150
+val x151 = 151
+val x152 = 152
+val x153 = 153
+val x154 = 154
+val x155 = 155
+val x156 = 156
+val x157 = 157
+val x158 = 158
+val x159 = 159
+val x160 = 160
+val x161 = 161
+val x162 = 162
+val x163 = 163
+val x164 = 164
+val x165 = 165
+val x166 = 166
+val x167 = 167
+val x168 = 168
+val x169 = 169
+val x170 = 170
+val x171 = 171
+val x172 = 172
+val x173 = 173
+val x174 = 174
+val x175 = 175
+val x176 = 176
+val x177 = 177
+val x178 = 178
+val x179 = 179
+val x180 = 180
+val x181 = 181
+val x182 = 182
+val x183 = 183
+val x184 = 184
+val x185 = 185
+val x186 = 186
+val x187 = 187
+val x188 = 188
+val x189 = 189
+val x190 = 190
+val x191 = 191
+val x192 = 192
+val x193 = 193
+val x194 = 194
+val x195 = 195
+val x196 = 196
+val x197 = 197
+val x198 = 198
+val x199 = 199
+val x200 = 200
+val x201 = 201
+val x202 = 202
+val x203 = 203
+val x204 = 204
+val x205 = 205
+val x206 = 206
+val x207 = 207
+val x208 = 208
+val x209 = 209
+val x210 = 210
+val x211 = 211
+val x212 = 212
+val x213 = 213
+val x214 = 214
+val x215 = 215
+val x216 = 216
+val x217 = 217
+val x218 = 218
+val x219 = 219
+val x220 = 220
+val x221 = 221
+val x222 = 222
+val x223 = 223
+val x224 = 224
+val x225 = 225
+val x226 = 226
+val x227 = 227
+val x228 = 228
+val x229 = 229
+val x230 = 230
+val x231 = 231
+val x232 = 232
+val x233 = 233
+val x234 = 234
+val x235 = 235
+val x236 = 236
+val x237 = 237
+val x238 = 238
+val x239 = 239
+val x240 = 240
+val x241 = 241
+val x242 = 242
+val x243 = 243
+val x244 = 244
+val x245 = 245
+val x246 = 246
+val x247 = 247
+val x248 = 248
+val x249 = 249
+val x250 = 250
+val x251 = 251
+val x252 = 252
+val x253 = 253
+val x254 = 254
+val x255 = 255
+val x256 = 256
+val x257 = 257
+val x258 = 258
+val x259 = 259
+val x260 = 260
+val x261 = 261
+val x262 = 262
+val x263 = 263
+val x264 = 264
+val x265 = 265
+val x266 = 266
+val x267 = 267
+val x268 = 268
+val x269 = 269
+val x270 = 270
+val x271 = 271
+val x272 = 272
+val x273 = 273
+val x274 = 274
+val x275 = 275
+val x276 = 276
+val x277 = 277
+val x278 = 278
+val x279 = 279
+val x280 = 280
+val x281 = 281
+val x282 = 282
+val x283 = 283
+val x284 = 284
+val x285 = 285
+val x286 = 286
+val x287 = 287
+val x288 = 288
+val x289 = 289
+val x290 = 290
+val x291 = 291
+val x292 = 292
+val x293 = 293
+val x294 = 294
+val x295 = 295
+val x296 = 296
+val x297 = 297
+val x298 = 298
+val x299 = 299
+val x300 = 300
+val x301 = 301
+val x302 = 302
+val x303 = 303
+val x304 = 304
+val x305 = 305
+val x306 = 306
+val x307 = 307
+val x308 = 308
+val x309 = 309
+val x310 = 310
+val x311 = 311
+val x312 = 312
+val x313 = 313
+val x314 = 314
+val x315 = 315
+val x316 = 316
+val x317 = 317
+val x318 = 318
+val x319 = 319
+val x320 = 320
+val x321 = 321
+val x322 = 322
+val x323 = 323
+val x324 = 324
+val x325 = 325
+val x326 = 326
+val x327 = 327
+val x328 = 328
+val x329 = 329
+val x330 = 330
+val x331 = 331
+val x332 = 332
+val x333 = 333
+val x334 = 334
+val x335 = 335
+val x336 = 336
+val x337 = 337
+val x338 = 338
+val x339 = 339
+val x340 = 340
+val x341 = 341
+val x342 = 342
+val x343 = 343
+val x344 = 344
+val x345 = 345
+val x346 = 346
+val x347 = 347
+val x348 = 348
+val x349 = 349
+val x350 = 350
+val x351 = 351
+val x352 = 352
+val x353 = 353
+val x354 = 354
+val x355 = 355
+val x356 = 356
+val x357 = 357
+val x358 = 358
+val x359 = 359
+val x360 = 360
+val x361 = 361
+val x362 = 362
+val x363 = 363
+val x364 = 364
+val x365 = 365
+val x366 = 366
+val x367 = 367
+val x368 = 368
+val x369 = 369
+val x370 = 370
+val x371 = 371
+val x372 = 372
+val x373 = 373
+val x374 = 374
+val x375 = 375
+val x376 = 376
+val x377 = 377
+val x378 = 378
+val x379 = 379
+val x380 = 380
+val x381 = 381
+val x382 = 382
+val x383 = 383
+val x384 = 384
+val x385 = 385
+val x386 = 386
+val x387 = 387
+val x388 = 388
+val x389 = 389
+val x390 = 390
+val x391 = 391
+val x392 = 392
+val x393 = 393
+val x394 = 394
+val x395 = 395
+val x396 = 396
+val x397 = 397
+val x398 = 398
+val x399 = 399
diff -Nru mosml-2.01/src/runtime/alloc.c mosml-2.10.1/src/runtime/alloc.c
--- mosml-2.01/src/runtime/alloc.c	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/runtime/alloc.c	2014-08-28 08:47:22.000000000 +0000
@@ -57,7 +57,6 @@
 value copy_double(double d)
 {
   value res;
-
   Alloc_small(res, Double_wosize, Double_tag);
   Store_double_val(res, d);
   return res;
diff -Nru mosml-2.01/src/runtime/config.h mosml-2.10.1/src/runtime/config.h
--- mosml-2.01/src/runtime/config.h	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/runtime/config.h	2014-08-28 08:47:22.000000000 +0000
@@ -1,34 +1,15 @@
 #ifndef _config_
 #define _config_
 
-
-#if defined(__MWERKS__) || defined(THINK_C)
 #include "m.h"
 #include "s.h"
-#else
-#ifdef macintosh
-#include ":::config:m.h"
-#include ":::config:s.h"
-#else
-#if defined(msdos)
-#include "../config.dos/m.h"
-#include "../config.dos/s.h"
-#elif defined(WIN32)
-#include "../config.w32/m.h"
-#include "../config.w32/s.h"
-#else
-#include "../config/m.h"
-#include "../config/s.h"
-#endif
-#endif
-#endif
 
 #ifdef WIN32
 
 #ifdef CAMLRT
-#define EXTERN __declspec(dllexport)
+#define EXTERN extern __declspec(dllexport)
 #else
-#define EXTERN __declspec(dllimport)
+#define EXTERN extern __declspec(dllimport)
 #endif
 
 #else
diff -Nru mosml-2.01/src/runtime/dynlib.c mosml-2.10.1/src/runtime/dynlib.c
--- mosml-2.01/src/runtime/dynlib.c	2000-03-10 08:59:25.000000000 +0000
+++ mosml-2.10.1/src/runtime/dynlib.c	2014-08-28 08:47:22.000000000 +0000
@@ -15,7 +15,7 @@
 #include 
 #endif
 
-/* Ken Larsen (kla@it.dtu.dk) 1998-01-08 */
+/* Ken Friis Larsen (ken@friislarsen.net) 1998-01-08 */
 
 /* Doug Currie (e@flavors.com) 1998May06 Macintosh specific changes */
 
diff -Nru mosml-2.01/src/runtime/expand.c mosml-2.10.1/src/runtime/expand.c
--- mosml-2.01/src/runtime/expand.c	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/runtime/expand.c	2014-08-28 08:47:22.000000000 +0000
@@ -265,8 +265,6 @@
     Instruct(ENVACC): 
     Instruct(DUMMY): 
     Instruct(RETURN):
-    Instruct(SETGLOBAL):
-    Instruct(GETGLOBAL):
     Instruct(APPTERM1):
     Instruct(APPTERM2):
     Instruct(APPTERM3):
@@ -275,11 +273,6 @@
     Instruct(PUSH_ENV1_APPTERM2):
     Instruct(PUSH_ENV1_APPTERM3):
     Instruct(PUSH_ENV1_APPTERM4):
-    Instruct(PUSH_GETGLOBAL):
-    Instruct(PUSH_GETGLOBAL_APPLY1): 
-    Instruct(PUSH_GETGLOBAL_APPLY2): 
-    Instruct(PUSH_GETGLOBAL_APPLY3): 
-    Instruct(PUSH_GETGLOBAL_APPLY4): 
     Instruct(GETFIELD):
     Instruct(SETFIELD):
     Instruct(C_CALL1):
@@ -292,6 +285,13 @@
 
     /* A four-byte unsigned argument. */
     Instruct(MAKEBLOCK):
+    Instruct(SETGLOBAL):
+    Instruct(GETGLOBAL):
+    Instruct(PUSH_GETGLOBAL):
+    Instruct(PUSH_GETGLOBAL_APPLY1): 
+    Instruct(PUSH_GETGLOBAL_APPLY2): 
+    Instruct(PUSH_GETGLOBAL_APPLY3): 
+    Instruct(PUSH_GETGLOBAL_APPLY4): 
       pc += LONG; realsize++;
       break;
 
@@ -322,7 +322,7 @@
     Instruct(PUSH_GETGLOBAL_APPTERM3):
     Instruct(PUSH_GETGLOBAL_APPTERM4):
       pc += SHORT; realsize++;
-      pc += SHORT; realsize++;
+      pc += LONG; realsize++;
       break;
 
     /* A one-byte argument and a table of four-byte signed (label) arguments */
@@ -335,7 +335,7 @@
       }
       break;
     default:
-      printf("buildrealmap: opcode = %d at %d\n", *pc, pc-byteprog);
+      printf("buildrealmap: opcode = %d at %ld\n", *pc, pc-byteprog);
       fatal_error("bad opcode\n");
     }
   }
@@ -572,8 +572,6 @@
     Instruct(ENVACC): 
     Instruct(DUMMY): 
     Instruct(RETURN):
-    Instruct(SETGLOBAL):
-    Instruct(GETGLOBAL):
     Instruct(APPTERM1):
     Instruct(APPTERM2):
     Instruct(APPTERM3):
@@ -582,11 +580,6 @@
     Instruct(PUSH_ENV1_APPTERM2):
     Instruct(PUSH_ENV1_APPTERM3):
     Instruct(PUSH_ENV1_APPTERM4):
-    Instruct(PUSH_GETGLOBAL):
-    Instruct(PUSH_GETGLOBAL_APPLY1): 
-    Instruct(PUSH_GETGLOBAL_APPLY2): 
-    Instruct(PUSH_GETGLOBAL_APPLY3): 
-    Instruct(PUSH_GETGLOBAL_APPLY4): 
     Instruct(GETFIELD):
     Instruct(SETFIELD):
     Instruct(C_CALL1):
@@ -601,6 +594,13 @@
 
     /* A four-byte unsigned argument. */
     Instruct(MAKEBLOCK):
+    Instruct(SETGLOBAL):
+    Instruct(GETGLOBAL):
+    Instruct(PUSH_GETGLOBAL):
+    Instruct(PUSH_GETGLOBAL_APPLY1): 
+    Instruct(PUSH_GETGLOBAL_APPLY2): 
+    Instruct(PUSH_GETGLOBAL_APPLY3): 
+    Instruct(PUSH_GETGLOBAL_APPLY4): 
       realprog[codeptr++] = jumptable[*pc++]; 
       realprog[codeptr++] = (void*)(unsigned long)u32pc;
       pc += LONG;
@@ -633,14 +633,14 @@
       pc += SHORT;
       break;
 
-    /* Two two-byte unsigned arguments. */
+    /* One two-byte and one four-byte unsigned argument. */
     Instruct(PUSH_GETGLOBAL_APPTERM1):
     Instruct(PUSH_GETGLOBAL_APPTERM2):
     Instruct(PUSH_GETGLOBAL_APPTERM3):
     Instruct(PUSH_GETGLOBAL_APPTERM4):
       realprog[codeptr++] = jumptable[*pc++]; 
       realprog[codeptr++] = (void*)(unsigned long)u16pc; pc += SHORT;
-      realprog[codeptr++] = (void*)(unsigned long)u16pc; pc += SHORT;
+      realprog[codeptr++] = (void*)(unsigned long)u32pc; pc += LONG;
       break;
 
     /* A one-byte argument and a table of four-byte signed (label) arguments. */
@@ -660,7 +660,7 @@
       }
       break;
     default:
-      printf("expandcode: opcode = %d at %d\n", *pc, pc-byteprog);
+      printf("expandcode: opcode = %d at %ld\n", *pc, pc-byteprog);
       fatal_error("bad opcode");
     }
   }
diff -Nru mosml-2.01/src/runtime/fix_code.c mosml-2.10.1/src/runtime/fix_code.c
--- mosml-2.01/src/runtime/fix_code.c	2000-01-25 16:55:42.000000000 +0000
+++ mosml-2.10.1/src/runtime/fix_code.c	2014-08-28 08:47:22.000000000 +0000
@@ -30,13 +30,9 @@
       /* Instructions with a two-byte immediate argument */
     case PUSHACC: case ACCESS: case POP: case ASSIGN:
     case PUSHENVACC: case ENVACC: case DUMMY: case RETURN: 
-    case SETGLOBAL: case GETGLOBAL: 
     case APPTERM1: case APPTERM2: case APPTERM3: case APPTERM4:
     case PUSH_ENV1_APPTERM1: case PUSH_ENV1_APPTERM2: 
     case PUSH_ENV1_APPTERM3: case PUSH_ENV1_APPTERM4: 
-    case PUSH_GETGLOBAL: 
-    case PUSH_GETGLOBAL_APPLY1: case PUSH_GETGLOBAL_APPLY2:
-    case PUSH_GETGLOBAL_APPLY3: case PUSH_GETGLOBAL_APPLY4:
     case GETFIELD: case SETFIELD:
     case C_CALL1: case C_CALL2: case C_CALL3: case C_CALL4:
     case C_CALL5: 
@@ -54,15 +50,19 @@
     case BRANCHIFEQ: case BRANCHIFNEQ: case BRANCHIFLT:
     case BRANCHIFGT: case BRANCHIFLE: case BRANCHIFGE:
     case MAKEBLOCK: case PUSHCONSTINT: case CONSTINT:
+    case SETGLOBAL: case GETGLOBAL: 
+    case PUSH_GETGLOBAL: 
+    case PUSH_GETGLOBAL_APPLY1: case PUSH_GETGLOBAL_APPLY2:
+    case PUSH_GETGLOBAL_APPLY3: case PUSH_GETGLOBAL_APPLY4:
       Reverse_word(p);
       p += 4;
       break;
-      /* Instructions with two two-byte immediate arguments */
+      /* Instructions with one two-byte and one four-byte immediate argument */
     case PUSH_GETGLOBAL_APPTERM1: case PUSH_GETGLOBAL_APPTERM2: 
     case PUSH_GETGLOBAL_APPTERM3: case PUSH_GETGLOBAL_APPTERM4: 
       Reverse_short(p);
-      Reverse_short(p+2);
-      p += 4;
+      Reverse_word(p+2);
+      p += 6;
       break;
       /* Instructions with two four-byte immediate arguments */
     case BRANCHINTERVAL: 
diff -Nru mosml-2.01/src/runtime/.gitignore mosml-2.10.1/src/runtime/.gitignore
--- mosml-2.01/src/runtime/.gitignore	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/runtime/.gitignore	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,8 @@
+*.o
+/camlrt.dll
+camlrunm
+jumptbl.h
+m.h
+primitives
+prims.c
+s.h
diff -Nru mosml-2.01/src/runtime/globals.h mosml-2.10.1/src/runtime/globals.h
--- mosml-2.01/src/runtime/globals.h	2000-01-24 21:59:00.000000000 +0000
+++ mosml-2.10.1/src/runtime/globals.h	2014-08-28 08:47:22.000000000 +0000
@@ -28,8 +28,9 @@
 #define SYS__MAX_STRING_LENGTH 17 /* "sys","max_string_length" */
 #define SYS__MAX_VECT_LENGTH 18   /* "sys","max_vect_length" */
 
-/* Exn indexes names for pervasive dynamic exceptions.  The
-   corresponding exn names (string refs) are allocated by sys_init */
+/* Exn indexes names for pervasive dynamic exceptions.  
+   The table globalexn in sys.c must correspond to this list.
+   The actual exn names (string refs) are allocated by sys_init in sys.c */
 
 #define SYS__EXN_MEMORY     19   /* "sys","exn_memory" */
 #define SYS__EXN_ARGUMENT   20   /* "sys","exn_argument" */
@@ -47,14 +48,17 @@
 #define SYS__EXN_BIND       32   /* "sys","exn_bind" */
 #define SYS__EXN_MATCH      33   /* "sys","exn_match" */
 #define SYS__EXN_IO         34   /* "sys","exn_io" */
+#define SYS__EXN_OPTION     35   /* "sys","exn_option" */
+#define SYS__EXN_SPAN       36   /* "sys","exn_span" */
+
 
 /* Frequently used exception values (NOT exn indexes); alloc by sys_init */
 
-#define EXN_INTERRUPT       35   /* "sys","val_exn_interrupt" */
-#define EXN_DIV             36   /* "sys","val_exn_div" */
-#define EXN_OVERFLOW        37   /* "sys","val_exn_overflow" */
+#define EXN_INTERRUPT       37   /* "sys","val_exn_interrupt" */
+#define EXN_DIV             38   /* "sys","val_exn_div" */
+#define EXN_OVERFLOW        39   /* "sys","val_exn_overflow" */
 
 #define SYS__FIRST_EXN 19
-#define SYS__LAST_EXN 34
+#define SYS__LAST_EXN 36
 
 #endif /* _globals_ */
diff -Nru mosml-2.01/src/runtime/hash.c mosml-2.10.1/src/runtime/hash.c
--- mosml-2.01/src/runtime/hash.c	2000-02-20 22:32:21.000000000 +0000
+++ mosml-2.10.1/src/runtime/hash.c	2014-08-28 08:47:22.000000000 +0000
@@ -6,8 +6,9 @@
 
 static unsigned long hash_accu;
 static long hash_univ_limit, hash_univ_count;
+static char safe;		/* Fail on refs and exceeded limits */
 
-static void hash_aux();
+static void hash_aux(value obj);
 
 value hash_univ_param(count, limit, obj) /* ML */
      value obj, count, limit;
@@ -15,6 +16,20 @@
   hash_univ_limit = Long_val(limit);
   hash_univ_count = Long_val(count);
   hash_accu = 0;
+  safe = 0;
+  hash_aux(obj);
+  return Val_long(hash_accu & 0x3FFFFFFF);
+  /* The & has two purposes: ensure that the return value is positive
+     and give the same result on 32 bit and 64 bit architectures. */
+}
+
+value hash_univ_safe_param(count, limit, obj) /* ML */
+     value obj, count, limit;
+{
+  hash_univ_limit = Long_val(limit);
+  hash_univ_count = Long_val(count);
+  hash_accu = 0;
+  safe = 1;
   hash_aux(obj);
   return Val_long(hash_accu & 0x3FFFFFFF);
   /* The & has two purposes: ensure that the return value is positive
@@ -26,16 +41,19 @@
 #define Combine(new)  (hash_accu = hash_accu * Alpha + (new))
 #define Combine_small(new) (hash_accu = hash_accu * Beta + (new))
 
-static void hash_aux(obj)
-     value obj;
+static void hash_aux(value obj)
 {
   unsigned char * p;
   mlsize_t i;
   tag_t tag;
 
   hash_univ_limit--;
-  if (hash_univ_count < 0 || hash_univ_limit < 0) return;
-
+  if (hash_univ_count < 0 || hash_univ_limit < 0) {
+    if (safe) 
+      fatal_error("hash: count limit exceeded\n");
+    else
+      return;
+  }
   if (Is_long(obj)) {
     hash_univ_count--;
     Combine(Long_val(obj));
@@ -60,10 +78,17 @@
     switch (tag) {
     case String_tag:
       hash_univ_count--;
-      i = string_length(obj);
-      for (p = &Byte_u(obj, 0); i > 0; i--, p++)
-        Combine_small(*p);
-      break;
+      { 
+	mlsize_t len = string_length(obj);
+	i = len <= 128 ? len : 128;
+	// Hash on 128 first characters
+	for (p = &Byte_u(obj, 0); i > 0; i--, p++)
+	  Combine_small(*p);
+	// Hash on logarithmically many additional characters beyound 128
+	for (i=1; i+127 < len; i*=2)
+	  Combine_small(Byte_u(obj, 127+i));
+	break;
+      }
     case Double_tag:
       /* For doubles, we inspect their binary representation, LSB first.
          The results are consistent among all platforms with IEEE floats. */
@@ -91,7 +116,9 @@
 	 terminate because the hash_univ_count gets decremented. */
       /* Poor idea to hash on the pointed-to structure, even so: it may change,
 	 and hence the hash value of the value changes, although the ref doesn't.
-	 This breaks most hash table implementations.  sestoft 2000-02-20.
+	 This breaks most hash table implementations.  sestoft 2000-02-20. */
+      if (safe) 
+	fatal_error("hash: ref encountered\n");
       Combine_small(tag);
       hash_univ_count--;
       /* hash_aux(Field(obj, 0)); */
diff -Nru mosml-2.01/src/runtime/intern.c mosml-2.10.1/src/runtime/intern.c
--- mosml-2.01/src/runtime/intern.c	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/runtime/intern.c	2014-08-28 08:47:22.000000000 +0000
@@ -473,7 +473,7 @@
     hd = Hd_val (res);
     color = Color_hd (hd);
     Assert (color == White || color == Black);
-    expand_block(block, Hp_val(res), whsize32, whsize, color);
+    expand_block(block, (value *)Hp_val(res), whsize32, whsize, color);
     stat_free((char *) block);
   } else {
     /* Block has natural word size (64) */
@@ -515,7 +515,7 @@
     }
     wosize = Wosize_whsize(whsize);
     if (wosize > Max_wosize)
-      failwith("intern: structure too big");
+      failwith("intern: structure too big #1");
     res = alloc_shr(wosize, String_tag);
     hd = Hd_val (res);
     color = Color_hd (hd);
@@ -528,8 +528,10 @@
     stat_free((char *) block);
   } else {
     /* Block has natural word size (32) */
-    if (wosize > Max_wosize)
-      failwith("intern: structure too big");
+    // printf("wosize = %d\n", wosize);
+    if (wosize > Max_wosize) {
+      failwith("intern: structure too big #2");
+    }
     res = alloc_shr(wosize, String_tag);
     hd = Hd_val (res);
     color = Color_hd (hd);
@@ -549,7 +551,6 @@
 value intern_val(struct channel * chan)          /* ML */
 {
   unsigned long magic;
-
   magic = (uint32) getword(chan);
   if (magic < First_valid_magic_number || magic > Last_valid_magic_number)
     failwith("intern: bad object");
diff -Nru mosml-2.01/src/runtime/interp.c mosml-2.10.1/src/runtime/interp.c
--- mosml-2.01/src/runtime/interp.c	2000-07-19 21:13:44.000000000 +0000
+++ mosml-2.10.1/src/runtime/interp.c	2014-08-28 08:47:22.000000000 +0000
@@ -49,7 +49,7 @@
 typedef unsigned char opcode_t;
 
 /* byte_raise_break_exn raises the Interrupt exception
-   (GETGLOBAL takes a short arg) 
+   (GETGLOBAL takes a long (4B) arg) 
 
    byte_callback[123]_code do callbacks from C to ML code:
    POP, 1, 0 means pop(1) 
@@ -57,18 +57,18 @@
 
 #if defined(MOSML_BIG_ENDIAN) && !defined(ALIGNMENT)
 static opcode_t byte_raise_break_exn[] =
-       { GETGLOBAL, 0, EXN_INTERRUPT, RAISE };
+       { GETGLOBAL, 0, 0, 0, EXN_INTERRUPT, RAISE };
 static opcode_t byte_callback1_code[] = { ACC1, APPLY1, POP, 0, 1, STOP };
 static opcode_t byte_callback2_code[] = { ACC2, APPLY2, POP, 0, 1, STOP };
 static opcode_t byte_callback3_code[] = { ACC3, APPLY3, POP, 0, 1, STOP };
 #else
 static opcode_t byte_raise_break_exn[] =
-       { GETGLOBAL, EXN_INTERRUPT, 0, RAISE };
+       { GETGLOBAL, EXN_INTERRUPT, 0, 0, 0, RAISE };
 static opcode_t byte_callback1_code[] = { ACC1, APPLY1, POP, 1, 0, STOP };
 static opcode_t byte_callback2_code[] = { ACC2, APPLY2, POP, 1, 0, STOP };
 static opcode_t byte_callback3_code[] = { ACC3, APPLY3, POP, 1, 0, STOP };
 #endif
-#define RAISE_CODE_LEN 4
+#define RAISE_CODE_LEN 6
 #define CALLBACK_CODE_LEN 6
 
 CODE callback1_code;		/* Set by interprete on initialization */
@@ -695,15 +695,15 @@
       *--sp = accu;
       /* Fallthrough */
     Instruct(GETGLOBAL):
-      accu = Field(global_data, u16pc);
-      pc += SHORT;
+      accu = Field(global_data, u32pc);
+      pc += LONG;
       Next;
 
     Instruct(PUSH_GETGLOBAL_APPLY1): 
     { sp -= 4;
       sp[0] = accu;
-      accu = Field(global_data, u16pc);
-      pc += SHORT;
+      accu = Field(global_data, u32pc);
+      pc += LONG;
       sp[1] = (value)pc;
       sp[2] = env;
       sp[3] = Val_long(extra_args);
@@ -751,8 +751,8 @@
       sp -= 4;
       sp[0] = accu;
       sp[1] = arg2;
-      accu = Field(global_data, u16pc);
-      pc += SHORT;
+      accu = Field(global_data, u32pc);
+      pc += LONG;
       sp[2] = (value)pc;
       sp[3] = env;
       sp[4] = Val_long(extra_args);
@@ -767,8 +767,8 @@
       sp[0] = accu;
       sp[1] = arg2;
       sp[2] = arg3;
-      accu = Field(global_data, u16pc);
-      pc += SHORT;
+      accu = Field(global_data, u32pc);
+      pc += LONG;
       sp[3] = (value)pc;
       sp[4] = env;
       sp[5] = Val_long(extra_args);
@@ -784,8 +784,8 @@
       sp[1] = arg2;
       sp[2] = arg3;
       sp[3] = arg4;
-      accu = Field(global_data, u16pc);
-      pc += SHORT;
+      accu = Field(global_data, u32pc);
+      pc += LONG;
       sp[4] = (value)pc;
       sp[5] = env;
       sp[6] = Val_long(extra_args);
@@ -798,7 +798,7 @@
       sp = sp + u16pc - 2; pc += SHORT;
       sp[0] = accu;
     getglobal_appterm:
-      accu = Field(global_data, u16pc);
+      accu = Field(global_data, u32pc);
       pc = Code_val(accu);
       env = accu;
       goto check_signals;
@@ -837,9 +837,9 @@
     }
 
     Instruct(SETGLOBAL):
-      modify(&Field(global_data, u16pc), accu);
+      modify(&Field(global_data, u32pc), accu);
       accu = Val_unit; /* ? */
-      pc += SHORT;
+      pc += LONG;
       Next;
 
 /* Allocation of blocks */
diff -Nru mosml-2.01/src/runtime/major_gc.c mosml-2.10.1/src/runtime/major_gc.c
--- mosml-2.01/src/runtime/major_gc.c	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/runtime/major_gc.c	2014-08-28 08:47:22.000000000 +0000
@@ -1,4 +1,5 @@
 #include 
+#include 
 #include "config.h"
 #include "debugger.h"
 #include "fail.h"
@@ -35,6 +36,395 @@
 char *gc_sweep_hp;
 int gc_phase;
 
+typedef struct {
+  intptr_t low, high;
+} p_table_entry;
+
+static p_table_entry *p_table;
+static size_t p_table_total_size;
+static size_t p_table_current_size;
+
+void p_table_init(size_t initial) {
+  p_table = malloc(initial*sizeof(p_table_entry));
+  if(p_table == NULL)
+      fatal_error ("No room for allocating page table\n");
+  p_table_total_size = initial;
+  p_table_current_size = 0;
+}
+
+#define RawPage(p) (((intptr_t) (p)) >> Page_log)
+
+char p_table_in_heap_simple(addr a) {
+  int i;
+  intptr_t p = RawPage(a);
+  for(i = 0; i < p_table_current_size; i++) {
+    //printf("p: %u low: %u high: %u\n", p, p_table[i].low, p_table[i].high);
+    if(p_table[i].low <= p && p < p_table[i].high) {
+      return In_heap;
+    }
+  }
+  return Not_in_heap;
+}
+
+char p_table_in_heap_16(addr a) {
+  intptr_t p = RawPage(a);
+  int i = 0;
+  while(i + 15 < p_table_current_size) {
+    if(   (p_table[i].low <= p && p < p_table[i].high)
+       || (p_table[i + 1].low <= p && p < p_table[i + 1].high)
+       || (p_table[i + 2].low <= p && p < p_table[i + 2].high)
+       || (p_table[i + 3].low <= p && p < p_table[i + 3].high)
+       || (p_table[i + 4].low <= p && p < p_table[i + 4].high)
+       || (p_table[i + 5].low <= p && p < p_table[i + 5].high)
+       || (p_table[i + 6].low <= p && p < p_table[i + 6].high)
+       || (p_table[i + 7].low <= p && p < p_table[i + 7].high)
+       || (p_table[i + 8].low <= p && p < p_table[i + 8].high)
+       || (p_table[i + 9].low <= p && p < p_table[i + 9].high)
+       || (p_table[i + 10].low <= p && p < p_table[i + 10].high)
+       || (p_table[i + 11].low <= p && p < p_table[i + 11].high)
+       || (p_table[i + 12].low <= p && p < p_table[i + 12].high)
+       || (p_table[i + 13].low <= p && p < p_table[i + 13].high)
+       || (p_table[i + 14].low <= p && p < p_table[i + 14].high)
+       || (p_table[i + 15].low <= p && p < p_table[i + 15].high)
+       ) return In_heap;
+    i += 16;
+  }
+  switch(p_table_current_size - i) {
+  case 15:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 14:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 13:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 12:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 11:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 10:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 9:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 8:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 7:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 6:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 5:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 4:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 3:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 2:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 1:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  default: return Not_in_heap;
+  }
+}
+
+char p_table_in_heap(addr a) {
+  intptr_t p = RawPage(a);
+  int i = 0;
+  while(i + 63 < p_table_current_size) {
+    if(   (p_table[i].low <= p && p < p_table[i].high)
+       || (p_table[i + 1].low <= p && p < p_table[i + 1].high)
+       || (p_table[i + 2].low <= p && p < p_table[i + 2].high)
+       || (p_table[i + 3].low <= p && p < p_table[i + 3].high)
+       || (p_table[i + 4].low <= p && p < p_table[i + 4].high)
+       || (p_table[i + 5].low <= p && p < p_table[i + 5].high)
+       || (p_table[i + 6].low <= p && p < p_table[i + 6].high)
+       || (p_table[i + 7].low <= p && p < p_table[i + 7].high)
+       || (p_table[i + 8].low <= p && p < p_table[i + 8].high)
+       || (p_table[i + 9].low <= p && p < p_table[i + 9].high)
+       || (p_table[i + 10].low <= p && p < p_table[i + 10].high)
+       || (p_table[i + 11].low <= p && p < p_table[i + 11].high)
+       || (p_table[i + 12].low <= p && p < p_table[i + 12].high)
+       || (p_table[i + 13].low <= p && p < p_table[i + 13].high)
+       || (p_table[i + 14].low <= p && p < p_table[i + 14].high)
+       || (p_table[i + 15].low <= p && p < p_table[i + 15].high)
+       || (p_table[i + 16].low <= p && p < p_table[i + 16].high)
+       || (p_table[i + 17].low <= p && p < p_table[i + 17].high)
+       || (p_table[i + 18].low <= p && p < p_table[i + 18].high)
+       || (p_table[i + 19].low <= p && p < p_table[i + 19].high)
+       || (p_table[i + 20].low <= p && p < p_table[i + 20].high)
+       || (p_table[i + 21].low <= p && p < p_table[i + 21].high)
+       || (p_table[i + 22].low <= p && p < p_table[i + 22].high)
+       || (p_table[i + 23].low <= p && p < p_table[i + 23].high)
+       || (p_table[i + 24].low <= p && p < p_table[i + 24].high)
+       || (p_table[i + 25].low <= p && p < p_table[i + 25].high)
+       || (p_table[i + 26].low <= p && p < p_table[i + 26].high)
+       || (p_table[i + 27].low <= p && p < p_table[i + 27].high)
+       || (p_table[i + 28].low <= p && p < p_table[i + 28].high)
+       || (p_table[i + 29].low <= p && p < p_table[i + 29].high)
+       || (p_table[i + 30].low <= p && p < p_table[i + 30].high)
+       || (p_table[i + 31].low <= p && p < p_table[i + 31].high)
+       || (p_table[i + 32].low <= p && p < p_table[i + 32].high)
+       || (p_table[i + 33].low <= p && p < p_table[i + 33].high)
+       || (p_table[i + 34].low <= p && p < p_table[i + 34].high)
+       || (p_table[i + 35].low <= p && p < p_table[i + 35].high)
+       || (p_table[i + 36].low <= p && p < p_table[i + 36].high)
+       || (p_table[i + 37].low <= p && p < p_table[i + 37].high)
+       || (p_table[i + 38].low <= p && p < p_table[i + 38].high)
+       || (p_table[i + 39].low <= p && p < p_table[i + 39].high)
+       || (p_table[i + 40].low <= p && p < p_table[i + 40].high)
+       || (p_table[i + 41].low <= p && p < p_table[i + 41].high)
+       || (p_table[i + 42].low <= p && p < p_table[i + 42].high)
+       || (p_table[i + 43].low <= p && p < p_table[i + 43].high)
+       || (p_table[i + 44].low <= p && p < p_table[i + 44].high)
+       || (p_table[i + 45].low <= p && p < p_table[i + 45].high)
+       || (p_table[i + 46].low <= p && p < p_table[i + 46].high)
+       || (p_table[i + 47].low <= p && p < p_table[i + 47].high)
+       || (p_table[i + 48].low <= p && p < p_table[i + 48].high)
+       || (p_table[i + 49].low <= p && p < p_table[i + 49].high)
+       || (p_table[i + 50].low <= p && p < p_table[i + 50].high)
+       || (p_table[i + 51].low <= p && p < p_table[i + 51].high)
+       || (p_table[i + 52].low <= p && p < p_table[i + 52].high)
+       || (p_table[i + 53].low <= p && p < p_table[i + 53].high)
+       || (p_table[i + 54].low <= p && p < p_table[i + 54].high)
+       || (p_table[i + 55].low <= p && p < p_table[i + 55].high)
+       || (p_table[i + 56].low <= p && p < p_table[i + 56].high)
+       || (p_table[i + 57].low <= p && p < p_table[i + 57].high)
+       || (p_table[i + 58].low <= p && p < p_table[i + 58].high)
+       || (p_table[i + 59].low <= p && p < p_table[i + 59].high)
+       || (p_table[i + 60].low <= p && p < p_table[i + 60].high)
+       || (p_table[i + 61].low <= p && p < p_table[i + 61].high)
+       || (p_table[i + 62].low <= p && p < p_table[i + 62].high)
+       || (p_table[i + 63].low <= p && p < p_table[i + 63].high)
+       ) return In_heap;
+    i += 64;
+  }
+  switch(p_table_current_size - i) {
+  case 63:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 62:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 61:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 60:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 59:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 58:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 57:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 56:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 55:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 54:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 53:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 52:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 51:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 50:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 49:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 48:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 47:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 46:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 45:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 44:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 43:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 42:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 41:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 40:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 39:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 38:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 37:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 36:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 35:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 34:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 33:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 32:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 31:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 30:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 29:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 28:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 27:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 26:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 25:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 24:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 23:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 22:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 21:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 20:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 19:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 18:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 17:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 16:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 15:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 14:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 13:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 12:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 11:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 10:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 9:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 8:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 7:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 6:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 5:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 4:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 3:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 2:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  case 1:
+    if(p_table[i].low <= p && p < p_table[i].high) return In_heap;
+    i++;
+  default: return Not_in_heap;
+  }
+}
+
+
+void p_table_update_size() {
+  p_table_total_size *= 2;
+  p_table = realloc(p_table, sizeof(p_table_entry)*p_table_total_size);
+  if(p_table == NULL)
+    fatal_error("No memory for page table");
+  gc_message ("Growing p_table to %ld\n", p_table_total_size);
+
+}
+
+void p_table_add_pages(addr start, addr end) {
+  intptr_t s, e;
+  if(p_table_current_size == p_table_total_size)
+    p_table_update_size();
+  p_table[p_table_current_size].low = RawPage(start);
+  p_table[p_table_current_size].high = RawPage(end);
+  p_table_current_size++;
+}
+
+
+
 /* The mark phase will register pointers to live arrays of weak
    pointers in weak_arrays.  Then the weak phase traverses each weak
    array and resets pointers to objects that will be deallocated by the
@@ -347,7 +737,7 @@
 #else
   page_table_size = 4 * stat_heap_size / Page_size;
 #endif
-  page_table = (char *) malloc (page_table_size);
+  /*  page_table = (char *) malloc (page_table_size);
   if (page_table == NULL){
     fatal_error ("Fatal error: not enough memory for the initial heap.\n");
   }
@@ -357,6 +747,10 @@
   for (i = Page (heap_start); i < Page (heap_end); i++){
     page_table [i] = In_heap;
   }
+  */
+  //  p_table_init(page_table_size);
+  p_table_init(64);
+  p_table_add_pages(heap_start, heap_end);
   Hd_hp (heap_start) = Make_header (Wosize_bhsize (stat_heap_size), 0, Blue);
   fl_init_merge ();
   fl_merge_block (Bp_hp (heap_start));
diff -Nru mosml-2.01/src/runtime/major_gc.h mosml-2.10.1/src/runtime/major_gc.h
--- mosml-2.01/src/runtime/major_gc.h	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/runtime/major_gc.h	2014-08-28 08:47:22.000000000 +0000
@@ -31,7 +31,7 @@
 #define Page(p) (((addr) (p) - (addr) heap_start) >> Page_log)
 #define Is_in_heap(p) \
   ((addr)(p) >= (addr)heap_start && (addr)(p) < (addr)heap_end \
-   && page_table [Page (p)] == In_heap)
+   && (p_table_in_heap((addr)p) == In_heap))
 #else
 #define Page(p) \
   (((unsigned long)(p) >> (16 + Page_log - 4)) + ((unsigned)(p) >> Page_log))
@@ -44,6 +44,7 @@
 void major_collection_slice (void);
 void major_collection (void);
 void finish_major_cycle (void);
-
+char p_table_in_heap(addr a);
+void p_table_add_pages(addr start, addr end);
 
 #endif /* _major_gc_ */
diff -Nru mosml-2.01/src/runtime/Makefile mosml-2.10.1/src/runtime/Makefile
--- mosml-2.01/src/runtime/Makefile	2000-07-18 14:16:44.000000000 +0000
+++ mosml-2.10.1/src/runtime/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -1,11 +1,13 @@
-# Makefile for the Moscow ML 2.00 version of the Caml Light runtime system
+# Makefile for the Moscow ML 2.10 version of the Caml Light runtime system
 
-OPTS=-fno-defer-pop -fomit-frame-pointer -DTHREADED
-BASECFLAGS= -Dunix -O2 $(OPTS)
+OPTS=-DTHREADED
+include ../Makefile.inc
 
-BASELIBS=-lm
+BASECFLAGS= -Dunix -O3 $(OPTS)
 
-include ../Makefile.inc
+ifeq ($(UNAME_S),Cross_W32)
+	BASECFLAGS= -Dunix -DCAMLRT -DWIN32 -D_CONSOLE -D_MBCS -O3 $(OPTS)
+endif
 
 BASEOBJS=interp.o expand.o misc.o stacks.o fix_code.o main.o fail.o signals.o \
   freelist.o major_gc.o minor_gc.o memory.o alloc.o roots.o \
@@ -38,16 +40,32 @@
 	$(STRIP) camlrunm$(EXE)
 
 camlrunmd$(EXE): $(DOBJS) prims.d.o
-	$(CC) $(CFLAGS) -o camlrunmd$(EXE) prims.d.o $(DOBJS) $(LIBS)
+	$(LD) $(CFLAGS) -o camlrunmd$(EXE) prims.d.o $(DOBJS) $(LIBS)
+
+
+# For cross compiling to WIN32
+camlrt.dll: $(OBJS) prims.o
+	$(DYNLD) -o camlrt.dll prims.o $(OBJS) $(LIBS) -mconsole
+#        $(CC) $(CFLAGS) /Fecamlrt.dll prims.obj $(OBJS) $(LIBS) /link /subsystem:console /def:"mosmldll.def"
+#        $(CC) $(CFLAGS) /Fecamlrt.dll prims.obj $(OBJS) $(LIBS) /link /subsystem:console
+
 
 clean:
 	rm -f camlrunm$(EXE) camlrunmd$(EXE) *.o *.a
 	rm -f primitives prims.c opnames.h jumptbl.h
 	rm -f .debugobj/*.o
+	rm -f m.h s.h
 
 install:
-	${INSTALL_PROGRAM} camlrunm$(EXE) $(BINDIR)
-	${INSTALL_PROGRAM} *.h $(INCDIR)
+	${INSTALL_PROGRAM} camlrunm$(EXE) $(DESTDIR)$(BINDIR)
+	${INSTALL_PROGRAM} camlrunm$(EXE) $(DESTDIR)$(LIBDIR)
+	${INSTALL_DATA} *.h $(DESTDIR)$(INCDIR)
+
+install_w32: camlrt.dll
+	${INSTALL_PROGRAM} camlrt.dll $(DESTDIR)$(BINDIR)
+	${INSTALL_PROGRAM} camlrt.dll $(DESTDIR)$(LIBDIR)
+	${INSTALL_DATA} *.h $(DESTDIR)$(INCDIR)
+
 
 primitives : $(PRIMS)
 	sed -n -e '/\/\* ML \*\//s/.* \([a-zA-Z0-9_][a-zA-Z0-9_]*\) *(.*/\1/p' \
@@ -81,7 +99,8 @@
 .SUFFIXES: .d.o
 
 .c.d.o:
-	cd .debugobj; $(CC) -c -g -I.. -I.. -DDEBUG $(OPTS) ../$<
+	sh -c 'if  [ ! -d .debugobj ] ; then mkdir .debugobj; fi'
+	cd .debugobj; $(CC) -Dunix -c -g -I.. -I.. -DDEBUG $(OPTS) ../$<
 	mv .debugobj/$*.o $*.d.o
 
 depend : prims.c opnames.h jumptbl.h
diff -Nru mosml-2.01/src/runtime/memory.c mosml-2.10.1/src/runtime/memory.c
--- mosml-2.01/src/runtime/memory.c	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/runtime/memory.c	2014-08-28 08:47:22.000000000 +0000
@@ -19,11 +19,9 @@
 */
 static char *expand_heap (mlsize_t request)
 {
-  char *mem;
-  char *new_page_table = NULL;
-  asize_t new_page_table_size = 0;
+  char *mem, *orig_ptr;
   asize_t malloc_request;
-  asize_t i, more_pages;
+  asize_t i;
 
   malloc_request = round_heap_chunk_size (Bhsize_wosize (request));
   gc_message ("Growing heap to %ldk\n",
@@ -34,37 +32,46 @@
     gc_message ("No room for growing heap\n", 0);
     return NULL;
   }
+  orig_ptr = ((char **)mem)[0];
   mem += sizeof (heap_chunk_head);
   (((heap_chunk_head *) mem) [-1]).size = malloc_request;
   Assert (Wosize_bhsize (malloc_request) >= request);
   Hd_hp (mem) = Make_header (Wosize_bhsize (malloc_request), 0, Blue);
 
 #ifndef SIXTEEN
-  if (mem < heap_start){
-    more_pages = -Page (mem);
-  }else if (Page (mem + malloc_request) > page_table_size){
-    Assert (mem >= heap_end);
-    more_pages = Page (mem + malloc_request) - page_table_size;
-  }else{
-    more_pages = 0;
-  }
+  /* if (mem < heap_start){ */
+  /*   /\* This is WRONG, Henning Niss 2005: *\/ */
+  /*   /\*    more_pages = -Page (mem); *\/ */
+  /*   /\* Actually, it is right. Albeit is depending on some intricate */
+  /*      properties of unsigned arithmetic. Below is a more */
+  /*      straightforward formulation. Ken Friis Larsen 2010. */
+  /*    *\/ */
+  /*   more_pages = (heap_start - mem) >> Page_log; */
+  /* }else if (Page (mem + malloc_request) > page_table_size){ */
+  /*   Assert (mem >= heap_end); */
+  /*   more_pages = Page (mem + malloc_request) - page_table_size; */
+  /* }else{ */
+  /*   more_pages = 0; */
+  /* } */
 
-  if (more_pages != 0){
+  /*if (more_pages != 0){
     new_page_table_size = page_table_size + more_pages;
     new_page_table = (char *) malloc (new_page_table_size);
     if (new_page_table == NULL){
-      gc_message ("No room for growing page table\n", 0);
-      free (mem);
+      gc_message ("No room for growing page table to: %zuMB\n",
+		  new_page_table_size / 1024*1024);
+      free (orig_ptr);
       return NULL;
     }
   }
-
+  */
   if (mem < heap_start){
-    Assert (more_pages != 0);
-    for (i = 0; i < more_pages; i++){
+    //    Assert (more_pages != 0);
+    /*    for (i = 0; i < more_pages; i++){
       new_page_table [i] = Not_in_heap;
     }
     bcopy (page_table, new_page_table + more_pages, page_table_size);
+    */    
     (((heap_chunk_head *) mem) [-1]).next = heap_start;
     heap_start = mem;
   }else{
@@ -72,12 +79,13 @@
     char *cur;
 
     if (mem >= heap_end) heap_end = mem + malloc_request;
-    if (more_pages != 0){
+    /*if (more_pages != 0){
       for (i = page_table_size; i < new_page_table_size; i++){
         new_page_table [i] = Not_in_heap;
       }
       bcopy (page_table, new_page_table, page_table_size);
     }
+    */
     last = &heap_start;
     cur = *last;
     while (cur != NULL && cur < mem){
@@ -88,11 +96,12 @@
     *last = mem;
   }
 
-  if (more_pages != 0){
+  /*  if (more_pages != 0){
     free (page_table);
     page_table = new_page_table;
     page_table_size = new_page_table_size;
   }
+  */
 #else                           /* Simplified version for the 8086 */
   {
     char **last;
@@ -109,9 +118,11 @@
   }
 #endif
 
-  for (i = Page (mem); i < Page (mem + malloc_request); i++){
+  /*  for (i = Page (mem); i < Page (mem + malloc_request); i++){
     page_table [i] = In_heap;
   }
+  */
+  p_table_add_pages(mem, mem+malloc_request);  
   stat_heap_size += malloc_request;
   return Bp_hp (mem);
 }
diff -Nru mosml-2.01/src/runtime/misc.c mosml-2.10.1/src/runtime/misc.c
--- mosml-2.01/src/runtime/misc.c	2000-03-15 22:06:47.000000000 +0000
+++ mosml-2.10.1/src/runtime/misc.c	2014-08-28 08:47:22.000000000 +0000
@@ -132,7 +132,7 @@
 
 char *aligned_malloc (asize_t size, int modulo)
 {
-  char *raw_mem;
+  char *raw_mem, *ptr, *result;
   unsigned long aligned_mem;
 /*
 #ifndef __MWERKS__
@@ -140,9 +140,13 @@
 #endif
 */
                                                  Assert (modulo < Page_size);
-  raw_mem = malloc (size + Page_size);
+  ptr = raw_mem = malloc (size + Page_size);
   if (raw_mem == NULL) return NULL;
   raw_mem += modulo;		/* Address to be aligned */
   aligned_mem = (((unsigned long) raw_mem / Page_size + 1) * Page_size);
-  return (char *) (aligned_mem - modulo);
+  result = (char *) (aligned_mem - modulo);
+
+  /* Save the original ptr from malloc */
+  ((char **) result)[0] = ptr;
+  return result;
 }
diff -Nru mosml-2.01/src/runtime/mosml.c mosml-2.10.1/src/runtime/mosml.c
--- mosml-2.01/src/runtime/mosml.c	2004-01-15 11:02:51.000000000 +0000
+++ mosml-2.10.1/src/runtime/mosml.c	2014-08-28 08:47:22.000000000 +0000
@@ -68,7 +68,19 @@
   if (Tag_val(v1) != Tag_val(v2)) return 0;
   switch(Tag_val(v1)) {
   case String_tag:
-    return (compare_strings(v1, v2) == Val_long(0));
+    { // Faster string comparison 2002-12-03
+      register int len = string_length(v1);
+      register unsigned char * p1, * p2;
+      if (len != string_length(v2))
+	return 0;
+      for (p1 = (unsigned char *) String_val(v1),
+	   p2 = (unsigned char *) String_val(v2);
+	   len > 0;
+	   len--, p1++, p2++)
+	if (*p1 != *p2)
+	  return 0;
+      return 1;
+    }
   case Double_tag:
     return (Double_val(v1) == Double_val(v2));
   case Reference_tag:  /* Different reference cells are not equal! */
@@ -102,7 +114,13 @@
 
 value sml_system(value cmd)        /* ML */
 {
-  return Val_int(system(String_val(cmd)));
+  value res;
+  errno = 0;
+  res = system(String_val(cmd));
+  if (errno == ENOENT)
+    return -1;
+  else
+    return Val_int(res);
 }
 
 value sml_abs_int(value x)          /* ML */
@@ -398,7 +416,6 @@
 
 value sml_float_of_string(value s)        /* ML */
 {
-
   char buff[64];
   mlsize_t len;
   int i, e_len;
@@ -613,10 +630,6 @@
 #pragma mpwc_newline off
 #endif
 
-/* The following must agree with timebase in mosmllib/Time.sml: */
-
-#define TIMEBASE (-1073741824)
-
 /* There is another problem on the Mac: with a time base of 1904,
    most times are simply out of range of mosml integers. So, I added
    the macros below to compensate. 07Sep95 e
@@ -629,6 +642,8 @@
 
 #endif
 
+/* Return time as (double) number of usec since the epoch */
+
 value sml_getrealtime (value v) /* ML */
 {
 #ifdef WIN32
@@ -648,19 +663,12 @@
   */
 
   ftime(&t);
-  res = alloc (2, 0);
-  Field (res, 0) = Val_long (t.time + TIMEBASE);
-  Field (res, 1) = Val_long (((long) t.millitm) * 1000);
-  return res;
+  return copy_double(t.time*1000000.0 + t.millitm*1000.0);
 #else
-  value res;
   struct timeval tp;
 
   gettimeofday(&tp, NULL);
-  res = alloc (2, 0);
-  Field (res, 0) = Val_long (SYStoSMLtime(tp.tv_sec)+TIMEBASE);
-  Field (res, 1) = Val_long (tp.tv_usec);
-  return res;
+  return copy_double((SYStoSMLtime(tp.tv_sec))*1000000.0 + (double)tp.tv_usec);
 #endif
 }
 
@@ -681,9 +689,9 @@
   struct timeb t;
   ftime(&t);
   res = alloc (6, 0);
-  Field (res, 2) = Val_long (t.time)+TIMEBASE;
+  Field (res, 2) = Val_long (t.time);
   Field (res, 3) = Val_long (((long) t.millitm) * 1000);
-  Field (res, 4) = Val_long (t.time)+TIMEBASE;
+  Field (res, 4) = Val_long (t.time);
   Field (res, 5) = Val_long (((long) t.millitm) * 1000);
 #elif defined(hpux) || defined(__svr4__)
   struct tms buffer;
@@ -964,7 +972,7 @@
 }
 
 #ifndef HAS_STRERROR
-#if (!defined(__FreeBSD__) && !defined(linux))
+#if (!defined(__FreeBSD__) && !defined(linux) && !defined(__APPLE__))
   extern int sys_nerr;
   extern char * sys_errlist [];
 #endif   
@@ -972,13 +980,12 @@
 #endif
 
 value sml_tmpnam(value v)          /* ML */
-{ 
-  char *res;
+{ char *res;
 #ifdef WIN32
   value value_res;
-
+ 
   res = _tempnam(NULL, "mosml");
-  if (res == NULL) 
+  if (res == NULL)
     failwith("tmpnam");
   value_res = copy_string(res);
   free(res);
@@ -1001,7 +1008,7 @@
   if (errnum < 0 || errnum >= sys_nerr) 
       return copy_string("(Unknown error)");
   else 
-    return copy_string(sys_errlist[errnum]);
+    return copy_string((char *)sys_errlist[errnum]);
 #endif
 }
 
@@ -1096,7 +1103,7 @@
 
 value sml_mktime (value v) /* ML */
 {
-  struct tm tmr;
+  struct tm tmr = {0};
 
   tmr.tm_hour  = Long_val(Field (v, 0));
   tmr.tm_isdst = Long_val(Field (v, 1));
@@ -1113,7 +1120,7 @@
 
 value sml_asctime (value v) /* ML */
 {
-  struct tm tmr;
+  struct tm tmr = {0};
   char *res;
 
   tmr.tm_hour  = Long_val(Field (v, 0));
@@ -1134,7 +1141,7 @@
 
 value sml_strftime (value fmt, value v) /* ML */
 {
-  struct tm tmr;
+  struct tm tmr = {0};
 #define BUFSIZE 256      
   char buf[BUFSIZE];
   long ressize;
@@ -1616,3 +1623,25 @@
   free(buf);
   return res;
 }
+
+/* Sleep for the number of usec indicated the Double val vtime */
+
+value sml_sleep(value vtime)	/* ML */
+{
+  double time = Double_val(vtime);
+#ifdef WIN32
+/* cvr: is this correct for win32? */
+  unsigned long msec = (long)(time/1000.0);
+  if (time > 0) {
+    Sleep(msec);
+  }
+#else
+  unsigned long sec = (long)(time/1000000.0);
+  unsigned long usec = (long)(time - 1000000.0 * sec);
+  if (time > 0) {
+    sleep(sec);
+    usleep(usec);
+  } 
+#endif       
+  return Val_unit;
+}
diff -Nru mosml-2.01/src/runtime/sys.c mosml-2.10.1/src/runtime/sys.c
--- mosml-2.01/src/runtime/sys.c	2000-07-19 21:13:44.000000000 +0000
+++ mosml-2.10.1/src/runtime/sys.c	2014-08-28 08:47:22.000000000 +0000
@@ -6,6 +6,7 @@
 #include 
 #include 
 #include 
+#include 
 #ifdef WIN32
 #include 
 #include 
@@ -33,15 +34,12 @@
 
 #else
 
-extern int sys_nerr;
-extern char * sys_errlist [];
-
 char * error_message(void)
 {
   if (errno < 0 || errno >= sys_nerr)
     return "unknown error";
   else
-    return sys_errlist[errno];
+    return (char *)sys_errlist[errno];
 }
 
 #endif /* HAS_STRERROR */
@@ -62,7 +60,9 @@
        "Overflow",
        "Bind",
        "Match",
-       "Io" };
+       "Io",
+       "Option",
+       "Span" };
 
 void sys_error(char * arg)
 {
diff -Nru mosml-2.01/src/test/mosmlyac/Makefile mosml-2.10.1/src/test/mosmlyac/Makefile
--- mosml-2.01/src/test/mosmlyac/Makefile	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/test/mosmlyac/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -2,12 +2,12 @@
 
 test1:
 	mosmlyac test1.grm
-	mosmlc -c test1.s??
+	mosmlc -c -liberal test1.s??
 
 test3: 
 	mosmlyac test3.grm
 	mosmllex test3lex.lex
-	mosmlc -c test3aux.sml test3.s?? test3lex.s?? test3main.sml
+	mosmlc -c -liberal test3aux.sml test3.s?? test3lex.s?? test3main.sml
 	mosml test3load	
 
 clean:
diff -Nru mosml-2.01/src/test/ovlsucc.sml mosml-2.10.1/src/test/ovlsucc.sml
--- mosml-2.01/src/test/ovlsucc.sml	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/test/ovlsucc.sml	2014-08-28 08:47:22.000000000 +0000
@@ -95,5 +95,5 @@
 local
    fun f(i,a,(ind,max)) = if a > max then (i,a) else (ind,max) 
 in
-   fun maxi ar = Array.foldli f (0,Array.sub(ar,0)) (ar,0,NONE)
+   fun maxi ar = Array.foldli f (0,Array.sub(ar,0)) ar
 end;
diff -Nru mosml-2.01/src/test/result.ok mosml-2.10.1/src/test/result.ok
--- mosml-2.01/src/test/result.ok	2004-01-12 22:59:36.000000000 +0000
+++ mosml-2.10.1/src/test/result.ok	2014-08-28 08:47:22.000000000 +0000
@@ -1,4 +1,4 @@
-Moscow ML version 2.01 (January 2004)
+Moscow ML version 2.01a (January 2004)
 Enter `quit();' to quit.
 [opening file "test.sml"]
 [opening file "test1.sml"]
@@ -497,10 +497,10 @@
 > val eew1 = true : bool
 > val eec1 = true : bool
 > val eeg1 = true : bool
-User: 0.410  System: 0.000  GC: 0.000  Real: 0.412
+User: 0.390  System: 0.000  GC: 0.000  Real: 0.390
 > val it = 7 : int
 > val loop2 = fn : int -> int
-User: 0.380  System: 0.000  GC: 0.000  Real: 0.376
+User: 0.400  System: 0.000  GC: 0.000  Real: 0.391
 > val it = 7 : int
 > val maxi = fn : int array -> int * int
 [closing file "ovlsucc.sml"]
@@ -942,7 +942,7 @@
 > val h = so far so good : int
 [closing file "testpp.sml"]
 > val it = () : unit
-Moscow ML version 2.01 (January 2004)
+Moscow ML version 2.01a (January 2004)
 Enter `quit();' to quit.
 - > type word8 = word8
 - ! Toplevel input:
@@ -1076,7 +1076,7 @@
 !                  ^^^^^
 ! Word8.word constant is too large
 - 
-Moscow ML version 2.01 (January 2004)
+Moscow ML version 2.01a (January 2004)
 Enter `quit();' to quit.
 - ! Toplevel input:
 ! val fail1 = ~1073741825;
@@ -1135,7 +1135,7 @@
 !              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 ! Lexical error: word constant is too large.
 - 
-Moscow ML version 2.01 (January 2004)
+Moscow ML version 2.01a (January 2004)
 Enter `quit();' to quit.
 - ! Toplevel input:
 ! datatype t = true;
@@ -1282,7 +1282,7 @@
 !             ^^^
 ! Illegal rebinding or respecification
 - 
-Moscow ML version 2.01 (January 2004)
+Moscow ML version 2.01a (January 2004)
 Enter `quit();' to quit.
 - > val ('a, 'b) it = fn : 'a -> ('a -> 'b) -> 'b
 - ! Toplevel input:
@@ -1332,7 +1332,7 @@
 !   'b
 ! because of circularity
 - 
-Moscow ML version 2.01 (January 2004)
+Moscow ML version 2.01a (January 2004)
 Enter `quit();' to quit.
 - ! Toplevel input:
 ! fun f1 x = (x=x, x 1);
@@ -1478,7 +1478,7 @@
 !   'a -> 'a
 ! cannot have explicit type 'a
 - 
-Moscow ML version 2.01 (January 2004)
+Moscow ML version 2.01a (January 2004)
 Enter `quit();' to quit.
 - ! Toplevel input:
 ! fun true x  = x;
diff -Nru mosml-2.01/src/tools/installer/addlines.bat mosml-2.10.1/src/tools/installer/addlines.bat
--- mosml-2.01/src/tools/installer/addlines.bat	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/tools/installer/addlines.bat	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,5 @@
+@echo off
+echo REM Do NOT delete this line.  This line and the following two lines will be deleted unconditional by the Moscow ML uninstaller >> c:\autoexec.bat
+echo SET MOSMLLIB = %1 >> c:\autoexec.bat
+echo PATH = $PATH; %2 >> c:\autoexec.bat
+cls
diff -Nru mosml-2.01/src/tools/installer/dellines.sml mosml-2.10.1/src/tools/installer/dellines.sml
--- mosml-2.01/src/tools/installer/dellines.sml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/tools/installer/dellines.sml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,20 @@
+fun main () =
+    let val dev = TextIO.openIn"c:\\autoexec.bat"
+        val stop = "REM Do NOT delete this line.  This line and the following two lines will be deleted unconditional by the Moscow ML uninstaller \n"
+        fun readlines acc =
+            let val line = TextIO.inputLine dev
+            in  if line = "" then acc
+                else if line = stop then 
+                     ( TextIO.inputLine dev
+                     ; TextIO.inputLine dev
+                     ; TextIO.inputAll dev :: acc
+                     )
+                else readlines (line :: acc)
+            end
+         val lines = List.rev(readlines[])
+         val dev   = (TextIO.closeIn dev; TextIO.openOut "c:\\autoexec.bat")
+     in  List.app (fn line => TextIO.output(dev, line)) lines
+       ; TextIO.closeOut dev
+     end
+
+val _ = main() handle ? => ()
diff -Nru mosml-2.01/src/tools/installer/infoafter.txt mosml-2.10.1/src/tools/installer/infoafter.txt
--- mosml-2.01/src/tools/installer/infoafter.txt	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/tools/installer/infoafter.txt	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,3 @@
+Welcome to the wonderful world of Moscow ML version 2.00.
+
+You might need to reboot your computer before Moscow ML works.
diff -Nru mosml-2.01/src/tools/installer/mosml.iss mosml-2.10.1/src/tools/installer/mosml.iss
--- mosml-2.01/src/tools/installer/mosml.iss	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/tools/installer/mosml.iss	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,104 @@
+; Inno Setup Script for installing Moscow ML ver. 2.00
+; Created: 2001-02-04 by Ken Friis Larsen 
+; Modified: 2001-05-10 kfl
+
+[Setup]
+AppName            = Moscow ML
+AppVerName         = Moscow ML version 2.00
+AppVersion         = 2.00
+;AppCopyright=Copyright © 1997-2001 Peter Sestoft
+AppPublisherURL    = http://www.dina.kvl.dk/~sestoft/mosml.html
+DefaultDirName     = {pf}\Mosml
+DefaultGroupName   = Moscow ML
+CompressLevel      = 9
+InfoAfterFile      = src/install/infoafter.txt
+OutputBaseFilename = mosml-setup-2.00
+
+[Dirs]
+Name: "{app}\bin"
+Name: "{app}\copyrght"
+Name: "{app}\config.w32"
+Name: "{app}\doc"
+Name: "{app}\doc\mosmllib"
+Name: "{app}\examples"
+Name: "{app}\examples\calc"
+Name: "{app}\examples\cgi"
+Name: "{app}\examples\lexyacc"
+Name: "{app}\examples\lexyacc\cl"
+Name: "{app}\examples\manual"
+Name: "{app}\examples\mls"
+Name: "{app}\examples\modules"
+Name: "{app}\examples\parsercomb"
+Name: "{app}\examples\paulson"
+Name: "{app}\examples\pretty"
+Name: "{app}\examples\small"
+Name: "{app}\examples\units"
+Name: "{app}\examples\weak"
+Name: "{app}\examples\webserver"
+Name: "{app}\include"
+Name: "{app}\lib"
+Name: "{app}\tools"
+Name: "{app}\utility"
+Name: "{app}\utility\sml-mode-3.3b"
+
+[Files]
+Source : "bin\*"; DestDir : "{app}\bin"
+Source : "config"; DestDir : "{app}"
+Source : "config.w32\*"; DestDir : "{app}\config.w32" 
+Source : "copyrght\*"; DestDir : "{app}\copyrght"
+Source : "doc\*"; DestDir : "{app}\doc"
+Source : "doc\recomp"; DestDir : "{app}\doc"
+Source : "doc\mosmllib\*"; DestDir : "{app}\doc\mosmllib"
+Source : "examples\*" ; DestDir : "{app}\examples"
+Source : "examples\calc\*" ; DestDir : "{app}\examples\calc"
+Source : "examples\cgi\*" ; DestDir : "{app}\examples\cgi"
+Source : "examples\lexyacc\*" ; DestDir : "{app}\examples\lexyacc"
+Source : "examples\lexyacc\cl\*" ; DestDir : "{app}\examples\lexyacc\cl"
+Source : "examples\manual\*" ; DestDir : "{app}\examples\manual"
+Source : "examples\mls\*" ; DestDir : "{app}\examples\mls"
+Source : "examples\modules\*" ; DestDir : "{app}\examples\modules"
+Source : "examples\parsercomb\*" ; DestDir : "{app}\examples\parsercomb"
+Source : "examples\paulson\*" ; DestDir : "{app}\examples\paulson"
+Source : "examples\pretty\*" ; DestDir : "{app}\examples\pretty"
+Source : "examples\small\*" ; DestDir : "{app}\examples\small"
+Source : "examples\units\*" ; DestDir : "{app}\examples\units"
+Source : "examples\weak\*" ; DestDir : "{app}\examples\weak"
+Source : "examples\webserver\*" ; DestDir : "{app}\examples\webserver"
+Source : "include\*" ; DestDir : "{app}\include"
+Source : "install.txt" ; DestDir : "{app}"
+Source : "readme" ; DestDir : "{app}"
+Source : "roadmap" ; DestDir : "{app}"
+Source : "lib\*" ; DestDir : "{app}\lib"
+Source : "tools\*" ; DestDir : "{app}\tools"
+Source : "utility\*" ; DestDir : "{app}\utility"
+Source : "utility\sml-mode-3.3b\*" ; DestDir : "{app}\utility\sml-mode-3.3b"
+
+; Some helper programs for Windows 95 and derrived
+Source : "addline.bat"; DestDir : "{tmp}" ; Flags : deleteafterinstall ; OnlyBelowVersion : 0,3.0
+Source : "dellines.exe"; DestDir : "{app}\lib" ; OnlyBelowVersion : 0,3.0
+
+
+[Icons]
+Name : "{group}\Moscow ML" ; FileName : "{app}\bin\mosml.exe" ; Parameters : "-P full" ; WorkingDir : "{app}" ; IconFilename : "{app}\utility\FS2_cow.ico" 
+Name : "{userdesktop}\Moscow ML" ; FileName : "{app}\bin\mosml.exe" ; Parameters : "-P full" ; WorkingDir : "{app}" ; IconFilename : "{app}\utility\FS2_cow.ico" 
+
+[Registry]
+; Set environment variables on Windows NT, Windows 2000
+Root: HKCU ; Subkey : "Environment"; ValueType : string ; ValueName : "MOSMLLIB"; ValueData : "{app}\lib"; Flags: uninsdeletevalue; MinVersion : 0,3.51
+Root: HKCU ; Subkey : "Environment"; ValueType : string ; ValueName : "MOSMLBIN"; ValueData : "{app}\bin"; Flags: uninsdeletevalue; MinVersion : 0,3.51
+; Use MOSMLBIN instead of {app}\bin
+Root: HKCU ; Subkey : "Environment"; ValueType : expandsz ; ValueName : "Path"; ValueData : "{olddata};{app}\bin"; MinVersion : 0,3.51
+
+; The following two lines are system-wide installation
+;Root: HKLM ; Subkey : "SYSTEM\CurrentControlSet\Control\Session Manager\Environment"; ValueType : string ; ValueName : "MOSMLLIB"; ValueData : "{app}\lib"; MinVersion : 0,3.51
+;Root: HKLM ; Subkey : "SYSTEM\CurrentControlSet\Control\Session Manager\Environment"; ValueType : expandsz ; ValueName : "PATH"; ValueData : "{olddata};{app}\bin"; MinVersion : 0,3.51
+
+[Run]
+; Set environment variables on Windows 95 and derrived
+Filename : "{tmp}\addline.bat"; Description : "Set environment variables"; StatusMsg : "Setting environment variables..."; Parameters : """{app}\lib"" ""{app}\bin""" ; Flags : postinstall ; OnlyBelowVersion : 0,3.0
+
+[UninstallRun]
+; Unset environment variables on Windows 95 and derrived
+Filename : "{app}\lib\dellines.exe" ; OnlyBelowVersion : 0,3.0
+
+
diff -Nru mosml-2.01/src/tools/installer/README mosml-2.10.1/src/tools/installer/README
--- mosml-2.01/src/tools/installer/README	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/tools/installer/README	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,14 @@
+
+This directory contains configuration scripts for various installation
+builders.
+
+
+File                     Description
+---------------------------------------
+mosml.spec               For rpm (remember to update version nr.)
+
+mosml.iss                For Inno Setup (Windows) see README.inno for
+                         more information.
+infoafter.txt            For Inno Setup
+addline.bat              For Inno Setup
+dellines.sml             For Inno Setup
diff -Nru mosml-2.01/src/tools/installer/README.inno mosml-2.10.1/src/tools/installer/README.inno
--- mosml-2.01/src/tools/installer/README.inno	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/tools/installer/README.inno	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,49 @@
+Notes on how to build a windows installer
+=========================================
+
+We use the free program Inno Setup:
+   http://www.jrsoftware.org/isinfo.htm
+
+
+The configuration script is in the file mosml.iss.  This file should
+be moved to the root of the mosml dir when building the installer.
+
+The installer shows the contents of the file infoafter.txt.  [The
+contents of this file should be updated.]
+
+Current status of the resulting installer is:
+
+    * Perfect on W2K and NT.
+    * Does not set MOSMLHOME nor update PATH on win9x.  Solutions: 
+      1. A technical solution can be made (write two small programs);
+      2. or we can document our way out of it (Inno Setup has some
+         nice hooks for this kind of documentation).
+
+I've made an attempt on solution 1. [But Claudio reports that it is broken].
+
+     [addlines.bat  ] adds the following 3 lines to
+     c:\autoexec.bat
+ 
+        REM Do NOT delete this line.  This line and the following two lines will be deleted unconditional by the Moscow ML uninstaller
+        SET MOSMLLIB = 
+        PATH = $PATH; 
+
+     [dellines.sml] deletes the 3 lines above from c:\autoexec.bat 
+
+
+How to build an installer step by step:
+---------------------------------------
+
+1. Prepare a binary distrubution of mosml (ie. compile everything) 
+
+2. Move mosml.iss to root of the bin. dist. 
+
+3. Update mosml.iss as needed (version number etc.)
+
+4. Update infoafter.txt as needed
+
+5. Compile dellines.sml to dellines.exe
+
+6. Run Inno Setup on mosml.iss
+
+7. The installer can now be found the directory "Output"
diff -Nru mosml-2.01/src/tools/travis mosml-2.10.1/src/tools/travis
--- mosml-2.01/src/tools/travis	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/tools/travis	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,24 @@
+#!/bin/sh
+# Script for handling execution of builds with Travis CI (travis-ci.org).
+
+# show information about system used for building
+uname -a
+
+case "$1" in
+    "install")
+        case "$TARGET" in
+            "linux") sudo apt-get install -y libgmp-dev ;;
+            "cross_w32") which i586-mingw32msvc-gcc || sudo apt-get -f -y install gcc-mingw32 ;;
+        esac
+    ;;
+    "build")
+        case "$TARGET" in
+            "linux") cd src && make world && sudo make install ;;
+            "cross_w32")
+                INSTALLDIR=/tmp/mosml_install
+                cd src && make cross_w32 PREFIX=$INSTALLDIR ;;
+        esac
+    ;;
+    "test")
+    ;;
+esac
diff -Nru mosml-2.01/src/toolssrc/Deplex.lex mosml-2.10.1/src/toolssrc/Deplex.lex
--- mosml-2.01/src/toolssrc/Deplex.lex	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/toolssrc/Deplex.lex	2014-08-28 08:47:22.000000000 +0000
@@ -69,13 +69,12 @@
 val savedLexemeStart = ref 0;
 
 fun getQual s =
-  let open CharVector
-      val len' = size s - 1
+  let val len' = size s - 1
       fun parse n =
         if n >= len' then
 	    ""				(* This can't happen *)
-        else if sub(s, n) = #"." then
-	    extract(s, 0, SOME n)
+        else if CharVector.sub(s, n) = #"." then
+	    CharVectorSlice.vector(CharVectorSlice.slice(s, 0, SOME n))
         else
 	    parse (n+1)
   in parse 0 end;
diff -Nru mosml-2.01/src/toolssrc/.gitignore mosml-2.10.1/src/toolssrc/.gitignore
--- mosml-2.01/src/toolssrc/.gitignore	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/src/toolssrc/.gitignore	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,8 @@
+*.ui
+*.uo
+Deplex.sml
+Deppars.sig
+Deppars.sml
+Mosmldep.sml
+cutdeps
+mosmldep
diff -Nru mosml-2.01/src/toolssrc/Makefile mosml-2.10.1/src/toolssrc/Makefile
--- mosml-2.01/src/toolssrc/Makefile	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/src/toolssrc/Makefile	2014-08-28 08:47:22.000000000 +0000
@@ -34,7 +34,7 @@
 	rm -f cutdeps mosmldep
 
 install:
-	${INSTALL_DATA} cutdeps mosmldep $(TOOLDIR)
+	${INSTALL_DATA} cutdeps mosmldep $(DESTDIR)$(TOOLDIR)
 
 depend: Deplex.sml Deppars.sml Mosmldep.sml
 	rm -f Makefile.bak
Binary files /tmp/HAzJFmIrvn/mosml-2.01/tools/cutdeps and /tmp/A1vl5z0ZBv/mosml-2.10.1/tools/cutdeps differ
Binary files /tmp/HAzJFmIrvn/mosml-2.01/tools/mosmldep and /tmp/A1vl5z0ZBv/mosml-2.10.1/tools/mosmldep differ
diff -Nru mosml-2.01/.travis.yml mosml-2.10.1/.travis.yml
--- mosml-2.01/.travis.yml	1970-01-01 00:00:00.000000000 +0000
+++ mosml-2.10.1/.travis.yml	2014-08-28 08:47:22.000000000 +0000
@@ -0,0 +1,27 @@
+# Configuration file for Travis CI (http://travis-ci.org)
+language: c
+compiler: gcc
+
+env:
+    - TARGET=linux
+    - TARGET=cross_w32
+
+before_install:
+    - sudo apt-get update -qq
+install:
+    - ./src/tools/travis install
+script:
+    - ./src/tools/travis build
+after_script:
+    - ./src/tools/travis test
+
+
+branches:
+    only:
+        - master
+        - devel
+
+notifications:
+    email:
+        on_success: change
+        on_failure: always
diff -Nru mosml-2.01/utility/dosedit mosml-2.10.1/utility/dosedit
--- mosml-2.01/utility/dosedit	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/utility/dosedit	1970-01-01 00:00:00.000000000 +0000
@@ -1,50 +0,0 @@
-Using Moscow ML under plain DOS
--------------------------------
-
-If you use mosml under plain DOS, then you need an external editor
-such as DOS `edit' to edit your ML source files.  
-
-Assume that the source file you want to edit is called "gcd.sml".
-Then you can invoke the editor from within the ML session by
-evaluating
-
-	system "edit gcd.sml";
-
-When returning from the editor, you can load the source file by
-evaluating
-
-	use "gcd.sml";
-
-This works, but is tedious.  To simplify the calls to edit and use,
-use the following program in file mosml\lib\edit:
-
-(* ---------------------------------------------------------- *)
-   local 
-      val file = ref ""
-      fun setit "" = !file
-	| setit s  = (file := s; s)
-   in 
-      fun e s = (system ("edit " ^ setit s); use (setit s))
-   end
-(* ---------------------------------------------------------- *)
-
-You may invoke Moscow ML with
-
-	mosml edit
-
-Then, inside the mosml session, you may evaluate
-
-	e "gcd.sml";
-
-This will invoke the DOS editor `edit' on file "gcd.sml".  When you
-are finished editing the file, save it, and exit the editor.  Then the
-edited file will automatically be loaded into the current mosml
-session by `use'.  (If you prefer to use e.g. the Turbo Pascal editor,
-then replace "edit " by "turbo " in function `e' above).
-
-The call to the `e' function saves the filename, so if you need to
-edit the same file "gcd.sml" again, you need to type only
-
-	e "";
-
-This will edit (and then use) the file most recently edited.
diff -Nru mosml-2.01/utility/emacs mosml-2.10.1/utility/emacs
--- mosml-2.01/utility/emacs	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/utility/emacs	1970-01-01 00:00:00.000000000 +0000
@@ -1,29 +0,0 @@
-The directory sml-mode-3.3b contains Matthew Morley's Emacs sml-mode
-version 3.2, including customization for Moscow ML, but excluding
-documentation.
-
-It is available from 
-
-	http://www.scs.leeds.ac.uk/mjm/sml-mode/
-
-On-line documentation is available at
-
-	http://www.scs.leeds.ac.uk/mjm/sml-mode/sml-mode.html
-
-Install as directed in file sml-mode-3.3b/README.
-
-If you follow those instructions, then from within an Emacs buffer in
-sml-mode, you can
-
- * type  C-c m    to invoke Moscow ML under Emacs 
- * type  C-c C-s  to jump to the Moscow ML buffer
- * type  C-c C-b  to load the buffer's contents into Moscow ML
- * type  C-c C-l  to load some file's contents into Moscow ML
-
- * type  C-h m    to get brief help on other commands in sml-mode
- * type  C-c C-i  to get extensive documentation on sml-mode
-
-In case of compilation errors, 
-
- * type  C-c C-`  to jump to the location of the error in the source code
-
diff -Nru mosml-2.01/utility/README mosml-2.10.1/utility/README
--- mosml-2.01/utility/README	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/utility/README	1970-01-01 00:00:00.000000000 +0000
@@ -1,18 +0,0 @@
-File mosml/utility/README
-
-dosedit         explains one way to use Moscow ML and an editor under 
-                plain MS DOS
-
-emacs           explains how to use Moscow ML under Emacs, with 
-                Matthew Morley's sml-mode
-
-MosML.ico       Moscow ML icon for Windows'95
-
-sml-mode-3.3b   Matthew Morley's Emacs sml-mode version 3.3b, including
-                customization for Moscow ML and Emacs Info documentation.  
-                Available from http://www.scs.leeds.ac.uk/mjm/sml-mode/.
-                Documentation in HTML and Postscript at:
-                http://www.scs.leeds.ac.uk/mjm/sml-mode/sml-mode.html
-
-                A more recent version (requires Emacs 20) is at 
-                ftp://rum.cs.yale.edu/pub/monnier/sml-mode/
diff -Nru mosml-2.01/utility/sml-mode-3.3b/README mosml-2.10.1/utility/sml-mode-3.3b/README
--- mosml-2.01/utility/sml-mode-3.3b/README	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/utility/sml-mode-3.3b/README	1970-01-01 00:00:00.000000000 +0000
@@ -1,153 +0,0 @@
-SML-MODE (3.3b) -- Major Emacs mode for editing Standard ML.
-
-  3.3(beta) because i really am looking at the indentation algorithm,
-  but the new features mentioned below are stable -- modulo bugs.
-
-Files:
-
-  sml-mode.el     (SML mode elisp code)
-  sml-proc.el     (ML interaction code, defaults to SML/NJ(0.93))
-  sml-hilite.el   (hilit19 functions)
-  sml-font.el     (font-lock functions)
-  sml-menus.el    (Simple menus)
-
-  sml-poly-ml.el  (Additional library code to run Poly/ML)
-  sml-mosml.el    (Additional library code to run Moscow ML)
-
-  sml-mode.info   (Softcopy manual -- Info for (X)Emacs19)
-  sml-site.el     (Simple, system-wide installation)
-
-Extras:
-
-  sml-mode.dvi    (Hardcopy manual)
-
-Warning:
-
-  Tried and sort of tested on GNU Emacs 19.3{3,4} and XEmacs 19.14.
-
-  XEmacs 19.11 is known to hang on sending regions to the interaction
-  buffer -- so leave the variable SML-TEMP-THRESHOLD = 0.
-
-System Installation Guide:
-
-  If you're installing this for others in the Emacs hierarchy, either
-
-    go to the site-lisp directory and unpack the tar file there, 
-
-    or create a subdirectory, say site-lisp/sml-mode, and copy at
-    least the sml*.el files into it.
-
-  In either case move or copy the file sml-site.el into the site-lisp
-  directory itself (or some other place that's on the user's default
-  load-path) and read and edit this file. All that's really needed is
-  to ensure that Emacs can find the sml*.el files and the .info file.
-
-  Tell your eager users to
-
-  (requite 'sml-site) 
-
-  in their .emacses. Point them to the help file. At your option, byte
-  compile the sml*.el files (and sml-site.el too, if you like).
-
-Private Installation Guide:
-
-  If you are having to install his in your home directory, say, create
-  a directory like "/home/xxx/lib/emacs/sml-mode", if your login name
-  is xxx, and copy the sml-*.el files to there. Then put:
-  
-  (setq load-path (cons "/home/xxx/lib/emacs/sml-mode" load-path))
-  (autoload 'sml-mode "sml-mode" "Major mode for editing ML programs." t)
-
-  in your .emacs file. Add:
-
-  (setq auto-mode-alist
-        (append '(("\\.sml$" . sml-mode) 
-                  ("\\.sig$" . sml-mode) 
-                  ("\\.ML$"  . sml-mode)) auto-mode-alist))
-
-  to your .emacs so that whenever you visit a file with one of these
-  extensions you will automatically be placed in sml-mode.
-
-  Put the info file (sml-mode.info) somewhere convenient like
-  "/home/xxx/lib/emacs/sml-mode/sml-mode.info", and add
-
-  (setq sml-mode-info "/home/xxx/lib/emacs/sml-mode/sml-mode.info")
-
-  again to your .emacs -- this gives access to on-line help. This help
-  file gives lots of tips about configuring SML mode to suit your
-  preferences: C-c C-i will get you there from SML mode.
-
-  If you want SML mode to speak to Moscow ML or Poly/ML instead of
-  SML/NJ, just add something like this to your .emacs:
-
-  (defun my-mosml-setup () "Configure inferior SML mode for Moscow ML"
-    (load-library "sml-mosml"))
-  (add-hook 'inferior-sml-load-hook 'my-mosml-setup)
-
-  so that when you M-x sml you'll get mosml instead.
-
-New in SML mode Version 3.3 (feedback welcomed on this):
-
-  1
-
-  implemented some multi-frame handling capabilities, specifically so 
-  sml runs in a dedicated window. this is more complex than it needs to
-  be because of XEmacs...
-
-  the variable SML-DEDICATED-FRAME defaults to t if running under a
-  window system; set it to nil in SML-LOAD-HOOK if you want the old
-  split window behaviour back.
-
-  2
-
-  debugged SML-NEXT-ERROR a bit, and improved it to echo the error
-  message in the minibuffer (if possible) and highlight the region in
-  which the error was found (if a suitable character range was given).
-
-  the variable SML-ERROR-OVERLAY controls whether or not to highlight
-  (default is yes); set this to nil in SML-MODE-HOOK to switch this
-  off. 
-
-  SML-NEXT-ERROR won't always raise the inferior ML buffer's frame; it
-  only does so if there's no window already showing the buffer, or if
-  there's an error message it can't understand. i think!
-
-  3
-
-  support for Moscow ML -- see sml-mosml.el.
-
-  4
-
-  forms (aka, templates or macros) insertion semantics have changed
-  because there were bugs. maybe there still are, but anyway: by
-  default C-c C-m inserts the macro at point, C-u C-c C-m will do a
-  newline-and-indent before inserting the macro.
-
-  abstractions are history, and you can play with extending the
-  collection of builtin macros to your heart's content. lookup the
-  function SML-ADDTO-FORMS-ALIST, and the variable SML-FORMS-ALIST.
-
-  5
-
-  drag-and-droppishness, without the drop: SML-DRAG-MOUSE is bound to
-  M-S-down-mouse-1; if you drag the mouse over a region it will be
-  magically sucked into the ML buffer (like C-c C-r, only you don't
-  have to C-@ first). this might be flakey as it heavily depends on
-  the underlying mouse-drag/track-mouse semantics of the various
-  Emacses out there. can't do much about that, sorry.
-
-  6
-
-  anything else i've forgotten already!
-
-To Do:
-
-  0
-
-  indentation is hopeless for sequential code (semicolons). this needs
-  attention; indeed all the indentation code does. Ian Zimmerman's very
-  excellent (looking) indentation code for caml-mode may point the way
-  forward. or we all go over to programming in Lisp instead of ML...
-
-Matthew Morley 
-05/97
diff -Nru mosml-2.01/utility/sml-mode-3.3b/sml-font.el mosml-2.10.1/utility/sml-mode-3.3b/sml-font.el
--- mosml-2.01/utility/sml-mode-3.3b/sml-font.el	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/utility/sml-mode-3.3b/sml-font.el	1970-01-01 00:00:00.000000000 +0000
@@ -1,191 +0,0 @@
-;;; sml-font.el --- Highlighting for sml-mode using font-lock.
-;;
-;; Copyright (C) 1995 Frederick Knabe
-;;
-;; Author:     Fritz Knabe 
-;;             ECRC GmbH, Arabellastr. 17, 81925 Munich, Germany
-;; Created:    26 June 1995
-;; Modified:   14 April 1997, M.J.Morley 
-;;             Add a couple of keywords to s-f-l-standard-keywords.
-;;
-;; $Revision: 1.1.1.1 $
-;; $Date: 2000/01/21 10:07:13 $
-;;
-;; ====================================================================
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2 of the License, or
-;; (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-;;
-;; If you did not receive a copy of the GNU General Public License with
-;; this program, write to the Free Software Foundation, Inc., 675 Mass
-;; Ave, Cambridge, MA 02139, USA.
-;; ====================================================================
-;;
-;;; DESCRIPTION
-;;
-;; This package sets up highlighting of SML using font-lock.  If you
-;; use the new version of font-lock distributed in GNU Emacs, SML's
-;; nested comments as well as its special string escapes will be
-;; handled properly.  The version of font-lock distributed with XEmacs
-;; can also be used, but these special cases will not be handled.
-;;
-;; Should the fontification become incorrect while editing (for
-;; example, when uncommenting), M-x font-lock-fontify-buffer will clear
-;; things up.
-;;
-;; To install (assuming that you use sml-mode 3.1), put the following
-;; in your .emacs:
-;;
-;;       (setq sml-hilite nil)     ; Turn off highlighting based on hilit19
-;;
-;;	  ;; For GNU Emacs
-;;       (eval-after-load "sml-mode" '(require 'sml-font))
-;;
-;;       ;; For XEmacs
-;;       (require 'sml-font)
-;;
-;;
-;; Versions 3.2 and later of sml-mode define sml-load-hook (and the
-;; variable sml-hilite is spurious), so you can simply put:
-;;
-;;       (setq sml-load-hook
-;;             '(lambda() "Fontify SML." (require 'sml-font)))
-;;
-;; By default, font-lock will be turned on automatically for every SML
-;; buffer.  If you don't want this, also add the following:
-;;
-;;       (setq sml-font-lock-auto-on nil)
-;;
-;; If you want to add to the keywords that will be fontified, set the
-;; variable sml-font-lock-extra-keywords (see its documentation).
-;;
-;; Thanks to Matthew Morley  for suggestions and fixes.
-;; 
-
-(require 'font-lock)
-
-(defvar sml-font-lock-auto-on t
-  "*If non-nil, turn on font-lock unconditionally for every SML buffer.")
-
-(defvar sml-font-lock-extra-keywords nil
-  ;; The example is easier to read if you load this package and use C-h v
-  ;; to view the documentation.
-  "*List of regexps to fontify as additional SML keywords.
-
-For example, to add `xfun', `xfn', `special', and `=>', the value could be
-
-	(\"\\=\\=\\=\\\\=\\=\\=\\\" \"=>\")
-
-The word delimiters in the first pattern prevent spurious highlighting
-of keywords embedded inside other words (e.g., we don't want the tail of
-`myxfun' to be highlighted).  You cannot use word delimiters with
-symbolic patterns, however, because only alphanumerics are defined as
-Emacs word constituents.  The second pattern would match the tail of a
-symbolic identifier such as `==>', which might not be what you want.")
-
-(defvar sml-font-lock-standard-keywords
-  ;; Generated with Simon Marshall's make-regexp:
-  ;; (make-regexp
-  ;;  '("abstype" "and" "andalso" "as" "case" "datatype"
-  ;;    "else" "end" "eqtype" "exception" "do" "fn" "fun" "functor"
-  ;;    "handle" "if" "in" "include" "infix" "infixr" "let" "local" "nonfix"
-  ;;    "of" "op" "open" "orelse" "overload" "raise" "rec" "sharing" "sig"
-  ;;    "signature" "struct" "structure" "then" "type" "val" "where" "while"
-  ;;    "with" "withtype") t)
-
-  "\\<\\(a\\(bstype\\|nd\\(\\|also\\)\\|s\\)\\|case\\|d\\(atatype\\|o\\)\\|\
-e\\(lse\\|nd\\|qtype\\|xception\\)\\|f\\(n\\|un\\(\\|ctor\\)\\)\\|\handle\\|\
-i\\([fn]\\|n\\(clude\\|fixr?\\)\\)\\|l\\(et\\|ocal\\)\\|nonfix\\|\
-o\\([fp]\\|pen\\|relse\\|verload\\)\\|r\\(aise\\|ec\\)\\|\
-s\\(haring\\|ig\\(\\|nature\\)\\|truct\\(\\|ure\\)\\)\\|t\\(hen\\|ype\\)\\|\
-val\\|w\\(h\\(ere\\|ile\\)\\|ith\\(\\|type\\)\\)\\)\\>"
-
-  "Regexp matching standard SML keywords.")
-
-(defvar sml-font-lock-all nil
-  "Font-lock matchers for SML.")
-
-(defun sml-font-lock-setup ()
-  "Set buffer-local font-lock variables and possibly turn on font-lock."
-  (let ((new-font-lock (boundp 'font-lock-defaults)))
-    ;; If new-font-lock is t, use sml-font-comments-and-strings to do
-    ;; fontification of comments and strings.  Otherwise, do
-    ;; fontification using the SML syntax table (which will not always
-    ;; be correct).
-    (or sml-font-lock-all
-	(setq sml-font-lock-all
-	      (append
-	       (and new-font-lock (list (list 'sml-font-comments-and-strings)))
-	       sml-font-lock-extra-keywords
-	       (list (list sml-font-lock-standard-keywords 1
-			   'font-lock-keyword-face)))))
-    (cond (new-font-lock
-	   (make-local-variable 'font-lock-defaults)
-	   (setq font-lock-defaults '(sml-font-lock-all t)))
-	  (t
-	   (setq font-lock-keywords sml-font-lock-all))))
-  (and sml-font-lock-auto-on (turn-on-font-lock)))
-
-(add-hook 'sml-mode-hook 'sml-font-lock-setup)
-
-(defvar sml-font-cache '((0 . normal))
-  "List of (POSITION . STATE) pairs for an SML buffer.
-The STATE is either `normal', `comment', or `string'.  The POSITION is
-immediately after the token that caused the state change.")
-
-(make-variable-buffer-local 'sml-font-cache)
-
-(defun sml-font-comments-and-strings (limit)
-  "Fontify SML comments and strings up to LIMIT.
-Handles nested comments and SML's escapes for breaking a string over lines.
-Uses sml-font-cache to maintain the fontification state over the buffer."
-  (let ((beg (point))
-	last class)
-    (while (< beg limit)
-      (while (and sml-font-cache
-		  (> (car (car sml-font-cache)) beg))
-	(setq sml-font-cache (cdr sml-font-cache)))
-      (setq last (car (car sml-font-cache)))
-      (setq class (cdr (car sml-font-cache)))
-      (goto-char last)
-      (cond
-       ((eq class 'normal)
-	(cond
-	 ((not (re-search-forward "\\((\\*\\)\\|\\(\"\\)" limit t))
-	  (goto-char limit))
-	 ((match-beginning 1)
-	  (setq sml-font-cache (cons (cons (point) 'comment) sml-font-cache)))
-	 ((match-beginning 2)
-	  (setq sml-font-cache (cons (cons (point) 'string) sml-font-cache)))))
-       ((eq class 'comment)
-	(cond
-	 ((let ((nest 1))
-	    (while (and (> nest 0)
-			(re-search-forward "\\((\\*\\)\\|\\(\\*)\\)" limit t))
-	      (cond
-	       ((match-beginning 1) (setq nest (+ nest 1)))
-	       ((match-beginning 2) (setq nest (- nest 1)))))
-	    (> nest 0))
-	  (goto-char limit))
-	 (t
-	  (setq sml-font-cache (cons (cons (point) 'normal) sml-font-cache))))
-	(put-text-property (- last 2) (point) 'face 'font-lock-comment-face))
-       ((eq class 'string)
-	(while (and (re-search-forward
-		     "\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" limit t)
-		     (not (match-beginning 1))))
-	(cond
-	 ((match-beginning 1)
-	  (setq sml-font-cache (cons (cons (point) 'normal) sml-font-cache)))
-	 (t
-	  (goto-char limit)))
-	(put-text-property (- last 1) (point) 'face 'font-lock-string-face)))
-      (setq beg (point)))))
-
-(provide 'sml-font)
diff -Nru mosml-2.01/utility/sml-mode-3.3b/sml-hilite.el mosml-2.10.1/utility/sml-mode-3.3b/sml-hilite.el
--- mosml-2.01/utility/sml-mode-3.3b/sml-hilite.el	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/utility/sml-mode-3.3b/sml-hilite.el	1970-01-01 00:00:00.000000000 +0000
@@ -1,138 +0,0 @@
-;;; sml-hilite.el. Highlighting for sml-mode using hilit19.
-
-;; Copyright (C) 1995 Frederick Knabe
-;;
-;; Author:     Fritz Knabe 
-;;             ECRC GmbH, Arabellastr. 17, 81925 Munich, Germany
-;;
-;; Created:    08-Nov-94, Fritz Knabe 
-;; Modified:   14-Apr-97, M.J.Morley 
-;;             Added a few keywords to hilit-set-mode-patters.
-
-;; This file is not part of GNU Emacs, but it is distributed under the
-;; same conditions.
-
-;; ====================================================================
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;; ====================================================================
-
-;; Put this code *after* the (require 'hilit19) in your .emacs.
-;; Alternatively, put it in an (eval-after-load "hilit19" ...).
-
-;; Better, use sml-load-hook like this:
-
-;; (setq sml-load-hook
-;;       '(lambda() "Highlights." (require 'sml-hilite)))
-
-;; hilit19 does not currently appear to belong to XEmacs -- they
-;; favour `font-lock'. Font-lock patterns in sml-font.el
-
-;;; CODE
-
-(require 'hilit19)
-
-(cond ((and (x-display-color-p) (eq hilit-background-mode 'light))
-       ;; for SML
-       (hilit-translate sml-comment	'firebrick-italic)
-       (hilit-translate sml-string	'ForestGreen-italic)
-       (hilit-translate sml-keyword	'blue-bold))
-      ((and (x-display-color-p) (eq hilit-background-mode 'dark))
-       ;; for SML
-       (hilit-translate sml-comment	'moccasin-italic)
-       (hilit-translate sml-string	'green-italic)
-       (hilit-translate sml-keyword	'cyan-bold))
-      (t
-       ;; for SML
-       (hilit-translate sml-comment	'default-italic)
-       (hilit-translate sml-string	'default-bold-italic)
-       (hilit-translate sml-keyword	'default-bold)))
-
-(hilit-set-mode-patterns
- 'sml-mode
- '((kn-hilit-sml-string-find "" sml-string)
-   (kn-hilit-sml-comment-find "" sml-comment)
-   ;; The old patterns
-   ;;("\"" "[^\\]\"" sml-string)
-   ;;("(\\*" "\\*)" sml-comment)
-   ("\\(\\`\\|[^_']\\)\
-\\<\\(\
-a\\(bstype\\|nd\\(\\|also\\)\\|s\\)\\|case\\|d\\(atatype\\|o\\)\\|\
-e\\(lse\\|nd\\|qtype\\|xception\\)\\|f\\(n\\|un\\(\\|ctor\\)\\)\\|\handle\\|\
-i\\([fn]\\|n\\(clude\\|fixr?\\)\\)\\|l\\(et\\|ocal\\)\\|nonfix\\|\
-o\\([fp]\\|pen\\|relse\\|verload\\)\\|r\\(aise\\|ec\\)\\|\
-s\\(haring\\|ig\\(\\|nature\\)\\|truct\\(\\|ure\\)\\)\\|t\\(hen\\|ype\\)\\|\
-val\\|w\\(h\\(ere\\|ile\\)\\|ith\\(\\|type\\)\\)
-\\)\\>\
-\\(\\'\\|[^_']\\)" 2 sml-keyword)))
-
-(defun kn-hilit-sml-string-find (dummy)
-  "Find an SML string and return (START . END); if none, returns nil. 
-Skips over potentially nested comments when searching for the start of the
-string. Skips over \f...f\ (where f is whitespace) sequences in strings."
-  (let ((nest 0)
-	(continue t)
-	st en)
-    (while (and continue
-		(re-search-forward "\\(\"\\)\\|\\((\\*\\)\\|\\(\\*)\\)" nil t))
-      (cond
-       ((match-beginning 1) (setq continue (> nest 0)))
-       ((match-beginning 2) (setq nest (+ nest 1)))
-       ((match-beginning 3) (setq nest (- nest 1)))))
-    (if (not continue)
-	(progn
-	  (setq st (match-beginning 1))
-	  (while (and (re-search-forward
-		       "\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" nil t)
-		      (cond
-		       ((match-beginning 1) (setq en (point)) nil)
-		       ((match-beginning 2) t)
-		       ((match-beginning 3) t))))
-	  (and en (cons st en))))))
-
-(defun kn-hilit-sml-comment-find (dummy)
-  "Find an SML comment and return (START . END); if none, returns nil.
-Handles nested comments. Ensures that the comment starts outside of a string."
-  (let ((continue t)
-	(nest 1)
-	st en)
-    (while (and continue
-		(re-search-forward "\\(\"\\)\\|\\((\\*\\)" nil t))
-      (cond
-       ((match-beginning 1)
-	(while (and (re-search-forward
-		     "\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" nil t)
-		    (cond
-		     ((match-beginning 1) nil)
-		     ((match-beginning 2) t)
-		     ((match-beginning 3) t)))))
-       ((match-beginning 2) (setq continue nil))))
-    (if (not continue)
-	(progn
-	  (setq st (match-beginning 2))
-	  (setq continue t)
-	  (while (and continue
-		      (re-search-forward "\\((\\*\\)\\|\\(\\*)\\)" nil t))
-	    (cond
-	     ((match-beginning 1) (setq nest (+ nest 1)))
-	     ((match-beginning 2)
-	      (setq nest (- nest 1)) (setq continue (> nest 0)))))
-	  (if (not continue)
-	      (cons st (match-end 2)))))))
-
-(provide 'sml-hilite)
-
-;;; no more sml-hilite.el, it's finished.
diff -Nru mosml-2.01/utility/sml-mode-3.3b/sml-menus.el mosml-2.10.1/utility/sml-mode-3.3b/sml-menus.el
--- mosml-2.01/utility/sml-mode-3.3b/sml-menus.el	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/utility/sml-mode-3.3b/sml-menus.el	1970-01-01 00:00:00.000000000 +0000
@@ -1,145 +0,0 @@
-;;; sml-menus.el. Simple menus for sml-mode
-
-;; Copyright (C) 1994, Matthew J. Morley
-
-;; This file is not part of GNU Emacs, but it is distributed under the
-;; same conditions.
-
-;; ====================================================================
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;; ====================================================================
-
-;;; DESCRIPTION
-
-;; You need auc-menu or easymenu on your lisp load-path.
-
-;; Menus appear only when the cursor is in an sml-mode buffer. They
-;; should appear automatically as long as sml-mode can find this file
-;; and easymenu.el (or auc-menu.el), but not otherwise.
-
-;; If you load sml-proc.el to run an inferior ML process -- or even a
-;; superior one, who knows? -- the "Process" submenu will become active.
-
-;;; CODE 
-
-(condition-case () (require 'easymenu) (error (require 'auc-menu)))
-
-;; That's FSF easymenu, distributed with GNU Emacs 19, or Per
-;; Abrahamsen's auc-menu distributed with AUCTeX, or from the Emacs
-;; lisp archive, or the IESD (ftp://sunsite.auc.dk/packages/auctex/)
-;; lisp archive at Aalborg (auc-menu works with XEmacs too).
-
-(defconst sml-menu
-  (list ;"SML"
-        (list "Process"
-              ["Start default ML compiler"  sml
-                :active (fboundp 'sml)]
-              ["-" nil nil]
-              ["load ML source file"        sml-load-file 
-                :active (featurep 'sml-proc)]
-              ["switch to ML buffer"        switch-to-sml
-                :active (featurep 'sml-proc)]
-              ["--" nil nil]
-              ["send buffer contents"       sml-send-buffer 
-                :active (featurep 'sml-proc)]
-              ["send region"                sml-send-region 
-                :active (featurep 'sml-proc)]
-              ["send paragraph"             sml-send-function 
-                :active (featurep 'sml-proc)]
-              ["goto next error"            sml-next-error 
-                :active (featurep 'sml-proc)]
-              ["---" nil nil]
-              ["Standard ML of New Jersey"  sml-smlnj
-                :active (fboundp 'sml-smlnj)]
-              ["Poly/ML"                    sml-poly-ml
-                :active (fboundp 'sml-poly-ml)]
-              ["Moscow ML"                  sml-mosml
-                :active (fboundp 'sml-mosml)]
-              ["Help for Inferior ML"   (describe-function 'inferior-sml-mode) 
-                :active (featurep 'sml-proc)]
-              )
-        ["electric pipe"     sml-electric-pipe t]
-        ["insert SML form"   sml-insert-form t]
-        (list "Forms" 
-              ["abstype"     sml-form-abstype t]
-              ["datatype"    sml-form-datatype t]
-              ["-" nil nil]
-              ["let"         sml-form-let t]
-              ["local"       sml-form-local t]
-              ["case"        sml-form-case t]
-              ["--" nil nil]
-              ["signature"   sml-form-signature t]
-              ["functor"     sml-form-functor t]
-              ["structure"   sml-form-structure t])
-        (list "Format/Mode Variables"
-              ["indent region"             sml-indent-region t]
-              ["outdent"                   sml-back-to-outer-indent t]
-              ["-" nil nil]
-              ["set indent-level"          sml-indent-level t]
-              ["set pipe-indent"           sml-pipe-indent t]
-              ["--" nil nil]
-              ["toggle type-of-indent"     (sml-type-of-indent) t]
-              ["toggle nested-if-indent"   (sml-nested-if-indent) t]
-              ["toggle case-indent"        (sml-case-indent) t]
-              ["toggle electric-semi-mode" (sml-electric-semi-mode) t])
-        ["-----" nil nil]
-        ["SML mode help (brief)"       describe-mode t]
-        ["SML mode *info*"             sml-mode-info t]
-        ["SML mode version"            sml-mode-version t]
-        ["-----" nil nil]
-        ["Fontify buffer"    (sml-mode-fontify-buffer)
-                :active (or (featurep 'sml-font) (featurep 'sml-hilite))]
-        ["Remove overlay"    (sml-error-overlay 'undo)
-                :active (sml-overlay-active-p)]
-        ))
-
-(defun sml-mode-fontify-buffer ()
-  "Just as it suggests."
-  (cond ((featurep 'sml-font) 
-         (font-lock-fontify-buffer))
-        ((featurep 'sml-hilite) 
-         (hilit-rehighlight-buffer))
-        (t
-         (message "No highlight scheme specified")))) ; belt & braces
-
-(easy-menu-define sml-mode-menu
-    sml-mode-map
-    "Menu used in sml-mode."
-    (cons "SML" sml-menu))
-
-;;; Make's sure they appear in the menu bar when sml-mode-map is active.
-
-;; On the hook for XEmacs only -- see easy-menu-add in auc-menu.el.
-
-(defun sml-mode-menu-bar ()
-  "Make sure menus appear in the menu bar as well as under mouse 3."
-  (and (eq major-mode 'sml-mode)
-       (easy-menu-add sml-mode-menu sml-mode-map)))
-
-(add-hook 'sml-mode-hook 'sml-mode-menu-bar)
-
-;; Autoload all the process code if these are selected.
-
-(autoload 'sml "sml-proc" sml-no-doc t)
-
-;; Not these two.
-;; (autoload 'sml-poly-ml "sml-poly-ml" sml-no-doc t) 
-;; (autoload 'sml-mosml "sml-mosml" sml-no-doc t) 
-
-(provide 'sml-menus)
-
-;;; sml-menu.el is over now.
diff -Nru mosml-2.01/utility/sml-mode-3.3b/sml-mode.el mosml-2.10.1/utility/sml-mode-3.3b/sml-mode.el
--- mosml-2.01/utility/sml-mode-3.3b/sml-mode.el	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/utility/sml-mode-3.3b/sml-mode.el	1970-01-01 00:00:00.000000000 +0000
@@ -1,1131 +0,0 @@
-;;; sml-mode.el. Major mode for editing (Standard) ML. Version 3.3(beta)
-
-;; Copyright (C) 1989, Lars Bo Nielsen; 1994,1997, Matthew J. Morley
-
-;; $Revision: 1.1.1.1 $
-;; $Date: 2000/01/21 10:07:13 $
-
-;; This file is not part of GNU Emacs, but it is distributed under the
-;; same conditions.
-
-;; ====================================================================
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;; ====================================================================
-
-;;; HISTORY 
-
-;; Still under construction: History obscure, needs a biographer as
-;; well as a M-x doctor. Change Log on request.
-
-;; Hacked by Olin Shivers for comint from Lars Bo Nielsen's sml.el.
-
-;; Hacked by Matthew Morley to incorporate Fritz Knabe's hilite and
-;; font-lock patterns, some of Steven Gilmore's (reduced) easy-menus,
-;; and numerous bugs and bug-fixes.
-
-;;; DESCRIPTION 
-
-;; See accompanying info file: sml-mode.info
-
-;;; FOR YOUR .EMACS FILE
-
-;; If sml-mode.el lives in some non-standard directory, you must tell 
-;; emacs where to get it. This may or may not be necessary:
-
-;; (setq load-path (cons (expand-file-name "~jones/lib/emacs") load-path))
-
-;; Then to access the commands autoload sml-mode with that command:
-
-;; (autoload 'sml-mode "sml-mode" "Major mode for editing ML programs." t)
-;;
-;; If files ending in ".sml" or ".ML" are hereafter considered to contain
-;; Standard ML source, put their buffers into sml-mode automatically:
-
-;; (setq auto-mode-alist
-;;       (cons '(("\\.sml$" . sml-mode)
-;;               ("\\.ML$"  . sml-mode)) auto-mode-alist))
-
-;; Here's an example of setting things up in the sml-mode-hook:
-
-;; (setq sml-mode-hook
-;;       '(lambda() "ML mode hacks"
-;;          (setq sml-indent-level 2         ; conserve on horiz. space
-;;                indent-tabs-mode nil)))    ; whatever
-
-;; sml-mode-hook is run whenever a new sml-mode buffer is created.
-;; There is an sml-load-hook too, which is only run when this file is
-;; loaded. One use for this hook is to select your preferred
-;; highlighting scheme, like this:
-
-;; (setq sml-load-hook
-;;       '(lambda() "Highlights." (require 'sml-hilite)))
-
-;; hilit19 is the magic that actually does the highlighting. My set up
-;; for hilit19 runs something like this:
-
-;; (if window-system
-;;     (setq hilit-background-mode   t ; monochrome (alt: 'dark or 'light)
-;;           hilit-inhibit-hooks     nil
-;;           hilit-inhibit-rebinding nil
-;;           hilit-quietly           t))
-
-;; Alternatively, you can (require 'sml-font) which uses the font-lock
-;; package instead. 
-
-;; Finally, there are inferior-sml-{mode,load}-hooks -- see comments
-;; in sml-proc.el. For much more information consult the mode's *info*
-;; tree.
-
-;;; VERSION STRING
-
-(defconst sml-mode-version-string
-  "sml-mode, version 3.3(beta)")
-
-(provide 'sml-mode)
-
-;;; VARIABLES CONTROLLING INDENTATION
-
-(defvar sml-indent-level 4
-  "*Indentation of blocks in ML (see also `sml-structure-indent').")
-
-(defvar sml-structure-indent 4          ; Not currently an option.
-  "Indentation of signature/structure/functor declarations.")
-
-(defvar sml-pipe-indent -2
-  "*Extra (usually negative) indentation for lines beginning with |.")
-
-(defvar sml-case-indent nil
-  "*How to indent case-of expressions.
-    If t:   case expr                     If nil:   case expr of
-              of exp1 => ...                            exp1 => ...
-               | exp2 => ...                          | exp2 => ...
-
-The first seems to be the standard in SML/NJ, but the second
-seems nicer...")
-
-(defvar sml-nested-if-indent nil
-  "*Determine how nested if-then-else will be formatted:
-    If t: if exp1 then exp2               If nil:   if exp1 then exp2
-          else if exp3 then exp4                    else if exp3 then exp4
-          else if exp5 then exp6                         else if exp5 then exp6
-               else exp7                                      else exp7")
-
-(defvar sml-type-of-indent t
-  "*How to indent `let' `struct' etc.
-    If t:  fun foo bar = let              If nil:  fun foo bar = let
-                             val p = 4                 val p = 4
-                         in                        in
-                             bar + p                   bar + p
-                         end                       end
-
-Will not have any effect if the starting keyword is first on the line.")
-
-(defvar sml-electric-semi-mode nil
-  "*If t, `\;' will self insert, reindent the line, and do a newline.
-If nil, just insert a `\;'. (To insert while t, do: C-q \;).")
-
-(defvar sml-paren-lookback 1000
-  "*How far back (in chars) the indentation algorithm should look
-for open parenthesis. High value means slow indentation algorithm. A
-value of 1000 (being the equivalent of 20-30 lines) should suffice
-most uses. (A value of nil, means do not look at all)")
-
-;;; OTHER GENERIC MODE VARIABLES
-
-(defvar sml-mode-info "sml-mode"
-  "*Where to find Info file for sml-mode.
-The default assumes the info file \"sml-mode.info\" is on Emacs' info
-directory path. If it is not, either put the file on the standard path
-or set the variable sml-mode-info to the exact location of this file
-which is part of the sml-mode 3.2 (and later) distribution. E.g:  
-
-  (setq sml-mode-info \"/usr/me/lib/info/sml-mode\") 
-
-in your .emacs file. You can always set it interactively with the
-set-variable command.")
-
-(defvar sml-mode-hook nil
-  "*This hook is run when sml-mode is loaded, or a new sml-mode buffer created.
-This is a good place to put your preferred key bindings.")
-
-(defvar sml-load-hook nil
-  "*This hook is run when sml-mode (sml-mode.el) is loaded into Emacs.")
-
-(defvar sml-mode-abbrev-table nil "*SML mode abbrev table (default nil)")
-
-(defvar sml-error-overlay t
-  "*Non-nil means use an overlay to highlight errorful code in the buffer.
-
-This gets set when `sml-mode' is invoked\; if you don't like/want SML 
-source errors to be highlighted in this way, do something like
-
-  \(setq-default sml-error-overlay nil\)
-
-in your `sml-load-hook', say.")
-
-(make-variable-buffer-local 'sml-error-overlay)
-
-;;; CODE FOR SML-MODE 
-
-(defun sml-mode-info ()
-  "Command to access the TeXinfo documentation for sml-mode.
-See doc for the variable sml-mode-info."
-  (interactive)
-  (require 'info)
-  (condition-case nil
-      (funcall 'Info-goto-node (concat "(" sml-mode-info ")"))
-    (error (progn
-             (describe-variable 'sml-mode-info)
-             (message "Can't find it... set this variable first!")))))
-
-(defun sml-indent-level (&optional indent)
-   "Allow the user to change the block indentation level. Numeric prefix 
-accepted in lieu of prompting."
-   (interactive "NIndentation level: ")
-   (setq sml-indent-level indent))
-
-(defun sml-pipe-indent (&optional indent)
-  "Allow to change pipe indentation level (usually negative). Numeric prefix
-accepted in lieu of prompting."
-   (interactive "NPipe Indentation level: ")
-   (setq sml-pipe-indent indent))
-
-(defun sml-case-indent (&optional of)
-  "Toggle sml-case-indent. Prefix means set it to nil."
-  (interactive "P")
-  (setq sml-case-indent (and (not of) (not sml-case-indent)))
-  (if sml-case-indent (message "%s" "true") (message "%s" nil)))
-
-(defun sml-nested-if-indent (&optional of)
-  "Toggle sml-nested-if-indent. Prefix means set it to nil."
-  (interactive "P")
-  (setq sml-nested-if-indent (and (not of) (not sml-nested-if-indent)))
-  (if sml-nested-if-indent (message "%s" "true") (message "%s" nil)))
-
-(defun sml-type-of-indent (&optional of)
-  "Toggle sml-type-of-indent. Prefix means set it to nil."
-  (interactive "P")
-  (setq sml-type-of-indent (and (not of) (not sml-type-of-indent)))
-  (if sml-type-of-indent (message "%s" "true") (message "%s" nil)))
-
-(defun sml-electric-semi-mode (&optional of)
-  "Toggle sml-electric-semi-mode. Prefix means set it to nil."
-  (interactive "P")
-  (setq sml-electric-semi-mode (and (not of) (not sml-electric-semi-mode)))
-  (message "%s" (concat "Electric semi mode is " 
-                   (if sml-electric-semi-mode "on" "off"))))
-
-;;; BINDINGS: these should be common to the source and process modes...
-
-(defun install-sml-keybindings (map)
-  ;; Text-formatting commands:
-  (define-key map "\C-c\C-m" 'sml-insert-form)
-  (define-key map "\C-c\C-i" 'sml-mode-info)
-  (define-key map "\M-|"     'sml-electric-pipe)
-  (define-key map "\;"       'sml-electric-semi)
-  (define-key map "\M-\t"    'sml-back-to-outer-indent)
-  (define-key map "\C-j"     'newline-and-indent)
-  (define-key map "\177"     'backward-delete-char-untabify)
-  (define-key map "\C-\M-\\" 'sml-indent-region)
-  (define-key map "\t"       'sml-indent-line) ; ...except this one
-  ;; Process commands added to sml-mode-map -- these should autoload
-  (define-key map "\C-c\C-l" 'sml-load-file)
-  (define-key map "\C-c`"    'sml-next-error))
-
-;;; Autoload functions -- no-doc is another idea cribbed from AucTeX!
-
-(defvar sml-no-doc
-  "This function is part of sml-proc, and has not yet been loaded.
-Full documentation will be available after autoloading the function."
-  "Documentation for autoloading functions.")
-
-(autoload 'sml             "sml-proc"   sml-no-doc t)
-(autoload 'sml-load-file   "sml-proc"   sml-no-doc t)
-
-(autoload 'switch-to-sml   "sml-proc"   sml-no-doc t)
-(autoload 'sml-send-region "sml-proc"   sml-no-doc t)
-(autoload 'sml-send-buffer "sml-proc"   sml-no-doc t)
-(autoload 'sml-next-error  "sml-proc"   sml-no-doc t)
-
-(defvar sml-mode-map nil "The keymap used in sml-mode.")
-(cond ((not sml-mode-map)
-       (setq sml-mode-map (make-sparse-keymap))
-       (install-sml-keybindings sml-mode-map)
-       (define-key sml-mode-map "\C-c\C-s" 'switch-to-sml)
-       (define-key sml-mode-map "\C-c\C-r" 'sml-send-region)
-       (define-key sml-mode-map "\C-c\C-b" 'sml-send-buffer)))
-
-;;; H A C K   A T T A C K !   X E M A C S   V E R S U S   E M A C S
-
-(cond ((fboundp 'make-extent)
-       ;; suppose this is XEmacs
-
-       (defun sml-make-overlay ()
-         "Create a new text overlay (extent) for the SML buffer."
-         (let ((ex (make-extent 1 1)))
-           (set-extent-property ex 'face 'zmacs-region) ex))
-
-       (defalias 'sml-is-overlay 'extentp)
-
-       (defun sml-overlay-active-p ()
-         "Determine whether the current buffer's error overlay is visible."
-         (and (sml-is-overlay sml-error-overlay)
-              (not (zerop (extent-length sml-error-overlay)))))
-
-       (defalias 'sml-move-overlay 'set-extent-endpoints))
-
-      ((fboundp 'make-overlay)
-       ;; otherwise assume it's Emacs
-
-       (defun sml-make-overlay ()
-         "Create a new text overlay (extent) for the SML buffer."
-         (let ((ex (make-overlay 0 0)))
-           (overlay-put ex 'face 'region) ex))
-
-       (defalias 'sml-is-overlay 'overlayp)
-
-       (defun sml-overlay-active-p ()
-         "Determine whether the current buffer's error overlay is visible."
-         (and (sml-is-overlay sml-error-overlay)
-              (not (equal (overlay-start sml-error-overlay)
-                          (overlay-end sml-error-overlay)))))
-
-       (defalias 'sml-move-overlay 'move-overlay))
-      (t
-       ;; what *is* this!?
-       (defalias 'sml-is-overlay 'ignore)
-       (defalias 'sml-overlay-active-p 'ignore)
-       (defalias 'sml-make-overlay 'ignore)
-       (defalias 'sml-move-overlay 'ignore)))
-
-;;; MORE CODE FOR SML-MODE
-
-(defun sml-mode-version ()
-  "This file's version number (sml-mode)."
-  (interactive)
-  (message sml-mode-version-string))
-
-(defvar sml-mode-syntax-table nil "The syntax table used in sml-mode.")
-(if sml-mode-syntax-table
-    ()
-  (setq sml-mode-syntax-table (make-syntax-table))
-  ;; Set everything to be "." (punctuation) except for [A-Za-z0-9],
-  ;; which will default to "w" (word-constituent).
-  (let ((i 0))
-    (while (< i ?0)
-      (modify-syntax-entry i "." sml-mode-syntax-table)
-      (setq i (1+ i)))
-    (setq i (1+ ?9))
-    (while (< i ?A)
-      (modify-syntax-entry i "." sml-mode-syntax-table)
-      (setq i (1+ i)))
-    (setq i (1+ ?Z))
-    (while (< i ?a)
-      (modify-syntax-entry i "." sml-mode-syntax-table)
-      (setq i (1+ i)))
-    (setq i (1+ ?z))
-    (while (< i 128)
-      (modify-syntax-entry i "." sml-mode-syntax-table)
-      (setq i (1+ i))))
-
-  ;; Now we change the characters that are meaningful to us.
-  (modify-syntax-entry ?\(      "()1"   sml-mode-syntax-table)
-  (modify-syntax-entry ?\)      ")(4"   sml-mode-syntax-table)
-  (modify-syntax-entry ?\[      "(]"    sml-mode-syntax-table)
-  (modify-syntax-entry ?\]      ")["    sml-mode-syntax-table)
-  (modify-syntax-entry ?{       "(}"    sml-mode-syntax-table)
-  (modify-syntax-entry ?}       "){"    sml-mode-syntax-table)
-  (modify-syntax-entry ?\*      ". 23"  sml-mode-syntax-table)
-  (modify-syntax-entry ?\"      "\""    sml-mode-syntax-table)
-  (modify-syntax-entry ?        " "     sml-mode-syntax-table)
-  (modify-syntax-entry ?\t      " "     sml-mode-syntax-table)
-  (modify-syntax-entry ?\n      " "     sml-mode-syntax-table)
-  (modify-syntax-entry ?\f      " "     sml-mode-syntax-table)
-  (modify-syntax-entry ?\'      "w"     sml-mode-syntax-table)
-  (modify-syntax-entry ?\_      "w"     sml-mode-syntax-table))
-
-;;;###Autoload
-(defun sml-mode ()
-  "Major mode for editing ML code.
-Tab indents for ML code.
-Comments are delimited with (* ... *).
-Blank lines and form-feeds separate paragraphs.
-Delete converts tabs to spaces as it moves back.
-
-For information on running an inferior ML process, see the documentation
-for inferior-sml-mode (set this up with \\[sml]).
-
-Customisation: Entry to this mode runs the hooks on sml-mode-hook.
-
-Variables controlling the indentation
-=====================================
-
-Seek help (\\[describe-variable]) on individual variables to get current settings.
-
-sml-indent-level (default 4)
-    The indentation of a block of code.
-
-sml-pipe-indent (default -2)
-    Extra indentation of a line starting with \"|\".
-
-sml-case-indent (default nil)
-    Determine the way to indent case-of expression.
-
-sml-nested-if-indent (default nil)
-    Determine how nested if-then-else expressions are formatted.
-
-sml-type-of-indent (default t)
-    How to indent let, struct, local, etc.
-    Will not have any effect if the starting keyword is first on the line.
-
-sml-electric-semi-mode (default nil)
-    If t, a `\;' will reindent line, and perform a newline.
-
-sml-paren-lookback (default 1000)
-    Determines how far back (in chars) the indentation algorithm should 
-    look to match parenthesis. A value of nil, means do not look at all.
-
-Mode map
-========
-\\{sml-mode-map}"
-
-  (interactive)
-  (kill-all-local-variables)
-  (sml-mode-variables)
-  (use-local-map sml-mode-map)
-  (setq major-mode 'sml-mode)
-  (setq mode-name "SML")
-  (run-hooks 'sml-mode-hook))            ; Run the hook last
-
-(defun sml-mode-variables ()
-  (set-syntax-table sml-mode-syntax-table)
-  (setq local-abbrev-table sml-mode-abbrev-table)
-  ;; A paragraph is separated by blank lines or ^L only.
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "^[\t ]*$\\|" page-delimiter))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'sml-indent-line)
-  (make-local-variable 'comment-start)
-  (setq comment-start "(* ")
-  (make-local-variable 'comment-end)
-  (setq comment-end " *)")
-  (make-local-variable 'comment-column)
-  (setq comment-column 40)              
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "(\\*+[ \t]?")
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'sml-comment-indent)
-  (setq sml-error-overlay (and sml-error-overlay (sml-make-overlay))))
-
-  ;; Adding these will fool the matching of parens -- because of a
-  ;; bug in Emacs (in scan_lists, i think)... it would be nice to 
-  ;; have comments treated as white-space.
-  ;;(make-local-variable 'parse-sexp-ignore-comments)
-  ;;(setq parse-sexp-ignore-comments t)
-
-(defun sml-error-overlay (undo &optional beg end buffer)
-  "Move `sml-error-overlay' so it surrounds the text region in the
-current buffer. If the buffer-local variable `sml-error-overlay' is
-non-nil it should be an overlay \(or extent, in XEmacs speak\)\; this
-function moves the overlay over the current region. If the optional
-BUFFER argument is given, move the overlay in that buffer instead of
-the current buffer.
-
-Called interactively, the optional prefix argument UNDO indicates that
-the overlay should simply be removed: \\[universal-argument] \
-\\[sml-error-overlay]."
-  (interactive "P")
-  (save-excursion
-    (set-buffer (or buffer (current-buffer)))
-    (if (sml-is-overlay sml-error-overlay)
-        (if undo
-            (sml-move-overlay sml-error-overlay 1 1)
-          ;; if active regions, signals mark not active if no region set
-          (let ((beg (or beg (region-beginning)))
-                (end (or end (region-end))))
-            (sml-move-overlay sml-error-overlay beg end))))))
-
-(defconst sml-pipe-matchers-reg
-  "\\bcase\\b\\|\\bfn\\b\\|\\bfun\\b\\|\\bhandle\\b\
-\\|\\bdatatype\\b\\|\\babstype\\b\\|\\band\\b"
-  "The keywords a `|' can follow.")
-
-(defun sml-electric-pipe ()
-  "Insert a \"|\". 
-Depending on the context insert the name of function, a \"=>\" etc."
-  (interactive)
-  (let ((case-fold-search nil)          ; Case sensitive
-        (here (point))
-        (match (save-excursion
-                 (sml-find-matching-starter sml-pipe-matchers-reg)
-                 (point)))
-        (tmp "  => ")
-        (case-or-handle-exp t))
-    (if (/= (save-excursion (beginning-of-line) (point))
-            (save-excursion (skip-chars-backward "\t ") (point)))
-        (insert "\n"))
-    (insert "|")
-    (save-excursion
-      (goto-char match)
-      (cond
-       ;; It was a function, insert the function name
-       ((looking-at "fun\\b")
-        (setq tmp (concat " " (buffer-substring
-                               (progn (forward-char 3)
-                                      (skip-chars-forward "\t\n ") (point))
-                               (progn (forward-word 1) (point))) " "))
-        (setq case-or-handle-exp nil))
-       ;; It was a datatype, insert nothing
-       ((looking-at "datatype\\b\\|abstype\\b")
-        (setq tmp " ") (setq case-or-handle-exp nil))
-       ;; If it is an and, then we have to see what is was
-       ((looking-at "and\\b")
-        (let (isfun)
-          (save-excursion
-            (condition-case ()
-                (progn
-                  (re-search-backward "datatype\\b\\|abstype\\b\\|fun\\b")
-                  (setq isfun (looking-at "fun\\b")))
-              (error (setq isfun nil))))
-          (if isfun
-              (progn
-                (setq tmp
-                      (concat " " (buffer-substring
-                                   (progn (forward-char 3)
-                                          (skip-chars-forward "\t\n ") (point))
-                                   (progn (forward-word 1) (point))) " "))
-                (setq case-or-handle-exp nil))
-            (setq tmp " ") (setq case-or-handle-exp nil))))))
-    (insert tmp)
-    (sml-indent-line)
-    (beginning-of-line)
-    (skip-chars-forward "\t ")
-    (forward-char (1+ (length tmp)))
-    (if case-or-handle-exp
-        (forward-char -4))))
-
-(defun sml-electric-semi ()
-  "Inserts a \;.
-If variable sml-electric-semi-mode is t, indent the current line, insert 
-a newline, and indent."
-  (interactive)
-  (insert "\;")
-  (if sml-electric-semi-mode
-      (reindent-then-newline-and-indent)))
-
-;;; INDENTATION !!!
-
-(defun sml-mark-function ()
-  "Synonym for mark-paragraph -- sorry.
-If anyone has a good algorithm for this..."
-  (interactive)
-  (mark-paragraph))
-
-(defun sml-indent-region (begin end)
-  "Indent region of ML code."
-  (interactive "r")
-  (message "Indenting region...")
-  (save-excursion
-    (goto-char end) (setq end (point-marker)) (goto-char begin)
-    (while (< (point) end)
-      (skip-chars-forward "\t\n ")
-      (sml-indent-line)
-      (end-of-line))
-    (move-marker end nil))
-  (message "Indenting region... done"))
-
-(defun sml-indent-line ()
-  "Indent current line of ML code."
-  (interactive)
-  (let ((indent (sml-calculate-indentation)))
-    (if (/= (current-indentation) indent)
-        (save-excursion                 ;; Added 890601 (point now stays)
-          (let ((beg (progn (beginning-of-line) (point))))
-            (skip-chars-forward "\t ")
-            (delete-region beg (point))
-            (indent-to indent))))
-    ;; If point is before indentation, move point to indentation
-    (if (< (current-column) (current-indentation))
-        (skip-chars-forward "\t "))))
-
-(defun sml-back-to-outer-indent ()
-  "Unindents to the next outer level of indentation."
-  (interactive)
-  (save-excursion
-    (beginning-of-line)
-    (skip-chars-forward "\t ")
-    (let ((start-column (current-column))
-          (indent (current-column)))
-      (if (> start-column 0)
-          (progn
-            (save-excursion
-              (while (>= indent start-column)
-                (if (re-search-backward "^[^\n]" nil t)
-                    (setq indent (current-indentation))
-                  (setq indent 0))))
-            (backward-delete-char-untabify (- start-column indent)))))))
-
-(defconst sml-indent-starters-reg
-  "abstraction\\b\\|abstype\\b\\|and\\b\\|case\\b\\|datatype\\b\
-\\|else\\b\\|fun\\b\\|functor\\b\\|if\\b\\|sharing\\b\
-\\|in\\b\\|infix\\b\\|infixr\\b\\|let\\b\\|local\\b\
-\\|nonfix\\b\\|of\\b\\|open\\b\\|raise\\b\\|sig\\b\\|signature\\b\
-\\|struct\\b\\|structure\\b\\|then\\b\\|\\btype\\b\\|val\\b\
-\\|while\\b\\|with\\b\\|withtype\\b"
-  "The indentation starters. The next line will be indented.")
-
-(defconst sml-starters-reg
-  "\\babstraction\\b\\|\\babstype\\b\\|\\bdatatype\\b\
-\\|\\bexception\\b\\|\\bfun\\b\\|\\bfunctor\\b\\|\\blocal\\b\
-\\|\\binfix\\b\\|\\binfixr\\b\\|\\bsharing\\b\
-\\|\\bnonfix\\b\\|\\bopen\\b\\|\\bsignature\\b\\|\\bstructure\\b\
-\\|\\btype\\b\\|\\bval\\b\\|\\bwithtype\\b\\|\\bwith\\b"
-  "The starters of new expressions.")
-
-(defconst sml-end-starters-reg
-  "\\blet\\b\\|\\blocal\\b\\|\\bsig\\b\\|\\bstruct\\b\\|\\bwith\\b"
-  "Matching reg-expression for the \"end\" keyword.")
-
-(defconst sml-starters-indent-after
-  "let\\b\\|local\\b\\|struct\\b\\|in\\b\\|sig\\b\\|with\\b"
-  "Indent after these.")
-
-(defun sml-calculate-indentation ()
-  (save-excursion
-    (let ((case-fold-search nil))
-      (beginning-of-line)
-      (if (bobp)                        ; Beginning of buffer
-          0                             ; Indentation = 0
-        (skip-chars-forward "\t ")
-        (cond
-         ;; Indentation for comments alone on a line, matches the
-         ;; proper indentation of the next line. Search only for the
-         ;; next "*)", not for the matching.
-         ((looking-at "(\\*")
-          (if (not (search-forward "*)" nil t))
-              (error "Comment not ended."))
-          (end-of-line)
-          (skip-chars-forward "\n\t ")
-          ;; If we are at eob, just indent 0
-          (if (eobp) 0 (sml-calculate-indentation)))
-         ;; Continued string ? (Added 890113 lbn)
-         ((looking-at "\\\\")
-          (save-excursion
-            (if (save-excursion (previous-line 1)
-                                (beginning-of-line)
-                                (looking-at "[\t ]*\\\\"))
-                (progn (previous-line 1) (current-indentation))
-            (if (re-search-backward "[^\\\\]\"" nil t)
-                (1+ (current-indentation))
-              0))))
-         ;; Are we looking at a case expression ?
-         ((looking-at "|.*=>")
-          (sml-skip-block)
-          (sml-re-search-backward "=>")
-          ;; Dont get fooled by fn _ => in case statements (890726)
-          ;; Changed the regexp a bit, so fn has to be first on line,
-          ;; in order to let the loop continue (Used to be ".*\bfn....")
-          ;; (900430).
-          (let ((loop t))
-            (while (and loop (save-excursion
-                               (beginning-of-line)
-                               (looking-at "[^ \t]+\\bfn\\b.*=>")))
-              (setq loop (sml-re-search-backward "=>"))))
-          (beginning-of-line)
-          (skip-chars-forward "\t ")
-          (cond
-           ((looking-at "|") (current-indentation))
-           ((and sml-case-indent (looking-at "of\\b"))
-            (1+ (current-indentation)))
-           ((looking-at "fn\\b") (1+ (current-indentation)))
-           ((looking-at "handle\\b") (+ (current-indentation) 5))
-           (t (+ (current-indentation) sml-pipe-indent))))
-         ((looking-at "and\\b")
-          (if (sml-find-matching-starter sml-starters-reg)
-              (current-column)
-            0))
-         ((looking-at "in\\b")          ; Match the beginning let/local
-          (sml-find-match-indent "in" "\\bin\\b" "\\blocal\\b\\|\\blet\\b"))
-         ((looking-at "end\\b")         ; Match the beginning
-          (sml-find-match-indent "end" "\\bend\\b" sml-end-starters-reg))
-         ((and sml-nested-if-indent (looking-at "else[\t ]*if\\b"))
-          (sml-re-search-backward "\\bif\\b\\|\\belse\\b")
-          (current-indentation))
-         ((looking-at "else\\b")        ; Match the if
-          (sml-find-match-indent "else" "\\belse\\b" "\\bif\\b" t))
-         ((looking-at "then\\b")        ; Match the if + extra indentation
-          (+ (sml-find-match-indent "then" "\\bthen\\b" "\\bif\\b" t)
-             sml-indent-level))
-         ((and sml-case-indent (looking-at "of\\b"))
-          (sml-re-search-backward "\\bcase\\b")
-          (+ (current-column) 2))
-         ((looking-at sml-starters-reg)
-          (let ((start (point)))
-            (sml-backward-sexp)
-            (if (and (looking-at sml-starters-indent-after)
-                     (/= start (point)))
-                (+ (if sml-type-of-indent
-                       (current-column)
-                     (if (progn (beginning-of-line)
-                                (skip-chars-forward "\t ")
-                                (looking-at "|"))
-                         (- (current-indentation) sml-pipe-indent)
-                       (current-indentation)))
-                   sml-indent-level)
-              (beginning-of-line)
-              (skip-chars-forward "\t ")
-              (if (and (looking-at sml-starters-indent-after)
-                       (/= start (point)))
-                  (+ (if sml-type-of-indent
-                         (current-column)
-                       (current-indentation))
-                     sml-indent-level)
-                (goto-char start)
-                (if (sml-find-matching-starter sml-starters-reg)
-                    (current-column)
-                  0)))))
-         (t
-          (let ((indent (sml-get-indent)))
-            (cond
-             ((looking-at "|")
-              ;; Lets see if it is the follower of a function definition
-              (if (sml-find-matching-starter
-                   "\\bfun\\b\\|\\bfn\\b\\|\\band\\b\\|\\bhandle\\b")
-                  (cond
-                   ((looking-at "fun\\b") (- (current-column) sml-pipe-indent))
-                   ((looking-at "fn\\b") (1+ (current-column)))
-                   ((looking-at "and\\b") (1+ (1+ (current-column))))
-                   ((looking-at "handle\\b") (+ (current-column) 5)))
-                (+ indent sml-pipe-indent)))
-             (t
-              (if sml-paren-lookback    ; Look for open parenthesis ?
-                  (max indent (sml-get-paren-indent))
-                indent))))))))))
-
-(defun sml-get-indent ()
-  (save-excursion
-    (let ((case-fold-search nil))
-      (beginning-of-line)
-      (skip-chars-backward "\t\n; ")
-      (if (looking-at ";") (sml-backward-sexp))
-      (cond
-       ((save-excursion (sml-backward-sexp) (looking-at "end\\b"))
-        (- (current-indentation) sml-indent-level))
-       (t
-        (while (/= (current-column) (current-indentation))
-          (sml-backward-sexp))
-        (skip-chars-forward "\t |")
-        (let ((indent (current-column)))
-          (skip-chars-forward "\t (")
-          (cond
-           ;; Started val/fun/structure...
-           ((looking-at sml-indent-starters-reg)
-            (+ (current-column) sml-indent-level))
-           ;; Indent after "=>" pattern, but only if its not an fn _ =>
-           ;; (890726)
-           ((looking-at ".*=>")
-            (if (looking-at ".*\\bfn\\b.*=>")
-                indent
-              (+ indent sml-indent-level)))
-           ;; else keep the same indentation as previous line
-           (t indent))))))))
-
-(defun sml-get-paren-indent ()
-  (save-excursion
-    (let ((levelpar 0)                  ; Level of "()"
-          (levelcurl 0)                 ; Level of "{}"
-          (levelsqr 0)                  ; Level of "[]"
-          (backpoint (max (- (point) sml-paren-lookback) (point-min))))
-      (catch 'loop
-        (while (and (/= levelpar 1) (/= levelsqr 1) (/= levelcurl 1))
-          (if (re-search-backward "[][{}()]" backpoint t)
-              (if (not (sml-inside-comment-or-string-p))
-                  (cond
-                   ((looking-at "(") (setq levelpar (1+ levelpar)))
-                   ((looking-at ")") (setq levelpar (1- levelpar)))
-                   ((looking-at "\\[") (setq levelsqr (1+ levelsqr)))
-                   ((looking-at "\\]") (setq levelsqr (1- levelsqr)))
-                   ((looking-at "{") (setq levelcurl (1+ levelcurl)))
-                   ((looking-at "}") (setq levelcurl (1- levelcurl)))))
-            (throw 'loop 0)))           ; Exit with value 0
-        (if (save-excursion
-              (forward-char 1)
-              (looking-at sml-indent-starters-reg))
-            (1+ (+ (current-column) sml-indent-level))
-          (1+ (current-column)))))))
-
-(defun sml-inside-comment-or-string-p ()
-  (let ((start (point)))
-    (if (save-excursion
-          (condition-case ()
-              (progn
-                (search-backward "(*")
-                (search-forward "*)")
-                (forward-char -1)       ; A "*)" is not inside the comment
-                (> (point) start))
-            (error nil)))
-        t
-      (let ((numb 0))
-        (save-excursion
-          (save-restriction
-            (narrow-to-region (progn (beginning-of-line) (point)) start)
-            (condition-case ()
-                (while t
-                  (search-forward "\"")
-                  (setq numb (1+ numb)))
-              (error (if (and (not (zerop numb))
-                              (not (zerop (% numb 2))))
-                         t nil)))))))))
-
-(defun sml-skip-block ()
-  (let ((case-fold-search nil))
-    (sml-backward-sexp)
-    (if (looking-at "end\\b")
-        (progn
-          (goto-char (sml-find-match-backward "end" "\\bend\\b"
-                                              sml-end-starters-reg))
-          (skip-chars-backward "\n\t "))
-      ;; Here we will need to skip backward past if-then-else
-      ;; and case-of expression. Please - tell me how !!
-      )))
-
-(defun sml-find-match-backward (unquoted-this this match &optional start)
-  (save-excursion
-    (let ((case-fold-search nil)
-          (level 1)
-          (pattern (concat this "\\|" match)))
-      (if start (goto-char start))
-      (while (not (zerop level))
-        (if (sml-re-search-backward pattern)
-            (setq level (cond
-                         ((looking-at this) (1+ level))
-                         ((looking-at match) (1- level))))
-          ;; The right match couldn't be found
-          (error (concat "Unbalanced: " unquoted-this))))
-      (point))))
-
-(defun sml-find-match-indent (unquoted-this this match &optional indented)
-  (save-excursion
-    (goto-char (sml-find-match-backward unquoted-this this match))
-    (if (or sml-type-of-indent indented)
-        (current-column)
-      (if (progn
-            (beginning-of-line)
-            (skip-chars-forward "\t ")
-            (looking-at "|"))
-          (- (current-indentation) sml-pipe-indent)
-        (current-indentation)))))
-
-(defun sml-find-matching-starter (regexp)
-  (let ((case-fold-search nil)
-        (start-let-point (sml-point-inside-let-etc))
-        (start-up-list (sml-up-list))
-        (found t))
-    (if (sml-re-search-backward regexp)
-        (progn
-          (condition-case ()
-              (while (or (/= start-up-list (sml-up-list))
-                         (/= start-let-point (sml-point-inside-let-etc)))
-                (re-search-backward regexp))
-            (error (setq found nil)))
-          found)
-      nil)))
-
-(defun sml-point-inside-let-etc ()
-  (let ((case-fold-search nil) (last nil) (loop t) (found t) (start (point)))
-    (save-excursion
-      (while loop
-        (condition-case ()
-            (progn
-              (re-search-forward "\\bend\\b")
-              (while (sml-inside-comment-or-string-p)
-                (re-search-forward "\\bend\\b"))
-              (forward-char -3)
-              (setq last (sml-find-match-backward "end" "\\bend\\b"
-                                                  sml-end-starters-reg last))
-              (if (< last start)
-                  (setq loop nil)
-                (forward-char 3)))
-          (error (progn (setq found nil) (setq loop nil)))))
-      (if found
-          last
-        0))))
-
-(defun sml-re-search-backward (regexpr)
-  (let ((case-fold-search nil) (found t))
-    (if (re-search-backward regexpr nil t)
-        (progn
-          (condition-case ()
-              (while (sml-inside-comment-or-string-p)
-                (re-search-backward regexpr))
-            (error (setq found nil)))
-          found)
-      nil)))
-
-(defun sml-up-list ()
-  (save-excursion
-    (condition-case ()
-        (progn
-          (up-list 1)
-          (point))
-      (error 0))))
-
-(defun sml-backward-sexp ()
-  (condition-case ()
-      (progn
-        (let ((start (point)))
-          (backward-sexp 1)
-          (while (and (/= start (point)) (looking-at "(\\*"))
-            (setq start (point))
-            (backward-sexp 1))))
-    (error (forward-char -1))))
-
-(defun sml-comment-indent ()
-  (if (looking-at "^(\\*")              ; Existing comment at beginning
-      0                                 ; of line stays there.
-    (save-excursion
-      (skip-chars-backward " \t")
-      (max (1+ (current-column))        ; Else indent at comment column
-           comment-column))))           ; except leave at least one space.
-
-;;; INSERTING PROFORMAS (COMMON SML-FORMS) 
-
-(defvar sml-forms-alist
-  '(("let") ("local") ("case") ("abstype") ("datatype")
-    ("signature") ("structure") ("functor"))
-  "*The list of templates to auto-insert.
-
-You can extend this alist to your heart's content. For each additional
-template NAME in the list, declare a keyboard macro or function (or
-interactive command) called 'sml-form-NAME'.
-
-If 'sml-form-NAME' is a function it takes no arguments and should
-insert the template at point\; if this is a command it may accept any
-sensible interactive call arguments\; keyboard macros can't take
-arguments at all. Apropos keyboard macros, see `name-last-kbd-macro'
-and `sml-addto-forms-alist'.
-
-`sml-forms-alist' understands let, local, case, abstype, datatype,
-signature, structure, and functor by default.")
-
-;; See also macros.el in emacs lisp dir.
-
-(defun sml-addto-forms-alist (name)
-  "Assign a name to the last keyboard macro defined.
-Argument NAME is transmogrified to sml-form-NAME which is the symbol
-actually defined. 
-
-The symbol's function definition becomes the keyboard macro string.
-
-If that works, NAME is added to `sml-forms-alist' so you'll be able to
-reinvoke the macro through \\[sml-insert-form]. You might want to save
-the macro to use in a later editing session -- see `insert-kbd-macro'
-and add these macros to your .emacs file.
-
-See also `edit-kbd-macro' which is bound to \\[edit-kbd-macro]."
-  (interactive "sName for last kbd macro (\"sml-form-\" will be added): ")
-  (if (string-equal name "")
-      (error "No command name given")
-    (name-last-kbd-macro (intern (concat "sml-form-" name)))
-    (message (concat "Macro bound to sml-form-" name))
-    (or (assoc name sml-forms-alist)
-        (setq sml-forms-alist (cons (list name) sml-forms-alist)))))
-
-;; at a pinch these could be added to SML/Forms menu through the good
-;; offices of activate-menubar-hook or something... but documentation
-;; of this and/or menu-bar-update-hook is sparse in 19.33. anyway, use
-;; completing read for sml-insert-form prompt...
-
-(defvar sml-last-form "let"
-  "The most recent sml form inserted.")
-
-(defun sml-insert-form (arg)
-  "Interactive short-cut to insert a common ML form.
-If a perfix argument is given insert a newline and indent first, or
-just move to the proper indentation if the line is blank\; otherwise
-insert at point (which forces indentation to current column).
-
-The default form to insert is 'whatever you inserted last time'
-\(just hit return when prompted\)\; otherwise the command reads with 
-completion from `sml-forms-alist'."
-  (interactive "P")
-  (let ((name (completing-read
-               (format "Form to insert: (default %s) " sml-last-form)
-               sml-forms-alist nil t nil)))
-    ;; default is whatever the last insert was...
-    (if (string= name "") (setq name sml-last-form))
-    (setq sml-last-form name)
-    (if arg
-        (if (save-excursion (beginning-of-line) (looking-at "[ \t]*$"))
-            (sml-indent-line)
-          (newline-and-indent)))
-    (cond ((string= name "let") (sml-form-let))
-          ((string= name "local") (sml-form-local))
-          ((string= name "case") (sml-form-case))
-          ((string= name "abstype") (sml-form-abstype))
-          ((string= name "datatype") (sml-form-datatype))
-          ((string= name "functor") (sml-form-functor))
-          ((string= name "structure") (sml-form-structure))
-          ((string= name "signature") (sml-form-signature))
-          (t
-           (let ((template (intern (concat "sml-form-" name))))
-             (if (fboundp template)
-                 (if (commandp template)
-                     ;; it may be a named kbd macro too
-                     (command-execute template)
-                   (funcall template))
-               (error
-                (format "Undefined format function: %s" template))))))))
-
-(defun sml-form-let () 
-  "Insert a `let in end' template."
-  (interactive)
-  (sml-let-local "let"))
-
-(defun sml-form-local ()
-  "Insert a `local in end' template."
-  (interactive)
-  (sml-let-local "local"))
-
-(defun sml-let-local (starter)
-  "Insert a let or local template, depending on STARTER string."
-  (let ((indent (current-column)))
-    (insert starter)
-    (insert "\n") (indent-to (+ sml-indent-level indent))
-    (save-excursion                     ; so point returns here
-      (insert "\n")
-      (indent-to indent)
-      (insert "in\n")
-      (indent-to (+ sml-indent-level indent))
-      (insert "\n")
-      (indent-to indent)
-      (insert "end"))))
-
-(defun sml-form-case ()
-  "Insert a case expression template, prompting for the case-expresion."
-  (interactive)
-  (let ((expr (read-string "Case expr: "))
-        (indent (current-column)))
-    (insert (concat "case " expr))
-    (if sml-case-indent
-        (progn
-          (insert "\n")
-          (indent-to (+ 2 indent))
-          (insert "of "))
-      (insert " of\n")
-      (indent-to (+ indent sml-indent-level)))
-    (save-excursion (insert " => "))))
-
-(defun sml-form-signature ()
-  "Insert a generative signature binding, prompting for the name."
-  (interactive)
-  (let ((indent (current-column))
-        (name (read-string "Signature name: ")))
-    (insert (concat "signature " name " ="))
-    (insert "\n")
-    (indent-to (+ sml-structure-indent indent))
-    (insert "sig\n")
-    (indent-to (+ sml-structure-indent sml-indent-level indent))
-    (save-excursion
-      (insert "\n")
-      (indent-to (+ sml-structure-indent indent))
-      (insert "end"))))
-
-(defun sml-form-structure ()
-  "Insert a generative structure binding, prompting for the name.
-The command also prompts for any signature constraint -- you should
-specify \":\" or \":>\" and the constraining signature."
-  (interactive)
-  (let ((indent (current-column))
-        (name (read-string (concat "Structure name: ")))
-        (signame (read-string "Signature constraint (default none): ")))
-    (insert (concat "structure " name " "))
-    (insert (if (string= "" signame) "=" (concat signame " =")))
-    (insert "\n")
-    (indent-to (+ sml-structure-indent indent))
-    (insert "struct\n")
-    (indent-to (+ sml-structure-indent sml-indent-level indent))
-    (save-excursion
-      (insert "\n")
-      (indent-to (+ sml-structure-indent indent))
-      (insert "end"))))
-
-(defun sml-form-functor ()
-  "Insert a genarative functor binding, prompting for the name.
-The command also prompts for the required signature constraint -- you
-should specify \":\" or \":>\" and the constraining signature."
-  (interactive)
-  (let ((indent(current-indentation))
-        (name (read-string "Name of functor: "))
-        (signame (read-string "Signature constraint: " ":" )))
-    (insert (concat "functor " name " () " signame " ="))
-    (insert "\n")
-    (indent-to (+ sml-structure-indent indent))
-    (insert "struct\n")
-    (indent-to (+ sml-structure-indent sml-indent-level indent))
-    (save-excursion                     ; return to () instead?
-      (insert "\n")
-      (indent-to (+ sml-structure-indent indent))
-      (insert "end"))))
-
-(defun sml-form-datatype ()
-  "Insert a datatype declaration, prompting for name and type parameter."
-  (interactive)
-  (let ((indent (current-indentation))
-        (type (read-string "Datatype type parameter (default none): "))
-        (name (read-string (concat "Name of datatype: "))))
-    (insert (concat "datatype "
-                    (if (string= type "") "" (concat type " "))
-                    name " ="))
-    (insert "\n")
-    (indent-to (+ sml-indent-level indent))))
-
-(defun sml-form-abstype ()
-  "Insert an abstype declaration, prompting for name and type parameter."
-  (interactive)
-  (let ((indent(current-indentation))
-        (type (read-string "Abstype type parameter (default none): "))
-        (name (read-string "Name of abstype: ")))
-    (insert (concat "abstype "
-                    (if (string= type "") "" (concat type " "))
-                    name " ="))
-    (insert "\n")
-    (indent-to (+ sml-indent-level indent))
-    (save-excursion
-      (insert "\n")
-      (indent-to indent)
-      (insert "with\n")
-      (indent-to (+ sml-indent-level indent))
-      (insert "\n")
-      (indent-to indent)
-      (insert "end"))))
-
-;;; Load the menus, if they can be found on the load-path
-
-(condition-case nil
-    (require 'sml-menus)
-  (error (message "Sorry, not able to load SML mode menus.")))
-
-;;; & do the user's customisation
-
-(add-hook 'sml-load-hook 'sml-mode-version t)
-
-(run-hooks 'sml-load-hook)
-
-;;; sml-mode.el has just finished.
diff -Nru mosml-2.01/utility/sml-mode-3.3b/sml-mode.info mosml-2.10.1/utility/sml-mode-3.3b/sml-mode.info
--- mosml-2.01/utility/sml-mode-3.3b/sml-mode.info	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/utility/sml-mode-3.3b/sml-mode.info	1970-01-01 00:00:00.000000000 +0000
@@ -1,1335 +0,0 @@
-This is Info file sml-mode.info, produced by Makeinfo version 1.67 from
-the input file sml-mode.texi.
-
-
-File: sml-mode.info,  Node: Top,  Next: Copying,  Prev: (dir),  Up: (dir)
-
-SML Mode Info
-*************
-
-You are looking at the top node of the Info tree documenting SML-MODE
-(Version 3.3). Not all functions are documented here, but those that
-aren't you probably won't miss. All commands and settable variables
-have built-in documentation, as per usual Emacs conventions.
-
-* Menu:
-
-* Copying::             You can copy SML mode
-* Introduction::        Setting things up
-* SML Mode::            Editing SML source
-* Interaction Mode::    Running ML processes
-* Configuration::       Menus, highlighting, setting defaults
-* Credits::             Credit and blame
-
-Indexes
-* Command Index::       Commands you can invoke
-* Variable Index::      Variables you can set
-* Key Index::           Default keybindings
-
-Introduction
-* Distribution::        What this distribution contains
-* Getting Started::     What to tell Emacs
-* Getting Help::        How Emacs can help
-
-SML Mode
-* Basics::              On entering SML mode
-* Indentation::         Prettying SML text
-* Magic Insertion::     Templates and electric keys
-* SML Mode Defaults::   Variables controlling indentation
-
-Interaction Mode
-* Running ML::          Commands to run the ML compiler in a buffer
-* ML Interaction::      Sending program fragments to the compiler
-* Tracking Errors::     Finding reported syntax errors
-* Process Defaults::    Setting defaults for process interaction
-
-Configuration
-* Hooks::               Creating hooks
-* Key Bindings::        Binding commands to keys
-* Menus::               Taking advantage of bitmapped screens
-* Highlighting::        Syntax colouring
-* Advanced Topics::     You may need to speak Emacs Lisp
-
-
-File: sml-mode.info,  Node: Copying,  Next: Introduction,  Prev: Top,  Up: Top
-
-Copying
-*******
-
-You can freely copy, modify and redistribute SML mode because it's made
-available under the liberal terms of the GNU General Public License.
-
-   GNU General Public License as published by the Free Software
-Foundation; either version 2, or (at your option) any later version.
-
-   SML mode is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
-Public License for more details.
-
-   You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to the Free
-Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-
-File: sml-mode.info,  Node: Introduction,  Next: SML Mode,  Prev: Copying,  Up: Top
-
-Introduction
-************
-
-SML mode is a major mode for Emacs for editing Standard ML. It has some
-novel bugs, and some nice features:
-
-   * Automatic indentation of sml code--a number of variables to
-     customise the indentation.
-
-   * Easy insertion for commonly used templates like let, local,
-     signature, and structure declarations, with minibuffer prompting
-     for types and expressions.
-
-   * Magic pipe insertion: `|' automatically determines if it is used
-     in a case or fun construct, and indents the next line as
-     appropriate, inserting `=>' or the name of the function.
-
-   * Inferior shell for running ML. There's no need to leave Emacs,
-     just keep on editing while the compiler runs in another window.
-
-   * Automatic "use file" in the inferior shell--you can send files,
-     buffers, or regions of code to the ML subprocess.
-
-   * Menus, and syntax and keyword highlighting supported for Emacs 19
-     and derivatives.
-
-   * Parsing errors from the inferior shell, and repositioning the
-     source--much like the next-error function used in c-mode.
-
-   * SML mode can be easily configured to work with a number of Standard
-     ML compilers, and other SML based tools.
-
-* Menu:
-
-* Distribution::        What this distribution contains
-* Getting Started::     What to tell Emacs
-* Getting Help::        How Emacs can help
-
-
-File: sml-mode.info,  Node: Distribution,  Next: Getting Started,  Prev: Introduction,  Up: Introduction
-
-The SML mode distribution
-=========================
-
-The distribution contains several Emacs Lisp files--this is for ease of
-maintenance, you can concatenate them if you're careful:
-
-`sml-mode.el'
-     Main file, and should work in any Emacs editor or version post
-     18.58--it only knows, or thinks it knows, about SML syntax and
-     indentation.
-
-`sml-menus.el'
-     Menus to access user settable features of the mode, and for those
-     who prefer menus over keys under Emacs 19 and derivatives.
-
-`sml-{hilite,font}.el'
-     Syntax highlighting functions to display keywords in a bold font,
-     comments in italics, etc., using one of Emacs' two popular syntax
-     colouring packages.
-
-`sml-proc.el'
-     Process interaction requires the `comint' package (normally
-     distributed with Emacs 19 and derivatives).
-
-`sml-{poly-ml,mosml}.el'
-     Auxiliary library support for Poly/ML and Moscow ML compilers.
-
-There is also the Texinfo generated `info' file:
-
-`sml-mode.{dvi,info}'
-     This file--rudimentary SML mode documentation, and
-
-`sml-site.el'
-     Configuration file for system-wide installation. Read and edit
-     this file if you are installing SML mode for general use.
-
-
-File: sml-mode.info,  Node: Getting Started,  Next: Getting Help,  Prev: Distribution,  Up: Introduction
-
-Getting started
-===============
-
-With luck your system administrator will have installed SML mode
-somewhere convenient, so all you have to do is put the line
-
-     (require 'sml-site)
-
-in your `.emacs' configuration file and all will be well--you can skip
-the rest of this getting started section. Otherwise you will need to
-tell Emacs where to find all the SML mode `.el' files, and when to use
-them. The where is addressed by locating the Lisp code on your Emacs
-Lisp load path--you may have to create a directory for this, say
-`/home/mjm/elisp', and then insert the following lines in your
-`/home/mjm/.emacs' file(1):
-
-     (setq load-path (cons "/home/mjm/elisp" load-path))
-     (autoload 'sml-mode "sml-mode" "Major mode for editing SML." t)
-
-The first line adjusts Emacs' internal search path so it can locate the
-Lisp source you have copied to that directory; the second line tells
-Emacs to load the code automatically when it is needed. You can then
-switch any Emacs buffer into SML mode by entering the command
-
-     M-x sml-mode
-
-It is usually more convenient to have Emacs automatically place the
-buffer in SML mode whenever you visit a file containing ML programs.
-The simplest way of achieving this is to put something like
-
-     (setq auto-mode-alist
-           (append '(("\\.sml$" . sml-mode)
-                     ("\\.sig$" . sml-mode)
-                     ("\\.ML$"  . sml-mode)) auto-mode-alist))
-
-also in your `.emacs' file. Subsequently (after a restart), any files
-with these extensions will be placed in SML mode buffers when you visit
-them.
-
-   You may want to pre-compile the `sml-*.el' files (`M-x
-byte-compile-file') for greater speed--byte compiled code loads and
-runs somewhat faster.
-
-   ---------- Footnotes ----------
-
-   (1)  cf. commentary in the site initialisation file `sml-site.el'.
-
-
-File: sml-mode.info,  Node: Getting Help,  Prev: Getting Started,  Up: Introduction
-
-Help!
-=====
-
-You're reading it. Apart from the on-line info tree (`C-h i' is the
-Emacs key to enter the `info' system--you should follow the brief
-tutorial if this is unfamiliar), there are further details on specific
-commands in their documentation strings. Only the most useful SML mode
-commands are documented in the info tree: to find out more use Emacs'
-help facilities.
-
-   Briefly, to get help on a specific function use `C-h f' and enter
-the command name. All (almost all, then) SML mode commands begin with
-`sml-', so if you type this and press  (for completion) you will
-get a list of all commands. Another way is to use `C-h a' and enter the
-string `sml'. This is command apropos; it will list all commands with
-that sub-string in their names, and any key binding they may have in
-the current buffer. Command apropos gives a one-line synopsis of what
-each command does.
-
-   Some commands are also variables--such things are allowed in Lisp, if
-not in ML! *Note Command Index::, for a list of (info) documented
-functions. *Note Variable Index::, for a list of user settable variables
-to control the behaviour of SML mode.
-
-   Before accessing this information on-line from within Emacs you may
-have to set the variable `sml-mode-info'. Put in your `.emacs' file
-something like:
-
-     (setq sml-mode-info "/home/mjm/info/sml-mode.info")
-
-When different from the default this variable should be a string giving
-the absolute name of the `.info' file. Then `C-c C-i' in SML mode
-(i.e., the command `M-x sml-mode-info') will bring up the manual. This
-help is also accessible from the menu. (Resetting this variable will
-not be necessary if your site administrator has been kind enough to
-install SML mode and its attendant documentation in the Emacs
-hierarchy.)
-
-
-File: sml-mode.info,  Node: SML Mode,  Next: Interaction Mode,  Prev: Introduction,  Up: Top
-
-Editing with SML Mode
-*********************
-
-Now SML mode provides just a few additional editing commands. Most of
-the work (*note Credit & Blame: Credits.) has gone into implementing
-the indentation algorithm which, if you think about it, has to be
-complicated for a language like ML. *Note Indentation Defaults: SML
-Mode Defaults, for details on how to control some of the behaviour of
-the indentation algorithm. Principal goodies are the `electric pipe'
-feature, and the ability to insert common SML forms (macros or
-templates).
-
-* Menu:
-
-* Basics::              On entering SML mode
-* Indentation::         Prettying SML text
-* Magic Insertion::     Templates and electric keys
-* SML Mode Defaults::   Variables controlling indentation
-
-
-File: sml-mode.info,  Node: Basics,  Next: Indentation,  Prev: SML Mode,  Up: SML Mode
-
-On entering SML mode
-====================
-
- - Command: sml-mode
-     This switches a buffer into SML mode. This is a *major mode* in
-     Emacs. To get out of SML mode the buffer's major mode must be set
-     to something else, like text-mode. *Note Getting Started::, for
-     details on how to set this up automatically when visiting an SML
-     file.
-
-   Emacs is all hooks of course. A hook is a variable: if the variable
-is non-nil it binds a list of Emacs Lisp functions to be run in some
-order (usually left to right). You can customise SML mode with these
-hooks:
-
- - Hook: sml-mode-hook
-     Default: `nil'
-
-     This is run every time a new SML mode buffer is created (or if you
-     type `M-x sml-mode'). This is one place to put your preferred key
-     bindings. *Note Configuration::, for some examples.
-
- - Hook: sml-load-hook
-     Default: `'sml-mode-version'
-
-     Another, maybe better, place for key bindings. This hook is only
-     run when SML mode is loaded into Emacs. *Note Configuration::.
-
- - Command: sml-mode-version
-     Prints the current version of SML mode in the mini-buffer, in case
-     you need to know. I've put it on `sml-load-hook' so you can easily
-     tell which version of SML mode you are running.
-
-
-File: sml-mode.info,  Node: Indentation,  Next: Magic Insertion,  Prev: Basics,  Up: SML Mode
-
-Automatic indentation
-=====================
-
-ML is a complicated language to parse, let alone compile. The
-indentation algorithm is a little wooden (for some tastes), and the best
-advice is not to fight it! There are several variables that can be
-adjusted to control the indentation algorithm (*note Customising SML
-Mode: SML Mode Defaults., below).
-
- - Command: sml-indent-line
-     Key: 
-
-     This command indents the current line. If you set the indentation
-     of the previous line by hand, `sml-indent-line' will indent
-     relative to this setting.
-
- - Command: sml-indent-region
-     Key: `C-M-\'
-
-     Indent the current region. Be patient if the region is large (like
-     the whole buffer).
-
- - Command: sml-back-to-outer-indent
-     Key: `M-'
-
-     Unindents the line to the next outer level of indentation.
-
-   Further indentation commands that Emacs provides (generically, for
-all modes) that you may like to recall:
-
-   - `M-x newline-and-indent'
-
-     On  by default.  Insert a newline, then indent according to
-     the major mode. *Note Indentation for Programs: (emacs)Program
-     Indent, for details.
-
-   - `M-x indent-rigidly'
-
-     On `C-x ' by default.  Moves all lines in the region right by
-     its argument (left, for negative arguments). *Note Indentation:
-     (emacs)Indentation.
-
-   - `M-x indent-for-comment'
-
-     On `M-;' by default.  Indent this line's comment to comment
-     column, or insert an empty comment. *Note Comment Commands:
-     (emacs)Comment Commands.
-
-   - `M-x indent-new-comment-line'
-
-     On `M-' by default.  Break line at point and indent,
-     continuing comment if within one.  *Note Multi-Line Comments:
-     (emacs)Multi-Line Comments.
-
-   As with other language modes, `M-;' gives you a comment at the end
-of the current line. The column where the comment starts is determined
-by the variable `comment-column'--default is 40, but it can be changed
-with `set-comment-column' (on `C-x ;' by default).
-
-
-File: sml-mode.info,  Node: Magic Insertion,  Next: SML Mode Defaults,  Prev: Indentation,  Up: SML Mode
-
-Electric features
-=================
-
-Electric keys are generally pretty irritating, so those provided by SML
-mode are fairly muted. The only truly electric key is `;', and this has
-to be enabled to take effect.
-
- - Command: sml-electric-pipe
-     Key: `M-|'
-
-     When the point is in a `case' statement this opens a new line,
-     indents and inserts `| =>' leaving point just before the double
-     arrow; if the enclosing construct is a `fun' declaration, the
-     newline is indented and the function name copied at the
-     appropriate column. Generally, try it whenever a `|' is
-     wanted--you'll like it!
-
- - Command: sml-electric-semi
-     Key: `;'
-
-     Just inserts a semi-colon, usually. The behaviour of this command
-     is governed by the variable `sml-electric-semi-mode'.
-
- - Command, Variable: sml-electric-semi-mode
-     Default: `nil'
-
-     If this variable is `nil', `sml-electric-semi' just inserts a
-     semi-colon, otherwise it inserts a semi-colon and a newline, and
-     indents the newline for SML. The command toggles the value of the
-     variable; if you give the command a prefix argument (i.e., `C-u M-x
-     sml-electric-semi-mode') this always disables the electric effect
-     of `;'.
-
- - Command: sml-insert-form
-     Key: `C-c '
-
-     Interactive short-cut to insert common ML forms (a.k.a. macros, or
-     templates). Recognised forms are `let', `local', `case', `abstype',
-     `datatype', `signature', `structure', and `functor'. Except for
-     `let' and `local', these will prompt for appropriate parameters
-     like functor name and signature, etc.. This command prompts in the
-     mini-buffer, with completion.
-
-     By default `C-c ' will insert at point, with the indentation
-     of the current column; if you give a prefix argument (i.e., `C-u
-     C-c ') the command will insert a newline first, indent, and
-     then insert the template.
-
-   `sml-insert-form' is also extensible: see *Note Configuration:: for
-further details.
-
-
-File: sml-mode.info,  Node: SML Mode Defaults,  Prev: Magic Insertion,  Up: SML Mode
-
-Indentation defaults
-====================
-
-Several variables try to control the indentation algorithm and other
-features of SML mode. For these user settable variables there is
-generally a function of the same name that does the job--look for them
-in the menu under *Format/Mode Variables*.
-
- - Command, Variable: sml-indent-level
-     Default: `4'
-
-     This variable controls the block indentation level. The command
-     prompts for a numeric value unless a numeric prefix is provided
-     instead. For example `M-2 M-x sml-indent-level' will set the
-     variable to 2 without prompting.
-
- - Command, Variable: sml-pipe-indent
-     Default: `-2'
-
-     This variable adjusts the indentation level for lines that begin
-     with a `|' (after any white space). The extra offset is usually
-     negative.  The command prompts for a numeric value unless a
-     numeric prefix is provided instead.
-
- - Variable: sml-paren-lookback
-     Default: `1000'
-
-     The number of characters the indentation algorithm searches for an
-     opening parenthesis. 1000 characters is about 30-40 lines; larger
-     values mean slower indentation. If the value of the variable is
-     `nil' this means the indentation algorithm won't look back at all.
-
-   If the default values are not acceptable you can set these variables
-permanently in your `.emacs' file. *Note Configuration::, for details
-and examples. Three further variables control the behaviour of
-indentation.
-
- - Command, Variable: sml-case-indent
-     Default: `nil'
-
-     How to indent `case' expressions:
-
-          If `t':                             If `nil':
-          case expr                           case expr of
-            of exp1 => ...                        exp1 => ...
-             | exp2 => ...                      | exp2 => ...
-
-     The first seems to be the standard in SML/NJ. The second is the
-     (nicer?) default.
-
- - Command, Variable: sml-nested-if-indent
-     Default: `nil'
-
-     Nested `if-then-else' expressions have the following indentation
-     depending on the value.
-
-          If `t':                           If `nil':
-          if exp1 then exp2                 if exp1 then exp2
-          else if exp3 then exp4            else if exp3 then exp4
-          else if exp5 then exp6                 else if exp5 then exp6
-               else exp7                              else exp7
-
- - Command, Variable: sml-type-of-indent
-     Default: `t'
-
-     Determines how to indent `let', `struct', etc..
-
-          If `t':                           If `nil':
-          fun foo bar = let                 fun foo bar = let
-                            val p = 4           val p = 4
-                        in                  in
-                            bar + p             bar + p
-                        end                 end
-
-     `sml-type-of-indent' will not have any effect if the starting
-     keyword is the first word on the line.
-
-
-File: sml-mode.info,  Node: Interaction Mode,  Next: Configuration,  Prev: SML Mode,  Up: Top
-
-Running ML under Emacs
-**********************
-
-The most useful feature of SML mode is that it provides a convenient
-interface to the compiler. How serious users of ML put up with a
-teletype interface to the compiler is beyond me... but perhaps there
-are other interfaces to compilers that require one to part with serious
-money. Such remarks can quickly become dated--in this case, let's hope
-so!
-
-   Anyway, SML mode provides an interaction mode, `inferior-sml-mode',
-where the compiler runs in a separate buffer in a window or frame of
-its own. You can use this buffer just like a terminal, but it's usually
-more convenient to mark some text in the SML mode buffer and have Emacs
-communicate with the sub-process. The features discussed below are
-syntax-independent, so they should work with a wide range of ML-like
-tools and compilers. *Note Process Defaults::, for some hints.
-
-   `inferior-sml-mode' is a specialisation of the `comint' package that
-comes with GNU Emacs and GNU XEmacs.
-
-* Menu:
-
-* Running ML::          Commands to run the ML compiler in a buffer
-* ML Interaction::      Sending program fragments to the compiler
-* Tracking Errors::     Finding reported syntax errors
-* Process Defaults::    Setting defaults for process interaction
-
-
-File: sml-mode.info,  Node: Running ML,  Next: ML Interaction,  Prev: Interaction Mode,  Up: Interaction Mode
-
-Starting the compiler
-=====================
-
-Start your favourite ML compiler with the command
-
-     M-x sml
-
-This creates a process interaction buffer that inherits some key
-bindings from SML mode and from `comint' (*note Shell Mode:
-(emacs)Shell Mode.). Starting the ML compiler adds some functions to
-SML mode buffers so that program text can be communicated between
-editor and compiler (*note ML Interaction::.).
-
-   The name of the ML compiler is the first thing you should know how to
-specify:
-
- - Variable: sml-program-name
-     Default: `"sml"'
-
-     The program to run as ML. You might need to specify the full path
-     name of the program.
-
- - Variable: sml-default-arg
-     Default: `""'
-
-     Useful for Poly/ML users who may supply a database file, or others
-     who have wrappers for setting various options around the command
-     to run the compiler. Moscow ML people might set this to `"-P
-     full"', etc..
-
-   The variable `sml-program-name' is a string holding the name of the
-program *as you would type it at the shell*. You can always choose a
-program different to the default by invoking
-
-     C-u M-x sml
-
-With the prefix argument Emacs will prompt for the command name and any
-command line arguments to pass to the compiler. Thereafter Emacs will
-use this new name as the default, but for a permanent change you should
-set this in your `.emacs' with, e.g.:
-
-     (setq sml-program-name "nj-sml")
-
-You probably shouldn't set this in `sml-mode-hook' because that will
-interfere if you occasionally run a different compiler (e.g., `poly' or
-`hol90').
-
- - Command: sml
-     Launches ML as an inferior process in another buffer; if an ML
-     process already exists, just switch to the process buffer. A
-     prefix argument allows you to edit the command line to specify the
-     program, and any command line options.
-
- - Hook: inferior-sml-mode-hook
-     Default: `nil'
-
-     `M-x sml' runs `comint-mode-hook' and `inferior-sml-mode-hook'
-     hooks in that order, but *after* the compiler is started. Use
-     `inferior-sml-mode-hook' to set any `comint' buffer-local
-     configurations for SML mode you like.
-
- - Hook: inferior-sml-load-hook
-     Default: `nil'
-
-     This hook is analogous to `sml-load-hook' and is run just after the
-     code for `inferior-sml-mode' is loaded into Emacs. Use this to set
-     process defaults, and preferred key bindings for the interaction
-     buffer.
-
- - Command: switch-to-sml
-     Key: `C-c C-s'
-
-     Switch from the SML buffer to the interaction buffer. By default
-     point will be placed at the end of the process buffer, but a
-     prefix argument will leave point wherever it was before. If you
-     try `C-c C-s' before an ML process has been started, you'll just
-     get an error message to the effect that there's no current process
-     buffer.
-
- - Variable: sml-dedicated-frame
-     Default: `(if window-system t nil)'
-
-     If `t' this indicates to `switch-to-sml' and other functions that
-     the interaction buffer where ML is running will be displayed on its
-     own, dedicated frame; otherwise the interaction buffer will appear
-     on the current frame, splitting the window if necessary. The
-     default means SML mode will try and use a dedicated frame if you
-     are running Emacs under X Windows (say), but not otherwise. The
-     variable `sml-display-frame-alist' configures the dedicated frame's
-     appearance (`C-h v sml-display-frame-alist' for details).
-
- - Command: sml-cd
-     When started, the ML compiler's default working directory is the
-     current buffer's default directory. This command allows the working
-     directory to be changed, if the compiler can do this. The variable
-     `sml-cd-command' specifies the compiler command to invoke (*note
-     Process Defaults::.).
-
-
-File: sml-mode.info,  Node: ML Interaction,  Next: Tracking Errors,  Prev: Running ML,  Up: Interaction Mode
-
-Speaking to the compiler
-========================
-
-Several commands are defined for sending program fragments to the
-running compiler. Each of the following commands takes a prefix argument
-that will switch the input focus to the process buffer afterwards
-(leaving point at the end of the buffer):
-
- - Command: sml-load-file
-     Key: `C-c C-l'
-
-     Send a `use file' command to the current ML process. The variable
-     `sml-use-command' is used to define the correct template for the
-     command to invoke (*note Process Defaults::.). The default file is
-     the file associated with the current buffer, or the last file
-     loaded if you are in the interaction buffer.
-
- - Command: sml-send-region
-     Key: `C-c C-r'
-
-     Send the current region of text in the SML buffer.
-     `sml-send-region-and-go' is a similar command for you to bind in
-     SML mode if you wish: it'll send the region and then switch-to-sml.
-
- - Command: sml-drag-region
-     Key: `M-S-down-mouse-1'
-
-     It's sometimes irritating to do all that `C-@' and `C-c C-r' stuff
-     to send regions to the ML process, so if you are running Emacs
-     under X Windows (say) you can do the same job by holding down both
-     the  and  keys, and dragging with mouse button one
-     over the region. This will temporarily highlight the region as you
-     move the mouse, like `mouse-drag-region' (i.e., `down-mouse-1'),
-     and send the highlighted text straight into the jaws of the ML
-     compiler.
-
-     If you only click the mouse button, instead of dragging, the
-     region of text sent to the compiler is delimited by the current
-     position of point and the place where you click the mouse. In
-     neither case will the command set the region.
-
- - Command: sml-send-buffer
-     Key: `C-c C-b'
-
-     Send the contents of the current buffer to ML.
-
-   By and large, Emacs can nowadays quite happily send large chunks of
-text to its subprocesses (`comint' does input splitting). However, it is
-still probably safest(1) to send larger program fragments to ML via the
-temporary file mechanism. This, for `sml-send-region' and other SML
-mode commands that use it in some way, takes advantage of the ML
-compiler's ability to open a file and compile the contents by making a
-temporary file of the indicated text. Two variables of interest are:
-
- - Variable: sml-temp-threshold
-     Default: `0'
-
-     Determines what constitutes a large program fragment. A value of
-     512, say, will declare half a kilobyte a suitable threshold and
-     larger fragments will be sent via a temporary file. A value of 0
-     means *all* text is sent via a temporary file; the value `nil'
-     inhibits the temporary file mechanism altogether.
-
- - Variable: sml-temp-file
-     Default: `(make-temp-name "/tmp/ml")'
-
-     A string that gives the name of the temporary file to use. This
-     default ensures Emacs will invent a unique name for this purpose
-     for use throughout the rest of the editing session. Only one
-     temporary file is used.
-
-   Another reason, you might well say *the reason*, for using the
-temporary file mechanism is that error messages reported by the ML
-compiler (*note Tracking Errors::.) are generally useless to SML mode
-unless a real file is associated with the input (an embedded *use file*
-will count as a real file). Of course, this all rather depends on the
-compiler producing sensible error messages, and on SML mode being able
-to parse them.
-
-   ---------- Footnotes ----------
-
-   (1)  XEmacs 19.11 users are warned that changing the default
-`sml-temp-threshold' may well cause XEmacs to hang; they seem to have
-fixed the problem in 19.12 and above.
-
-
-File: sml-mode.info,  Node: Tracking Errors,  Next: Process Defaults,  Prev: ML Interaction,  Up: Interaction Mode
-
-Finding errors
-==============
-
-SML mode provides one customisable function for locating the source
-position of errors reported by the compiler. This should work whether
-you type `use "puzzle.sml";' into the interaction buffer, or use one of
-the mechanisms provided for sending programs directly to the
-compiler--*note ML Interaction::..
-
- - Command: sml-next-error
-     Key: `C-c`'
-
-     Jump to the source location of the next error reported by the
-     compiler.  If the function bound to `sml-error-parser' returns a
-     range of character positions for the location of the error in the
-     source file, `sml-next-error' will put the mark at the end of the
-     range with point at the beginning; it may also highlight the
-     region specified; it will also echo the one-line text of the error
-     message if the error parser returns one.(1)
-
-     If you enter `C-u C-c`' instead, the command (a.k.a.
-     `sml-skip-errors') skips past all the remaining error messages and
-     removes any error overlay in the current buffer. Note that `C-c`'
-     also works in the ML interaction buffer (by default).
-
- - Variable, Command: sml-error-overlay
-     Default: `t'
-
-     Legal default values for this buffer-local variable are `t' and
-     `nil'. The variable attains a local value in each SML mode buffer
-     when the default is `t'; in this case the local value is an
-     overlay (or *extent* in XEmacs speak), and this means
-     `sml-next-error' will highlight errors in the buffer when it can.
-     If the default is `nil' it stays that way and `sml-next-error'
-     will not highlight anything, ever.
-
-     The command `M-x sml-error-overlay' will set the overlay around the
-     current region, or remove the overlay if a prefix argument is given
-     (i.e., `C-u M-x sml-error-overlay' removes the overlay, but this
-     functionality can be accessed from the menu to save typing).
-
-   Note that SML mode will usually locate errors relative to the start
-of the last major program fragment sent to the compiler (via
-`sml-load-file', etc.), but if you don't use the temporary file
-mechanism to communicate text to the ML process (*note Process
-Defaults::.), errors will generally not be located at all.
-
-   ---------- Footnotes ----------
-
-   (1)  Does `sml-error-parser' return these nice things? The answer is
-complicated! *Note Advanced Topics::, and the docstring `C-h v
-sml-error-parser'.
-
-
-File: sml-mode.info,  Node: Process Defaults,  Prev: Tracking Errors,  Up: Interaction Mode
-
-Process defaults
-================
-
-The process interaction code is independent of the compiler used,
-deliberately, so SML mode will work with a variety of ML compilers and
-ML-based tools. There are therefore a number of variables that may need
-to be set correctly before SML mode can speak to the compiler.  Things
-are by default set up for Standard ML of New Jersey, but switching to a
-new system is quite easy--very easy if you are using Poly/ML or Moscow
-ML as these are supported by libraries bundled with SML mode.
-
- - Variable: sml-use-command
-     Default: `"use \"%s\""'
-
-     Use file command template. Emacs will replace the `%s' with a file
-     name. Note that Emacs requires double quote characters inside
-     strings to be quoted with a backslash.
-
- - Variable: sml-cd-command
-     Default: `"System.Directory.cd \"%s\""'
-
-     Compiler command to change the working directory. Not all ML
-     systems support this feature (well, Edinburgh (core) ML didn't),
-     but they should.
-
- - Variable: sml-prompt-regexp
-     Default: `"^[\-=] *"'
-
-     Matches the ML compiler's prompt: `comint' uses this for various
-     purposes.
-
-   To customise error reportage for different ML compilers you need to
-set two further variables before `sml-next-error' can be useful:
-
- - Variable: sml-error-regexp
-     Default: `sml-smlnj-error-regexp'
-
-     This is the regular expression for matching the start of an error
-     message. The default matches the Standard ML of New Jersey
-     compiler's Error and Warning messages. If you don't want stop at
-     Warnings try, for example:
-            "^[-= ]*.+:[0-9]+\\.[0-9]+.+Error:"
-     If you're using Edinburgh (core) ML try `"^Parse error:"'.
-
- - Variable: sml-error-parser
-     Default: `'sml-smlnj-error-parser'
-
-     The function that actually parses the error message. Again, the
-     default is for SML/NJ. If you need to change this you may have to
-     do a little Emacs Lisp programming.
-
-   Note that bundled libraries supply an `sml-mosml-error-parser' and
-an `sml-poly-ml-error-parser', and set all the attendant compiler
-variables. *Note Advanced Topics::, for tips on how to program your own
-compiler extension to SML mode.
-
-
-File: sml-mode.info,  Node: Configuration,  Next: Credits,  Prev: Interaction Mode,  Up: Top
-
-Configuration Summary
-*********************
-
-This (sort of pedagogic) section gives more information on how to
-configure SML mode: menus, key bindings, hooks and highlighting are
-discussed, along with a few other random topics. First, though, the
-auxiliary files `sml-poly-ml.el' and `sml-mosml.el' define defaults for
-these popular (?) ML compilers--Poly/ML and Moscow ML, respectively.
-One way to setup SML mode to use Moscow ML is to add to your `.emacs':
-
-     (defun my-mosml-setup () "Initialise inferior SML mode for Moscow ML."
-       (load-library "sml-mosml.el")
-       (setq sml-program-name "/home/mjm/mosml/bin/mosml"))
-     (add-hook 'inferior-sml-load-hook 'my-mosml-setup)
-
-which creates a hook function `my-mosml-setup' and adds it to
-`inferior-sml-load-hook' so that the defaults for `sml-error-regexp'
-and its ilk (*note Process Defaults::.) are correctly initialised; I
-have to set `sml-program-name' explicitly here because that directory
-isn't on my (Unix) PATH. The story is similar if you use Poly/ML.
-Note, by the way, that order matters here: the `load-library' call
-comes first because the default for `sml-program-name' in
-`sml-mosml.el' is just `"mosml"'.
-
-   The auxiliary libraries bundled with SML mode define commands
-`sml-mosml' and `sml-poly-ml' (there's also an `sml-smlnj' for
-uniformity); these commands prompt for suitable values for
-`sml-program-name' and `sml-default-arg' before starting the compiler
-and setting the other process defaults. A prefix argument will give you
-the builtin defaults with no questions asked.
-
-* Menu:
-
-* Hooks::               Creating them
-* Key Bindings::        Binding commands to keys
-* Menus::               Taking advantage of bitmapped screens
-* Highlighting::        Syntax colouring
-* Advanced Topics::     You may need to speak Emacs Lisp
-
-
-File: sml-mode.info,  Node: Hooks,  Next: Key Bindings,  Prev: Configuration,  Up: Configuration
-
-Hooks
-=====
-
-One way to set SML mode variables (*note Indentation Defaults: SML Mode
-Defaults.), and other defaults, is through the `sml-mode-hook' in your
-`.emacs'. A simple example:
-
-     (defun my-sml-mode-hook () "Local defaults for SML mode"
-       (setq sml-indent-level 2)        ; conserve on horizontal space
-       (setq words-include-escape t)    ; \ loses word break status
-       (setq indent-tabs-mode nil))     ; never ever indent with tabs
-     (add-hook 'sml-mode-hook 'my-sml-mode-hook)
-
-The body of `my-sml-mode-hook' is a sequence of bindings. In this case
-it is not really necessary to set `sml-indent-level' in a hook because
-this variable is global (most SML mode variables are). With similar
-effect:
-
-     (setq sml-indent-level 2)
-
-anywhere in your `.emacs' file (but probably on `sml-load-hook'). The
-variable `indent-tabs-mode' is automatically made local to the current
-buffer whenever it is set explicitly, so it *must* be set in a hook if
-you always want SML mode to behave like this. The same goes for the
-buffer-local `sml-error-overlay'; since this is globally `t' by default,
-set it globally `nil' if you never want errors highlighted:
-
-     (setq-default sml-error-overlay nil)
-
-Again, on `sml-load-hook' would probably be the best place.
-
-   Another hook is `inferior-sml-mode-hook'. This can be used to
-control the behaviour of the interaction buffer through various
-variables meaningful to `comint'-based packages:
-
-     (defun my-inf-sml-mode-hook () "Local defaults for inferior SML mode"
-       (add-hook 'comint-output-filter-functions 'comint-truncate-buffer)
-       (setq      comint-scroll-show-maximum-output t)
-       (setq      comint-input-autoexpand nil))
-     (add-hook 'inferior-sml-mode-hook 'my-inf-sml-mode-hook)
-
-Again, the body is a sequence of bindings. Unless you run several ML
-compilers simultaneously under one Emacs, this hook will normally only
-get run once. You might want to look up the documentation (`C-h v' and
-`C-h f') for these buffer-local `comint' things.
-
-
-File: sml-mode.info,  Node: Key Bindings,  Next: Menus,  Prev: Hooks,  Up: Configuration
-
-Key bindings
-============
-
-Customisation (in Emacs) usually entails putting favourite commands on
-easily remembered keys. Two `keymaps' are defined in SML mode: one is
-effective in program text buffers (`sml-mode-map') and the other is
-effective in interaction buffers (`inferior-sml-mode-map').  The
-initial design ensures that (many of) the default key bindings from the
-former keymap will also be available in the latter (e.g., `C-c`').
-
-   Type `C-h m' in an SML mode buffer to find the default key bindings
-(and similarly in an ML interaction buffer), and use the hooks provided
-to install your preferred key bindings. Given that the keymaps are
-global (variables):
-
-     (defun my-sml-load-hook () "Global defaults for SML mode"
-       (define-key   sml-mode-map "\C-cd" 'sml-cd)
-       (define-key   sml-mode-map "\C-co" 'sml-error-overlay))
-     (add-hook 'sml-load-hook 'my-sml-load-hook)
-
-This has the effect of binding `sml-cd' to the key `C-c d', and the
-command `sml-error-overlay' to the key `C-c o'. If you want the same
-behaviour from `C-c d' in the ML buffer:
-
-     (defun my-inf-sml-load-hook () "Global defaults for inferior SML mode"
-       (define-key inferior-sml-mode-map "\C-cd" 'sml-cd)
-       ;; NB. for SML/NJ '96
-       (setq sml-cd-command "OS.FileSys.chDir \"%s\""))
-     (add-hook 'inferior-sml-load-hook 'my-inf-sml-load-hook)
-
-   There is nothing to stop you rebuilding the entire keymap for SML
-mode and the ML interaction buffer in your `.emacs' of course: SML mode
-won't define `sml-mode-map' or `inferior-sml-mode-map' if you have
-already done so.
-
-
-File: sml-mode.info,  Node: Menus,  Next: Highlighting,  Prev: Key Bindings,  Up: Configuration
-
-Menus
-=====
-
-Menus are useful for fiddling with mode defaults and finding out what
-keys commands are on if you are forgetful (not all commands are listed
-in the menu). For menus to appear in the menu bar under GNU Emacs or GNU
-XEmacs, the editor must be able to find one of two packages--i.e., one
-or both must be on your `load-path'. The first option is `easymenu'
-which is distributed with GNU Emacs. Easy!
-
-   The second option is `auc-menu' which was written by Per Abrahamsen
-and distributed with AUCTeX, but it is independently available from the
-IESD lisp archive(1) at Aalborg. You'll also find `auc-menu' is
-available from the LCD archive(2), the main repository for all Emacs
-Lisp. The advantage of `auc-menu' is that it works with XEmacs too.
-
-   Notice that certain menu entries are not illuminated at first--these
-are generally functions that depend on there being an ML process running
-with which to communicate.
-
-   ---------- Footnotes ----------
-
-   (1)  `ftp://sunsite.auc.dk/packages/auctex/'
-
-   (2)
-`ftp://archive.cis.ohio-state.edu/pub/gnu/emacs/elisp-archive/misc/'
-
-
-File: sml-mode.info,  Node: Highlighting,  Next: Advanced Topics,  Prev: Menus,  Up: Configuration
-
-Syntax colouring
-================
-
-Highlighting is very handy for picking out keywords in the program text,
-spotting misspelled kewyords, and, if you have Emacs' `ps-print'
-package installed (you usually do these days), obtaining pretty, even
-colourful code listings--quite properly for your colourful ML programs.
-
-   Various highlight (hilite, if you spell real bad!) packages are
-available for GNU Emacs 19, and GNU XEmacs. SML mode can use either
-`hilit19' which only comes with Emacs, or `font-lock' which is the
-package of choice with XEmacs. If you are not familiar with these
-highlight packages you'll have to check their sources for installation
-guidelines, etc..
-
-   Use `sml-load-hook' to tell Emacs which scheme you prefer for SML
-mode. For example:
-
-     (add-hook 'sml-load-hook '(lambda () (require 'sml-font)))
-
-This ensures the SML extensions to `font-lock' will be available once
-SML mode loads (from `sml-font.el'--if you prefer `hilit19' you should
-`(require 'sml-hilite)' instead.
-
-   The variable `sml-font-lock-extra-keywords' is for further
-customising `font-lock' for SML mode. The value of the variable should
-be a list of strings, each of which is a regular expression that should
-match the desired keyword exactly. Here's an example:
-
-     (setq sml-font-lock-extra-keywords
-           '("\\babstraction\\b" "\\bfunsig\\b" "=>" "::"))))
-
-The `\b' marks a word boundary, according to the syntax table defined
-for SML mode. Backslash must be quoted inside a string.  *Note Regexps:
-(emacs)Regexps, for a summary of Emacs' regular expression syntax.
-
-   Finally, the variable `sml-font-lock-auto-on' can be used to control
-whether or not `font-lock' should be enabled by default in SML mode
-buffers; it is enabled by default. The `sml-hilite' package is
-customisable, but only with regard to colour changes.
-
-
-File: sml-mode.info,  Node: Advanced Topics,  Prev: Highlighting,  Up: Configuration
-
-Advanced Topics
-===============
-
-* Menu:
-
-* Forms::    These forms are bloody useless; can't we have better ones?
-* Indents::  I hate that indentation algorithm; can't I suppress it?
-* Frames::   The dedicated frame for ML is too huge; can it be made smaller?
-* Multi ML:: Can SML mode handle more than one compiler running at once?
-* Other ML:: What needs to be done to support other ML compilers?
-
-
-File: sml-mode.info,  Node: Forms,  Next: Indents,  Prev: Advanced Topics,  Up: Advanced Topics
-
-           *These forms are bloody useless; can't we have better ones?*
-
-You can indeed. `sml-insert-form' is extensible so all you need to do
-is create the macros yourself. Define a *keybord macro* (`C-x ('
- `C-x )') and give it a suitable name:
-`sml-addto-forms-alist' prompts for a name, say `NAME', and binds the
-macro `sml-form-NAME'. Thereafter `C-c  NAME' will insert the
-macro at point, and `C-u C-c  NAME' will insert the macro after a
-`newline-and-indent'. If you want to keep your macros from one editing
-session to the next, go to your `.emacs' file and call
-`insert-kbd-macro'; you'll need to add `NAME' to `sml-forms-alist'
-permanently yourself:
-
-     (defun my-sml-load-hook () "Global defaults for SML mode"
-       ;; whatever else you do
-       (setq sml-forms-alist (cons '("NAME") sml-forms-alist)))
-
-   If you want to create templates like `case' that prompt for
-parameters you'll have to do some Lisp programming. The `tempo' package
-looks like a good stating point. You can always overwrite your own
-macros, but the builtin forms for `let', etc., can't be overwritten.
-
-
-File: sml-mode.info,  Node: Indents,  Next: Frames,  Prev: Forms,  Up: Advanced Topics
-
-              *I hate that indentation algorithm; can't I suppress it?*
-
-Ah, yes, a common complaint. It's actually very easy to use SML mode
-without the troublesome `sml-indent-line':
-
-     (defun my-sml-load-hook () "Global defaults for SML mode"
-       ;; whatever else you do
-       (fset 'sml-indent-line 'ignore))
-
-though `indent-relative-maybe' may conceivable be more useful than
-`ignore'.
-
-
-File: sml-mode.info,  Node: Frames,  Next: Multi ML,  Prev: Indents,  Up: Advanced Topics
-
-      *The dedicated frame for ML is too huge; can it be made smaller?*
-
-Of course, you just have to modify the frame parameters. The variable
-`sml-display-frame-alist' can be defined explicitly in your `.emacs';
-the default is a frame of 80 columns by 24 lines, and the icon name
-will be the same as the ML interaction buffer's name--something like
-`*mosml*'. I like a small, tidy font for this frame so I
-
-     (setq sml-display-frame-alist
-           (cons '(font . "7x14") sml-display-frame-alist))
-
-in my `inferior-sml-load-hook'. If you want fewer lines, try:
-
-     (setcdr (assoc 'height sml-display-frame-alist) 15)
-
-or something.
-
-
-File: sml-mode.info,  Node: Multi ML,  Next: Other ML,  Prev: Frames,  Up: Advanced Topics
-
-          *Can SML mode handle more than one compiler running at once?*
-
-The question is whether you can! See the `sml-buffer' variable's
-on-line help (`C-h v sml-buffer'). Note that the SML mode compiler
-variables (*note Process Defaults::.) are all buffer-local, so you can
-even switch between different ML compilers, not just different
-invocations of the same one. Well, you *can*.
-
-
-File: sml-mode.info,  Node: Other ML,  Prev: Multi ML,  Up: Advanced Topics
-
-                 *What needs to be done to support other ML compilers?*
-
-Not that much really, at least not to create minimal support. The
-interface between SML mode and the compiler is determined by the
-variables `sml-use-command', `sml-cd-command', `sml-prompt-regexp'
-(which are easy to get right), and `sml-error-regexp', and
-`sml-error-parser' (which are more tricky).  The general template to
-follow in setting this up is in the files `sml-{poly-ml,mosml}.el'.
-These rules will not change, I hope:
-
-   * `sml-next-error' uses `sml-error-regexp' to locate the start of
-     the next error report in the ML interaction buffer (P)
-
-   * `sml-next-error' calls `sml-error-parser', passing P, and expects
-     up to five return values in this order:
-
-       1. file name in which the error occurs (F)
-
-       2. start line of the error (L > 0)
-
-       3. start column of the error (C)
-
-       4. an Emacs Lisp expression to be `eval''d at (L,C) in F (EOE)
-
-       5. the actual text of the one-line error report (MSG)
-
-   * `sml-error-parser' can assume that P is the start of the next
-     error message that the user is interested in--since she defines
-     this point by defining `sml-error-regexp'.
-
-   * What `sml-error-parser' returns is a list. In the event of
-     problems, I foresee the following needs:
-
-        - if the file is the standard input, return `("std_in" L C)'
-
-        - if the file cannot be inferred, return `(nil L C)'
-
-        - if L=0, or the start cannot be inferred, return `(F nil C)'
-
-        - if the start column cannot be inferred, return `(F L 1)'
-
-   There's no need to return anything else. However, if you do want the
-errorful text in F highlighted you should return a simple Lisp
-expression in the fourth argument that'll compute the region. EOE will
-be called with point at character (L,C) in F, and should move point to
-the end of the errorful text. In fact, EOE can actually do anything you
-wish, but in the simplest cases it'll just `(forward-char 45)', or
-
-     (progn (forward-line 4) (forward-char 37))
-
-etc.. If it does more, make sure it leaves point at the end of the
-region in F--use `save-excursion' if switching buffers.  MSG, if
-returned, will be echoed in the minibuffer.
-
-
-File: sml-mode.info,  Node: Credits,  Next: Command Index,  Prev: Configuration,  Up: Top
-
-Credit & Blame
-**************
-
-SML Mode was written originally by Lars Bo Nielsen for Emacs 18.5n;
-later hacked for comint by Olin Shivers (who called it ml-mode); much
-later hacked by myself because it didn't seem to work... Fritz Knabe
-brilliantly posted the `hilit19' and `font-lock' functions on the net.
-Lars probably would recognise much of what remains, yet now there're
-menus, syntax highlighting, support for various ML compilers, Texinfo
-(hey!), and more than a little hope it'll work with a variety of Emacs
-19s. But there are still things to do. Lars wrote:
-     *The indentation algorithm still can be fooled. I don't know if it
-     will ever be 100% right, as this means it will have to actually
-     parse all of the buffer up to the actual line [...].*
-
-This is still the main cause of grief; SML's syntax is a nightmare for
-Emacs modes, and of course opinions vary about proper indentation. But
-there may be something we can do...
-
-
-File: sml-mode.info,  Node: Command Index,  Next: Variable Index,  Prev: Credits,  Up: Top
-
-Command Index
-*************
-
-* Menu:
-
-* inferior-sml-mode:                     Interaction Mode.
-* sml:                                   Running ML.
-* sml-back-to-outer-indent:              Indentation.
-* sml-buffer:                            Multi ML.
-* sml-case-indent:                       SML Mode Defaults.
-* sml-cd:                                Running ML.
-* sml-drag-region:                       ML Interaction.
-* sml-electric-pipe:                     Magic Insertion.
-* sml-electric-semi:                     Magic Insertion.
-* sml-error-overlay:                     Tracking Errors.
-* sml-indent-level:                      SML Mode Defaults.
-* sml-indent-line:                       Indentation.
-* sml-indent-region:                     Indentation.
-* sml-insert-form:                       Magic Insertion.
-* sml-load-file:                         ML Interaction.
-* sml-mode:                              Basics.
-* sml-mode-info:                         Getting Help.
-* sml-mode-version:                      Basics.
-* sml-nested-if-indent:                  SML Mode Defaults.
-* sml-next-error:                        Tracking Errors.
-* sml-pipe-indent:                       SML Mode Defaults.
-* sml-send-buffer:                       ML Interaction.
-* sml-send-region:                       ML Interaction.
-* sml-send-region-and-go:                ML Interaction.
-* sml-skip-errors:                       Tracking Errors.
-* sml-type-of-indent:                    SML Mode Defaults.
-* switch-to-sml:                         Running ML.
-
-
-File: sml-mode.info,  Node: Variable Index,  Next: Key Index,  Prev: Command Index,  Up: Top
-
-Variable Index
-**************
-
-* Menu:
-
-* inferior-sml-load-hook:                Running ML.
-* inferior-sml-mode-hook:                Running ML.
-* sml-buffer:                            Multi ML.
-* sml-case-indent:                       SML Mode Defaults.
-* sml-cd-command:                        Process Defaults.
-* sml-dedicated-frame:                   Running ML.
-* sml-default-arg:                       Running ML.
-* sml-display-frame-alist:               Running ML.
-* sml-electric-semi-mode:                Magic Insertion.
-* sml-error-overlay:                     Tracking Errors.
-* sml-error-parser:                      Process Defaults.
-* sml-error-regexp:                      Process Defaults.
-* sml-font-lock-auto-on:                 Highlighting.
-* sml-font-lock-extra-keywords:          Highlighting.
-* sml-indent-level:                      SML Mode Defaults.
-* sml-load-hook:                         Basics.
-* sml-mode-hook:                         Basics.
-* sml-mode-info:                         Getting Help.
-* sml-nested-if-indent:                  SML Mode Defaults.
-* sml-paren-lookback:                    SML Mode Defaults.
-* sml-pipe-indent:                       SML Mode Defaults.
-* sml-program-name:                      Running ML.
-* sml-prompt-regexp:                     Process Defaults.
-* sml-temp-file:                         ML Interaction.
-* sml-temp-threshold:                    ML Interaction.
-* sml-type-of-indent:                    SML Mode Defaults.
-* sml-use-command:                       Process Defaults.
-
-
-File: sml-mode.info,  Node: Key Index,  Prev: Variable Index,  Up: Top
-
-Key Index
-*********
-
-* Menu:
-
-* ;:                                     Magic Insertion.
-* :                                 Indentation.
-* :                                 Indentation.
-* C-c :                             Magic Insertion.
-* C-c C-b:                               ML Interaction.
-* C-c C-i:                               Getting Help.
-* C-c C-l:                               ML Interaction.
-* C-c C-r:                               ML Interaction.
-* C-c C-s:                               Running ML.
-* C-c`:                                  Tracking Errors.
-* C-M-\:                                 Indentation.
-* C-x ;:                                 Indentation.
-* C-x :                             Indentation.
-* M-;:                                   Indentation.
-* M-:                               Indentation.
-* M-:                               Indentation.
-* M-S-down-mouse-1:                      ML Interaction.
-* M-|:                                   Magic Insertion.
-
-
-
-Tag Table:
-Node: Top103
-Node: Copying1813
-Node: Introduction2622
-Node: Distribution4066
-Node: Getting Started5366
-Node: Getting Help7297
-Node: SML Mode9157
-Node: Basics9994
-Node: Indentation11325
-Node: Magic Insertion13412
-Node: SML Mode Defaults15517
-Node: Interaction Mode18528
-Node: Running ML19881
-Node: ML Interaction23788
-Node: Tracking Errors27568
-Node: Process Defaults30093
-Node: Configuration32381
-Node: Hooks34296
-Node: Key Bindings36426
-Node: Menus38104
-Node: Highlighting39293
-Node: Advanced Topics41229
-Node: Forms41717
-Node: Indents42929
-Node: Frames43418
-Node: Multi ML44151
-Node: Other ML44631
-Node: Credits46940
-Node: Command Index47983
-Node: Variable Index49633
-Node: Key Index51287
-
-End Tag Table
diff -Nru mosml-2.01/utility/sml-mode-3.3b/sml-mosml.el mosml-2.10.1/utility/sml-mode-3.3b/sml-mosml.el
--- mosml-2.01/utility/sml-mode-3.3b/sml-mosml.el	2000-01-21 10:07:13.000000000 +0000
+++ mosml-2.10.1/utility/sml-mode-3.3b/sml-mosml.el	1970-01-01 00:00:00.000000000 +0000
@@ -1,197 +0,0 @@
-;;; sml-mosml.el: Modifies inferior-sml-mode defaults for Moscow ML.
-
-;; Copyright (C) 1997, Matthew J. Morley
-
-;; $Revision: 1.1.1.1 $
-;; $Date: 2000/01/21 10:07:13 $
-
-;; This file is not part of GNU Emacs, but it is distributed under the
-;; same conditions.
-
-;; ====================================================================
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;; ====================================================================
-
-;;; DESCRIPTION
-
-;; To use this library just put
-
-;;(autoload 'sml-mosml "sml-mosml" "Set up and run Moscow ML." t)
-
-;; in your .emacs file. If you only ever use Moscow ML then you might
-;; as well put something like
-
-;;(setq sml-mode-hook
-;;      '(lambda() "SML mode defaults to Moscow ML"
-;;	 (define-key  sml-mode-map "\C-cp" 'sml-mosml)))
-
-;; for your sml-mode-hook. The command prompts for the program name 
-;; and any command line options. 
-
-;; If you need to reset the default value of sml-program-name, or any
-;; of the other compiler variables, put something like
-
-;;(eval-after-load "sml-mosml" '(setq sml-program-name "whatever"))
-
-;; in your .emacs -- or you can use the inferior-sml-{load,mode}-hooks
-;; to achieve the same ends.
-
-;;; CODE
-
-(require 'sml-proc)
-
-;; The regular expression used when looking for errors. Moscow ML errors:
-
-(defconst sml-mosml-error-regexp
-  (concat "^File \"\\([^\"]+\\)\","                    ;1
-          " line \\([0-9]+\\)-?\\([0-9]+\\)?,"         ;2-3?
-          " characters \\([0-9]+\\)-\\([0-9]+\\):")    ;4-5
-  "Default regexp matching Moscow ML error messages.
-If you change this significantly you may also need to redefine 
-`sml-mosml-error-parser' (qv).")
-
-;; File "puzz.ml", line 30-31, characters 10-70:
-;; ! ..........first 0 l = []
-;; !         | first n (h::t) = h::(first (n-1) t)
-;; ! Warning: pattern matching is not exhaustive
-
-;; ! Toplevel input:
-;; ditto
-
-(defconst sml-mosml-error-messages
-  (concat "^! \\("
-          (mapconcat 'identity
-                     (list "\\(Warning: .*\\)"
-                           "\\(Type clash\\):"
-                           "\\(Ill-formed infix expression\\)"
-                           "\\(Syntax error.*\\)")
-                     "\\|")
-          "\\).*$")
-  "RE to match Moscow ML type-of-error reports. This regular expression
-must follow the whole line pattern \"^! \\\\(%s\\\\).*$\", and the %s 
-stands for a \"\\\\|\" separated list of regular expressions each of
-which must, I repeat *must*, contain at least one \"\\\\(%s\\\\)\" group.
-The %s regexp in the first such group will be the actual error report
-echoed to the user.")
-
-(defun sml-mosml-error-parser (pt)
- "This function looks for the next Moscow ML error message following PT
-and parses an error message into a list
-  \(file start-line start-col end-of-err msg\)
-where
-
-  FILE is the file in which the error occurs
-
-  START-LINE is the line number in the file where the error occurs
-
-  START-COL is the character position on START-LINE where the error occurs
-
-  END-OF-ERR is an Emacs Lisp expression that when evaluated at
-  \(start-line,start-col\) moves point to the end of the errorful text
-
-  MSG is the text of the error message given by the compiler, if such text
-  can be found.
-
-The first three are mandatory return values for `sml-next-error'. 
-See also `sml-error-parser'."
- (save-excursion
-   (goto-char pt)
-   (if (not (looking-at sml-mosml-error-regexp))
-       ;; the user loses big time.
-       (list nil nil nil)
-     (let* ((file (match-string 1))                  ; the file
-            (slin (string-to-int (match-string 2)))  ; the start line
-            ;; char range is (n,m], 0 is column 1 of slin
-            (scol (string-to-int (match-string 4)))  ; the start col
-            ;; get to the end by doing "forward-char m - n"
-            (eoe `(forward-char ,(- (string-to-int (match-string 5)) scol)))
-            (msg))
-       ;; look for the error message at end of the chunk of "! " lines
-       (forward-line 1)
-       (while (and (looking-at "^! ")
-                   (not (looking-at sml-mosml-error-messages)))
-         (forward-line 1))
-       ;; found one if match-beginning 1 is non-nil.
-       (if (match-beginning 1)
-           (progn 
-             (setq msg (match-string 1))
-             ;; refine since m-begin 1 implies m-begin N for some N>1 as
-             ;; long as sml-mosml-error-messages is sane as advertised.
-             ;; match-data is a list N+1 of pairs, consecutive elts being
-             ;; beg and end markers for the \( \) in the match. 0 is the
-             ;; whole match.
-             (let ((matches (1- (/ (length (match-data)) 2))) ; ignore 0th
-                   (group 2))                                 ; & ignore 1st
-               (while (and (not (match-beginning group))
-                           (<= group matches))
-                 (setq group (1+ group)))
-               (if (<= group matches)
-                   (setq msg (match-string group))))))
-       ;; 1+ scol because char 0 means column 1 of slin.
-       (nconc (list file slin (1+ scol)) (list eoe) (list msg))))))
-
-;;;###autoload
-(defun sml-mosml (pfx)
-   "Set up and run Moscow ML.
-Prefix argument means accept the defaults below.
-
-Note: defaults set here will be clobbered if you setq them in the
-inferior-sml-mode-hook.
-
- sml-program-name