/* Auxiliary definitions for HimML compiled functions. Generated automatically by mkhimmlx.sh. Copyright (C) 2005 Jean Goubault-Larrecq and LSV, CNRS UMR 8643 & INRIA Futurs projet Secsi & ENS Cachan. This file is part of HimML. As an exception to the fact that HimML is licensed under the GNU General Public License, the present file is subject to the following license: Permission is granted to anyone to use this software for any purpose on any computer system, and to redistribute it freely, subject to the following restrictions: 1. The author is not responsible for the consequences of use of this software, no matter how awful, even if they arise from defects in it. 2. The origin of this software must not be misrepresented, either by explicit claim or by omission. 3. Altered versions must be plainly marked as such, and must not be misrepresented as being the original software. */ /* BEGIN general.h */ /* Operating systems: */ #define MAC 1 #define AMIGA_OS 2 #define UNIX_SYS_V 3 #define UNIX_BSD 4 /* The maximal number of generations in the system */ #define MAX_GENERATIONS 5 #define STD_ML_TYVAR 1 #define STD_ML_NJ_TYVAR 2 #define EFFECT_TYVAR 3 /* not fully implemented */ #define CALLCC 1 #define PROMPT 2 /* Felleisen and Friedman's prompts, not implemented */ #define CALLCT 4 /* Danvy and Filinski's reset/callct, not implemented */ #define SPLITTER 8 /* Queinnec and Serpette's splitter, not implemented */ #define CATCH 16 #define NUMERICAL_MODEL_SET SetAdd(KSTR("complex floating point"),NewMap()) #define NO_MODULE 0 #define CAML_LIKE_MODULE 1 #define STD_ML_MODULE 2 #define MODULE_SYSTEM CAML_LIKE_MODULE /* no choice here for now */ #define MODULE_SET SetAdd(KSTR("separate compilation a la CaML"),NewMap()) /* PROFILING may contain: - PROFILING_CALL_COUNTS: code is profiled to determine number of calls to each function - PROFILING_TOTAL_TIMES: code is profiled to determine the time spent in each function, between entry and exit, including subfunctions - PROFILING_PROPER_TIMES: code is profiled to determine the time spent in each function, not including its subfunctions - PROFILING_TOTAL_MEM: code is profiled to determine number of bytes allocated, including subfunctions - PROFILING_PROPER_MEM: code is profiled to determine number of bytes allocated, not including subfunctions */ #define PROFILING_CALL_COUNTS 1 #define PROFILING_TOTAL_TIMES 2 #define PROFILING_PROPER_TIMES 4 #define PROFILING_TOTAL_MEM 8 #define PROFILING_PROPER_MEM 16 #define PROFILING (PROFILING_CALL_COUNTS | PROFILING_TOTAL_TIMES | PROFILING_PROPER_TIMES) /* no choice, but not implemented either */ #define PROFILING_SET SetAdd(KSTR("proper times"),SetAdd(KSTR("total times"),SetAdd(KSTR("call counts"),NewMap()))) #define STD_DEBUGGING 1 #define REPLAY_DEBUGGING 2 /* not implemented */ #define IEEE754 1 #define OTHER_FLOAT 2 #define STATUS_ALPHA 1 #define STATUS_BETA 2 #define STATUS_GAMMA 3 #define STATUS_RELEASE 5 /* END general.h */ /* BEGIN system.h */ /* System configuration file, automatically generated by mksys and mksyscc/mksys.cli */ #define NBITS_IN_CHAR 8 #define MAX_UCHAR (255) #define SIZEOFLONG 4 #define BITSOFLONG 32 #define NBITS_IN_LIP_LONG 30 #define NBITSH 15 #define RADIX 1073741824 #define RADIXROOT 32768 #define LOG10RAD 9.03089986991943582950 #define LOG10RAD_BYTES 0x5f, 0x82, 0x95, 0x1b, 0xd2, 0xf, 0x22, 0x40 #define LIP_SIZE 2 /* lipzamp1.h: 5 clock ticks; lipzamp2.h: 2 clock ticks. */ /* */ #define LIPZAMP 2 /* lipzdiv1.h: 4 clock ticks; lipzdiv2.h: 4 clock ticks. */ /* */ #define LIPZDIV 1 #define LIPZMM 1 #define FLOAT_FORMAT 1 /* IEEE754 */ #define EXTP 0 #define FLOAT_LAYOUT 4 #define EXTENDED double #define REAL double #define EXT_SIZE 8 #define REAL_SIZE 8 #define LONG_SIZE 4 #define DEFAULT_IFLOOR(x) (long)floor(x) #define NBITS_IN_LONG (32) #define N_BITS_IN_HALF_LONG (16) #define MASK_HALF_LONG ((long)0xffff) #define MAX_TWO_TO_THE_N_INT (0x80000000) #define MAX_TWO_TO_THE_N_LONG ((long)0x80000000) #define MAX_SIGNED_INT (0x7fffffff) #define MAX_SIGNED_LONG ((long)0x7fffffff) #define MIN_SIGNED_LONG ((long)0x80000000) #define NBITS_IN_ADDR (32) #define NDIGS_IN_ULONG (9) #define DECL_POW10(name) EXTENDED name[]={ \ 1E-10, 1E-9, 1E-8, 1E-7, 1E-6, 1E-5, 1E-4, 1E-3, 1E-2, 1E-1, 1E0, 1E1, 1E2, 1E3, 1E4, 1E5, 1E6, 1E7, 1E8, 1E9, 1E10, 1E11 \ }; #define DIV_CORRECT_AB #undef MALLOC_0_0 #define NLOWBITS (3) #define MAP_CHAIN_LENGTH 29 #define MAP_STK0 NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, NOEXPR, #define EXPR_GAP 0 #define EXPR_PADDING 0 #define BLOCK_GAP 0 #define BUCKET_GAP 0 #define BH_BUCKET_GAP 0 #define BH_PADDING 0 #define PAGE_GAP 4 #undef ASCENDING_STACK #define ALIGNMENT (8) #define MBSTRIDE (8) #define HDSIZE (4) #define MODALIGN(x) ((x) & (-8L)) #define MODMBSTRIDE(x) ((x) & (-8L)) #define MBREALSIZE(size) MODMBSTRIDE(size+11L) #define MZHDSIZE (12) #define BEGIN_FROM_INT(l) CHAR MERGE(_ca_,l)[4] = { ((CHAR *)&l)[3], ((CHAR *)&l)[2], ((CHAR *)&l)[1], ((CHAR *)&l)[0], } #define FROM_INT(l) MERGE(_ca_,l) #define END_FROM_INT(l) #define BEGIN_TO_INT(l) CHAR MERGE(_cb_,l)[4] #define TO_INT(l) MERGE(_cb_,l) #define END_TO_INT(l) ((CHAR *)&l)[0] = MERGE(_cb_,l)[3]; ((CHAR *)&l)[1] = MERGE(_cb_,l)[2]; ((CHAR *)&l)[2] = MERGE(_cb_,l)[1]; ((CHAR *)&l)[3] = MERGE(_cb_,l)[0]; #define BEGIN_FROM_SHORT(l) CHAR MERGE(_ca_,l)[2] = { ((CHAR *)&l)[1], ((CHAR *)&l)[0], } #define FROM_SHORT(l) MERGE(_ca_,l) #define END_FROM_SHORT(l) #define BEGIN_TO_SHORT(l) CHAR MERGE(_cb_,l)[2] #define TO_SHORT(l) MERGE(_cb_,l) #define END_TO_SHORT(l) ((CHAR *)&l)[0] = MERGE(_cb_,l)[1]; ((CHAR *)&l)[1] = MERGE(_cb_,l)[0]; #define M_TYPE unsigned long #define M_BITSET(e) (((M_TYPE)(e)) & 0x1L) #define M_SETBIT(type,e) (type)(((M_TYPE)(e)) | 0x1L) #define M_CLRBIT(type,e) (type)(((M_TYPE)(e)) & ~0x1L) #define M_VARCALL(x,f,env,n) \ {\ switch (n) { \ case 0: { x = f (ENV_CONS(env,0)); } break; \ case 1: VA_START; { ExprPtr _x1 = va_arg(_args,ExprPtr); va_end(_args); x = f (ENV_CONS(env,1), _x1); } break; \ case 2: VA_START; { ExprPtr _x1 = va_arg(_args,ExprPtr); ExprPtr _x2 = va_arg(_args,ExprPtr); va_end(_args); x = f (ENV_CONS(env,2), _x1, _x2); } break; \ case 3: VA_START; { ExprPtr _x1 = va_arg(_args,ExprPtr); ExprPtr _x2 = va_arg(_args,ExprPtr); ExprPtr _x3 = va_arg(_args,ExprPtr); va_end(_args); x = f (ENV_CONS(env,3), _x1, _x2, _x3); } break; \ case 4: VA_START; { ExprPtr _x1 = va_arg(_args,ExprPtr); ExprPtr _x2 = va_arg(_args,ExprPtr); ExprPtr _x3 = va_arg(_args,ExprPtr); ExprPtr _x4 = va_arg(_args,ExprPtr); va_end(_args); x = f (ENV_CONS(env,4), _x1, _x2, _x3, _x4); } break; \ case 5: VA_START; { ExprPtr _x1 = va_arg(_args,ExprPtr); ExprPtr _x2 = va_arg(_args,ExprPtr); ExprPtr _x3 = va_arg(_args,ExprPtr); ExprPtr _x4 = va_arg(_args,ExprPtr); ExprPtr _x5 = va_arg(_args,ExprPtr); va_end(_args); x = f (ENV_CONS(env,5), _x1, _x2, _x3, _x4, _x5); } break; \ case 6: VA_START; { ExprPtr _x1 = va_arg(_args,ExprPtr); ExprPtr _x2 = va_arg(_args,ExprPtr); ExprPtr _x3 = va_arg(_args,ExprPtr); ExprPtr _x4 = va_arg(_args,ExprPtr); ExprPtr _x5 = va_arg(_args,ExprPtr); ExprPtr _x6 = va_arg(_args,ExprPtr); va_end(_args); x = f (ENV_CONS(env,6), _x1, _x2, _x3, _x4, _x5, _x6); } break; \ case 7: VA_START; { ExprPtr _x1 = va_arg(_args,ExprPtr); ExprPtr _x2 = va_arg(_args,ExprPtr); ExprPtr _x3 = va_arg(_args,ExprPtr); ExprPtr _x4 = va_arg(_args,ExprPtr); ExprPtr _x5 = va_arg(_args,ExprPtr); ExprPtr _x6 = va_arg(_args,ExprPtr); ExprPtr _x7 = va_arg(_args,ExprPtr); va_end(_args); x = f (ENV_CONS(env,7), _x1, _x2, _x3, _x4, _x5, _x6, _x7); } break; \ default: abort (); /*NOTREACHED*/ break;\ }\ } #define M_VARCALL2(x,f,bc,env,n) \ {\ switch (n) { \ case 0: { x = f (bc,ENV_CONS(env,0)); } break; \ case 1: VA_START; { ExprPtr _x1 = va_arg(_args,ExprPtr); va_end(_args); x = f (bc,ENV_CONS(env,1), _x1); } break; \ case 2: VA_START; { ExprPtr _x1 = va_arg(_args,ExprPtr); ExprPtr _x2 = va_arg(_args,ExprPtr); va_end(_args); x = f (bc,ENV_CONS(env,2), _x1, _x2); } break; \ case 3: VA_START; { ExprPtr _x1 = va_arg(_args,ExprPtr); ExprPtr _x2 = va_arg(_args,ExprPtr); ExprPtr _x3 = va_arg(_args,ExprPtr); va_end(_args); x = f (bc,ENV_CONS(env,3), _x1, _x2, _x3); } break; \ case 4: VA_START; { ExprPtr _x1 = va_arg(_args,ExprPtr); ExprPtr _x2 = va_arg(_args,ExprPtr); ExprPtr _x3 = va_arg(_args,ExprPtr); ExprPtr _x4 = va_arg(_args,ExprPtr); va_end(_args); x = f (bc,ENV_CONS(env,4), _x1, _x2, _x3, _x4); } break; \ case 5: VA_START; { ExprPtr _x1 = va_arg(_args,ExprPtr); ExprPtr _x2 = va_arg(_args,ExprPtr); ExprPtr _x3 = va_arg(_args,ExprPtr); ExprPtr _x4 = va_arg(_args,ExprPtr); ExprPtr _x5 = va_arg(_args,ExprPtr); va_end(_args); x = f (bc,ENV_CONS(env,5), _x1, _x2, _x3, _x4, _x5); } break; \ case 6: VA_START; { ExprPtr _x1 = va_arg(_args,ExprPtr); ExprPtr _x2 = va_arg(_args,ExprPtr); ExprPtr _x3 = va_arg(_args,ExprPtr); ExprPtr _x4 = va_arg(_args,ExprPtr); ExprPtr _x5 = va_arg(_args,ExprPtr); ExprPtr _x6 = va_arg(_args,ExprPtr); va_end(_args); x = f (bc,ENV_CONS(env,6), _x1, _x2, _x3, _x4, _x5, _x6); } break; \ case 7: VA_START; { ExprPtr _x1 = va_arg(_args,ExprPtr); ExprPtr _x2 = va_arg(_args,ExprPtr); ExprPtr _x3 = va_arg(_args,ExprPtr); ExprPtr _x4 = va_arg(_args,ExprPtr); ExprPtr _x5 = va_arg(_args,ExprPtr); ExprPtr _x6 = va_arg(_args,ExprPtr); ExprPtr _x7 = va_arg(_args,ExprPtr); va_end(_args); x = f (bc,ENV_CONS(env,7), _x1, _x2, _x3, _x4, _x5, _x6, _x7); } break; \ default: abort (); /*NOTREACHED*/ break;\ }\ } #define M_VARCALL_CC(x,f,env,n,data) \ {\ ExprPtr _env = env;\ switch (n) { \ case 0: x = f (_env); break; \ case 1: x = f (_env, data[1]); break; \ case 2: x = f (_env, data[1], data[2]); break; \ case 3: x = f (_env, data[1], data[2], data[3]); break; \ case 4: x = f (_env, data[1], data[2], data[3], data[4]); break; \ case 5: x = f (_env, data[1], data[2], data[3], data[4], data[5]); break; \ case 6: x = f (_env, data[1], data[2], data[3], data[4], data[5], data[6]); break; \ case 7: x = f (_env, data[1], data[2], data[3], data[4], data[5], data[6], data[7]); break; \ default: abort (); /*NOTREACHED*/ break;\ }\ } #define M_VARCALL2_CC(x,f,bc,env,n,data) \ {\ ExprPtr _env = env;\ switch (n) { \ case 0: x = f (bc,_env); break; \ case 1: x = f (bc,_env, data[1]); break; \ case 2: x = f (bc,_env, data[1], data[2]); break; \ case 3: x = f (bc,_env, data[1], data[2], data[3]); break; \ case 4: x = f (bc,_env, data[1], data[2], data[3], data[4]); break; \ case 5: x = f (bc,_env, data[1], data[2], data[3], data[4], data[5]); break; \ case 6: x = f (bc,_env, data[1], data[2], data[3], data[4], data[5], data[6]); break; \ case 7: x = f (bc,_env, data[1], data[2], data[3], data[4], data[5], data[6], data[7]); break; \ default: abort (); /*NOTREACHED*/ break;\ }\ } #define OS UNIX_BSD #define HAS_PROTOTYPES #define MERGE(a,b) a##b #define HAS_VOLATILE #define ANSI_CONST const #define HAS_STDARG #undef HAS_VARARGS #define HAS_STRING_H #undef HAS_TIME_T #define VOIDPTR void * #define SETJMP(jb) _setjmp(jb) #define LONGJMP(jb,n) _longjmp(jb,n) #define HAS_DIRENT #define HAS_CWD #define HAS_WD #define HAS_STRERROR #define HAS_SYSERROR #define HAS_STDLIB #define AGGR_INIT_OK #define MALLOC_T void * #define FREE_T void #define OS_STRING "Linux 3.1.2-1.fc16.i686.PAE" #undef BRAIN_DAMAGED_LONGJMP /* END system.h */ /* BEGIN perks.h */ /* size of the default memory zone (currently unexpandable); if the memory zone cannot be created this large, it is created with 7/8 of the size, or (7/8)^2, (7/8)^3, ... of the size until we succeed in allocating it */ #if OS==MAC || OS==AMIGA_OS # define MEM_SIZE 16000000L # define INC_SIZE 512L #else # define MEM_SIZE 256000000L # define INC_SIZE 400000L #endif #ifndef OS_STRING #if OS==MAC # define OS_STRING "Mac" #else #if OS==AMIGA_OS # define OS_STRING "Amiga" #else #if OS==UNIX_SYS_V # define OS_STRING "Unix System V" #else #if OS==UNIX_BSD # define OS_STRING "Unix BSD" #else error "Unknown OS" #endif #endif #endif #endif #endif #if FLOAT_FORMAT==IEEE754 #define FLOAT_FORMAT_STRING "IEEE 754" #else #define FLOAT_FORMAT_STRING "unknown" #endif /* END perks.h */ /* BEGIN config.h */ /* Configuration file for HimML, automatically generated from OPTIONS by makeconfig */ #define HIMML_LIGHT 1 #define KTUPLE2_HASH_SIZE 23227 #define KONS_HASH_SIZE 23227 #define MAPLETKONS_HASH_SIZE 23227 #define MAPKONS_HASH_SIZE 23227 #define KCOMPLEX_HASH_SIZE 9377 #define KTYPEAPPL_HASH_SIZE 2131 #define KTYPEFX_HASH_SIZE 97 #define KRECORD1_HASH_SIZE 2131 #define DATA_HASH_SIZE 9377 #define REAL_HASH_SIZE 3617 #define EXT_HASH_SIZE 2131 #define ARRAY_HASH_SIZE 2333 #define INT_HASH_SIZE 1733 #define STRING_HASH_SIZE 797 #define VAR_HASH_SIZE 97 #define REF_HASH_SIZE 197 #define MAX_GLOBALS 10000 #define GCMARK_STACK_SIZE 16384 #define SPECIAL_MALLOC 0 #define STOP_AND_COPY_VECTORS 0 #define STACK_SIZE 100000 #define SAFETY_SIZE 50000 #define SECURITY 4000 #define DEFAULT_THREADS 10 #define IMPERATIVE_TYPES STD_ML_TYVAR #define IMPERATIVE_TYPES_STRING "imperative tyvars" #define CONTINUATION_MODEL (0|CATCH) #define CONTINUATION_MODEL_SET SetAdd(KSTR("catch"),NewMap()) #define DEBUGGING (0|STD_DEBUGGING) #define DEBUGGING_SET SetAdd(KSTR("standard"),NewMap()) #define OPT_DEBUG_DATATYPE 0 #define TRANSLATOR 1 #define CORE_TRACE 1 #define PLDI93_HACK 0 #define MAINTENANCE "goubault@lsv.ens-cachan.fr\n (Jean Goubault-Larrecq LSV, ENS Cachan 61, av. du president-Wilson\n F-94235 Cachan Cedex)" #define MAJOR_VERSION 1 #define MINOR_VERSION 0 #define CODE_STATUS STATUS_ALPHA #if HIMML_LIGHT #undef STOP_AND_COPY_VECTORS #define STOP_AND_COPY_VECTORS 0 #endif /* END config.h */ /* BEGIN portable.h */ #ifndef PORTABLE_H #define PORTABLE_H #define EXTERN extern #define IMPORT extern #define EXPORT #define STATIC static #define PRIVATE static #define PUBLIC #define IN #define OUT #define INOUT #define CONST #define REGISTER register #ifdef HAS_PROTOTYPES # define P(list) list #else # define P(list) () #endif #define _NORETURN #define _PURE #ifdef __GNUC__ #if __GNUC__ >= 2 /* should be >=2.5 */ #undef _NORETURN #define HAS_NORETURN #define _NORETURN __attribute__ ((noreturn)) #endif #if __GNUC__ >= 2 /* should be >=2.96 */ #define HAS_PURE #undef _PURE #define _PURE __attribute__ ((pure)) #endif #define HAS_MALLOC #define _MALLOC __attribute__ ((malloc)) #endif #define CHAR unsigned char #define COUNTER int #define INT long #define SHORT short #ifdef HAS_STDLIB #include #else #ifndef malloc IMPORT MALLOC_T malloc P((long size)) _MALLOC; #endif #ifndef realloc IMPORT MALLOC_T realloc P((MALLOC_T p,long size)); #endif #ifndef free IMPORT FREE_T free P((MALLOC_T p)); #endif #endif #ifndef NULL #define NULL 0L #endif /* define the characters that end directory names (DIR_CHAR) and volume names (VOL_CHAR): */ #if OS==MAC # define DIR_CHAR ':' # define VOL_CHAR ':' #else # if OS==AMIGA_OS # define DIR_CHAR '/' # define VOL_CHAR ':' # else # define DIR_CHAR '/' # define VOL_CHAR '/' # endif #endif #ifndef THINK_C typedef enum Boolean { false, true } Boolean; #endif #ifdef HAS_VOLATILE #define VOLATILE volatile #else #define VOLATILE #endif /* #ifdef __GNUC__ #define PURE const #define NORETURN volatile #else #define PURE #define NORETURN #endif */ #define PURE #define NORETURN IMPORT VOIDPTR alloctmp P((long size)); IMPORT VOIDPTR alloctmp_anchored P((long size, char *anchor)); IMPORT void freetmp P((VOIDPTR b)); IMPORT void safememcpy P((INOUT VOIDPTR to, IN CONST VOIDPTR from, IN INT size)); IMPORT char *newptr P((long size)) _MALLOC; IMPORT char *newptr_gc P((long size)) _MALLOC; IMPORT char *newptr_gc_fail P((long size)) _MALLOC; IMPORT char *newptr_fail P((long size)) _MALLOC; EXTERN INT currentHeapSize; #define SAFEMALLOC(size) newptr((long)size) #define MALLOC(size) newptr_gc((long)size) #define MALLOC_FAIL(size) newptr_gc_fail((long)size) #if SPECIAL_MALLOC #if STOP_AND_COPY_VECTORS #define MARKFREE(addr) Mfree((char *)addr) #define COMMITFREE() #else #define MARKFREE(addr) markFree(addr) #define COMMITFREE() commitFree() #endif IMPORT void Mfree P((char *addr)); #define FREE(addr) Mfree(addr) IMPORT char *Mrealloc P((char *ptr,unsigned long newsize)); #define REALLOC(addr,size) Mrealloc(addr,(unsigned long)size) #else #define MARKFREE(addr) free(addr) #define COMMITFREE() #define FREE(addr) free(addr) #define REALLOC(addr,size) realloc(addr,size) #endif #define C_QNAN 0 #define C_SNAN 1 #define C_INFINITE 2 #define C_ZERONUM 3 #define C_NORMALNUM 4 #define C_DENORMALNUM 5 #define MAX_NAN 7 IMPORT int classifyD P((IN CONST REAL *x)); #if EXTP IMPORT int classifyX P((IN CONST EXTENDED *x)); #else #define classifyX(x) classifyD(x) #endif #if FLOAT_FORMAT==IEEE754 IMPORT int NaNcodeD P((IN CONST REAL *x)); /* *x must be a NaN */ IMPORT void makeNaND P((IN int i,OUT REAL *x)); #endif IMPORT double floor P((double x)); EXTERN EXTENDED zero,fhalf; #define ifloor(x) DEFAULT_IFLOOR(x) #define G(x) ((unsigned short *)&(x)) #define Gg(x) ((unsigned char *)&(x)) /* NEGR(x) is true if x<0.0 POSR(x) is true if x>=0.0 ZEROR(x) is true if x=0.0 or x=-0.0 SMALLR(x) is true if x is zero or denormalized valid only if x is a REAL variable */ #if FLOAT_FORMAT==IEEE754 #if FLOAT_LAYOUT==4 # define NEGR(x) ((G(x)[3] & 0x8000)!=0) # define POSR(x) ((G(x)[3] & 0x8000)==0) # define HASHR(x) Gg(x)[6] # define ZEROR(x) ((G(x)[3] & 0x7fff)==0 && G(x)[2]==0 && G(x)[1]==0 && G(x)[0]==0) # define SMALLR(x) ((G(x)[3] & 0x7ff0)==0) #else # define NEGR(x) ((Gg(x)[0] & 0x80)!=0) # define POSR(x) ((Gg(x)[0] & 0x80)==0) # define HASHR(x) Gg(x)[1] # if FLOAT_LAYOUT==1 # define ZEROR(x) ((G(x)[0] & 0x7fff)==0 && G(x)[1]==0 && G(x)[2]==0 && G(x)[3]==0) # define SMALLR(x) ((G(x)[0] & 0x7ff0)==0) #else # if FLOAT_LAYOUT==2 # define ZEROR(x) ((G(x)[0] & 0xff7f)==0 && G(x)[1]==0 && G(x)[2]==0 && G(x)[3]==0) # define SMALLR(x) ((G(x)[0] & 0xf07f)==0) #else # if FLOAT_LAYOUT==3 # define ZEROR(x) ((Gg(x)[0] & 0x7f)==0 && Gg(x)[1]==0 && Gg(x)[2]==0 && Gg(x)[3]==0 && Gg(x)[4]==0 && Gg(x)[5]==0 && Gg(x)[6]==0 && Gg(x)[7]==0) # define SMALLR(x) ((Gg(x)[0] & 0x7f)==0 && (Gg(x)[1] & 0xf0)==0) #else #endif #endif #endif #endif #else # define NEGR(x) ((x)<0.0) # define POSR(x) ((x)>=0.0) # define HASHR(x) Gg(x)[1] # define ZEROR(x) ((x)==0.0 || (x)==-0.0) # define SMALLR(x) ZEROR(x) #endif /* NEGX(x) is true if x<0.0 POSX(x) is true if x>=0.0 ZEROX(x) is true if x=0.0 or x=-0.0 SMALLX(x) is true if x is zero or denormalized valid only if x is an EXTENDED variable */ #define NEGX(x) NEGR(x) #define POSX(x) POSR(x) #if FLOAT_FORMAT==IEEE754 #if EXTP==0 # define ZEROX(x) ZEROR(x) # define SMALLX(x) SMALLR(x) #else # if FLOAT_LAYOUT==1 # define SMALLX(x) ((G(x)[0] & 0x7fff)==0) # else # if FLOAT_LAYOUT==2 # define SMALLX(x) ((G(x)[0] & 0xff7f)==0) # else # if FLOAT_LAYOUT==3 # define SMALLX(x) ((Gg(x)[0] & 0x7f)==0 && (Gg(x)[1] & 0xff)==0) # endif # endif # endif # if EXTP==1 # if FLOAT_LAYOUT==1 # define ZEROX(x) ((G(x)[0] & 0x7fff)==0 && G(x)[1]==0 && G(x)[2]==0 && G(x)[3]==0 && G(x)[4]==0) # else # if FLOAT_LAYOUT==2 # define ZEROX(x) ((G(x)[0] & 0xff7f)==0 && G(x)[1]==0 && G(x)[2]==0 && G(x)[3]==0 && G(x)[4]==0) # else # if FLOAT_LAYOUT==3 # define ZEROX(x) ((Gg(x)[0] & 0x7f)==0 && Gg(x)[1]==0 && Gg(x)[2]==0 && Gg(x)[3]==0 && Gg(x)[4]==0 && Gg(x)[5]==0 && Gg(x)[6]==0 && Gg(x)[7]==0 && Gg(x)[8]==0 && Gg(x)[9]==0) # else # if FLOAT_LAYOUT==4 # define ZEROX(x) ((G(x)[4] & 0x7fff)==0 && G(x)[3]==0 && G(x)[2]==0 && G(x)[1]==0 && G(x)[0]==0) # define SMALLX(x) ((G(x)[4] & 0x7fff)==) # endif # endif # endif # endif # else # if EXTP==2 # if FLOAT_LAYOUT==1 # define ZEROX(x) ((G(x)[0] & 0x7fff)==0 && G(x)[1]==0 && G(x)[2]==0 && G(x)[3]==0 && G(x)[4]==0 && G(x)[5]==0) # else # if FLOAT_LAYOUT==2 # define ZEROX(x) ((G(x)[0] & 0xff7f)==0 && G(x)[1]==0 && G(x)[2]==0 && G(x)[3]==0 && G(x)[4]==0 && G(x)[5]==0) # else # if FLOAT_LAYOUT==3 # define ZEROX(x) ((Gg(x)[0] & 0x7f)==0 && Gg(x)[1]==0 && Gg(x)[2]==0 && Gg(x)[3]==0 && Gg(x)[4]==0 && Gg(x)[5]==0 && Gg(x)[6]==0 && Gg(x)[7]==0 && Gg(x)[8]==0 && Gg(x)[9]==0 && Gg(x)[10]==0 && Gg(x)[11]==0) # else # if FLOAT_LAYOUT==4 # define ZEROX(x) ((G(x)[5] & 0x7fff)==0 && G(x)[4]==0 && G(x)[3]==0 && G(x)[2]==0 && G(x)[1]==0 && G(x)[0]==0) # define SMALLX(x) ((G(x)[5] & 0x7fff)==0) # endif # endif # endif # endif # endif # endif #endif #else # define ZEROX(x) ((x)==0.0 || (x)==-0.0) # define SMALLX(x) ZEROX(x) #endif #if OS==MAC # ifndef THINK_C pascal void Debugger(); extern 0xa9ff; # endif # define CRASH() Debugger() # define FREEZE() Debugger() #else #if OS==UNIX_SYS_V || OS==UNIX_BSD # define CRASH() abort() # define FREEZE() #else #if OS==AMIGA_OS IMPORT NORETURN void crash P((void)) _NORETURN; # define CRASH() crash() # define FREEZE() crash() #else # define CRASH() ml_done(20); # define FREEZE() #endif #endif #endif #ifdef offsetof #define OFFSETOF(type,field) ((INT)offsetof(type,field)) #else #define OFFSETOF(type,field) ((INT)(((char *)&((type *)0L)->field)-((char *)(type *)0L))) #endif #define VARSIZE(type,arrayname,n) OFFSETOF(type,arrayname[n]) IMPORT char *message P((int n)); IMPORT void bmsg P((char *msg,...)); IMPORT NORETURN void berror P((char *msg,...)) _NORETURN; IMPORT NORETURN void bfatal P((char *msg,...)) _NORETURN; #endif /* END portable.h */ /* BEGIN file.h */ /* why do we need a replacement for stdio functions ? well, normally, we don't, but on certain machines (like the IBM RS/6000), buffered file functions allocate memory for buffers on the fly, and instead of doing it through malloc(), they use their own inlined version of it. This conflicts with the redefinition of the memory management routines in mem.c, and produces very obscure bugs. This is also necessary, now, to provide the suspend/revive facility that we need to build the automatic reopening of files. */ #if OS==AMIGA_OS typedef struct ProcID *pid_type; #define NO_PROCESS NULL #else typedef int pid_type; #define NO_PROCESS (-1) #endif #define hFILE_BUFSIZE 2048 #define PWD_BUFSIZE 1024 typedef struct hFILE { struct hFILE *next; CHAR *dirname; /* directory name at the moment of creation */ CHAR *filename; /* file name; used to suspend/revive */ CHAR *ptr; /* pointer inside the buffer buf */ CHAR *end; /* pointer to the end of data read in buf */ int fildesc; /* number of file descriptor; -1 if file is suspended */ pid_type pid; /* process id for hpopen() */ long pos; /* position in file of character at start of buf */ long realpos; /* position in file as said by lseek() on fildesc */ int flags; /* some flags on the buffer and file */ CHAR buf[hFILE_BUFSIZE]; } hFILE; #define H_READ 0x01 #define H_WRITE 0x02 #define H_TEXTFILE 0x04 /* used if open without a 'b' mode; currently ignored */ #define H_EOF 0x08 /* set if reached end of file */ #define H_PROCESS 0x10 /* used if opened by hpopen() */ IMPORT hFILE *hfopen P((IN CONST char *name,IN CONST char *mode)); IMPORT int hfclose P((IN hFILE *f)); IMPORT hFILE *hfreopen P((IN CONST char *filename,IN CONST char *mode,IN hFILE *f)); IMPORT int hfsuspend P((IN hFILE *hf)); IMPORT int hfrevive P((IN hFILE *hf)); IMPORT int hfflush P((IN hFILE *f)); IMPORT long hftell P((IN hFILE *f)); IMPORT int hfseek P((IN hFILE *f,IN long offset,IN int whence)); #define hgetc(f) (((f)->ptr<(f)->end)?((int)(*(f)->ptr++)):hReadNewBufGetc(f)) #define hgetcN(f,n) (((f)->ptr<(f)->end)?((int)(*(f)->ptr++)):hReadNewBufGetcN(f,n)) IMPORT int hfgetc P((IN hFILE *f)); #define hputc(c,f) (((f)->ptr<(f)->buf+hFILE_BUFSIZE)?(*(f)->ptr++ = (CHAR)(c), c):hWriteNewBufPutc(c,f)) IMPORT int hfputc P((IN int c,IN hFILE *f)); IMPORT int hfputs P((IN CONST char *s,IN hFILE *f)); IMPORT int hfprintf P((IN hFILE *f,IN CONST char *msg,...)); EXTERN hFILE *hstdin,*hstdout,*hstderr; IMPORT void InitHIO P((void)); IMPORT void EndHIO P((void)); IMPORT char *ltoasc P((IN unsigned long a)); IMPORT char *rtoasc P((IN CONST EXTENDED *xp)); IMPORT char *timetoasc P((unsigned long t)); /* internal functions: */ IMPORT int hReadNewBufGetcN P((IN hFILE *f,IN int n)); IMPORT int hReadNewBufGetc P((IN hFILE *f)); IMPORT int hWriteNewBufPutc P((IN int c,IN hFILE *f)); IMPORT void unlinkbuf P((IN hFILE *f)); IMPORT void linkbuf P((IN hFILE *f)); IMPORT int hftruncate P((INOUT hFILE *f,IN INT n)); IMPORT int wait_pid P((pid_type pid)); IMPORT int hpopen P((IN CONST char **argv, IN CONST char *mode,OUT hFILE **hff)); /* with argv an array terminated by a NULL entry, and argv[0] not NULL. */ /* END file.h */ /* BEGIN refcount.h */ EXTERN struct Expression *writeBarrier; #define NEWGEN ((struct Expression *)-1L) #define OLDGEN ((struct Expression *)1L) /* NEWGEN and OLDGEN are different from NOEXPR, since NOEXPR is already taken to be the end of the linked list of shared cons cells in hash tables. */ #define HITBARRIER(x) {if (ELINK(x)==OLDGEN) { ELINK(x)=writeBarrier;writeBarrier=(x); }} #define SETREFVAL1(x,e) { REFVAL(x) = e; HITBARRIER(x);} #define SETCAR1(x,e) { CAR(x) = e; HITBARRIER(x);} #define SETCDR1(x,e) { CDR(x) = e; HITBARRIER(x);} #define SETSHAPE1(x,e) { ASHAPE(x) = e; HITBARRIER(x);} #define SETQENV1(x,e) { QENV(x) = e; HITBARRIER(x);} EXTERN CHAR IncRefTable[],DecRefTable[]; #define REFCOUNT(e) ((e)->mark & MARK_REF_COUNT) #define SETREFCOUNT(e,n) (e)->mark = ((e)->mark & ~MARK_REF_COUNT) | (n) #define INCREF(e) (e)->mark = IncRefTable[(int)(e)->mark] #define DECREFP(e) ((((e)->mark = DecRefTable[(int)(e)->mark]) & MARK_REF_COUNT)==0) #define SETQ(x,e) { x = e; } #define POPQ(x) { x = CDR(x); } #define PUSHQ(x,e,aux) { MAKECONS(e,x,aux); x = aux; } #define SETREFVAL(x,e) SETREFVAL1(x,e) #define SETCAR(x,e) SETCAR1(x,e) #define SETCDR(x,e) SETCDR1(x,e) #define SETSHAPE(x,e) SETSHAPE1(x,e) #define SETQENV(x,e) SETQENV1(x,e) #define SETMAPLETY SETCDR #if STOP_AND_COPY_VECTORS #define PAGESIZE MODALIGN(4096+ALIGNMENT-1) #define MAXALLOC_IN_PAGE (PAGESIZE/4) typedef struct Page { struct Page *next; char *end,*top; #if PAGE_GAP!=0 char filler[PAGE_GAP]; #endif char contents[PAGESIZE]; } Page,*PagePtr; EXTERN PagePtr twinPageList; /* list of couple of pages */ EXTERN PagePtr curPage; EXTERN int spaceIndex; EXTERN INT nPages,neededPages,allocedPages,minAllocedPages; #define pageStart(page) (page)->contents #define pageEnd(page) (page)->end #define pageTop(page) (page)->top #define pageNext(page) (page)->next IMPORT PagePtr NewPage P((char *(*new)())); IMPORT void DelPage P((void)); IMPORT char *nextscAlloc P((unsigned long rsize)); #define scRealSize(size) MODALIGN(size+(ALIGNMENT-1)) /* size need not be >=sizeof(char *), to allow gc to put a forwarding pointer in a block, because we don't use forwarding pointers (objects in pages are referenced exactly once); moreover, the size is not recorded in the block, because we use we know it from elsewhere. */ #define scAlloc1(p,xwzRealSize) {\ if (xwzRealSize<=MAXALLOC_IN_PAGE && pageTop(curPage)+xwzRealSize<=pageEnd(curPage)) \ { p = pageTop(curPage); pageTop(curPage) += xwzRealSize; } \ else p = nextscAlloc(xwzRealSize); } #define scAlloc(p,size) {\ unsigned long xwzRealSize = scRealSize(size); \ scAlloc1(p,xwzRealSize); } IMPORT char *scCopy P((char *p,unsigned long size)); #define scMARK(p,size) *(char **)&(p) = scCopy((char *)p,size) #define scFREE(p,size) {if (scRealSize(size)>MAXALLOC_IN_PAGE) {MARKFREE(p);}} #else #define scAlloc(p,size) VECALLOC(p,size) #define scMARK(p,size) #define scFREE(p,size) VECFREE(p,size) #endif /* END refcount.h */ /* BEGIN eval.h */ #include #ifdef HAS_STDARG #include #else #ifdef HAS_VARARGS #include #endif #endif #if STOP_AND_COPY_VECTORS #define HEAP VOLATILE #else #define HEAP #endif #define CODE unsigned long typedef struct TZone { unsigned short line1,line2; unsigned short pos1,pos2; } TZone; struct build_header { CHAR kind; /* = BUILD_HEADER_KIND */ CHAR mark; SHORT type; TZone z; struct Expression *args; #if BH_PADDING!=0 char padding[BH_PADDING]; #endif }; #define ZONE(expr) (&((struct build_header *)expr)->z) #define TYPE(expr) ((struct build_header *)expr)->type #define ARGS(expr) ((struct build_header *)expr)->args typedef enum ExprKind { /* 0x00 */ E_FREE, E_NIL, E_INT, /* 0x03 */ E_REAL, E_COMPLEX, E_STRING, E_CONS, /* 0x07 */ E_EMPTY, E_MAPLET, E_MAP, /* 0x0a */ E_TUPLE_0, E_TUPLE_1, E_TUPLE_2, E_TUPLE_GNRL, /* 0x0e */ E_PAT_REVTUPLE_2, /* 0x0f */ E_PAT_TUPLE_GNRL_CONS, E_PAT_REVTUPLE_GNRL_CONS, /* 0x11 */ E_PAT_RECORD_GNRL_CONS, E_PAT_REVRECORD_GNRL_CONS, /* 0x13 */ E_PAT_RECORD_MAPADD, E_PAT_CONS, /* 0x15 */ E_RECORD_0, E_RECORD_1, E_RECORD_GNRL, /* 0x18 */ E_PATCHOICE, /* 0x19 */ E_EXCEPTION, /* 0x1a */ E_COMPILED_CLOSURE, E_INTERPRETED_CLOSURE, OBSOLETE_E_MEMO_CLOSURE/*FREE*/, /* 0x1d */ E_POLYFUN, E_MEMO_FN, E_DATACON, /* 0x20 */ E_NUMTYPE, E_TYPEFX, E_QUOTE, E_REF, /* 0x24 */ E_DATA, OBSOLETE_E_ARRAY_1/*FREE*/, E_ARRAY_2, E_ARRAY_GNRL, /* 0x28 */ E_VARINTRO, E_VARREF, E_DEBUGNAME, /* E_DEBUGNAME is reserved for debugging */ /* 0x2b */ E_ENV, E_LET, /* 0x2d */ E_APPL, E_GOTO, E_TYPE_APPL, /* 0x30 */ E_PAT_ANY, E_PAT_AS, E_PAT_CHECK, E_PAT_PACK, /* 0x34 */ E_PAT_MAPADD, E_PAT_CARD_EQ, E_PAT_CARD_GEQ, /* 0x37 */ E_PAT_REVCONS, /* 0x38 */ E_GET, E_SET, E_MAPGET, /* 0x3b */ E_TSELECT, E_TSEL1, E_TSEL2, E_TSELGNRL, /* 0x3f */ E_RSELECT, E_RSEL1, E_RSELGNRL, /* 0x42 */ E_RMU1, E_UNSHARED_RMU1, E_RMUX, E_UNSHARED_RMUX, /* 0x46 */ E_IF, E_PROG, E_AND, E_OR, /* 0x4a */ E_PROG_OF, E_LIST_OF, E_UNSHARED_LIST_OF, E_SET_OF, E_APPEND_OF, /* 0x4f */ E_UNSHARED_APPEND_OF, E_UNION_OF, E_UNION_UNDER_OF, E_INTER_OF, /* 0x53 */ E_MAP_OF, E_MAP_UNDER_OF, E_ALL_OF, E_EXISTS_OF, E_SOME_OF, E_UNSHARED_SOME_OF, /* 0x59 */ E_PROG_MAP, E_LIST_MAP, E_UNSHARED_LIST_MAP, E_SET_MAP, E_APPEND_MAP, /* 0x5e */ E_UNSHARED_APPEND_MAP, E_UNION_MAP, E_UNION_UNDER_MAP, E_INTER_MAP, /* 0x62 */ E_MAP_MAP, E_MAP_UNDER_MAP, E_ALL_MAP, E_EXISTS_MAP, E_SOME_MAP, E_UNSHARED_SOME_MAP, /* 0x68 */ E_PROG_WHILE, E_LIST_WHILE, E_UNSHARED_LIST_WHILE, E_SET_WHILE, E_APPEND_WHILE, /* 0x6d */ E_UNSHARED_APPEND_WHILE, E_UNION_WHILE, E_UNION_UNDER_WHILE, E_INTER_WHILE, /* 0x71 */ E_MAP_WHILE, E_MAP_UNDER_WHILE, E_ALL_WHILE, E_EXISTS_WHILE, E_SOME_WHILE, /* 0x76 */ E_UNSHARED_SOME_WHILE, E_HANDLE, E_RAISE, /* 0x79 */ E_DELAY, E_STACK, E_PACK, /* 0x7c */ E_EXTERNAL, /* kinds reserved for instrumenting the code: */ /* 0x7d */ E_DEBUGZONE, E_DEBUGDECL, /* 0x7f */ E_PROFILE, /* special evaluation kinds for non-sharing allocation: */ /* 0x80 */ E_UNSHARED_CONS, /* 0x81 */ E_UNSHARED_TUPLE_1, E_UNSHARED_TUPLE_2, E_UNSHARED_TUPLE_GNRL, /* 0x84 */ E_UNSHARED_RECORD_1, E_UNSHARED_RECORD_GNRL, /* 0x86 */ E_OVERWRITE, E_UNDERWRITE, /* kinds of objects that are not Expressions: */ /* 0x88 */ TYPE_ASSUM_KIND, TYPE_STATE_KIND, COMPILE_ASSUM_KIND, BUILD_HEADER_KIND, /* 0x8c */ E_SLOT_BRANCH, E_COUNTED, /* 0x8e */ E_EQUAL, E_NEQUAL, E_NOT, /* 0x91 */ E_BYTECODE, E_N_APPL,/*FREE*/ E_N_LAMBDA,/*FREE*/ /* 0x94 */ E_UNUSED } ExprKind; #define E_VAR E_STRING #define MARK_SHARED 0x40 #define MARK_IN_CAR 0x04 #define MARK_IN_CDR 0x08 #define MARK_IN_REF 0x10 #define MARK_IN_DATA 0x20 #define MARK_REF_COUNT 0x03 #define MARK_GC 0x80 #define GC_MARK(e) (e)->mark |= MARK_GC #define GC_UNMARK(e) (e)->mark &= ~MARK_GC #define GC_MARKED(e) ((e)->mark & MARK_GC) #define NOEXPR (ExprPtr)0L typedef CONST void (*printFunc) P((IN CONST CHAR *text, IN COUNTER len, INOUT char *printdata)); #define PRINTFUNC(fun) \ PRIVATE void fun P((IN CONST CHAR *text,IN COUNTER len, \ INOUT char *_data)); \ PRIVATE void fun(text,len,_data) \ IN CONST CHAR *text; \ IN COUNTER len; \ INOUT char *_data; #define PRINTDATA(type) ((type)_data) typedef CONST void (*readFunc) P((OUT CHAR *text, IN COUNTER len, INOUT char *readdata)); #define READFUNC(fun) \ PRIVATE void fun P((INOUT CHAR *text,IN COUNTER len, \ INOUT char *_data)); \ PRIVATE void fun(text,len,_data) \ INOUT CHAR *text; \ IN COUNTER len; \ INOUT char *_data; #define READDATA(type) ((type)_data) typedef struct StackChunk { struct Expression *protected; struct excHandler *excStack; struct stackMark *thread; char *contents; /* NULL if still on stack */ char *top; /* overestimated top of stack after capture of continuation */ char *alloctmp_blocks; INT age; #if DEBUGGING!=0 #ifdef OBSOLETE struct Expression *applStack; #endif #endif } StackChunk; typedef struct stackMark { char *highMark; char *lowMark; struct stackMark *prev,*next; /* for LRU management of threads */ char *alloctmp_blocks; struct Expression *stack; /* NOEXPR if no E_STACK ExprPtr points to it */ jmp_buf topBuf; } stackMark; typedef struct Vector { COUNTER n; struct Expression *expr[1]; } Vector,*VecPtr; #define VECSIZE(n) VARSIZE(Vector,expr,n) typedef enum doExtTag { X_MARK, /* to mark external data; used by GCmark1() */ X_FREE, /* to free external data; used by GCsweep1() */ X_MARKDATA, /* to put reference counts on data; used by markData() */ X_SAVE, /* to save structure to disk or to transmit it over a network */ } doExtTag; typedef void (*markAction) P((INOUT struct Expression *expr)); typedef struct Expression *(*loadAction) P((INOUT struct Expression *sharedref)); typedef struct doExtDesc { doExtTag xtag; markAction action; } doExtDesc; typedef struct extDesc { CHAR *name; /* for identification, and printing when no print method is provided */ CHAR id[4]; /* for short identification */ struct extDesc *next; unsigned long (*hash) P((IN CONST char *extdata)); /* hash code function if data must be shared */ Boolean (*eq) P((IN CONST char *ext1,IN CONST char *ext2)); /* comparison function if data must be shared */ void (*print) P((IN CONST char *ext, IN printFunc doprint, INOUT char *printdata)); /* print function; may be NULL */ void (*sweep) P((INOUT char *extdata,IN CONST doExtDesc *doext)); /* must do action specified by the xtag on the external data recursively and call (*action)() on all HimML objects that are in the external */ struct Expression *(*load) P((IN CONST struct extDesc *desc,IN Boolean shared, INOUT struct Expression *sharedref, IN CONST loadAction load)); } extDesc,*extDescPtr; typedef CONST struct Expression *(*compiledAction) P((struct Expression *env, ...)); typedef struct stackDesc { struct gcStackView *stack_frames,*heap_frames; jmp_buf buf; } stackDesc; #define SETJUMP(sd) ((sd).stack_frames = theStackFrames, (sd).heap_frames = theHeapFrames, SETJMP((sd).buf)) #define LONGJUMP(sd,n) (theStackFrames = (sd).stack_frames, theHeapFrames = (sd).heap_frames, LONGJMP((sd).buf,n)) #define OPCODE SHORT typedef struct Expression { /*ExprKind*/ CHAR kind; CHAR mark; SHORT magic; /* used in particular for fast switching on datatypes (E_DATA, E_DATACON); stores arity of functions (E_POLYFUN). */ #if EXPR_GAP!=0 CHAR filler[EXPR_GAP]; #endif struct Expression *link; union e_what { struct Int { INT val; struct Expression *next; } i; struct Str { INT len; CHAR *HEAP text; } str; struct Pair { struct Expression *car,*cdr; } pair; struct Quote { struct Expression *ref; INT n; } quote; struct Array { /* represents arrays (n>=3), tuples (n>=3), records */ struct Expression *shape; /* map field => index for records; NIL for others */ Vector *HEAP val; } array; struct Var { COUNTER rank,level; } var; struct Compiled { compiledAction action; struct Expression *env; /* closure environment, or any expression in the closure */ } compiled; struct Handler { struct Expression *eh; /* cons(env,handlers) or NIL */ stackDesc *HEAP jb; } handler; struct Stack { StackChunk *chunk; /* a real chunk (current stack) */ stackDesc *HEAP jb; } stack; struct ByteCode { struct byteCodeChunk *chunk; struct Expression *env; } bytecode; struct External { /* external data structures unknown to the HimML runtime */ extDescPtr desc; char *data; } external; REAL x; } what; #if EXPR_PADDING!=0 char padding[EXPR_PADDING]; #endif } Expression,*ExprPtr; #define VEXPRPTR Expression *VOLATILE EXTERN ExprPtr nihil; #undef NIL #define NIL nihil #define Map Expression #define MapPtr ExprPtr #define Symbol Expression #define SymPtr ExprPtr #define UNIT tuple0 #define ISCONS(e) (/*(e)!=NIL && */(e)->kind==(CHAR)E_CONS) #define ISMAP(e) (/*(e)!=NIL && */\ ((e)->kind<=(CHAR)E_MAP &&\ (e)->kind>=(CHAR)E_EMPTY)) #define ISNEMAP(e) (/*(e)!=NIL && */\ ((e)->kind==(CHAR)E_MAP ||\ (e)->kind==(CHAR)E_MAPLET)) #define NPROTECTED 512 EXTERN ExprPtr ProtectedListAgainstGC; EXTERN ExprPtr ProtectedTable[]; EXTERN ExprPtr *ProtectedTableTop; EXTERN ExprPtr ProtectedAgainstGC; typedef struct GCMarker { ExprPtr pList; ExprPtr *pTop; } GCMarker; /* there are two ways to protect your data against GC: the first protects *values*, by copying them to special-purpose stacks that GC knows about; the second protects *variables*, by maintaing a list of explicit stack frames in the C stack. While the first method allows for more efficient code (since variable values can be put in registers), the second produces code that is more easily maintained, or more easily generated by the compiler. */ /* first method: */ IMPORT ExprPtr Protect P((IN CONST ExprPtr e)); IMPORT void EndProtect P((GCMarker *save)); IMPORT ExprPtr getProtectWrapper P((void)); IMPORT void setProtectWrapper P((ExprPtr wrapper,ExprPtr keep)); #define ENTER struct GCMarker protectThemAgainstGCs; \ protectThemAgainstGCs.pList = ProtectedListAgainstGC; \ protectThemAgainstGCs.pTop = ProtectedTableTop #define QUIT EndProtect(&protectThemAgainstGCs) #define KEEP(e) ((ProtectedTableToplink #define IVAL(a) (a)->what.i.val #define INEXT(a) (a)->what.i.next #define XVAL(a) (a)->what.x #define CAR(a) (a)->what.pair.car #define CDR(a) (a)->what.pair.cdr #define MAPLEFT(a) CAR(a) #define MAPRIGHT(a) CDR(a) #define MAPLETX(a) CAR(a) #define MAPLETY(a) CDR(a) #define LETBIND(a) CAR(a) #define LETBODY(a) CDR(a) #define MEMOREM(a) CAR(a) #define MEMOFUN(a) CDR(a) #define APPLFUN(a) CAR(a) #define APPLARG(a) CDR(a) #define PATAS1(a) CAR(a) #define PATAS2(a) CDR(a) #define PATMAPADDXY(a) CAR(a) #define PATMAPADDREST(a) CDR(a) #define SETREF(a) CAR(a) #define SETVAL(a) CDR(a) #define TESTIF(a) CAR(a) #define TESTFORK(a) CDR(a) #define PROGDO(a) CAR(a) #define PROGTHEN(a) CDR(a) #define OFFP(a) CAR(a) #define OFDOM(a) CDR(a) #define WCOND(a) CAR(a) #define WBODY(a) CDR(a) #define HBODY(a) CAR(a) #define HHANDLERS(a) CDR(a) #define PACKVAL(a) CAR(a) #define PACKTYPE(a) CDR(a) #define REPART(a) CAR(a) #define IMPART(a) CDR(a) #define DZCODE(a) CAR(a) #define DZINFO(a) CDR(a) #define DNPAT(a) CAR(a) #define DNINFO(a) CDR(a) #define REFVAL(a) (a)->what.quote.ref #define COUNTEDVAL(a) (a)->what.quote.ref #define COUNTEDN(a) (a)->what.quote.n #define SETCOUNTEDN(a,nn) (a)->what.quote.n = nn #define FUNARITY(a) (a)->magic #define SETFUNARITY(a,n) (a)->magic = (SHORT)(n) #define GETREF(a) REFVAL(a) #define RBODY(a) REFVAL(a) #define EXCVAL(a) REFVAL(a) #define DCODE(a) REFVAL(a) #define NEXTFREE(a) REFVAL(a) #define ASHAPE(a) (a)->what.array.shape #define AVAL(a) (a)->what.array.val #define ACTION(e) (e)->what.compiled.action #define QENV(e) (e)->what.compiled.env #define EVARS(e) AVAL(e) #define ENEXT(e) ASHAPE(e) #define STEXT(sym) (sym)->what.str.text #define SLEN(sym) (sym)->what.str.len #define VARRANK(a) (a)->what.var.rank #define VARLEVEL(a) (a)->what.var.level #define PATCHECKVAL(a) (a)->what.handler.eh #define PATCHECKBITS(a) (*(CHAR **)&(a)->what.handler.jb) #define SCHUNK(a) (a)->what.stack.chunk #define SJMPBUF(a) (a)->what.stack.jb #define EXTDESC(a) (a)->what.external.desc #define EXTDATA(a) (a)->what.external.data #define MAX_ARITY ((1L<=2^NLOWBITS, we always resort to unary calls. */ #define ACTION_NAME(name) MERGE(name,Action) #define ACTION_PROTO(name) ExprPtr ACTION_NAME(name) P((IN CONST ExprPtr env, ...)); #define DECL_ACTION(name) IMPORT ACTION_PROTO(name) #define DECL_ACTION_NORETURN(name) IMPORT NORETURN ExprPtr ACTION_NAME(name) P((IN CONST ExprPtr env, ...)) _NORETURN; #ifdef HAS_STDARG #define FUN_HEADER(name) ExprPtr name(IN CONST ExprPtr env, ...) #define VA_START va_start(_args,env) #else #define FUN_HEADER(name) ExprPtr name(env,va_alist) \ IN CONST ExprPtr env; \ va_dcl #define VA_START va_start(_args) #endif #define ACTION_HEADER(name) FUN_HEADER(ACTION_NAME(name)) #define FC_KEEP(a) (void) KEEP(a); #define FC_IGN(a) #define FUN_COLLECT(keep) va_list _args; ExprPtr arg, res; \ VA_START; \ switch (ENV_ARITY(env)) \ { \ case 0: \ arg = tuple0; \ break; \ case 1: \ arg = va_arg(_args,ExprPtr); \ break; \ case 2: \ { \ ExprPtr arg1 = va_arg(_args,ExprPtr); \ ExprPtr arg2 = va_arg(_args,ExprPtr); \ arg = Ktuple2(arg1,arg2); \ keep(arg) \ break; \ } \ default: \ { \ COUNTER i, n = ENV_ARITY(env); \ ExprPtr args[MAX_ARITY+1]; \ for (i=0; iexpr[0]; \ arg2 = vp->expr[1]; \ arg3 = vp->expr[2]; \ } \ va_end(_args); { #define ACTION_HEADER_4ARGS(name) ACTION_HEADER(name) { \ va_list _args; ExprPtr arg1,arg2,arg3,arg4; \ VA_START; \ if (ENV_ARITY(env)==4) { \ arg1 = va_arg(_args,ExprPtr); \ arg2 = va_arg(_args,ExprPtr); \ arg3 = va_arg(_args,ExprPtr); \ arg4 = va_arg(_args,ExprPtr); \ } \ else { \ ExprPtr _arg = va_arg(_args,ExprPtr); \ VecPtr vp = AVAL(_arg); \ arg1 = vp->expr[0]; \ arg2 = vp->expr[1]; \ arg3 = vp->expr[2]; \ arg4 = vp->expr[3]; \ } \ va_end(_args); { #define ACTION_HEADER_5ARGS(name) ACTION_HEADER(name) { \ va_list _args; ExprPtr _arg,arg1,arg2,arg3,arg4,arg5; \ VA_START; \ if (ENV_ARITY(env)==5) { \ arg1 = va_arg(_args,ExprPtr); \ arg2 = va_arg(_args,ExprPtr); \ arg3 = va_arg(_args,ExprPtr); \ arg4 = va_arg(_args,ExprPtr); \ arg5 = va_arg(_args,ExprPtr); \ } \ else { \ ExprPtr _arg = va_arg(_args,ExprPtr); \ VecPtr vp = AVAL(_arg); \ arg1 = vp->expr[0]; \ arg2 = vp->expr[1]; \ arg3 = vp->expr[2]; \ arg4 = vp->expr[3]; \ arg5 = vp->expr[4]; \ } \ va_end(_args); { #define ACTION_HEADER_6ARGS(name) ACTION_HEADER(name) { \ va_list _args; ExprPtr arg1,arg2,arg3,arg4,arg5,arg6; \ VA_START; \ if (ENV_ARITY(env)==6) { \ arg1 = va_arg(_args,ExprPtr); \ arg2 = va_arg(_args,ExprPtr); \ arg3 = va_arg(_args,ExprPtr); \ arg4 = va_arg(_args,ExprPtr); \ arg5 = va_arg(_args,ExprPtr); \ arg6 = va_arg(_args,ExprPtr); \ } \ else { \ ExprPtr _arg = va_arg(_args,ExprPtr); \ VecPtr vp = AVAL(_arg); \ arg1 = vp->expr[0]; \ arg2 = vp->expr[1]; \ arg3 = vp->expr[2]; \ arg4 = vp->expr[3]; \ arg5 = vp->expr[4]; \ arg6 = vp->expr[5]; \ } \ va_end(_args); { #define ACTION_END }} #define DEF_ACTION(name) PUBLIC ACTION_HEADER(name) #define DEF_PRIVATE_ACTION(name) PRIVATE ACTION_HEADER(name) #define DEF_ACTION_0ARG(name) PUBLIC ACTION_HEADER_0ARG(name) #define DEF_ACTION_1ARG(name) PUBLIC ACTION_HEADER_1ARG(name) #define DEF_ACTION_2ARGS(name) PUBLIC ACTION_HEADER_2ARGS(name) #define DEF_ACTION_3ARGS(name) PUBLIC ACTION_HEADER_3ARGS(name) #define DEF_ACTION_4ARGS(name) PUBLIC ACTION_HEADER_4ARGS(name) #define DEF_ACTION_5ARGS(name) PUBLIC ACTION_HEADER_5ARGS(name) #define DEF_ACTION_6ARGS(name) PUBLIC ACTION_HEADER_6ARGS(name) #define DEF_ACTION_COLLECT(name) PUBLIC ACTION_HEADER_COLLECT(name) #define DEF_ACTION_COLLECT_WEAK(name) PUBLIC ACTION_HEADER_COLLECT_WEAK(name) #define ACTION_END_COLLECT } QUIT; return res; } #define DEF_PRIVATE_ACTION_0ARG(name) PRIVATE ACTION_HEADER_0ARG(name) #define DEF_PRIVATE_ACTION_1ARG(name) PRIVATE ACTION_HEADER_1ARG(name) #define DEF_PRIVATE_ACTION_2ARGS(name) PRIVATE ACTION_HEADER_2ARGS(name) #define DEF_PRIVATE_ACTION_3ARGS(name) PRIVATE ACTION_HEADER_3ARGS(name) #define DEF_PRIVATE_ACTION_COLLECT(name) PRIVATE ACTION_HEADER_COLLECT(name) #define DEF_PRIVATE_ACTION_COLLECT_WEAK(name) PRIVATE ACTION_HEADER_COLLECT_WEAK(name) IMPORT void GC P((void)); IMPORT void GCgrow P((IN COUNTER urgency, IN CONST ExprPtr tag)); IMPORT ExprPtr Reverse1 P((IN CONST ExprPtr expr,IN CONST ExprPtr tail)) _PURE; #define Reverse(expr) Reverse1(expr,NIL) IMPORT ExprPtr Append1 P((IN CONST ExprPtr e1,IN CONST ExprPtr e2)) _PURE; IMPORT ExprPtr Append0 P((IN CONST ExprPtr e1,IN CONST ExprPtr e2)) _PURE; IMPORT ExprPtr Append P((IN CONST ExprPtr e1,IN CONST ExprPtr e2)) _PURE; #define SetAdd(x,map) MapPut(x,UNIT,map) #define SetRemove(x,map) MapRemove(x,map) #define SetUnion(map1,map2) MapMerge(map1,map2) #define SetInter(map1,map2) MapDomRestrTo(map1,map2) #define SetDiff(map1,map2) MapDomRestrBy(map1,map2) #define SetDelta(map1,map2) MapDelta(map1,map2) #define SetInterp(map1,map2) MapInterp(map1,map2) IMPORT INT ListLength P((IN CONST ExprPtr list)) _PURE; IMPORT MapPtr Elems0 P((IN CONST ExprPtr list)) _PURE; IMPORT MapPtr Inds0 P((IN CONST ExprPtr list)) _PURE; IMPORT MapPtr ListToMap0 P((IN CONST ExprPtr list)) _PURE; IMPORT ExprPtr Nreverse0 P((INOUT ExprPtr list,IN CONST ExprPtr tail)); IMPORT ExprPtr Nreverse1 P((INOUT ExprPtr list,IN CONST ExprPtr tail)); #define Nreverse(list) Nreverse1(list,NIL) IMPORT ExprPtr Nappend P((INOUT ExprPtr list1,IN CONST ExprPtr list2)); EXTERN MapPtr empty_map; #define NewMap() empty_map #define EmptyMap() NewMap() #define EmptyMapp(map) ((map)==empty_map) IMPORT MapPtr MapSingleton P((IN CONST ExprPtr x,IN CONST ExprPtr y)) _PURE; #define Singleton(x) MapSingleton(x,UNIT) IMPORT MapPtr MapPair P((IN CONST ExprPtr x1,IN CONST ExprPtr y1, IN CONST ExprPtr x2,IN CONST ExprPtr y2)) _PURE; #define Pair(x,y) MapPair(x,UNIT,y,UNIT) IMPORT ExprPtr MapGet1 P((IN CONST ExprPtr elem,IN CONST MapPtr map, IN CONST CODE mask,OUT Boolean *found)); IMPORT ExprPtr MapGet P((IN CONST ExprPtr elem,IN CONST MapPtr map, OUT Boolean *found)); IMPORT ExprPtr MapGetMaplet1 P((IN REGISTER CONST ExprPtr elem, IN REGISTER CONST MapPtr map, IN REGISTER CODE mask,OUT Boolean *found)); IMPORT ExprPtr MapGetSure P((IN CONST ExprPtr elem,IN CONST MapPtr map)) _PURE; IMPORT MapPtr MapPutTrie P((IN CONST ExprPtr x,IN CONST ExprPtr y, IN CONST MapPtr map0,IN CODE mask)) _PURE; IMPORT MapPtr MapPutBehindTrie P((IN CONST ExprPtr x,IN CONST ExprPtr y, IN CONST MapPtr map0,IN CODE mask)) _PURE; IMPORT MapPtr MapPutMapletTrie P((IN CONST ExprPtr maplet,IN CONST MapPtr map0, IN REGISTER CODE mask)) _PURE; IMPORT MapPtr MapPutMapletBehindTrie P((IN CONST ExprPtr maplet,IN CONST MapPtr map0, IN REGISTER CODE mask)) _PURE; IMPORT MapPtr MapRemoveTrie P((IN CONST ExprPtr x,IN CONST MapPtr map0,IN CODE mask)) _PURE; IMPORT ExprPtr MapPut P((IN CONST ExprPtr x,IN CONST ExprPtr y, IN CONST MapPtr map)) _PURE; IMPORT ExprPtr MapPutBehind P((IN CONST ExprPtr x,IN CONST ExprPtr y, IN CONST MapPtr map)) _PURE; IMPORT MapPtr MapRemove P((IN CONST ExprPtr x,IN CONST MapPtr map)) _PURE; typedef CONST Boolean (*mapSweepFunc) P((IN CONST ExprPtr elt, IN CONST ExprPtr val, INOUT CHAR *data)); typedef CONST MapPtr (*mapCollectFunc) P((IN CONST ExprPtr elt, IN CONST ExprPtr val, INOUT CHAR *data)); typedef CONST MapPtr (*mapFoldFunc) P((IN CONST ExprPtr elt, IN CONST ExprPtr val, INOUT CHAR *data)); typedef CONST ExprPtr (*mapFoldOp) P((IN CONST ExprPtr e1, IN CONST ExprPtr e2)); #define MAPFUNC(returntype,fun) \ PRIVATE returntype fun P((IN CONST ExprPtr x,IN CONST ExprPtr y, \ INOUT CHAR *_data)); \ PRIVATE returntype fun(x,y,_data) \ IN CONST ExprPtr x,y; \ INOUT CHAR *_data; #define MAPSWEEPFUNC(fun) MAPFUNC(Boolean,fun) #define MAPCOLLECTFUNC(fun) MAPFUNC(MapPtr,fun) #define MAPFOLDFUNC(fun) MAPFUNC(MapPtr,fun) #define MAPDATA(type) ((type)_data) #define MAPFOLDOP(op) \ PRIVATE ExprPtr op P((IN CONST ExprPtr e1,IN CONST ExprPtr e2)); \ PRIVATE ExprPtr op(e1,e2) \ IN CONST ExprPtr e1,e2; IMPORT Boolean MapSweep P((IN CONST MapPtr map, IN mapSweepFunc func, INOUT VOIDPTR data)); IMPORT ExprPtr MapSome P((IN CONST MapPtr map, IN mapSweepFunc func, INOUT VOIDPTR data)); IMPORT MapPtr MapCollect0 P((IN CONST MapPtr map, IN mapCollectFunc func, INOUT VOIDPTR data)); IMPORT MapPtr MapCollect P((IN CONST MapPtr map, IN mapCollectFunc func, INOUT VOIDPTR data)); IMPORT ExprPtr MapFold P((IN CONST MapPtr map, IN mapFoldFunc func, INOUT VOIDPTR data, IN CONST ExprPtr neutral, IN mapFoldOp op )); IMPORT INT MapCard P((IN CONST MapPtr map)) _PURE; IMPORT INT MapCardDec P((IN CONST MapPtr map,IN INT n)) _PURE; #define MapCardEq(map,n) (MapCardDec(map,n)==0) #define MapCardGeq(map,n) (MapCardDec(map,n)<=0) #define MapCardLeq(map,n) (MapCardDec(map,n)>=0) IMPORT MapPtr MapMerge1 P((IN CONST MapPtr map1,IN CONST MapPtr map2,IN CONST CODE mask)) _PURE; IMPORT MapPtr MapMerge P((IN CONST MapPtr map1,IN CONST MapPtr map2)) _PURE; IMPORT MapPtr MapDomRestrTo1 P((IN CONST MapPtr map1,IN CONST MapPtr map2,IN CODE mask)) _PURE; IMPORT MapPtr MapDomRestrBy1 P((IN CONST MapPtr map1,IN CONST MapPtr map2,IN CODE mask)) _PURE; IMPORT MapPtr MapRngRestrTo1 P((IN CONST MapPtr map1,IN CONST MapPtr map2)) _PURE; IMPORT MapPtr MapRngRestrBy1 P((IN CONST MapPtr map1,IN CONST MapPtr map2)) _PURE; IMPORT MapPtr MapDelta1 P((IN CONST MapPtr map1,IN CONST MapPtr map2,IN CODE mask)) _PURE; IMPORT MapPtr MapDomRestrTo P((IN CONST MapPtr map,IN CONST MapPtr s)) _PURE; IMPORT MapPtr MapDomRestrBy P((IN CONST MapPtr map,IN CONST MapPtr s)) _PURE; IMPORT MapPtr MapRngRestrTo P((IN CONST MapPtr map,IN CONST MapPtr s)) _PURE; IMPORT MapPtr MapRngRestrBy P((IN CONST MapPtr map,IN CONST MapPtr s)) _PURE; IMPORT MapPtr MapInter P((IN CONST MapPtr map1,IN CONST MapPtr map2)) _PURE; IMPORT MapPtr MapDelta P((IN CONST MapPtr map1,IN CONST MapPtr map2)) _PURE; IMPORT MapPtr MapDom1 P((IN CONST MapPtr map)) _PURE; IMPORT MapPtr Dom P((IN CONST MapPtr map)) _PURE; IMPORT MapPtr Rng0 P((IN CONST MapPtr map)) _PURE; IMPORT Boolean MapMemberp P((IN CONST ExprPtr x,IN CONST MapPtr map)) _PURE; IMPORT Boolean MapInterp P((IN CONST MapPtr map1,IN CONST MapPtr map2)) _PURE; IMPORT Boolean MapIncludedp P((IN CONST MapPtr map1,IN CONST MapPtr map2)) _PURE; IMPORT Boolean SetIncludedp P((IN CONST MapPtr map1,IN CONST MapPtr map2)) _PURE; IMPORT ExprPtr ChooseInDom P((IN CONST MapPtr map)) _PURE; IMPORT ExprPtr ChooseInRng P((IN CONST MapPtr map)) _PURE; IMPORT Boolean Setp P((IN CONST MapPtr map)) _PURE; IMPORT MapPtr MapCompose P((IN CONST MapPtr map1,IN CONST MapPtr map2)) _PURE; IMPORT MapPtr MapImage P((IN CONST MapPtr map,IN CONST MapPtr s)) _PURE; IMPORT void MapSplit P((IN CONST MapPtr map,OUT MapPtr *map1,OUT MapPtr *map2)); IMPORT Boolean sameDomains P((IN CONST MapPtr map1,IN CONST MapPtr map2)) _PURE; IMPORT void setMapPut P((IN CONST ExprPtr x,IN CONST ExprPtr y,INOUT MapPtr *loc)); IMPORT void setrefMapPut P((IN CONST ExprPtr x,IN CONST ExprPtr y,INOUT ExprPtr ref)); IMPORT void setcarMapPut P((IN CONST ExprPtr x,IN CONST ExprPtr y,INOUT ExprPtr pair)); IMPORT void setcdrMapPut P((IN CONST ExprPtr x,IN CONST ExprPtr y,INOUT ExprPtr pair)); #define setSetAdd(x,sp) setMapPut(x,UNIT,sp) IMPORT void setMapRemove P((IN CONST ExprPtr x,INOUT MapPtr *map)); IMPORT void setcarMapRemove P((IN CONST ExprPtr x,INOUT ExprPtr pair)); IMPORT void setcdrMapRemove P((IN CONST ExprPtr x,INOUT ExprPtr pair)); IMPORT void setMapMerge P((INOUT MapPtr *loc,IN CONST MapPtr map)); #define setSetUnion(sp,s) setMapMerge(sp,s) IMPORT void setcarMapMerge P((INOUT ExprPtr pair,IN CONST MapPtr map)); IMPORT void setcdrMapMerge P((INOUT ExprPtr pair,IN CONST MapPtr map)); IMPORT void setMapDomRestrTo P((INOUT MapPtr *loc,IN CONST MapPtr map)); IMPORT void setMapDomRestrBy P((INOUT MapPtr *loc,IN CONST MapPtr map)); /* a few of the same operations, but not KEEP()ing their results. */ EXTERN ExprPtr mapStack[]; EXTERN ExprPtr *mapStackTop; #define MASK0 (CODE)(1L<next==NULL, and the next pointer is in SCHUNK(exc->data)->excStack */ ExprPtr code; /* code and jb are only used for X_HANDLER. */ stackDesc jb; } excHandler; EXTERN excHandler *excStack; #define NEXTEXCHANDLER(exc) (((exc)->tag==X_CONT)?SCHUNK((exc)->data)->excStack:(exc)->next) IMPORT ExprPtr Raise P((IN CONST ExprPtr exception)) _NORETURN; IMPORT NORETURN void Toplevel P((IN CONST ExprPtr errcond)) _NORETURN; /*IMPORT ExprPtr Eval P((IN CONST ExprPtr e, IN CONST ExprPtr env));*/ EXTERN stackMark *currentThread; EXTERN char *lowMark; IMPORT ExprPtr CallCC P((IN compiledAction action,IN CONST ExprPtr env, IN Boolean catchp)); IMPORT NORETURN void Throw1 P((IN CONST ExprPtr stack,IN CONST ExprPtr e, IN CONST stackDesc *sd)) _NORETURN; #define Throw(stack,e) Throw1(stack,e,(stackDesc *)0L) #ifdef ASCENDING_STACK #define STKFULL(var) (((char *)&var)>lowMark) #else #define STKFULL(var) (((char *)&var) #define BUCKET_SIZE 512 typedef struct Bucket { struct Bucket *next; SHORT firstNewCell; /* index of the first new cell in the newcell array below */ SHORT occupancy[MAX_GENERATIONS]; /* occupancy[i] is the number of allocated cells in the bucket that are in the ith generation. */ #if BUCKET_GAP!=0 char filler[BUCKET_GAP]; #endif Expression cell[BUCKET_SIZE]; Expression *newcells[BUCKET_SIZE]; /* used by GCsweep() */ /* this is the list of pointers to entries in the cell array, ordered by increasing generations; the first entry corresponding to the current generation is firstNewCell */ } Bucket,*BucketPtr; EXTERN BucketPtr theBucketList; EXTERN BucketPtr theHomoBucketList,*endHomoBucketList; EXTERN BucketPtr theHeteroBucketList,*endHeteroBucketList; EXTERN ExprPtr *nextHomoExpr,*nextHeteroExpr; EXTERN ExprPtr *lastHomoExpr,*lastHeteroExpr; EXTERN BucketPtr currentHomoBucket,currentHeteroBucket; EXTERN BucketPtr oldHomoBucketList,oldHeteroBucketList; IMPORT void bumpHomoExpr P((void)); IMPORT void bumpHeteroExpr P((void)); EXTERN BucketPtr theSlotBucketList; EXTERN ExprPtr theAvailSlotList; EXTERN ExprPtr reserveSlot; typedef struct VecBucket { struct VecBucket *next; struct VecBucket *contents[1]; /* actually variable-sized */ } VecBucket,*VecBucketPtr; #define VECBN_N 13 EXTERN COUNTER VecBucketN[VECBN_N]; EXTERN VecBucketPtr theVecBucketList[VECBN_N]; EXTERN VecBucketPtr theAvailVecBuckets[VECBN_N]; EXTERN INT nCells; typedef CONST char *(*allocFunction) P((long size)); EXTERN BucketPtr NewBucket P((allocFunction new,Boolean force)) _MALLOC; EXTERN BucketPtr NewSlotBucket P((allocFunction new)) _MALLOC; EXTERN VecBucketPtr NewVecBucket P((allocFunction new,IN INT n)) _MALLOC; EXTERN VOIDPTR VecAlloc P((IN INT size)) _MALLOC; EXTERN void VecFree P((IN VOIDPTR p,IN INT size)); EXTERN char dummy; #define VECALLOC(p,size) \ { \ REGISTER INT _V_size=size, \ _V_n = (_V_size + (sizeof(VecBucketPtr)-1))/sizeof(VecBucketPtr); \ if (_V_n==0) p = (VOIDPTR)&dummy; \ else if (_V_n>=VECBN_N) p = (VOIDPTR)MALLOC(_V_size); \ else { \ REGISTER VecBucketPtr *_V_vp = theAvailVecBuckets+_V_n; \ if (*_V_vp==(VecBucketPtr)0L) (void) NewVecBucket(newptr_gc,_V_n); \ p = (VOIDPTR)*_V_vp; \ *_V_vp = *(VecBucketPtr *)*_V_vp; \ } \ } #define VECFREE(p,size) \ { \ REGISTER INT _V_n = (size + (sizeof(VecBucketPtr)-1))/sizeof(VecBucketPtr); \ if (_V_n!=0) { \ if (_V_n>=VECBN_N) { MARKFREE(p); } \ else { \ REGISTER VecBucketPtr *_V_vp = theAvailVecBuckets+_V_n; \ *(VecBucketPtr *)p = *_V_vp; \ *_V_vp = (VecBucketPtr)p; \ } \ } \ } #define CHECKHOMOFREE() \ if (nextHomoExpr!=lastHomoExpr) ; else \ bumpHomoExpr() #define CHECKHETEROFREE() \ if (nextHeteroExpr!=lastHeteroExpr) ; else \ bumpHeteroExpr() #define EALLOC_HOMO_NOGC(e) \ e = *nextHomoExpr++; \ (e)->mark = 0; \ ELINK(e) = NEWGEN #define EALLOC_HOMO(e) \ CHECKHOMOFREE(); \ EALLOC_HOMO_NOGC(e) #define EALLOC_HETERO_NOGC(e) \ e = *nextHeteroExpr++; \ (e)->mark = 0; \ ELINK(e) = NEWGEN #define EALLOC_HETERO(e) \ CHECKHETEROFREE(); \ EALLOC_HETERO_NOGC(e) #define QALLOC_HOMO(e) \ e = *nextHomoExpr++ #define QALLOC_HETERO(e) \ e = *nextHeteroExpr++ #define EFREE(e) #define SLOTALLOC(e) \ e = theAvailSlotList; \ theAvailSlotList = NEXTFREE(e) #define MAKEINT(ii,e) \ { \ REGISTER ExprPtr tmpxIz; \ \ EALLOC_HOMO(tmpxIz); \ tmpxIz->kind = (CHAR)E_INT; \ IVAL(tmpxIz) = ii; \ INEXT(tmpxIz) = NOEXPR; \ e = tmpxIz; \ } #define MAKEREAL(xx,e) \ EALLOC_HOMO(e); \ (e)->kind = (CHAR)E_REAL; \ XVAL(e) = xx #define MAKESTRING(l,t,e) \ EALLOC_HETERO(e); \ (e)->kind = (CHAR)E_STRING; \ SLEN(e) = l; \ STEXT(e) = t #define MAKEPAIR1(xkind,xcar,xcdr,e) \ EALLOC_HOMO(e); \ (e)->kind = (CHAR)xkind; \ CAR(e) = xcar; \ CDR(e) = xcdr #define MAKEPAIR(xkind,xcar,xcdr,e) \ EALLOC_HOMO(e); \ (e)->kind = (CHAR)xkind; \ CAR(e) = xcar; \ CDR(e) = xcdr #define MAKEDATA(xmagic,xcar,xcdr,e) \ EALLOC_HOMO(e); \ (e)->kind = (CHAR)E_DATA; \ (e)->magic = xmagic; \ CAR(e) = xcar; \ CDR(e) = xcdr #define MAKECONS1(xcar,xcdr,e) MAKEPAIR1(E_CONS,xcar,xcdr,e) #define MAKECONS(xcar,xcdr,e) MAKEPAIR(E_CONS,xcar,xcdr,e) #define MAKEUNSHAREDCONS(xcar,xcdr,e) MAKEPAIR(E_UNSHARED_CONS,xcar,xcdr,e) #define MAKETUPLE2(xcar,xcdr,e) MAKEPAIR(E_TUPLE_2,xcar,xcdr,e) #define MAKEUNSHAREDTUPLE2(xcar,xcdr,e) MAKEPAIR(E_UNSHARED_TUPLE_2,xcar,xcdr,e) #define MAKERECORD1(label,val,e) MAKEPAIR(E_RECORD_1,label,val,e) #define MAKEMAPLET(x,y,e) MAKEPAIR(E_MAPLET,x,y,e) #define MAKEMEMO(rem,f,e) MAKEPAIR(E_MEMO_FN,rem,f,e) #define MAKEPROG(k,e1,e2,e) MAKEPAIR(k,e1,e2,e) #define MAKEKTUPLE(xkind,xcdr,e) \ EALLOC_HETERO(e); \ (e)->kind = (CHAR)xkind; \ ASHAPE(e) = NIL; \ AVAL(e) = xcdr #define MAKETUPLE(xcdr,e) MAKEKTUPLE(E_TUPLE_GNRL,xcdr,e) #define MAKEKTUPLE_NOGC(xkind,xcdr,e) \ EALLOC_HETERO_NOGC(e); \ (e)->kind = (CHAR)xkind; \ ASHAPE(e) = NIL; \ AVAL(e) = xcdr #define MAKETUPLE_NOGC(xcdr,e) MAKEKTUPLE_NOGC(E_TUPLE_GNRL,xcdr,e) #define MAKEKRECORD(xkind,xcar,xcdr,e) \ EALLOC_HETERO(e); \ (e)->kind = (CHAR)xkind; \ ASHAPE(e) = xcar; \ AVAL(e) = xcdr #define MAKERECORD(xcar,xcdr,e) MAKEKRECORD(E_RECORD_GNRL,xcar,xcdr,e) #define MAKEKRECORD_NOGC(xkind,xcar,xcdr,e) \ EALLOC_HETERO_NOGC(e); \ (e)->kind = (CHAR)xkind; \ ASHAPE(e) = xcar; \ AVAL(e) = xcdr #define MAKERECORD_NOGC(xcar,xcdr,e) MAKEKRECORD_NOGC(E_RECORD_GNRL,xcar,xcdr,e) #define MAKESING(k,expr,e) \ EALLOC_HOMO(e); \ (e)->kind = (CHAR)k; \ REFVAL(e) = expr #define MAKEREF(expr,e) MAKESING(E_REF,expr,e) #define MAKEENV1(v,n,e) \ EALLOC_HETERO(e); \ (e)->kind = (CHAR)E_ENV; \ EVARS(e) = v; \ ENEXT(e) = n #define MAKEENV1_NOGC(v,n,e) \ EALLOC_HETERO_NOGC(e); \ (e)->kind = (CHAR)E_ENV; \ EVARS(e) = v; \ ENEXT(e) = n #define MAKEENV(v,n,e) \ MAKEENV1(v,n,e) #define MAKEENV_NOGC(v,n,e) \ MAKEENV1_NOGC(v,n,e) IMPORT ExprPtr MakePair P((IN ExprKind kind,IN CONST ExprPtr car,IN CONST ExprPtr cdr)) _MALLOC; #define MakeLet(bind,body) MakePair(E_LET,bind,body) #define MakeGoto(kind,f,arg) MakePair(kind,f,arg) #define MakeAppl(f,arg) MakeGoto(E_APPL,f,arg) #define MakePatAs(pat1,pat2) MakePair(E_PAT_AS,pat1,pat2) #define MakePatMapAdd(xy,rest) MakePair(E_PAT_MAPADD,xy,rest) #define MakeSet(ref,val) MakePair(E_SET,ref,val) #define MakeTest(cond,thenelse) MakePair(E_IF,cond,thenelse) #define MakeOfOrMap(kind,fP,dom) MakePair(kind,fP,dom) #define MakeWhile(kind,cond,body) MakePair(kind,cond,body) #define MakeHandle(body,handlers) MakePair(E_HANDLE,body,handlers) #define MakePack(kind,expr,type) MakePair(kind,expr,type) #define MakeDebugZone(code,info) MakePair(E_DEBUGZONE,code,info) #define MakeDebugName(code,info) MakePair(E_DEBUGNAME,code,info) #define MakeMapget(m,s) MakePair(E_MAPGET,m,s) #define makeMu(kind,rec,mod) MakePair(kind,rec,mod) #define MakePatTupleCons(pat,tail) MakePair(E_PAT_TUPLE_GNRL_CONS,pat,tail) #define MakePatRecordCons(pat,tail) MakePair(E_PAT_RECORD_GNRL_CONS,pat,tail) #define MakePatRecordMapAdd(pat,tail) MakePair(E_PAT_RECORD_MAPADD,pat,tail) #define MakePatCons(pat) MakeSing(E_PAT_CONS,pat) IMPORT ExprPtr MakeData P((IN SHORT magic,IN CONST ExprPtr car,IN CONST ExprPtr cdr)) _MALLOC; IMPORT ExprPtr MakeCounted P((IN ExprKind kind,IN CONST ExprPtr expr,IN INT n)) _MALLOC; IMPORT ExprPtr MakePolyfun P((IN SHORT magic,IN CONST ExprPtr expr,IN INT n)) _MALLOC; #define MakeSing(kind,expr) MakeCounted(kind,expr,0L) #define MakeQuote(expr) MakeSing(E_QUOTE,expr) #define MakeRaise(exc) MakeSing(E_RAISE,exc) #define EXC_BENIGN 0x1 #define EXC_CHECKED 0x0 #define MakeException(exc,flags) MakeCounted(E_EXCEPTION,exc,flags) #define MakeGet(ref) MakeSing(E_GET,ref) #define MakeDelay(code) MakeSing(E_DELAY,code) #define MakeTuple1(e) MakeSing(E_TUPLE_1,e) IMPORT ExprPtr MakePromise P((IN CONST ExprPtr fun)) _MALLOC; IMPORT ExprPtr MakeStack P((IN CONST stackDesc *jb,IN CONST StackChunk *chunk)) _MALLOC; IMPORT ExprPtr MakeRecord P((IN ExprKind kind,IN CONST ExprPtr shape,IN INT n,IN ExprPtr *exprs)) _MALLOC; IMPORT ExprPtr MakeArray P((COUNTER n,ExprPtr e)) _MALLOC; IMPORT ExprPtr ListToArray0 P((ExprPtr l)) _MALLOC; IMPORT ExprPtr MakeExternal P((IN CONST extDescPtr desc,IN CONST char *data)) _MALLOC; IMPORT ExprPtr MakeCompiled P((IN ExprKind kind, IN compiledAction action, IN CONST ExprPtr env)) _MALLOC; #define makePrimitive(name) MakeCompiled(E_COMPILED_CLOSURE,ACTION_NAME(name),NIL) typedef struct field { ExprPtr label; ExprPtr val; } field; IMPORT int CompareStrings P((IN CONST ExprPtr s1,IN CONST ExprPtr s2)); IMPORT void sortFieldArray P((IN COUNTER n,INOUT field *array)); IMPORT ExprPtr fieldsToShape1 P((IN COUNTER n,IN COUNTER n0,IN CONST field *array)); #define fieldsToShape(n,array) fieldsToShape1(n,1,array) IMPORT void fieldsToExprs P((OUT ExprPtr *exprs,IN CONST field *array,IN COUNTER n)); IMPORT ExprPtr MakeRecordGnrl P((IN COUNTER n,IN CONST field *array, IN CONST ExprPtr shape)) _MALLOC; IMPORT extDesc *getExtDesc P((IN CONST CHAR *id)); IMPORT void registerExtDesc P((INOUT extDesc *desc)); IMPORT INT idiv P((INT a,INT b)); IMPORT INT imod P((INT a,INT b)); /* END expr.h */ /* BEGIN bciaux.h */ IMPORT void mergeFieldLists P((INOUT ExprPtr *fields1, INOUT ExprPtr *fields2, OUT ExprPtr *newfields, IN INT m, IN INT n, OUT INT *np)); IMPORT void dumpShape P((IN CONST ExprPtr shape, OUT ExprPtr *fields)); IMPORT MapPtr undumpShape P((IN CONST ExprPtr *fields, IN INT n)); IMPORT ExprPtr Kmu1 P((IN CONST ExprPtr rec, IN CONST ExprPtr modlab, IN CONST ExprPtr modval)); IMPORT ExprPtr Mu1 P((IN CONST ExprPtr rec, IN CONST ExprPtr modlab, IN CONST ExprPtr modval)); IMPORT ExprPtr KmuGnrl P((IN CONST ExprPtr rec, IN CONST ExprPtr mod)); IMPORT ExprPtr MuGnrl P((IN CONST ExprPtr rec, IN CONST ExprPtr mod)); IMPORT ExprPtr envCons P((IN REGISTER COUNTER n, IN CONST ExprPtr env)); IMPORT ExprPtr QueueToList P((IN ExprPtr queue)); IMPORT ExprPtr ListToQueue P((IN CONST ExprPtr list)); IMPORT Boolean do_initialsubmap P((IN CONST ExprPtr x,IN CONST ExprPtr y, INOUT CHAR *_data)); DECL_ACTION(datacon_shared) IMPORT void resetHandlerStack P((void)); IMPORT void setHandlerStack P((IN CONST excHandler *stack)); /* END bciaux.h */ /* BEGIN himmlx.h */ struct xhandler { COUNTER handlerNum; COUNTER n; }; /* struct xhandlerinfo { struct xhandler *curxhandler; struct xhandler *endxhandler; struct xhandler exc[1]; }; #define XHISIZE(maxexc) OFFSETOF(struct xhandlerifo,exc[maxexc]) */ EXTERN ExprPtr subscriptException,stringnthException; /* END himmlx.h */ /* BEGIN gram.h */ #ifndef YYLTYPE typedef struct yyltype { int first_line; int first_column; int last_line; int last_column; char *text; } yyltype; #define YYLTYPE yyltype #endif #if CORE_TRACE #undef YYLEX EXTERN hFILE *coreTraceFile; IMPORT void resetTracingYyLex P((void)); IMPORT int tracingYylex P((void)); #define YYLEX tracingYylex() #else #ifndef YYLEX #define YYLEX yylex #endif #endif EXTERN Boolean unit_recognized; EXTERN COUNTER star_recognized,union_recognized; EXTERN SymPtr lexId,lexPath; EXTERN ExprPtr lexEnv, /* maps ids to precedences as E_INT */ consEnv; /* sets of constructors */ #if MODULE_SYSTEM & STD_ML_MODULE EXTERN ExprPtr strEnv, sigEnv; #endif EXTERN SymPtr consSym,itSym,it2Sym; EXTERN char *yytext; EXTERN int yylineno,yyposno; EXTERN ExprPtr toplevelCont; IMPORT void InitMarkerStack P((void)); IMPORT void pushMarker P((void)); PUBLIC ExprPtr popMarker P((ExprPtr keep)); IMPORT void ResetFiles P((IN CONST char *mark,IN Boolean flushRemText)); IMPORT char *getMarkFiles P((void)); IMPORT void CloseFile P((void)); IMPORT Boolean OpenFile P((IN CONST CHAR *name)); IMPORT Boolean PushFile P((void)); IMPORT Boolean OpenString P((IN CONST CHAR *str,IN COUNTER len)); IMPORT void exportML P((IN CONST ExprPtr name)); IMPORT void importML P((IN CONST ExprPtr name)); IMPORT void setLocalEnv P((void)); IMPORT void setTopEnv P((void)); #if MODULE_SYSTEM & STD_ML_SYSTEM IMPORT void keepEnv P((void)); IMPORT void restoreEnv P((void)); IMPORT void lexOpen P((IN CONST struct yyltype *loc,IN CONST SymPtr id,IN Boolean overwritep,IN CONST ExprPtr env)); IMPORT void popEnvMakeStruct P((IN CONST SymPtr strname)); IMPORT void popEnvMakeSig P((IN CONST SymPtr signame)); IMPORT void poppopEnvMakeFunctor P((IN CONST SymPtr funname,IN CONST SymPtr inname)); IMPORT void poppopEnvMakeFunctorSig P((IN CONST SymPtr funname,IN CONST SymPtr inname)); IMPORT void longLexOpen P((IN CONST ExprPtr longsym,IN Boolean sigp)); IMPORT void longLexOpenList P((IN CONST ExprPtr longsymlist,IN Boolean sigp)); IMPORT void saveLexDummy P((INOUT ExprPtr env)); IMPORT void initSaveLexDummy P((void)); IMPORT void endSaveLexDummy P((INOUT ExprPtr env)); IMPORT void popEnvMakeStructMatch P((IN CONST TZone *zone,IN CONST SymPtr strname,IN CONST SymPtr signame)); IMPORT void popEnvStructMatch P((IN CONST TZone *zone,IN CONST SymPtr signame)); IMPORT void popOtherEnv P((void)); PUBLIC void popEnvApplyFunctor P((IN CONST ExprPtr longsym)); #else #define keepEnv() #define restoreEnv() #define lexOpen(loc,id,overwritep,env) #endif #if FLOAT_FORMAT==IEEE754 EXTERN ExprPtr *NaNs; #endif IMPORT ExprPtr DupCompAssum P((IN CONST ExprPtr table)); IMPORT COUNTER nLocals P((IN CONST ExprPtr table)); IMPORT void setNLocals P((IN CONST ExprPtr assum,IN COUNTER n)); EXTERN ExprPtr basisAssum,basisState,basisTable,basisEnv; IMPORT ExprPtr genVar P((IN CONST struct yyltype *start,IN CONST struct yyltype *end)); IMPORT void tildeToMinus P((CHAR *text)); IMPORT ExprPtr getReal P((IN CONST struct yyltype *start,IN CONST struct yyltype *end,IN CHAR *text)); IMPORT ExprPtr getComplex P((IN CONST struct yyltype *start,IN CONST struct yyltype *end,IN CHAR *text)); IMPORT ExprPtr setFix P((IN CONST struct yyltype *start,IN CONST struct yyltype *end,IN CONST ExprPtr ll,IN COUNTER p)); IMPORT void makeZone P((OUT struct TZone *zone,IN CONST struct yyltype *yylsp1,IN CONST struct yyltype *yylsp2)); IMPORT ExprPtr Build P((IN CONST struct yyltype *start,IN CONST struct yyltype *end,IN COUNTER f,IN CONST ExprPtr info)); IMPORT ExprPtr build1 P((IN CONST struct yyltype *start,IN CONST struct yyltype *end,IN COUNTER f,IN CONST ExprPtr a)); IMPORT ExprPtr build2 P((IN CONST struct yyltype *start,IN CONST struct yyltype *end,IN COUNTER f,IN CONST ExprPtr a,IN CONST ExprPtr b)); IMPORT ExprPtr build3 P((IN CONST struct yyltype *start,IN CONST struct yyltype *end,IN COUNTER f,IN CONST ExprPtr a,IN CONST ExprPtr b,IN CONST ExprPtr c)); IMPORT ExprPtr buildrev P((IN CONST struct yyltype *start,IN CONST struct yyltype *end,IN COUNTER f,IN CONST ExprPtr list)); IMPORT ExprPtr build1rev P((IN CONST struct yyltype *start,IN CONST struct yyltype *end,IN COUNTER f,IN CONST ExprPtr a,IN CONST ExprPtr list)); IMPORT ExprPtr build2rev P((IN CONST struct yyltype *start,IN CONST struct yyltype *end,IN COUNTER f,IN CONST ExprPtr a,IN CONST ExprPtr b,IN CONST ExprPtr list)); IMPORT ExprPtr build1list P((IN CONST struct yyltype *start,IN CONST struct yyltype *end,IN COUNTER f,IN CONST ExprPtr a,IN CONST ExprPtr list)); IMPORT ExprPtr build2list P((IN CONST struct yyltype *start,IN CONST struct yyltype *end,IN COUNTER f,IN CONST ExprPtr a,IN CONST ExprPtr b,IN CONST ExprPtr list)); #define BUILD(start,end,f,info) Build(start,end,f,info) IMPORT ExprPtr applyBin P((IN CONST struct yyltype *start,IN CONST struct yyltype *end,IN CONST ExprPtr f,IN CONST ExprPtr arg1,IN CONST ExprPtr arg2)); IMPORT ExprPtr patApplyBin P((IN CONST struct yyltype *start,IN CONST struct yyltype *end,IN CONST ExprPtr f,IN CONST ExprPtr arg1,IN CONST ExprPtr arg2)); IMPORT ExprPtr lexVar P((IN CONST struct yyltype *start,IN Boolean longp)); IMPORT ExprPtr buildFun P((IN CONST struct yyltype *start,IN CONST struct yyltype *end,IN COUNTER n,IN CONST ExprPtr list)); IMPORT ExprPtr buildFunBind P((IN CONST struct yyltype *start,IN CONST struct yyltype *end,IN CONST ExprPtr list)); IMPORT void patchMemoFunList P((INOUT ExprPtr ll,IN CONST ExprPtr tyvarseq,IN CONST ExprPtr rest)); IMPORT void installMapPattern P((IN CONST struct yyltype *yylsp,IN CONST ExprPtr mapadds,IN CONST ExprPtr rest)); IMPORT ExprPtr zeroTuple P((IN CONST struct yyltype *yylsp)); IMPORT ExprPtr zeroPatTuple P((IN CONST struct yyltype *yylsp)); IMPORT ExprPtr patNil P((IN CONST struct yyltype *yylsp)); IMPORT ExprPtr makeNum P((IN CONST struct yyltype *yylsp,IN CONST ExprPtr num)); IMPORT ExprPtr makeInt P((IN CONST struct yyltype *yylsp,IN CONST ExprPtr num)); IMPORT void checkValRec P((IN CONST ExprPtr valrec)); IMPORT void checkUniqueCon P((IN CONST ExprPtr con,IN CONST ExprPtr conbind)); IMPORT void checkUniqueConstructors P((IN CONST ExprPtr datbind,IN CONST ExprPtr datbindlist)); IMPORT void checkUniqueIdInType P((IN CONST ExprPtr typbind,IN CONST ExprPtr typbindlist)); IMPORT void checkUniqueTypeSeq P((IN CONST ExprPtr typevar,IN CONST ExprPtr typeseq)); IMPORT void checkUniqueUnit P((IN CONST ExprPtr unit,IN CONST ExprPtr unitlist)); IMPORT void checkUniqueQuantityAndUnit P((IN CONST ExprPtr quan,IN CONST ExprPtr quanlist)); IMPORT void checkUniqueLabel P((IN CONST ExprPtr lexpr,IN CONST ExprPtr lrow)); IMPORT void checkQuantifiedType P((IN CONST ExprPtr tyvarseq,IN CONST ExprPtr type)); IMPORT void checkQuantifiedDatatype P((IN CONST ExprPtr tyvarseq,IN CONST ExprPtr conbindlist)); IMPORT void checkWithType P((IN CONST ExprPtr datbind,IN CONST ExprPtr typbind)); IMPORT void checkUniqueException P((IN CONST ExprPtr exc,IN CONST ExprPtr exclist)); IMPORT void checkEqTypes P((IN CONST ExprPtr eqtylist,IN CONST ExprPtr datbind)); IMPORT void checkUniqueValDesc P((IN CONST ExprPtr val,IN CONST ExprPtr vallist)); #if MODULE_SYSTEM & STD_ML_MODULE IMPORT void checkUniqueSig P((IN CONST ExprPtr sig,IN CONST ExprPtr siglist)); IMPORT void checkUniqueStruct P((IN CONST ExprPtr str,IN CONST ExprPtr strlist)); IMPORT void checkUniqueFunctor P((IN CONST ExprPtr fun,IN CONST ExprPtr funlist)); #endif IMPORT ExprPtr exprTyVars P((IN CONST ExprPtr expr,IN CONST ExprPtr tyvars)); IMPORT ExprPtr listTyVars P((IN CONST ExprPtr ll,IN CONST ExprPtr tyvars)); IMPORT ExprPtr exprToDecls P((IN CONST struct yyltype *start, IN CONST struct yyltype *end, IN CONST ExprPtr expr, IN CONST ExprPtr sym)); #ifdef OBSOLETE IMPORT ExprPtr evalExpression P((IN CONST struct yyltype *start, IN CONST struct yyltype *end, IN CONST ExprPtr expr,IN CONST ExprPtr type)); typedef void (*prepEnvFun) P((IN CONST ExprPtr env)); IMPORT ExprPtr readValue P((IN CONST char *s,IN CONST ExprPtr cast, IN CONST prepEnvFun prep,IN CONST ExprPtr env)); IMPORT ExprPtr readValueSimple P((IN CONST char *s,IN CONST ExprPtr cast, IN CONST ExprPtr env)); #endif IMPORT void yyinit P((void)); IMPORT NORETURN void ml_done P((int code)) _NORETURN; IMPORT void cutoffInitials P((void)); typedef struct Basis { ExprPtr parseMarker; ExprPtr parseMarkerStack; Boolean syntax_analysis; #if DEBUGGING Boolean evaluatingp; Boolean stopwanted; #endif Boolean unit_recognized; int condState; /* obsolete */ int condLevel; /* obsolete */ COUNTER star_recognized; COUNTER union_recognized; #if DEBUGGING #ifdef OBSOLETE ExprPtr debugApplStk; #endif #endif ExprPtr lexEnv; ExprPtr consEnv; ExprPtr strEnv; ExprPtr sigEnv; ExprPtr toplevelCont; excHandler *excStack; ExprPtr basisState; ExprPtr basisAssum; ExprPtr basisTable; ExprPtr basisEnv; ExprPtr bindings; } Basis; #define CHECKSUM_WIDTH 8 typedef CHAR Checksum[CHECKSUM_WIDTH]; IMPORT void CheckSum P((IN CONST ExprPtr e,OUT Checksum cs)); struct cslist { struct cslist *next; Checksum cs; ExprPtr basis; INT age; }; IMPORT struct cslist *Checksums; IMPORT ExprPtr basisNew P((IN Boolean copy)); IMPORT void basisInstall P((IN CONST ExprPtr e,IN Boolean errp,IN Boolean copy)); IMPORT void StoreInitialBasis P((void)); IMPORT struct cslist *CurrentChecksum P((void)); IMPORT struct cslist *GetChecksum P((IN CONST Checksum cs)); IMPORT void ResetCurrentAge P((IN INT age)); EXTERN ExprPtr theTypes,theBindings; DECL_ACTION(precompile) IMPORT int HimMLParse1 P((IN compiledAction action)); IMPORT ExprPtr preCompile P((IN CONST CHAR *filename,OUT CHAR **realname)); IMPORT ExprPtr moduleLoad P((IN CONST TZone *zone,IN CONST CHAR *name,IN Boolean recompile)); IMPORT ExprPtr moduleCompile P ((IN CONST CHAR *name)); IMPORT void checkConsEnv P((IN CONST TZone *zone,IN CONST ExprPtr basis)); IMPORT void augmentLexicalEnv P((IN CONST ExprPtr basis)); #if DEBUGGING IMPORT void setCurrentFile P((void)); #endif /* END gram.h */ /* BEGIN himml.tab.h */ typedef union { int i; ExprPtr e; } YYSTYPE; #ifndef YYLTYPE typedef struct yyltype { int timestamp; int first_line; int first_column; int last_line; int last_column; char *text; } yyltype; #define YYLTYPE yyltype #endif #define kw_abstype 257 #define kw_all 258 #define kw_and 259 #define kw_andalso 260 #define kw_as 261 #define kw_case 262 #define kw_do 263 #define kw_datatype 264 #define kw_else 265 #define kw_end 266 #define kw_exception 267 #define kw_exists 268 #define kw_fn 269 #define kw_fun 270 #define kw_handle 271 #define kw_if 272 #define kw_in 273 #define kw_in_list 274 #define kw_in_map 275 #define kw_in_set 276 #define kw_infix 277 #define kw_infixr 278 #define kw_let 279 #define kw_local 280 #define kw_nonfix 281 #define kw_of 282 #define kw_orelse 283 #define kw_dimension 284 #define kw_raise 285 #define kw_rec 286 #define kw_some 287 #define kw_such_that 288 #define kw_then 289 #define kw_type 290 #define kw_scale 291 #define kw_val 292 #define kw_with 293 #define kw_withtype 294 #define kw_while 295 #define kw_open_paren 296 #define kw_close_paren 297 #define kw_open_bracket 298 #define kw_close_bracket 299 #define kw_open_array_ref 300 #define kw_array_assign 301 #define kw_open_brace_under 302 #define kw_open_brace 303 #define kw_close_brace 304 #define kw_open_record 305 #define kw_close_record 306 #define kw_open_array 307 #define kw_close_array 308 #define kw_comma 309 #define kw_colon 310 #define kw_semicolon 311 #define kw_ellipsis 312 #define kw_underscore 313 #define kw_vbar 314 #define kw_vbar_vbar 315 #define kw_equal 316 #define kw_big_arrow 317 #define kw_arrow 318 #define kw_star 319 #define precedence_constant 320 #define string_constant 321 #define integer_constant 322 #define real_constant 323 #define complex_constant 324 #define hex_integer_constant 325 #define octal_integer_constant 326 #define binary_integer_constant 327 #define kw_identifier 328 #define kw_cons_id 329 #define kw_type_variable 330 #define kw_left_0 331 #define kw_right_0 332 #define kw_left_1 333 #define kw_right_1 334 #define kw_left_2 335 #define kw_right_2 336 #define kw_left_3 337 #define kw_right_3 338 #define kw_left_4 339 #define kw_right_4 340 #define kw_left_5 341 #define kw_right_5 342 #define kw_left_6 343 #define kw_right_6 344 #define kw_left_7 345 #define kw_right_7 346 #define kw_left_8 347 #define kw_right_8 348 #define kw_left_9 349 #define kw_right_9 350 #define kw_left_0_constructor 351 #define kw_right_0_constructor 352 #define kw_left_1_constructor 353 #define kw_right_1_constructor 354 #define kw_left_2_constructor 355 #define kw_right_2_constructor 356 #define kw_left_3_constructor 357 #define kw_right_3_constructor 358 #define kw_left_4_constructor 359 #define kw_right_4_constructor 360 #define kw_left_5_constructor 361 #define kw_right_5_constructor 362 #define kw_left_6_constructor 363 #define kw_right_6_constructor 364 #define kw_left_7_constructor 365 #define kw_right_7_constructor 366 #define kw_left_8_constructor 367 #define kw_right_8_constructor 368 #define kw_left_9_constructor 369 #define kw_right_9_constructor 370 #define kw_scale_star 371 #define kw_scale_power 372 #define kw_union 373 #define kw_map_arrow 374 #define kw_iterate 375 #define kw_eqtype 376 #define kw_sharp 377 #define kw_open_mu 378 #define kw_use 379 #define kw_pinf 380 #define kw_minf 381 #define kw_nan0 382 #define kw_nan1 383 #define kw_nan2 384 #define kw_nan3 385 #define kw_nan4 386 #define kw_nan5 387 #define kw_nan6 388 #define kw_nan7 389 #define kw_mnan1 390 #define kw_mnan2 391 #define kw_mnan3 392 #define kw_mnan4 393 #define kw_mnan5 394 #define kw_mnan6 395 #define kw_mnan7 396 #define kw_sub_map 397 #define kw_delay 398 #define kw_pack 399 #define kw_memo_fn 400 #define kw_memo_fun 401 #define kw_extern 402 #define kw_pragma 403 #define kw_sig 404 #define kw_signature 405 #define kw_structure 406 #define kw_sharing 407 #define kw_open 408 #define kw_openx 409 #define kw_include 410 #define kw_functor 411 #define kw_abstraction 412 #define kw_struct 413 #define kw_compile 414 extern YYSTYPE yylval; /* END himml.tab.h */ /* BEGIN input.h */ /* methods for reading: */ #define YY_INPUT_FILE 0 #define YY_INPUT_STDIN 1 #define YY_INPUT_STRING0 2 #define YY_INPUT_STRING 3 EXTERN int yy_input_device /*=YY_INPUT_STDIN by default*/; EXTERN CHAR *yyfilename; /* when yy_input_device is YY_INPUT_FILE or YY_INPUT_STDIN, the input file */ /* when yy_input_device==YY_INPUT_STRING, we use the following: */ EXTERN CHAR *yystring; EXTERN long yystrlen; EXTERN long yyoffset; /* END input.h */ /* BEGIN type.h */ IMPORT void TypePrint P((IN CONST ExprPtr type, IN printFunc doprint, INOUT char *printdata, IN CONST ExprPtr state)); EXTERN COUNTER crtab_maxlines; EXTERN ExprPtr maxLinesRef; IMPORT Boolean TypePretty P((IN CONST ExprPtr type, IN printFunc doprint, INOUT char *printdata, IN CONST ExprPtr state, IN COUNTER lmargin, IN COUNTER rmargin)); EXTERN ExprPtr basisAssum,basisState; EXTERN ExprPtr moduleName; EXTERN SymPtr stringsym,stringSym,intsym,intSym, listsym,listSym,arraysym,arraySym,iarraysym,iarraySym, refsym,refSym,funSym,mapSym,optsym,optSym,tablesym,tableSym, boolsym,boolSym,exnsym,exnSym,dynsym,dynSym, promisesym,promiseSym,ufindsym,ufindSym,contsym,contSym,unitsym, outstreamsym,instreamsym,writesym,readsym, readlinesym,flushsym,tellsym,seeksym,advancesym,seekendsym, suspendsym,truncatesym,convertsym,killsym,rematchsym,resubstsym, rematchfullsym,rematchpsym; EXTERN SymPtr alpha,alphaeq,_alpha,_alphaeq,beta,betaeq,_beta,gama,gamaeq; EXTERN SymPtr nilSym,consSym,derefSym,assignSym,forceSym, bindSym,matchSym,emptySym,mapgetSym, parsweepSym,nomemSym,nonsenseSym,catchSym, stackSym,incompSym,noninvSym,nthSym, rangeSym,asciiSym,stringnthSym, #ifdef OBSOLETE undefSym, #endif subscriptSym,arithSym,ioSym,reSym,ufindSym,futureSym, appendSym,dunionSym,overwriteSym, underwriteSym,interSym,identitySym, mergeSym,powerSym,throwSym,callccSym,mapappSym; EXTERN SymPtr falseSym,trueSym; EXTERN SymPtr ellSym,elleqSym,ellimpSym,elleqimpSym; #if IMPERATIVE_TYPES==EFFECT_TYVAR EXTERN ExprPtr fxInitSym,fxReadSym,fxWriteSym,fxExnSym,fxFromSym,fxGotoSym,fxTopSym; EXTERN ExprPtr rgnSym,effectSym; EXTERN ExprPtr pureGenFx,genRgn; EXTERN MapPtr autoDecorations,autoPatFx; #endif EXTERN ExprPtr stringType,intType,numType,boolType,exnType,powerType,dynType,timeType, iarrayType; EXTERN SymPtr itSym; EXTERN ExprPtr unitset; IMPORT ExprPtr tc P((ExprPtr expr,ExprPtr assum,ExprPtr state)); #define TC tc #define REST_TAG NIL /* types may be: E_VAR : type variables E_TYPE_APPL : application of a type name to a list of arguments E_EMPTY, E_MAPLET, E_MAP : record type (maps from symbols [or REST_TAG] to types) E_NUMTYPE : numerical type (in argument, a map from type variables or dimension types (TypeAppl(quan,NIL)) to non-zero exponents) E_CONS : cartesian products and in the EFFECT_TYVAR case, an APPLFUN (what is applied in an E_TYPE_APPL) may be not only a name (free or rigid), or a type function (a cons (header,type)), but also a: E_TYPEFX : (pointer to) sets of effects; all effects have the form name(region,args...), or are effect variables; second component is the real name of the type function (always constant). */ #define E_BIAS E_TUPLE_2 #define Kbias(a,b) Ktuple2(a,b) /* fnlevel : number of abstractions or delays above current expression (counted from toplevel) ids : map from variables (including constructors) to their types idlocs : map from variables to their zones idexts : map with the same structure as ids, expresses constraints on external vars (except that variables used but not defined are mapped to UNIT; see below for an explanation). cons : map from datatype constructors to their types. tyfcns : map from type identifiers to type functions (couples (tyhdr,type), where tyhdr=(tyvarseq,eqconds), and eqconds is a map from tyvars to an eqcond, that is a TDG involving type names and nonref vars whose truth implies that the corresponding tyvar can only be replaced by types that admit equality) tyexts : map with the same structure as tyfcns, expressing constraints on external datatypes or dimensions (as idexts with ids). structs : map from structure and functor identifiers to (name,assum) where name is a structure or functor name, and assum is the most general signature (or the coercing one) sigs : map from signature identifiers to assums representing signatures nongens : set of non-generic (free) type variables (and also free region and effect variables, as E_TYPEFX nodes, in the EFFECT_TYVAR case) units : map from unit identifiers to couples (scale,dimension type) scale = tuple2(coeff,map from unit names to exponents) tyvars : map from quantified explicit type variables to temporary non-generics. ids and idexts are used to record what variables are imported, exported, or simply used in a CaML-like module. A variable may be regular (defined, then possibly used), imported (declared extern, then used at least once, never redefined), or singular (declared extern, not used, not defined). By default, an extern variable is singular. Then, the status of a variable is determined by whether ids and idexts contain the id of this variable. singular: IDEXTS: x => type, not in IDS imported: IDEXTS: x => UNIT, IDS: x => type regular: not in IDEXTS, IDS: x => type tyfcns and tyexts are used to record the same thing on datatypes and dimensions (not their constructors, just the type names, arities, and so on). But there is no singular state, as an extern declaration serves as a definition, so singular is merged with imported. imported: TYEXTS: id => tyfcn, TYFCNS: id => tyfcn regular: not in TYEXTS, TYFCNS: id => tyfcn */ #define TA_REGULAR 0 #define TA_PRECOMPILE 1 #define A_NOEQ_DATATYPES (0x1) #define A_NOWARN_NOBIND (0x2) struct type_assum { CHAR kind; /* = TYPE_ASSUM_KIND */ CHAR mark; CHAR ta_kind; CHAR flags; COUNTER fnlevel; struct type_assum *next; ExprPtr ids; ExprPtr idlocs; ExprPtr idexts; ExprPtr cons; ExprPtr tyfcns; ExprPtr tyexts; #if MODULE_SYSTEM & STD_ML_MODULE ExprPtr structs; ExprPtr sigs; #endif ExprPtr nongens; ExprPtr units; ExprPtr tyvars; }; #if MODULE_SYSTEM & STD_ML_MODULE #define MAKE_ASSUM(fnlevel,ids,idlocs,idexts,cons,tyfcns,tyexts,structs,sigs,nongens,units,tyvars) \ MakeTypeAssum(fnlevel,ids,idlocs,idexts,cons,tyfcns,tyexts,structs,sigs,nongens,units,tyvars) #else #define MAKE_ASSUM(fnlevel,ids,idlocs,idexts,cons,tyfcns,tyexts,structs,sigs,nongens,units,tyvars) \ MakeTypeAssum(fnlevel,ids,idlocs,idexts,cons,tyfcns,tyexts,nongens,units,tyvars) #endif #define A_FNLEVEL(assum) ((struct type_assum *)assum)->fnlevel #define A_KIND(assum) ((struct type_assum *)assum)->ta_kind #define A_FLAGS(assum) ((struct type_assum *)assum)->flags #define A_IDS(assum) ((struct type_assum *)assum)->ids #define A_IDLOCS(assum) ((struct type_assum *)assum)->idlocs #define A_IDEXTS(assum) ((struct type_assum *)assum)->idexts #define A_CONS(assum) ((struct type_assum *)assum)->cons #define A_TYFCNS(assum) ((struct type_assum *)assum)->tyfcns #define A_TYEXTS(assum) ((struct type_assum *)assum)->tyexts #if MODULE_SYSTEM & STD_ML_MODULE #define A_STRUCTS(assum) ((struct type_assum *)assum)->structs #define A_SIGS(assum) ((struct type_assum *)assum)->sigs #else #define A_STRUCTS(assum) NIL #define A_SIGS(assum) NIL #endif #define A_NONGENS(assum) ((struct type_assum *)assum)->nongens #define A_UNITS(assum) ((struct type_assum *)assum)->units #define A_TYVARS(assum) ((struct type_assum *)assum)->tyvars /* tyvarsubs : substitution, mapping non-generic type variables to types conds : map f => set of (type1,type2), where f is the first flexible symbol of type1 and type1 is not trivial (a 2nd order pattern is appl(f,...) where f is flexible it is trivial if it is appl(f,x1,...,xn) where xi are generic and pairwise distinct) eqconds : TDG (as in noneqs) describing conjunction of mandatory equality conditions eqflags : map from type variables to TDGs describing if this variable admits equality (no entry means no equality, except if there are two quotes in the name of the variable) nexgen : next number for creating the next new generic variable noneqs : set of type names that don't preserve equality (actually map from propositional variables to TDGs [except trueValue] with, as propositional variables: - type names [meaning: this type name respects equality] - shared E_REF(type name) [meaning: this type name is *not* a 'ref' or an 'array']) tycons : map from type names to couples (tyhdr,cons) for datatype type names, or to the default unit identifier for a dimension, or from unit names to scales, or from structure names to structure signatures, or from functor names to functor signatures. packers : map from abstract syntax expressions (only for dynamics) to the types of packed things, coded as a tree of maplets (this is because maps may only have ExprPtrs in their domains, and because it will be clear that there is no repetition) annotations : map from abstract syntax expressions to their types, coded as a tree of maplets (same reason as for packers). Not all expressions are annotated, only those needed by the debugger or the compiler. nongens : set of (imperative) type variables that have not been generalized */ struct type_state { CHAR kind; /* = TYPE_STATE_KIND */ CHAR mark; struct type_state *next; ExprPtr conds; ExprPtr eqconds; ExprPtr eqflags; COUNTER nexgen; ExprPtr noneqs; ExprPtr tycons; ExprPtr packers; ExprPtr annotations; MapPtr nongens; #if IMPERATIVE_TYPES==STD_ML_NJ_TYVAR MapPtr strength,maxstrength; #endif ExprPtr tyvarsubs,tyvarsubcache; }; #if IMPERATIVE_TYPES==STD_ML_NJ_TYVAR #define MAKE_STATE(conds,eqconds,eqflags,nexgen,noneqs,tycons,packers,annotations,nongens,strength,maxstrength) \ MakeTypeState(conds,eqconds,eqflags,nexgen,noneqs,tycons,packers,annotations,nongens,strength,maxstrength) #else #define MAKE_STATE(conds,eqconds,eqflags,nexgen,noneqs,tycons,packers,annotations,nongens) \ MakeTypeState(conds,eqconds,eqflags,nexgen,noneqs,tycons,packers,annotations,nongens) #endif #define S_TYVARSUBS(state) ((struct type_state *)state)->tyvarsubs #define S_TYVARSUBCACHE(state) ((struct type_state *)state)->tyvarsubcache #define S_CONDS(state) ((struct type_state *)state)->conds #define S_EQCONDS(state) ((struct type_state *)state)->eqconds #define S_EQFLAGS(state) ((struct type_state *)state)->eqflags #define S_NEXGEN(state) ((struct type_state *)state)->nexgen #define S_NONEQS(state) ((struct type_state *)state)->noneqs #define S_TYCONS(state) ((struct type_state *)state)->tycons #define S_PACKERS(state) ((struct type_state *)state)->packers #define S_ANNOTATIONS(state) ((struct type_state *)state)->annotations #define S_NONGENS(state) ((struct type_state *)state)->nongens #if IMPERATIVE_TYPES==STD_ML_NJ_TYVAR #define S_STRENGTH(state) ((struct type_state *)state)->strength #define S_MAXSTRENGTH(state) ((struct type_state *)state)->maxstrength #endif #if MODULE_SYSTEM & STD_ML_MODULE IMPORT ExprPtr MakeTypeAssum P((COUNTER fnlevel,ExprPtr ids,ExprPtr idlocs, ExprPtr idexts,ExprPtr cons,ExprPtr tyfcns, ExprPtr tyexts, ExprPtr structs,ExprPtr sigs, ExprPtr nongens,ExprPtr units,ExprPtr tyvars)); #else IMPORT ExprPtr MakeTypeAssum P((COUNTER fnlevel,ExprPtr ids,ExprPtr idlocs, ExprPtr idexts,ExprPtr cons,ExprPtr tyfcns, ExprPtr tyexts, ExprPtr nongens,ExprPtr units,ExprPtr tyvars)); #endif IMPORT ExprPtr NewTypeAssum P((void)); IMPORT ExprPtr DupTypeAssum P((IN CONST ExprPtr assum)); IMPORT void AddTypeAssum P((IN CONST ExprPtr assum,IN CONST ExprPtr new)); #if IMPERATIVE_TYPES==STD_ML_NJ_TYVAR IMPORT ExprPtr MakeTypeState P((ExprPtr conds,ExprPtr eqconds,ExprPtr eqflags, COUNTER nexgen,ExprPtr noneqs,ExprPtr tycons,MapPtr packers, MapPtr annotations,MapPtr nongens, MapPtr strength,MapPtr maxstrength )); #else IMPORT ExprPtr MakeTypeState P((ExprPtr conds,ExprPtr eqconds,ExprPtr eqflags, COUNTER nexgen,ExprPtr noneqs,ExprPtr tycons,ExprPtr packers, ExprPtr annotations,MapPtr nongens )); #endif IMPORT ExprPtr NewTypeState P((void)); IMPORT ExprPtr DupTypeState P((IN CONST ExprPtr state)); IMPORT void overwriteTypeState P((INOUT ExprPtr newstate,IN CONST ExprPtr state)); #if IMPERATIVE_TYPES==EFFECT_TYVAR IMPORT void resetFx P((void)); IMPORT ExprPtr fxRealSigma P((IN CONST ExprPtr sigma,IN CONST ExprPtr state)); IMPORT ExprPtr freshFxVar P((IN CONST MapPtr constr,IN CONST ExprPtr sort,INOUT ExprPtr assum,INOUT ExprPtr state)); IMPORT ExprPtr funTypeFx P((IN CONST ExprPtr a,IN CONST ExprPtr b,IN CONST ExprPtr sigma)); IMPORT ExprPtr promiseTypeFx P((IN CONST ExprPtr a,IN CONST ExprPtr sigma)); IMPORT ExprPtr exnTypeFx P((IN CONST ExprPtr rho)); IMPORT ExprPtr initFx P((IN CONST ExprPtr rho,IN CONST ExprPtr type)); IMPORT ExprPtr exnFx P((IN CONST ExprPtr rho,IN CONST ExprPtr type)); IMPORT ExprPtr fromFx P((IN CONST ExprPtr rho)); IMPORT ExprPtr gotoFx P((IN CONST ExprPtr rho)); IMPORT ExprPtr readFx P((IN CONST ExprPtr rho)); IMPORT ExprPtr writeFx P((IN CONST ExprPtr rho)); #define fxSym(f) (((f)->kind==(CHAR)E_TYPEFX)?CAR(f):(f)) IMPORT void addTopFx P((INOUT ExprPtr type,INOUT ExprPtr assum,IN CONST ExprPtr state)); IMPORT MapPtr obsFx P((IN CONST MapPtr constr,IN CONST MapPtr vars,IN CONST ExprPtr state)); IMPORT MapPtr convertPatFx P((IN CONST MapPtr fx)); #else #define resetFx() #define funTypeFx(a,b,sigma) funType(a,b) IMPORT ExprPtr promiseType P((IN CONST ExprPtr a)); #define promiseTypeFx(a,sigma) promiseType(a) #define fxSym(f) f #endif IMPORT ExprPtr coupleType P((IN CONST ExprPtr a,IN CONST ExprPtr b)); IMPORT ExprPtr funType P((IN CONST ExprPtr a,IN CONST ExprPtr b)); IMPORT ExprPtr mapType P((IN CONST ExprPtr a,IN CONST ExprPtr b)); #define setType(a) mapType(a,NIL) IMPORT ExprPtr listType P((IN CONST ExprPtr a)); IMPORT Boolean genericp P((ExprPtr tyvar,ExprPtr assum)); #define rigidp(name,assum) genericp(name,assum) /* attribute flags */ #define F_EQ 1 #if IMPERATIVE_TYPES!=EFFECT_TYVAR #define F_IMP 2 #endif #define F_NUM 4 #define IN_FLAGS(f1,f2) (((f1) & ~(f2))==0) #if IMPERATIVE_TYPES==STD_ML_NJ_TYVAR # define INF_STRENGTH MAX_SIGNED_LONG #endif IMPORT void getNumber P((IN COUNTER n,OUT CHAR *buf)); IMPORT int varFlags P((SymPtr tyvar)); IMPORT ExprPtr varEqTdg P((ExprPtr var,ExprPtr state)); #if IMPERATIVE_TYPES==STD_ML_NJ_TYVAR IMPORT INT naturalStrength P((SymPtr tyvar)); IMPORT INT tyvarStrength P((SymPtr tyvar,ExprPtr state)); IMPORT INT tyvarMaxStrength P((SymPtr tyvar,ExprPtr state)); #endif IMPORT SymPtr freshInstfromFlags #if IMPERATIVE_TYPES==STD_ML_NJ_TYVAR P((SHORT flags,ExprPtr eqtdg,ExprPtr assum,ExprPtr state,IN INT strength,IN INT maxstrength)); #else P((SHORT flags,ExprPtr eqtdg,ExprPtr assum,ExprPtr state)); #endif IMPORT SymPtr _freshInstfromFlags #if IMPERATIVE_TYPES==STD_ML_NJ_TYVAR P((SHORT flags,ExprPtr eqtdg,ExprPtr assum,ExprPtr state,IN INT strength,IN INT maxstrength)); #else P((SHORT flags,ExprPtr eqtdg,ExprPtr assum,ExprPtr state)); #endif IMPORT ExprPtr nongenValue P((IN CONST ExprPtr tyvar,IN CONST ExprPtr state,OUT Boolean *foundp)); #define setNongenValue(typevar,val,state) setMapPut(typevar,val,&S_TYVARSUBCACHE(state)) IMPORT ExprPtr _nongenValue P((SymPtr typevar,ExprPtr state)); IMPORT void flushTyVarSubCache P((INOUT ExprPtr state)); #if IMPERATIVE_TYPES==EFFECT_TYVAR IMPORT ExprPtr newTypeInst P((ExprPtr type,ExprPtr assum,ExprPtr state)); IMPORT ExprPtr newTypeInst1 P((ExprPtr type,ExprPtr assum,ExprPtr state,INOUT MapPtr *rename)); #define developType(type,state) newTypeInst(type,NIL,state) #else IMPORT ExprPtr newTypeInst P((ExprPtr type,ExprPtr assum,ExprPtr state,Boolean noimpp)); IMPORT ExprPtr newTypeInst1 P((ExprPtr type,ExprPtr assum,ExprPtr state,Boolean noimpp,INOUT MapPtr *rename)); #define developType(type,state) newTypeInst(type,NIL,state,false) #endif IMPORT ExprPtr eqTypeTdg P((ExprPtr type,ExprPtr state,Boolean eqp)); #if IMPERATIVE_TYPES==STD_ML_TYVAR IMPORT Boolean impTypep P((ExprPtr type,ExprPtr state)); #endif #if IMPERATIVE_TYPES==STD_ML_NJ_TYVAR IMPORT Boolean impTypep P((ExprPtr type,ExprPtr state,INT strength)); #endif IMPORT Boolean numTypep P((ExprPtr type,ExprPtr state)); IMPORT MapPtr typeMul1 P((MapPtr map1,MapPtr map2)); IMPORT MapPtr typePower1 P((MapPtr map,ExprPtr exp)); IMPORT ExprPtr typeMul P((IN CONST TZone *zone1,IN CONST TZone *zone2,IN CONST ExprPtr type1,IN CONST ExprPtr type2,IN CONST ExprPtr state)); IMPORT ExprPtr typePower P((IN CONST TZone *zone,IN CONST ExprPtr type,IN CONST ExprPtr exp,IN CONST ExprPtr state)); IMPORT ExprPtr scaleMul P((IN CONST ExprPtr scale1,IN CONST ExprPtr scale2)); IMPORT ExprPtr scalePower P((IN CONST ExprPtr scale,IN CONST ExprPtr exp)); IMPORT ExprPtr instScale P((IN CONST ExprPtr scale,IN CONST ExprPtr state)); IMPORT MapPtr instNumType P((MapPtr map,MapPtr subst,ExprPtr state,OUT Boolean *finep)); IMPORT void incompatibleTypes P((IN CONST TZone *zone, IN CONST ExprPtr type1,IN CONST ExprPtr type2, IN CONST CHAR *msg1, IN CONST CHAR *msg2, INOUT ExprPtr assum,INOUT ExprPtr state)); IMPORT void typeError P((TZone *zone,CHAR *msg,ExprPtr type,ExprPtr state)); IMPORT char *varMsg P((IN CONST char *msg,IN CONST SymPtr var)); IMPORT char *nameMsg P((IN CONST char *msg,IN CONST SymPtr var)); IMPORT MapPtr overrideMapType P((IN CONST MapPtr type1,IN CONST MapPtr type2, IN CONST ExprPtr assum,IN CONST ExprPtr state)); IMPORT void coerceFlagTypes #if IMPERATIVE_TYPES==STD_ML_NJ_TYVAR P((TZone *zone,int flags,ExprPtr eqtdg,INT strength,INT maxstrength,ExprPtr type,ExprPtr assum,ExprPtr state)); #else P((TZone *zone,int flags,ExprPtr eqtdg,ExprPtr type,ExprPtr assum,ExprPtr state)); #endif IMPORT void coerceTyFcn P((IN CONST TZone *zone,IN CONST ExprPtr tyfcn1,IN CONST ExprPtr tyfcn2,INOUT ExprPtr assum,INOUT ExprPtr state)); #if IMPERATIVE_TYPES==STD_ML_NJ_TYVAR IMPORT ExprPtr Weaken P((ExprPtr type,ExprPtr assum,ExprPtr state,INT delta)); #endif IMPORT void coerceScales P((IN CONST TZone *zone,IN CONST ExprPtr scale1,IN CONST ExprPtr scale2,INOUT ExprPtr assum,INOUT ExprPtr state)); IMPORT MapPtr getTypeSubst P((TZone *zone,ExprPtr tyhdr,ExprPtr args,ExprPtr assum,ExprPtr state)); IMPORT ExprPtr typeSubst P((TZone *zone,IN CONST ExprPtr type,IN CONST MapPtr subst,IN CONST ExprPtr assum,INOUT ExprPtr state)); IMPORT void maximizeEquality P((IN CONST MapPtr tycons,IN CONST MapPtr tyfcns,INOUT ExprPtr state,IN CONST MapPtr sureeq,IN CONST MapPtr spec,IN Boolean noeq,IN CONST TZone *zone)); IMPORT SymPtr freshTyName P((IN CONST SymPtr name,IN CONST ExprPtr assum,INOUT ExprPtr state)); IMPORT SymPtr copyTyName P((IN CONST SymPtr name,INOUT ExprPtr state)); IMPORT MapPtr InitAbsEq P((IN CONST MapPtr tyfcns,IN CONST ExprPtr state)); IMPORT ExprPtr funEqTdg P((IN CONST SymPtr f,IN CONST ExprPtr state)); IMPORT ExprPtr funNotRefTdg P((IN CONST SymPtr f,IN CONST ExprPtr state)); IMPORT ExprPtr realName P((IN CONST SymPtr name,IN CONST ExprPtr state)); IMPORT ExprPtr applFun P((IN CONST ExprPtr type,IN CONST ExprPtr state)); IMPORT ExprPtr correctTypeAppl P((IN CONST ExprPtr type,IN CONST ExprPtr state)); IMPORT MapPtr getSubst1 P((IN CONST ExprPtr varlist,IN CONST ExprPtr arglist)); IMPORT SymPtr getCarTyName P((IN CONST SymPtr name,INOUT ExprPtr state)); IMPORT SymPtr getCdrTyName P((IN CONST SymPtr name,INOUT ExprPtr state)); IMPORT ExprPtr getTyHdr P((IN CONST ExprPtr tyvarseq,IN CONST ExprPtr xx,IN CONST ExprPtr state)); IMPORT void getTyHdrSubsts P((IN CONST ExprPtr tyhdr1,IN CONST ExprPtr tyhdr2,OUT MapPtr *s1p,OUT MapPtr *s2p,INOUT ExprPtr state)); #if IMPERATIVE_TYPES==STD_ML_TYVAR IMPORT Boolean expansivep P((IN CONST ExprPtr expr)); #endif IMPORT MapPtr valTyVars P((IN CONST ExprPtr tyvarlist,INOUT ExprPtr assum,INOUT ExprPtr state)); IMPORT MapPtr tyVars #if IMPERATIVE_TYPES==STD_ML_NJ_TYVAR P((IN CONST ExprPtr type, IN CONST ExprPtr assum,IN CONST ExprPtr state, SHORT flags,INT strength,INOUT ExprPtr memoref)); #else P((IN CONST ExprPtr type, IN CONST ExprPtr assum,IN CONST ExprPtr state, SHORT flags,INOUT ExprPtr memoref)); #endif IMPORT MapPtr unquant_x P((IN CONST MapPtr exps, IN CONST ExprPtr assum,IN CONST ExprPtr state, INOUT ExprPtr memoref)); #if IMPERATIVE_TYPES!=EFFECT_TYVAR IMPORT MapPtr unquant_y P((IN CONST MapPtr exps, IN CONST ExprPtr assum,IN CONST ExprPtr state, INOUT ExprPtr memoref)); #endif IMPORT MapPtr unquant_packers P((IN CONST ExprPtr assum, IN CONST ExprPtr state,INOUT ExprPtr memoref)); #if IMPERATIVE_TYPES==STD_ML_NJ_TYVAR IMPORT MapPtr getStrengths P((IN CONST MapPtr tyvars,IN CONST ExprPtr state)); IMPORT void setStrengths P((IN CONST MapPtr tyvars,INOUT ExprPtr state,IN INT strength)); IMPORT void checkStrengths P((IN CONST TZone *zone,IN CONST MapPtr tyvars,IN CONST ExprPtr state)); #endif IMPORT ExprPtr checkExplicits P((IN CONST TZone *zone,IN CONST MapPtr tyvarmap,IN CONST ExprPtr assum,IN CONST ExprPtr state)); IMPORT MapPtr getSureeq P((IN CONST ExprPtr eqlist)); IMPORT void addPacker P((IN CONST ExprPtr expr,IN CONST ExprPtr type,IN COUNTER fnlevel,INOUT ExprPtr state)); IMPORT void addAnnotation1 P((IN CONST ExprPtr expr,IN CONST ExprPtr type,IN COUNTER fnlevel,IN CONST ExprPtr sharingp,INOUT ExprPtr state)); IMPORT void addAnnotation P((IN CONST ExprPtr expr,IN CONST ExprPtr type,IN COUNTER fnlevel,INOUT ExprPtr state)); #define TDG_OR_HASH_SIZE 137 #define TDG_EQUIV_HASH_SIZE 37 EXTERN ExprPtr tdgOrHashTable,tdgEquivHashTable; IMPORT Boolean tdgVarLess P((IN CONST ExprPtr x,IN CONST ExprPtr y)); IMPORT ExprPtr tdgNot P((IN CONST ExprPtr t)); IMPORT ExprPtr nameToTdg P((IN CONST ExprPtr x)); IMPORT ExprPtr tdgOr P((IN CONST ExprPtr t1,IN CONST ExprPtr t2)); IMPORT ExprPtr tdgAnd P((IN CONST ExprPtr t1,IN CONST ExprPtr t2)); IMPORT ExprPtr tdgImply P((IN CONST ExprPtr t1,IN CONST ExprPtr t2)); IMPORT ExprPtr tdgEquiv P((IN CONST ExprPtr t1,IN CONST ExprPtr t2)); IMPORT ExprPtr tdgInst P((IN CONST ExprPtr t,IN CONST ExprPtr subst,IN Boolean defselfp)); IMPORT ExprPtr tdgGetEquivVar P((IN CONST ExprPtr t)); IMPORT Boolean unify1 P((IN CONST ExprPtr type1,IN CONST ExprPtr type2, INOUT ExprPtr assum,INOUT ExprPtr state,IN Boolean higherp)); #define TYPE_HASH_SIZE 137 #define TYPE_HASH(t) (((unsigned long)t) % TYPE_HASH_SIZE) IMPORT ExprPtr newMemoRef P((void)); #if MODULE_SYSTEM & STD_ML_MODULE /* A signature is a type_assum, summing up all declarations in the sig, with nongens=the set of all type, structure, signature and functor names in the sig. A signature is not completely specified, and all conditions on names and bindings of names are held in the current state. A structure is coded as a signature, too, with nongens containing no type, structure, signature or functor names. A functor is a triple (locals,sig,struct), where locals are the flexible names in sig. A functor signature is a couple (locals,sig,sig). */ #define TYPE_FUNCTOR_KIND E_TUPLE_GNRL #define FUNCTOR_LOCALS(f) AVAL(f)->expr[0] #define FUNCTOR_IN(f) AVAL(f)->expr[1] #define FUNCTOR_OUT(f) AVAL(f)->expr[2] IMPORT ExprPtr makeFunctor P((IN CONST MapPtr locals,IN CONST ExprPtr in,IN CONST ExprPtr out)); #define MAKE_FUNCTOR(locals,in,out) MakeLet(in,out) IMPORT Boolean setTyFcn P((IN CONST ExprPtr f,IN CONST ExprPtr tyfcn, IN CONST ExprPtr assum,INOUT ExprPtr state)); IMPORT Boolean recoverUnify2 P((IN CONST ExprPtr type1,IN CONST ExprPtr type2, IN CONST ExprPtr assum,INOUT ExprPtr state)); IMPORT ExprPtr instSig P((IN CONST ExprPtr sig,IN CONST ExprPtr state)); IMPORT void getLongStruct P((IN CONST TZone *zone,IN CONST ExprPtr path,INOUT ExprPtr *assump,IN CONST ExprPtr state)); IMPORT Boolean unify2 P((IN CONST ExprPtr type1,IN CONST ExprPtr type2,IN CONST ExprPtr assum,INOUT ExprPtr state)); #else #define getLongStruct(zone,path,assump,state) #endif #ifdef OLDEXT IMPORT void checkExports P((IN CONST TZone *zone,IN CONST ExprPtr assum1, IN CONST ExprPtr assum2)); #endif /* END type.h */ /* BEGIN abssyn.h */ /* codes for abstract syntax. Certain conditions should hold: - for every *_OF, *_MAP should be *_OF+1 */ #define A_STRING 0 #define A_NUMBER 1 #define A_VARIABLE 2 #define A_UNIT_POWER 3 #define A_UNIT_STAR 4 #define A_SET_UNIT 5 #define A_LABEL 6 #define A_RECORD_MAPLET 7 #define A_RECORD 8 #define A_CODEPOINT 9 #define A_TUPLE 10 #define A_PROGN 11 #define A_LIST 12 #define A_LIST_OF 13 #define A_LIST_MAP 14 #define A_IN_SET 15 #define A_IN_LIST 16 #define A_MAPLET 17 #define A_MAP 18 #define A_MAP_OF 19 #define A_MAP_MAP 20 #define A_MAP_UNDER 21 #define A_MAP_UNDER_OF 22 #define A_MAP_UNDER_MAP 23 #define A_PROG_OF 24 #define A_PROG_MAP 25 #define A_ALL_OF 26 #define A_ALL_MAP 27 #define A_EXISTS_OF 28 #define A_EXISTS_MAP 29 #define A_SOME_OF 30 #define A_SOME_MAP 31 #define A_LET 32 #define A_APPLY 33 #define A_CAST 34 #define A_AND 35 #define A_OR 36 #define A_HANDLE 37 #define A_RAISE 38 #define A_FN 39 #define A_LAMBDA 40 #define A_IF 41 #define A_WHILE 42 #define A_WHILE_LIST 43 #define A_WHILE_MAP 44 #define A_WHILE_MAP_UNDER 45 #define A_WHILE_ALL 46 #define A_WHILE_EXISTS 47 #define A_WHILE_SOME 48 #define A_DECL_LIST 49 #define A_LOCAL 50 #define A_VAL 51 #define A_VALREC 52 #define A_BIND 53 #define A_PAT_TUPLE 54 #define A_QUANTITY 55 #define A_NEWQUAN 56 #define A_UNIT 57 #define A_NEWUNIT 58 #define A_TYPE 59 #define A_TYPE_BIND 60 #define A_DATATYPE 61 #define A_DATATYPE_BIND 62 #define A_ABSTYPE 63 #define A_TYPE_VAR_SEQ 64 #define A_CONSTRUCTOR 65 #define A_EXCEPTION 66 #define A_NEWEXC 67 #define A_EXC_BIND 68 #define A_MAPLET_TYPE 69 #define A_RECORD_TYPE 70 #define A_TYPE_APPLY 71 #define A_TYPE_POWER 72 #define A_TYPE_STAR 73 #define A_TUPLE_TYPE 74 #define A_FUNCTION_TYPE 75 #define A_MAP_TYPE 76 #define A_PAT_ANY 77 #define A_PAT_RECORD_ELLIPSIS 78 #define A_PAT_TUPLE_ELLIPSIS 79 #define A_PAT_RECORD_MAPLET 80 #define A_PAT_RECORD 81 #define A_PAT_AS 82 #define A_PAT_CAST 83 #define A_PAT_NIL 84 #define A_PAT_ANYLIST 85 #define A_PAT_APPLY 86 #define A_PAT_EMPTY 87 #define A_PAT_ANYMAP 88 #define A_PAT_MAPLET 89 #define A_PAT_MAPADD 90 #define A_PRIME_DATABIND 91 #define A_UNIT_NAME 92 #define A_TYPE_VAR 93 #define A_REAL_VAR 94 #define A_PAT_VAR 95 #define A_PAT_CONST 96 #define A_SELECT_FN 97 #define A_MATCH 98 #define A_MU 99 #define A_SUB_MAP 100 #define A_DELAY 101 #define A_NONSENSE 102 #define A_PACK 103 #define A_PAT_PACK 104 #define A_INTEGER 105 #define A_TYPE_ELLIPSIS 106 #define A_EXT_DATATYPE 107 #define A_EXT_EQTYPE 108 #define A_EXT_QUANTITY 109 #define A_EXT_VAL 110 #define A_MEMO_FN 111 #define A_CONS_INFO 112 #define A_EQTYPE_INFO 113 #define A_EXT_EXC 114 #define A_BASIS 115 #define A_ENTER_FILE 116 #define A_EXIT_FILE 117 #define A_PRAGMA 118 #define A_FUNBIND 119 #define A_MODULES 120 #define A_SIG (A_MODULES+0) #define A_LOCAL_SPEC (A_MODULES+1) #define A_VAL_SPEC (A_MODULES+2) #define A_VAL_BIND_SPEC (A_MODULES+3) #define A_TYPE_SPEC (A_MODULES+4) #define A_EQTYPE_SPEC (A_MODULES+5) #define A_NUMTYPE_SPEC (A_MODULES+6) #define A_TYPE_BIND_SPEC (A_MODULES+7) #define A_DATATYPE_DESC (A_MODULES+8) /*#define A_EXCEPTION_DESC (A_MODULES+9) FREE */ /*#define A_NEWEXC_DESC (A_MODULES+10) FREE */ #define A_STRUCT_DESC (A_MODULES+11) #define A_STRUCT_BIND_DESC (A_MODULES+12) #define A_SHARING_DESC (A_MODULES+13) #define A_STRUCT_SHARE_DESC (A_MODULES+14) #define A_TYPE_SHARE_DESC (A_MODULES+15) #define A_FUNCTOR_DESC (A_MODULES+16) #define A_FUNCTOR_BIND_DESC (A_MODULES+17) #define A_OPEN_DESC (A_MODULES+18) #define A_UNIT_SPEC (A_MODULES+19) #define A_INCLUDE_DESC (A_MODULES+20) #define A_SIG_BIND (A_MODULES+21) #define A_SIG_DECL (A_MODULES+22) #define A_OPEN_DECL (A_MODULES+23) #define A_STRUCT_DECL (A_MODULES+24) #define A_STRUCT_BIND (A_MODULES+25) #define A_STRUCT_CAST (A_MODULES+26) #define A_FUNCTOR_APPLY (A_MODULES+27) #define A_LET_STRUCT (A_MODULES+28) #define A_FUNCTOR_DECL (A_MODULES+29) #define A_FUNCTOR_BIND (A_MODULES+30) IMPORT ExprPtr tc P((INOUT ExprPtr expr,INOUT ExprPtr assum,INOUT ExprPtr state)); /* END abssyn.h */ /* BEGIN transfer.h */ #define CROSS_DEF 0xff #define CROSS_REF 0xfe #define SHORT_CROSS_DEF 0xfd #define SHORT_CROSS_REF 0xfc IMPORT void markData P((INOUT ExprPtr e)); EXTERN void (*markDataHook) P((INOUT ExprPtr e)); IMPORT void unmarkBucketLists P((void)); IMPORT void outChars P((IN CONST CHAR *s,IN COUNTER len)); IMPORT void inChars P((OUT CHAR *s,IN COUNTER len)); IMPORT void outInt P((IN INT n)); IMPORT INT inInt P((void)); IMPORT void outShort P((IN SHORT n)); IMPORT SHORT inShort P((void)); IMPORT void outInts P((IN CONST INT *p, IN INT n)); IMPORT void inInts P((INOUT INT *p, IN INT n)); IMPORT void outShorts P((IN CONST SHORT *p, IN INT n)); IMPORT void inShorts P((INOUT SHORT *p, IN INT n)); IMPORT void outReal P((IN REAL *x)); IMPORT void inReal P((OUT REAL *x)); IMPORT void outTransfer P((IN CONST ExprPtr e,IN printFunc doprint, INOUT char *printdata,IN Boolean sortmaps)); IMPORT ExprPtr inTransfer P((IN readFunc doread,INOUT char *readdata)); /* END transfer.h */ /* BEGIN evlproto.h */ IMPORT void InitEval P((void)); IMPORT Boolean EvalBindingsRC P((IN CONST ExprPtr bindings,INOUT ExprPtr env,IN COUNTER from,IN COUNTER to)); IMPORT Boolean EvalBindingsRCIt P((IN CONST ExprPtr bindings,INOUT ExprPtr env,IN COUNTER from,IN COUNTER to)); DECL_ACTION(datacon_shared) #if PROFILING & PROFILING_PROPER_TIMES IMPORT void syncProfProper P((IN CONST ExprPtr save)); #endif /* END evlproto.h */ /* BEGIN errproto.h */ IMPORT void type_warn P((IN CONST TZone *zone,IN CONST CHAR *msg)); IMPORT void type_soft_error P((IN CONST TZone *zone,IN CONST CHAR *msg)); IMPORT NORETURN void type_error P((IN CONST TZone *zone,IN CONST CHAR *msg)) _NORETURN; IMPORT NORETURN void ml_done P((int code)) _NORETURN; IMPORT void ml_break P((int code)); IMPORT void ml_fpe P((int code)); IMPORT NORETURN void kinderror P((IN CONST char *name,IN CHAR kind)) _NORETURN; IMPORT NORETURN void crash_error P((IN CONST TZone *zone,IN CONST CHAR *msg)) _NORETURN; IMPORT NORETURN ExprPtr Error P((ExprPtr exception)) _NORETURN; IMPORT NORETURN void yy_error P((IN int l1,IN int c1,IN int l2,IN int c2, IN CONST char *msg)) _NORETURN; IMPORT void printZone P((IN CONST CHAR *filename,IN CONST TZone *zone,INOUT hFILE *out, IN Boolean trailingp)); /* END errproto.h */ /* BEGIN grmproto.h */ #ifndef YYLTYPE typedef struct yyltype { int first_line; int first_column; int last_line; int last_column; char *text; } yyltype; #define YYLTYPE yyltype #endif IMPORT ExprPtr ZBuild P((IN CONST TZone *zone,IN COUNTER f,IN CONST ExprPtr info)); IMPORT ExprPtr getString P((IN CONST struct yyltype *start, IN CONST struct yyltype *end, IN CHAR *text,IN Boolean build)); IMPORT void add_path P((char *name,int len)); IMPORT hFILE *xfopen P((char *name,char *mode,char **realname)); IMPORT int yyparse P((void)); IMPORT void InitLex P((void)); IMPORT void InitGram P((void)); IMPORT int yylex P((void)); IMPORT int skipOrwhen P((void)); IMPORT int skipOtherwise P((void)); IMPORT void skipThen P((void)); IMPORT void setConstructor P((IN CONST ExprPtr name)); IMPORT void popEnv P((void)); IMPORT void pushEnv P((void)); IMPORT ExprPtr copyLexEnv P((void)); IMPORT ExprPtr copyConsEnv P((void)); #if MODULE_SYSTEM & STD_ML_MODULE IMPORT ExprPtr copyStrEnv P((void)); IMPORT ExprPtr copySigEnv P((void)); #endif IMPORT int HimMLParse P((void)); IMPORT int HimMLCompile P((void)); IMPORT void StoreInitialBasis P((void)); /* END grmproto.h */ /* BEGIN expproto.h */ IMPORT void installGrowFactor P((double *grow)); IMPORT void installMaxGrowFactor P((double *grow)); IMPORT void InitExprs P((void)); /* END expproto.h */ /* BEGIN stkproto.h */ typedef CONST void (*mlAction) P((INOUT char *data)); IMPORT void doML P((IN mlAction fun,INOUT char *data)); typedef NORETURN void (*loweredStackAction) P((char *data)); IMPORT NORETURN void InitStack P((loweredStackAction fun,char *data)) _NORETURN; IMPORT NORETURN void EndStack P((int n)) _NORETURN; IMPORT void setHandlerStack P((IN CONST excHandler *stack)); IMPORT void resetHandlerStack P((void)); IMPORT void stackChunkFree P((INOUT StackChunk *chunk)); IMPORT void lockThread P((IN CONST stackMark *mark)); IMPORT void unlockThread P((IN CONST stackMark *mark)); /* END stkproto.h */ /* BEGIN prtproto.h */ IMPORT void realPrint P((IN CONST REAL *x, IN printFunc doprint, INOUT char *printdata)); IMPORT void do_printfile P((IN CONST CHAR *text,IN COUNTER len,INOUT char *stream)); /* actually, stream is an hFILE * */ IMPORT void valPrint P((IN CONST ExprPtr val, IN CONST ExprPtr type, IN printFunc doprint, INOUT char *printdata, IN COUNTER pri)); IMPORT void endPretty P((IN printFunc doprint,INOUT char *printdata)); IMPORT Boolean valPretty P((IN CONST ExprPtr val, IN CONST ExprPtr type, IN printFunc doprint, INOUT char *printdata, IN COUNTER pri, IN COUNTER lmargin, IN COUNTER rmargin)); IMPORT void valPrintNoType P((IN CONST ExprPtr val, IN printFunc doprint, INOUT char *printdata, IN COUNTER pri)); IMPORT void valsPrint P((IN CONST ExprPtr assum, IN CONST printFunc doprint, INOUT VOIDPTR printdata)); IMPORT void TypePrint P((IN CONST ExprPtr type, IN printFunc doprint, INOUT char *printdata, IN CONST ExprPtr state)); IMPORT Boolean TypePretty P((IN CONST ExprPtr type, IN printFunc doprint, INOUT char *printdata, IN CONST ExprPtr state, IN COUNTER lmargin, IN COUNTER rmargin)); IMPORT Boolean typeEnvPrint P((IN CONST ExprPtr assum, IN CONST printFunc doprint, INOUT VOIDPTR printdata, IN CONST ExprPtr state)); IMPORT void dynPrint P((IN CONST ExprPtr val, IN printFunc doprint,INOUT char *printdata, IN COUNTER pri)); IMPORT Boolean dynPretty P((IN CONST ExprPtr val, IN printFunc doprint,INOUT char *printdata, IN COUNTER lmargin,IN COUNTER rmargin)); EXTERN ExprPtr rightMarginRef; IMPORT ExprPtr getValueByName P((IN CONST ExprPtr name,OUT Boolean *foundp, IN CONST ExprPtr env)); IMPORT ExprPtr getTypeInExn P((IN CONST ExprPtr exc)); /* END prtproto.h */ /* BEGIN iniproto.h */ typedef NORETURN void (*mainAction) P((int argc,char **argv)) _NORETURN; IMPORT NORETURN void InitML P((mainAction main,int argc,char **argv)) _NORETURN; #if TRANSLATOR IMPORT void InitBC P((void)); #endif #if DEBUGGING IMPORT void InitDebug P((void)); #endif IMPORT void InitHlex P((void)); IMPORT void InitHyacc P((void)); IMPORT void InitLIP P((void)); /* END iniproto.h */ /* BEGIN dirproto.h */ IMPORT struct Expression *listDir P((IN CONST CHAR *dirname)); IMPORT int changeDir P((IN CONST CHAR *dirname)); IMPORT CHAR *getDir P((INOUT CHAR *buf,IN COUNTER size)); IMPORT int rmDir P((IN CONST CHAR *dirname)); IMPORT int makeDir P((IN CONST CHAR *dirname)); IMPORT char *ioerrormsg P((IN COUNTER code)); IMPORT struct Expression *ioErrorMsg P((IN COUNTER code)); IMPORT struct Expression *fileBits P((IN CONST CHAR *name)); /* END dirproto.h */ /* BEGIN cmpproto.h */ IMPORT MapPtr TyTags P((IN CONST ExprPtr table)); IMPORT MapPtr IdLocs P((IN CONST ExprPtr table)); IMPORT void InitCompile P((void)); IMPORT ExprPtr NewCompAssum P((void)); IMPORT ExprPtr cp P((IN CONST ExprPtr syntax,INOUT ExprPtr table)); IMPORT void addVal P((IN CONST ExprPtr name,IN CONST ExprPtr val, IN CONST ExprPtr xcon)); #ifdef OLDDATA IMPORT void addConstructor P((IN CONST ExprPtr tyname,IN CONST ExprPtr id, IN CONST ExprPtr con, IN CONST MapPtr innerkinds)); #else IMPORT ExprPtr addConstructors P((IN CONST ExprPtr tyname, IN COUNTER minmagic, IN COUNTER maxmagic,...)); #endif IMPORT ExprPtr getTopEnv P((void)); IMPORT COUNTER itIndex P((void)); IMPORT COUNTER nLocals P((IN CONST ExprPtr assum)); IMPORT void setNLocals P((IN CONST ExprPtr assum,IN COUNTER n)); IMPORT ExprPtr optPattern P((INOUT ExprPtr pat)); IMPORT ExprPtr tackPattern P((IN CONST ExprPtr pats,IN CONST ExprPtr pat, IN CONST ExprPtr body,INOUT ExprPtr dbgnames, INOUT INT *np)); IMPORT Boolean constantPattern P((IN CONST ExprPtr syntax,OUT ExprPtr *cstp)); IMPORT ExprPtr shiftExpr P((IN CONST ExprPtr e,IN COUNTER shift)); IMPORT INT exprSize P((IN CONST ExprPtr e,IN INT limit)); IMPORT INT funSize P((IN CONST ExprPtr e,IN INT limit)); /* END cmpproto.h */ /* BEGIN typproto.h */ IMPORT MapPtr IdTypes P((IN CONST ExprPtr assum)); IMPORT MapPtr STyCons P((IN CONST ExprPtr state)); IMPORT ExprPtr ApplyType P((IN CONST ExprPtr type, IN CONST ExprPtr tyhdr, IN CONST ExprPtr argtypes, IN CONST ExprPtr assum, IN CONST ExprPtr state)); IMPORT void addIdTypes P((IN CONST ExprPtr id,IN CONST ExprPtr type,INOUT ExprPtr assum)); IMPORT void addConsTypes P((IN CONST ExprPtr id,IN CONST ExprPtr type,INOUT ExprPtr assum)); IMPORT void remConsTypes P((IN CONST ExprPtr id,INOUT ExprPtr assum)); IMPORT void addIdType P((IN CONST ExprPtr name,IN CONST ExprPtr type)); IMPORT void addIdLocs P((IN CONST ExprPtr id,IN CONST ExprPtr type,INOUT ExprPtr assum)); IMPORT void addDataType P((IN CONST ExprPtr name,IN CONST ExprPtr tyvarseq, IN CONST ExprPtr type,IN CONST ExprPtr cons)); IMPORT ExprPtr correctTypeAppl P((IN CONST ExprPtr type, IN CONST ExprPtr state)); IMPORT void InitTypes P((void)); #if IMPERATIVE_TYPES==EFFECT_TYVAR IMPORT ExprPtr varType P((ExprPtr var,ExprPtr assum,ExprPtr state)); #else IMPORT ExprPtr varType P((ExprPtr var,ExprPtr assum,ExprPtr state,Boolean noimpp)); #endif IMPORT Boolean coerceTypes P((TZone *zone,ExprPtr type1,ExprPtr type2, ExprPtr assum,ExprPtr state,Boolean higherp)); IMPORT Boolean coerceTypesImport P((TZone *zone,ExprPtr type1,ExprPtr type2, ExprPtr assum,ExprPtr state, ExprPtr var,Boolean higherp)); IMPORT Boolean TypeMatch P((IN CONST MapPtr pat,IN CONST MapPtr type)); IMPORT ExprPtr tcDeclaration P((IN CONST ExprPtr syntax, IN CONST ExprPtr assum, INOUT ExprPtr state)); /* END typproto.h */ /* Declare all global actions. */ DECL_ACTION(datacon_shared) DECL_ACTION(datacon_shared) DECL_ACTION(mapadd) DECL_ACTION(mapaddunder) DECL_ACTION(add) DECL_ACTION(sub) DECL_ACTION(mul) DECL_ACTION(div) DECL_ACTION(pow) DECL_ACTION(neg) DECL_ACTION(sqr) DECL_ACTION(sqrt) DECL_ACTION(abs) DECL_ACTION(re) DECL_ACTION(im) DECL_ACTION(conj) DECL_ACTION(less) DECL_ACTION(leq) DECL_ACTION(greater) DECL_ACTION(greq) DECL_ACTION(nummin) DECL_ACTION(nummax) DECL_ACTION(exp) DECL_ACTION(log) DECL_ACTION(exp1) DECL_ACTION(log1) DECL_ACTION(sin) DECL_ACTION(cos) DECL_ACTION(tan) DECL_ACTION(asin) DECL_ACTION(acos) DECL_ACTION(atan) DECL_ACTION(sh) DECL_ACTION(ch) DECL_ACTION(th) DECL_ACTION(ash) DECL_ACTION(ach) DECL_ACTION(ath) DECL_ACTION(arg) DECL_ACTION(real) DECL_ACTION(integer) DECL_ACTION(natural) DECL_ACTION(floor) DECL_ACTION(ceil) DECL_ACTION(quotient) DECL_ACTION(remainder) DECL_ACTION(quotrem) DECL_ACTION(classify) DECL_ACTION(compose) DECL_ACTION(inv) DECL_ACTION(mapcompose) DECL_ACTION(rev) DECL_ACTION(rev1) DECL_ACTION(append) DECL_ACTION(concat) DECL_ACTION(concatof) DECL_ACTION(domrestrto) DECL_ACTION(domrestrby) DECL_ACTION(rngrestrto) DECL_ACTION(rngrestrby) DECL_ACTION(union) DECL_ACTION(inter) DECL_ACTION(interp) DECL_ACTION(diff) DECL_ACTION(delta) DECL_ACTION(submap) DECL_ACTION(subset) DECL_ACTION(inset) DECL_ACTION(inmap) DECL_ACTION(card) DECL_ACTION(len) DECL_ACTION(nth) DECL_ACTION(nthtail) DECL_ACTION(range) DECL_ACTION(size) DECL_ACTION(chr) DECL_ACTION(ord) DECL_ACTION(ordnth) DECL_ACTION(explode) DECL_ACTION(substr) DECL_ACTION(chooseindom) DECL_ACTION(chooseinrng) DECL_ACTION(mapremove) DECL_ACTION(mapsplit) DECL_ACTION(gc) DECL_ACTION(gcfull) DECL_ACTION(array) DECL_ACTION(aref) DECL_ACTION(aset) DECL_ACTION(length) DECL_ACTION(listarray) DECL_ACTION(iarray) DECL_ACTION(iaref) DECL_ACTION(iaset) DECL_ACTION(ilength) DECL_ACTION(ilistarray) DECL_ACTION(strless) DECL_ACTION(before) DECL_ACTION(null) DECL_ACTION(empty) DECL_ACTION(print) DECL_ACTION(pretty) DECL_ACTION(prtstdout) DECL_ACTION(flushstdout) DECL_ACTION(prtstderr) DECL_ACTION(flushstderr) DECL_ACTION(outfile) DECL_ACTION(appendfile) DECL_ACTION(outprocess) DECL_ACTION(outstring) DECL_ACTION(readstdin) DECL_ACTION(lstdin) DECL_ACTION(infile) DECL_ACTION(inprocess) DECL_ACTION(inoutprocess) DECL_ACTION(instring) DECL_ACTION(filebits) DECL_ACTION(dir) DECL_ACTION(cd) DECL_ACTION(pwd) DECL_ACTION(rmdir) DECL_ACTION(mkdir) DECL_ACTION(unlink) DECL_ACTION(rename) DECL_ACTION(system) DECL_ACTION(getenv) DECL_ACTION(errormsg) DECL_ACTION(rrand) DECL_ACTION(zrand) DECL_ACTION(maybe) DECL_ACTION(time) DECL_ACTION(dom) DECL_ACTION(rng) DECL_ACTION(inds) DECL_ACTION(elems) DECL_ACTION(listmap) DECL_ACTION(callcc) DECL_ACTION(throw) DECL_ACTION(catch) DECL_ACTION_NORETURN(quit) DECL_ACTION(rand) DECL_ACTION(num) DECL_ACTION(int) DECL_ACTION(iabs) DECL_ACTION(ilt) DECL_ACTION(ile) DECL_ACTION(igt) DECL_ACTION(ige) DECL_ACTION(imin) DECL_ACTION(imax) DECL_ACTION(idiv) DECL_ACTION(imod) DECL_ACTION(idivmod) DECL_ACTION(iplus) DECL_ACTION(iminus) DECL_ACTION(itimes) DECL_ACTION(ineg) DECL_ACTION(isqr) DECL_ACTION(ior) DECL_ACTION(ixor) DECL_ACTION(iand) DECL_ACTION(inot) DECL_ACTION(ilsl) DECL_ACTION(ilsr) DECL_ACTION(iasr) DECL_ACTION(inc) DECL_ACTION(dec) DECL_ACTION(map) DECL_ACTION(app) DECL_ACTION(fold) DECL_ACTION(revfold) DECL_ACTION(hd) DECL_ACTION(tl) DECL_ACTION(denormal) DECL_ACTION(rotten) DECL_ACTION(system_less) DECL_ACTION(ldexp) DECL_ACTION(frexp) DECL_ACTION(modf) DECL_ACTION(getargs) DECL_ACTION(atoi) DECL_ACTION(atof) DECL_ACTION(table) DECL_ACTION(table_get) DECL_ACTION(table_put) DECL_ACTION(table_put_behind) DECL_ACTION(table_remove) DECL_ACTION(table_kill) DECL_ACTION(table_sweep) DECL_ACTION(table_collect) DECL_ACTION(cons) DECL_ACTION(force) DECL_ACTION(ref) DECL_ACTION(appendof) DECL_ACTION(unionof) DECL_ACTION(mergeof) DECL_ACTION(mergeunderof) DECL_ACTION(interof) DECL_ACTION(id) DECL_ACTION(overwrite) DECL_ACTION(underwrite) DECL_ACTION(mapapp) DECL_ACTION(compose) DECL_ACTION(deref) DECL_ACTION(assign) DECL_ACTION(make_io_exc) DECL_ACTION(equal) DECL_ACTION(nequal) DECL_ACTION(not) DECL_ACTION_NORETURN(abort) DECL_ACTION(q_mapapp) DECL_ACTION(stampworld) DECL_ACTION(hbegin) DECL_ACTION(hstart) DECL_ACTION(hsetinteractive) DECL_ACTION(hisinteractive) DECL_ACTION(hsetbol) DECL_ACTION(hatbol) DECL_ACTION(htext) DECL_ACTION(hbuildyytbl) DECL_ACTION(hlex) DECL_ACTION(hnewdata) DECL_ACTION(hunput) DECL_ACTION(hinput) DECL_ACTION(hswitchbuf) DECL_ACTION(hnewbuf) DECL_ACTION(hflushbuf) DECL_ACTION(hpushstate) DECL_ACTION(hpopstate) DECL_ACTION(htopstate) DECL_ACTION(hless) DECL_ACTION(hlen) DECL_ACTION(hyylloc) DECL_ACTION(herrormsg) DECL_ACTION(hbuf) DECL_ACTION(hmaxdepth) DECL_ACTION(hsetmaxdepth) DECL_ACTION(hyval) DECL_ACTION(hydefval) DECL_ACTION(hyloc) DECL_ACTION(hyerrok) DECL_ACTION(hyclearin) DECL_ACTION(hyrecovering) DECL_ACTION(hysetdebug) DECL_ACTION(hychar) DECL_ACTION(hyparse) DECL_ACTION(hbuildhytbl) DECL_ACTION(hynewdata) DECL_ACTION(hyerrmsg) DECL_ACTION(zmulmods) DECL_ACTION(zdoub) DECL_ACTION(zintoz) DECL_ACTION(ztoint) DECL_ACTION(zsbastoz) DECL_ACTION(zbastoz) DECL_ACTION(zstobas) DECL_ACTION(zstosymbas) DECL_ACTION(ztobas) DECL_ACTION(ztosymbas) DECL_ACTION(zcompare) DECL_ACTION(znegate) DECL_ACTION(zsadd) DECL_ACTION(zadd) DECL_ACTION(zsub) DECL_ACTION(zsmul) DECL_ACTION(zmul) DECL_ACTION(zsqr) DECL_ACTION(zsdiv) DECL_ACTION(zsmod) DECL_ACTION(zdiv) DECL_ACTION(zmod) DECL_ACTION(zaddmod) DECL_ACTION(zsubmod) DECL_ACTION(zsmulmod) DECL_ACTION(zmulmod) DECL_ACTION(zsqmod) DECL_ACTION(zdivmod) DECL_ACTION(zinvmod) DECL_ACTION(zmstart) DECL_ACTION(ztom) DECL_ACTION(zmtoz) DECL_ACTION(zmontadd) DECL_ACTION(zmontsub) DECL_ACTION(zsmontmul) DECL_ACTION(zmontmul) DECL_ACTION(zmontsqr) DECL_ACTION(zmontdiv) DECL_ACTION(zmontinv) DECL_ACTION(zexteucl) DECL_ACTION(zchirem) DECL_ACTION(zmontexp) DECL_ACTION(zsexpmod) DECL_ACTION(zexpmod) DECL_ACTION(z2expmod) DECL_ACTION(zdefault_m) DECL_ACTION(zmontexp_m_ary) DECL_ACTION(zexpmod_m_ary) DECL_ACTION(zsexp) DECL_ACTION(zexp) DECL_ACTION(zexpmods) DECL_ACTION(zexpmod_doub) DECL_ACTION(zmontexp_doub) DECL_ACTION(z2mul) DECL_ACTION(z2div) DECL_ACTION(z2mod) DECL_ACTION(zlshift) DECL_ACTION(zrshift) DECL_ACTION(z_makeodd) DECL_ACTION(zsqrts) DECL_ACTION(zsqrt) DECL_ACTION(zroot) DECL_ACTION(zgcd) DECL_ACTION(zgcdeucl) DECL_ACTION(nextprime) DECL_ACTION(zpollardrho) DECL_ACTION(ztridiv) DECL_ACTION(zsign) DECL_ACTION(zabs) DECL_ACTION(z2logs) DECL_ACTION(z2log) DECL_ACTION(zln) DECL_ACTION(zweights) DECL_ACTION(zweight) DECL_ACTION(znot) DECL_ACTION(zand) DECL_ACTION(IntToSet) DECL_ACTION(SetToInt) DECL_ACTION(zxor) DECL_ACTION(zor) DECL_ACTION(zlowbits) DECL_ACTION(zhighbits) DECL_ACTION(zbit) DECL_ACTION(zsetbit) DECL_ACTION(zclrbit) DECL_ACTION(zreverses) DECL_ACTION(zreverse) DECL_ACTION(zjacobi) DECL_ACTION(zjacobis) DECL_ACTION(zprobprime) DECL_ACTION(zsrand) DECL_ACTION(zrandoml) DECL_ACTION(zrandoml1) DECL_ACTION(z_rand) DECL_ACTION(zrand1) DECL_ACTION(zrandomprime) DECL_ACTION(zrandomprime1) DECL_ACTION(zrandompprime) DECL_ACTION(zrandompprime1) DECL_ACTION(zrandomfprime) DECL_ACTION(zrandomfprime1) DECL_ACTION(zrandomgprime) DECL_ACTION(zrandomgprime1) DECL_ACTION(zecm) DECL_ACTION(regcomp) DECL_ACTION(regerrormsg) /* End declare all global actions. */