/* --------------------------------------------------------------------------
 * Basic data type definitions, prototypes and standard macros including
 * machine dependent variations...
 *
 * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
 * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU,
 * 1994-2003, All rights reserved.  It is distributed as free software under
 * the license in the file "License", which is included in the distribution.
 *
 * $RCSfile: prelude.h,v $
 * $Revision: 1.1 $
 * $Date: 2008/11/30 09:11:36 $
 * ------------------------------------------------------------------------*/
#ifndef __PRELUDE_H__
#define __PRELUDE_H__

#include "config.h"
#include "options.h"
#include <stdio.h>

#if HAVE_STDLIB_H
# include <stdlib.h>
#endif
#if HAVE_SYS_TYPES_H
# include <sys/types.h>
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif

/*---------------------------------------------------------------------------
 * Most of the configuration code from earlier versions of Hugs has been moved
 * into config.h (which is usually automatically generated).  
 *
 * Most of the configuration code is "feature based".  That is, the 
 * configure script looks to see if a particular feature (or misfeature)
 * is present on the compiler/OS.  
 *
 * A small amount of configuration code is still "system based": it tests
 * flags to determine what kind of compiler/system it's running on - from
 * which it infers what features the compiler/system has.  Use of system
 * based tests generally indicates that we can't remember/figure out
 * what the original problem was and so we can't add an appropriate feature
 * test to the configure script.
 *-------------------------------------------------------------------------*/

/*---------------------------------------------------------------------------
 * Configuration options
 *
 * Most configuration options are arguments to the configure script
 * (try running "configure --help").  The following options are either
 * experimental or require changes to "Prelude.hs", the standard libraries
 * and demos and therefore cannot be modified using the configure script.
 * Most users should leave them alone!
 *
 *   OBSERVATIONS   to include support for `observe' and friends
 *   IPARAM	    to include support for Implicit Parameters.
 *   MUDO	    to include support for Recursive-do notation
 *   ZIP_COMP       to include support for Zip Comprehensions
 *   MULTI_INST	    to include support for Multi-Instance Resolution.
 *   HASKELL_ARRAYS to include support for Haskell array primitives.
 *   IO_MONAD	    to include the IO monad primitives and support.
 *   IO_HANDLES     to include the IO file operations.
 *   IO_REFS	    Ref type for IO_MONAD, and simple operations.
 *   FLUSHEVERY	    to force a fflush after every char in putStr/hPutStr.
 *   NPLUSK	    to include support for (n+k) patterns.
 *   BIGNUMS	    to include support for Integer bignums.
 *   FIXED_SUBST    to force a fixed size for the current substitution.
 *   DYN_TABLES	    to allocate tables dynamically, currently just a memory
 *		    saving trick, but this may be extended at a later stage
 *		    to allow at least some of the tables to be extended
 *		    dynamically at run-time to avoid exhausted space errors.
 *   GC_STABLEPTRS  to include support for safely passing Haskell
 *                  pointers over to C
 *                  (only required if you use callbacks in the foreign
 *                  language interface)
 *   GC_MALLOCPTRS  to include support for automatic deallocation of 
 *                  C objects when Haskell is done with them.
 *   GC_WEAKPTRS    to include support for weak pointers.
 *   STABLE_NAMES   stable names a la Simon PJ
 *   MONAD_COMPS    to allow monad comprehensions.
 *   REDIRECT_OUTPUT ability to redirect stdout/stderr to a buffer.
 *                  Only necessary for the Hugs server interface
 *                  (which is used in the Netscape plugin and the standalone
 *                  evaluator). 
 *   WORD_OPS       to include operations on unsigned ints
 *   ADDR_OPS       to include operations on addresses
 *   PROVIDE_INT64  to include 64 bit Ints
 *   SHORT_CIRCUIT_COERCIONS to try to apply these rewrites at runtime:
 *                    integerToInt (intToInteger x) -> x
 *                    rationalToFloat  (fromDouble {dict} x) -> doubleToFloat x
 *                    rationalToDouble (fromDouble {dict} x) -> x
 *-------------------------------------------------------------------------*/

#if !HASKELL_98_ONLY
#define IPARAM		1
#define MUDO		1
#define OBSERVATIONS    1
#define ZIP_COMP	1
#define HERE_DOC	1
#else
#define IPARAM          0
#define MUDO		0
#define OBSERVATIONS    0
#define ZIP_COMP	0
#define HERE_DOC	0
#endif
#define HASKELL_ARRAYS	 1
#define IO_MONAD	 1
#define IO_HANDLES       1
#define IO_REFS		 1 /* Experimental IO Ref type			   */
#define FLUSHEVERY	 1
#define NPLUSK		 1 /* Warning: There are those that would prefer 0 */
#define BIGNUMS		 1 /* Experimental bignum implementation           */
#define FIXED_SUBST	 0 /* Warning: This may not be appropriate for PCs */
#define DYN_TABLES	 SMALL_HUGS /* For dynamically allocated tables	   */
#define GC_STABLEPTRS    1 /* May be required by external libraries        */
#define GC_MALLOCPTRS    1 /* May be required by external libraries        */
#define GC_WEAKPTRS      1
#define STABLE_NAMES     1
#define MONAD_COMPS	 0
#define WORD_OPS         1
#define ADDR_OPS         1
#define PROVIDE_INT64    1
#define TIME_MODULE      1
#define DIRECTORY_MODULE 1
#define MULTI_LINEFEED   1 /* Platform-independent linefeed handling        */
#define MULTI_INST       0
#define WANT_FIXED_SIZE_TABLES 0 /* use fixed-size tables for internal structs */
                                 /* (as opposed to dynamically growable ones)  */

#define SHORT_CIRCUIT_COERCIONS 1

/*---------------------------------------------------------------------------
 * Macros used in declarations:
 *  function prototypes
 *  local/far declarations
 *  HUGS_noreturn/HUGS_unused (prevent spurious warnings)
 *  result type of main
 *  dynamic linking declarations
 *-------------------------------------------------------------------------*/

#if PROTOTYPES		  /* To enable use of prototypes whenever possible */
#define Args(x) x
#else
#define Args(x) ()
#endif

/* local = prefix for locally defined functions */
/* far   = prefix for far pointers              */
#define local
#define far

#define HUGS_noreturn  
#define HUGS_unused

/*---------------------------------------------------------------------------
 * Dynamic linking tricks
 *-------------------------------------------------------------------------*/

#define DLLIMPORT(rty) rty 
#define DLLEXPORT(rty) rty 

/* #ifdef __EXTERNAL */
/* #define HUGSAPI(rty) DLLIMPORT(rty) */
/* #else */
/* #define HUGSAPI(rty) DLLEXPORT(rty) */
/* #endif */

/*---------------------------------------------------------------------------
 * String operations:
 *-------------------------------------------------------------------------*/

#if HAVE_STRING_H
# include <string.h>
#else
extern int      strcmp     Args((const char*, const char*));
extern int      strncmp    Args((const char*, const char*, int));
extern char     *strchr    Args((const char*, int));
extern char     *strrchr   Args((const char*, int));
extern size_t   strlen     Args((const char *));
extern char	    *strcpy    Args((char *, const char*));
extern char     *strcat	   Args((char *, const char*));
#endif

#if HAVE_STRCMP
#define strCompare strcmp
#endif

#if HAVE_CTYPE_H
# include <ctype.h>
#endif
#ifndef isascii
#define  isascii(c)	(((unsigned)(c))<128)
#endif

/*---------------------------------------------------------------------------
 * Printf-related operations:
 *-------------------------------------------------------------------------*/

#if HAVE_STDARG_H
#include <stdarg.h>
#else
#include <varargs.h>
#endif

#if !HAVE_SNPRINTF
# if HAVE__SNPRINTF
#  define snprintf _snprintf
# else
extern int snprintf   Args((char*, size_t, const char*, ...));
# endif
#endif

#if !HAVE_VSNPRINTF
extern int vsnprintf  Args((char*, size_t, const char*, va_list));
#endif

/*---------------------------------------------------------------------------
 * Pipe-related operations:
 *
 * On Windows, many standard Unix names acquire a leading underscore.
 * Irritating, but easy to work around.
 *-------------------------------------------------------------------------*/

#if !HAVE_POPEN && HAVE__POPEN
#define popen(x,y) _popen(x,y)
#endif
#if !HAVE_PCLOSE && HAVE__PCLOSE
#define pclose(x) _pclose(x)
#endif

/*---------------------------------------------------------------------------
 * Interrupting execution (signals, allowBreak):
 *-------------------------------------------------------------------------*/

#if VOID_INT_SIGNALS
# define sigProto(nm)	void nm Args((int))
# define sigRaise(nm)	nm(1)
# define sigHandler(nm)	void nm(sig_arg) int sig_arg;
# define sigResume	return
#else
# define sigProto(nm)	int nm Args((Void))
# define sigRaise(nm)	nm()
# define sigHandler(nm)	int nm(Void)
# define sigResume	return 1
#endif

/* allowBreak: call to allow user to interrupt computation
 * ctrlbrk:    set control break handler
 */

/* On Unix (and almost every other system), the interrupt handlers perform
 * a longjmp to break out of the current computation.
 * On Win32 this does not work because the interrupt handler is run in
 * a separate thread from the main computation.  Instead we set a 
 * flag (the global variable "broken") to request an interrupt and
 * all potentially infinite loops of the evaluator check the flag using
 * the "allowBreak" call.
 */ 

# if HAVE_SIGPROCMASK
#  include <signal.h>
#  define ctrlbrk(bh)	{ sigset_t mask; \
			  signal(SIGINT,bh); \
			  sigemptyset(&mask); \
			  sigaddset(&mask, SIGINT); \
			  sigprocmask(SIG_UNBLOCK, &mask, NULL); \
			}
# else
#  define ctrlbrk(bh)	signal(SIGINT,bh)
# endif
# define allowBreak()   doNothing()

#ifndef SIGBREAK /* Sigh, not defined in cygwin32 beta release 16 */
# define SIGBREAK 21
#endif

/*---------------------------------------------------------------------------
 * Floating point support
 *-------------------------------------------------------------------------*/

/* Can we fit floats into ints? */
#define BREAK_FLOATS (SIZEOF_FLOAT > SIZEOF_INT)

#if  FLOATS_SUPPORTED

#define FloatImpType	   float
#define FloatPro	   double  /* type to use in prototypes		   */
				   /* strictly ansi (i.e. gcc) conforming  */
				   /* but breaks data hiding :-(	   */
#define FloatFMT	   "%.7g"

/* Is double too big for two ints?  (if so, use float instead) */
#define DOUBLE_IS_FLOAT (SIZEOF_DOUBLE > 2*SIZEOF_INT)

#if DOUBLE_IS_FLOAT
#define DoubleImpType	   FloatImpType
#define DoublePro	   FloatPro
#define DoubleFMT          FloatFMT
#else
#define DoubleImpType	   double
#define DoublePro	   double
#define DoubleFMT          "%.15g"
#endif

#if HAVE_FLOAT_H

#include <float.h>

# define HUGS_FLT_RADIX    FLT_RADIX
# define HUGS_FLT_MANT_DIG FLT_MANT_DIG
# define HUGS_FLT_MIN_EXP  FLT_MIN_EXP
# define HUGS_FLT_MAX_EXP  FLT_MAX_EXP

#if DOUBLE_IS_FLOAT
# define HUGS_DBL_MANT_DIG HUGS_FLT_MANT_DIG
# define HUGS_DBL_MIN_EXP  HUGS_FLT_MIN_EXP
# define HUGS_DBL_MAX_EXP  HUGS_FLT_MAX_EXP
#else
# define HUGS_DBL_MANT_DIG DBL_MANT_DIG
# define HUGS_DBL_MIN_EXP  DBL_MIN_EXP
# define HUGS_DBL_MAX_EXP  DBL_MAX_EXP
#endif

#elif HAVE_VALUES_H

#include <values.h>

# define HUGS_FLT_RADIX    _EXPBASE
# define HUGS_FLT_MANT_DIG FSIGNIF
# define HUGS_FLT_MIN_EXP  FMINEXP
# define HUGS_FLT_MAX_EXP  FMAXEXP 

#if DOUBLE_IS_FLOAT
# define HUGS_DBL_MANT_DIG HUGS_FLT_MANT_DIG
# define HUGS_DBL_MIN_EXP  HUGS_FLT_MIN_EXP
# define HUGS_DBL_MAX_EXP  HUGS_FLT_MAX_EXP
#else
# define HUGS_DBL_MANT_DIG DSIGNIF
# define HUGS_DBL_MIN_EXP  DMINEXP
# define HUGS_DBL_MAX_EXP  DMAXEXP
#endif

#endif


#else /* !FLOATS_SUPPORTED */

#define FloatImpType	   int     /*dummy*/
#define FloatPro	   int
#define FloatFMT	   "%d"
#define DoubleImpType	   int     /*dummy*/
#define DoublePro	   int
#define DoubleFMT	   "%d"

#endif /* !FLOATS_SUPPORTED */

/*---------------------------------------------------------------------------
 * Memory allocation
 *-------------------------------------------------------------------------*/

#if HAVE_FARCALLOC
# include <alloc.h>
# define farCalloc(n,s)	farcalloc((unsigned long)n,(unsigned long)s)
#elif HAVE_VALLOC
# define farCalloc(n,s)	(Void *)valloc(((unsigned)n)*((unsigned)s))
#else
# define farCalloc(n,s)	(Void *)calloc(((unsigned)n),((unsigned)s))
#endif

/* bison-generated parsers like to have alloca - so try to define it */

#if HAVE_ALLOCA_H
#include <alloca.h>
#else
# if HAVE__ALLOCA 
#  include <malloc.h>
# endif
#endif


/*---------------------------------------------------------------------------
 * Assertions
 *-------------------------------------------------------------------------*/

#if HAVE_ASSERT_H
#include <assert.h>
#else
#define assert(x) doNothing()
#endif

/*---------------------------------------------------------------------------
 * Preprocessor support
 *-------------------------------------------------------------------------*/

/*
 * Note: initially defined as
 *   #define SUPPORT_PREPROCESSOR USE_PREPROCESSOR && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
 *
 * which worked OK with GNU cpp, but MSVC didn't expand the 'defined' correctly.
 *
 */
#if USE_PREPROCESSOR
# if HAVE_POPEN || HAVE__POPEN
#  define SUPPORT_PREPROCESSOR 1
# else
#  define SUPPORT_PREPROCESSOR 0
# endif
#else
# define SUPPORT_PREPROCESSOR 0
#endif

/*---------------------------------------------------------------------------
 * File operations:
 *-------------------------------------------------------------------------*/

#if !HAVE_UNISTD_H
extern int 	chdir 	   Args((const char*));
#endif

#if HAVE_DIRECT_H
#include <direct.h>
#endif

#ifndef HAVE_STDLIB_H
extern int      system	   Args((const char *));
extern double   atof	   Args((const char *));
extern void     exit       Args((int));
#endif

#ifndef FILENAME_MAX	   /* should already be defined in an ANSI compiler*/
# define FILENAME_MAX 256
#elif   FILENAME_MAX < 256
# undef  FILENAME_MAX
# define FILENAME_MAX 256
#elif   FILENAME_MAX > 8192
	/* Systems with no limit on path length (e.g. the Hurd), will have */
	/* FILENAME_MAX impossibly large.  Ideally we should dynamically   */
	/* allocate/grow these buffers and not use FILENAME_MAX at all.    */
# undef  FILENAME_MAX
# define FILENAME_MAX 8192
#endif

# define filenamecmp(s1,s2) strcmp(s1,s2)


/*---------------------------------------------------------------------------
 * General settings:
 *-------------------------------------------------------------------------*/

#define Void     void   /* older compilers object to: typedef void Void;   */
#if !defined(_XLIB_H_)  /* clashes with similar declaration in Xlib.h      */
typedef unsigned Bool;
#endif
#define TRUE     1
#define FALSE    0
#ifndef _XtIntrinsic_h
typedef char    *String;
#endif
typedef int      Int;
typedef signed char Int8;
typedef short    Int16;
typedef long     Long;
typedef int      Char;
typedef unsigned Unsigned;
typedef void*    Pointer;

#define doNothing() do { } while (0) /* Null statement */

#ifndef STD_PRELUDE
#define STD_PRELUDE      "Prelude"
#define STD_PRELUDE_HUGS "Hugs.Prelude"
#define STD_EMPTY_MODULE "Hugs"
#endif

#if IO_MONAD
#define NUM_HANDLES	    40
#endif
#define NUM_TUPLES      100
#define NUM_OFFSETS     1024
#define NUM_LAT1_CHARS  256

#if PROFILING
#define DEF_PROFINTDIV	10		/* hpsize/this cells between samples*/
#endif

#if     SMALL_HUGS			/* the McDonalds mentality :-)	   */
#define Pick(s,r,l)	   s
#endif
#if     REGULAR_HUGS
#define Pick(s,r,l)	   r
#endif
#if     LARGE_HUGS
#define Pick(s,r,l)	   l
#endif

#if OBSERVATIONS
#define NUM_OBS_TAGS       Pick(100,    200,        1000)
#define NUM_BRKPTS         Pick(100,    200,        200)
#endif

#define NUM_SCRIPTS        Pick(64,     200,        800)
#define NUM_FIXUPS         Pick(400,    400,        1000)
#define NUM_TYCON          Pick(60,     320,        2000)
#define NUM_NAME           Pick(1000,   4000,       32000)
#define NUM_CLASSES        Pick(30,     240,        1000)
#define NUM_INSTS          Pick(200,    400,        4000)
#define NUM_TEXT           Pick(12000,  20000,      320000)
#define NUM_TEXTH	   Pick(1,      10,         10)
#define NUM_TYVARS         Pick(800,    2000,       8000)
#define NUM_STACK          Pick(1800,   16000,      160000)
#define NUM_ADDRS          Pick(28000,  120000,     1280000)
#define MINIMUMHEAP	   Pick(7500,   19000,      19000)
#define MAXIMUMHEAP	   Pick(32765,  0,          0)
#define DEFAULTHEAP        Pick(28000,  100000,      1000000)
#define MAXPOSINT          Pick(0x7fff, 0x7fffffff, 0x7fffffff)
#define MAXHUGSWORD        Pick(0xffffU, 0xffffffffU, 0xffffffffU)
#define NUM_STABLEPTRS	   Pick(10,     100,        10000)
#define NUM_MALLOCPTRS	   Pick(10,     100,        10000)
#define NUM_DTUPLES	       Pick(3,      5,          5)

/* Some infinite computations generate an infinite depth of alternations
 * between eval() and run().  If they don't use the Hugs stack or heap,
 * they will overrun the C stack, crashing the interpreter.  To protect
 * against this, we place a limit on the depth of recursion of eval().
 */
#define MAX_EVAL_DEPTH	   Pick(1024,	4096,	    16384)

/* Representation of Integer: requires BIGBASE == 10^BIGEXP */
#define BIGBASE		   Pick(100,    10000,      10000)
#define BIGEXP		   Pick(2,      4,          4)

#define MINNEGINT          (-MAXPOSINT-1)

#define NUM_MODULE         NUM_SCRIPTS


#if DYN_TABLES				/* Tables may be alloc'd at runtime*/
#define DECTABLE(tab)	   far *tab	/* macros for declaration & defn   */
#define DYNDECTABLE(tab)   DECTABLE(tab)
#define DEFTABLE(tab,sz)   far *tab = 0
#else					/* or at compile-time:		   */
#define DECTABLE(tab)	   tab[]
#define DYNDECTABLE(tab)   far *tab
#define DEFTABLE(tab,sz)   tab[sz]
#endif

#define minRecovery	   Pick(1000,  1000,       1000)
#define bitsPerWord	   Pick(16,    32,         32)
#define wordShift	   Pick(4,     5,          5)
#define wordMask	   Pick(15,    31,         31)

#define bitArraySize(n)    ((n)/bitsPerWord + 1)
#define placeInSet(n)      ((-(n)-1)>>wordShift)
#define maskInSet(n)       (1<<((-(n)-1)&wordMask))

/*-------------------------------------------------------------------------*/

#endif /* __PRELUDE_H__ */
