Menu
▾
▴
mlton-commit — [MLton-commit] Code commits
You can subscribe to this list here.
| 2005 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(56) |
Sep
(40) |
Oct
(30) |
Nov
(144) |
Dec
(23) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2006 |
Jan
(41) |
Feb
(29) |
Mar
(31) |
Apr
(39) |
May
(193) |
Jun
(45) |
Jul
(19) |
Aug
(3) |
Sep
(23) |
Oct
(83) |
Nov
(92) |
Dec
(123) |
| 2007 |
Jan
(90) |
Feb
(267) |
Mar
(120) |
Apr
(51) |
May
(40) |
Jun
(121) |
Jul
(109) |
Aug
(173) |
Sep
(77) |
Oct
(52) |
Nov
(121) |
Dec
(62) |
| 2008 |
Jan
(76) |
Feb
(53) |
Mar
(98) |
Apr
(87) |
May
(26) |
Jun
(27) |
Jul
(23) |
Aug
(136) |
Sep
(79) |
Oct
(68) |
Nov
(29) |
Dec
(14) |
| 2009 |
Jan
(7) |
Feb
(2) |
Mar
(11) |
Apr
(75) |
May
(1) |
Jun
(95) |
Jul
(19) |
Aug
(4) |
Sep
(8) |
Oct
(93) |
Nov
(43) |
Dec
(21) |
| 2010 |
Jan
(20) |
Feb
(23) |
Mar
(18) |
Apr
(6) |
May
(20) |
Jun
(23) |
Jul
(1) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2011 |
Jan
(2) |
Feb
(6) |
Mar
(15) |
Apr
(5) |
May
(9) |
Jun
(14) |
Jul
(9) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2012 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(2) |
Jun
(17) |
Jul
(37) |
Aug
|
Sep
(1) |
Oct
(6) |
Nov
|
Dec
|
| 2013 |
Jan
|
Feb
|
Mar
(5) |
Apr
(2) |
May
(7) |
Jun
(11) |
Jul
(8) |
Aug
|
Sep
(1) |
Oct
(2) |
Nov
|
Dec
|
| 2014 |
Jan
|
Feb
(2) |
Mar
(1) |
Apr
|
May
(1) |
Jun
(1) |
Jul
(7) |
Aug
(2) |
Sep
|
Oct
(5) |
Nov
(2) |
Dec
(4) |
| 2015 |
Jan
|
Feb
(2) |
Mar
(2) |
Apr
|
May
|
Jun
(9) |
Jul
(1) |
Aug
|
Sep
|
Oct
(4) |
Nov
(1) |
Dec
|
| 2016 |
Jan
(2) |
Feb
(1) |
Mar
(1) |
Apr
(1) |
May
(1) |
Jun
(2) |
Jul
(1) |
Aug
|
Sep
(5) |
Oct
|
Nov
|
Dec
|
| 2017 |
Jan
(1) |
Feb
(3) |
Mar
(3) |
Apr
(7) |
May
(2) |
Jun
(2) |
Jul
(5) |
Aug
(1) |
Sep
(2) |
Oct
(17) |
Nov
(4) |
Dec
(7) |
| 2018 |
Jan
(5) |
Feb
(14) |
Mar
(2) |
Apr
(5) |
May
(2) |
Jun
(5) |
Jul
|
Aug
(2) |
Sep
|
Oct
(3) |
Nov
(5) |
Dec
|
| 2019 |
Jan
(4) |
Feb
(2) |
Mar
(3) |
Apr
(1) |
May
(8) |
Jun
(14) |
Jul
(2) |
Aug
|
Sep
(2) |
Oct
(2) |
Nov
(15) |
Dec
(2) |
| 2020 |
Jan
(10) |
Feb
(3) |
Mar
(1) |
Apr
|
May
(9) |
Jun
(4) |
Jul
(16) |
Aug
(10) |
Sep
(4) |
Oct
(3) |
Nov
|
Dec
|
| 2021 |
Jan
(11) |
Feb
(2) |
Mar
(2) |
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
|
Oct
(6) |
Nov
(4) |
Dec
(4) |
| 2022 |
Jan
(4) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(6) |
Jun
(3) |
Jul
|
Aug
(1) |
Sep
|
Oct
|
Nov
(1) |
Dec
|
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
(2) |
May
(5) |
Jun
(1) |
Jul
(4) |
Aug
(1) |
Sep
|
Oct
(1) |
Nov
(13) |
Dec
|
| 2024 |
Jan
(1) |
Feb
|
Mar
(5) |
Apr
|
May
(10) |
Jun
|
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
(1) |
Dec
(14) |
| 2025 |
Jan
(3) |
Feb
|
Mar
(1) |
Apr
|
May
(2) |
Jun
(3) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Matthew F. <fl...@ml...> - 2006-05-07 17:54:20
|
Revert creating target arch-os directory in basis ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/Makefile ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-05-08 00:52:10 UTC (rev 4482) +++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-05-08 00:54:20 UTC (rev 4483) @@ -212,7 +212,6 @@ $(CC) $(OPTCFLAGS) $(WARNCFLAGS) -o gen/gen-types gen/gen-types.c $(UTILOFILES) cd gen && ./gen-types cp gen/c-types.h c-types.h - mkdir -p ../basis-library/config/c/$(TARGET_ARCH)-$(TARGET_OS) cp gen/c-types.sml ../basis-library/config/c/$(TARGET_ARCH)-$(TARGET_OS)/c-types.sml cp gen/ml-types.h ml-types.h rm -f gen/gen-types gen/c-types.h gen/c-types.sml gen/ml-types.h |
|
From: Matthew F. <fl...@ml...> - 2006-05-07 17:52:10
|
Create target arch-os directory in basis library ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/Makefile ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-05-07 20:26:11 UTC (rev 4481) +++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-05-08 00:52:10 UTC (rev 4482) @@ -212,6 +212,7 @@ $(CC) $(OPTCFLAGS) $(WARNCFLAGS) -o gen/gen-types gen/gen-types.c $(UTILOFILES) cd gen && ./gen-types cp gen/c-types.h c-types.h + mkdir -p ../basis-library/config/c/$(TARGET_ARCH)-$(TARGET_OS) cp gen/c-types.sml ../basis-library/config/c/$(TARGET_ARCH)-$(TARGET_OS)/c-types.sml cp gen/ml-types.h ml-types.h rm -f gen/gen-types gen/c-types.h gen/c-types.sml gen/ml-types.h |
|
From: Stephen W. <sw...@ml...> - 2006-05-07 13:26:12
|
Moved the conditional definitions of FE_ and FP_ constants from IEEEReal-consts.c to platform.h. They need to be accessible in other files (e.g. basis/Real/class.c). ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/IEEEReal-consts.c U mlton/branches/on-20050822-x86_64-branch/runtime/platform.h ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/IEEEReal-consts.c =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/IEEEReal-consts.c 2006-05-07 20:01:49 UTC (rev 4480) +++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/IEEEReal-consts.c 2006-05-07 20:26:11 UTC (rev 4481) @@ -1,56 +1,11 @@ #include "platform.h" -#if not HAS_FPCLASSIFY -#ifndef FP_INFINITE -#define FP_INFINITE 1 -#endif -#ifndef FP_NAN -#define FP_NAN 0 -#endif -#ifndef FP_NORMAL -#define FP_NORMAL 4 -#endif -#ifndef FP_SUBNORMAL -#define FP_SUBNORMAL 3 -#endif -#ifndef FP_ZERO -#define FP_ZERO 2 -#endif -#endif - const C_Int_t IEEEReal_FloatClass_FP_INFINITE = FP_INFINITE; const C_Int_t IEEEReal_FloatClass_FP_NAN = FP_NAN; const C_Int_t IEEEReal_FloatClass_FP_NORMAL = FP_NORMAL; const C_Int_t IEEEReal_FloatClass_FP_SUBNORMAL = FP_SUBNORMAL; const C_Int_t IEEEReal_FloatClass_FP_ZERO = FP_ZERO; - -#define FE_NOSUPPORT -1 - -/* Can't handle undefined rounding modes with code like the following. - * #ifndef FE_TONEAREST - * #define FE_TONEAREST FE_NOSUPPORT - * #endif - * On some platforms, FE_* are defined via an enum, not the - * preprocessor, and hence don't show up as #defined. In that case, - * the below code overwrites them. - */ - -#if not HAS_FEROUND -#ifndef FE_TONEAREST -#define FE_TONEAREST 0 -#endif -#ifndef FE_DOWNWARD -#define FE_DOWNWARD 1 -#endif -#ifndef FE_UPWARD -#define FE_UPWARD 2 -#endif -#ifndef FE_TOWARDZERO -#define FE_TOWARDZERO 3 -#endif -#endif - const C_Int_t IEEEReal_RoundingMode_FE_TONEAREST = FE_TONEAREST; const C_Int_t IEEEReal_RoundingMode_FE_DOWNWARD = FE_DOWNWARD; const C_Int_t IEEEReal_RoundingMode_FE_NOSUPPORT = FE_NOSUPPORT; Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform.h =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-05-07 20:01:49 UTC (rev 4480) +++ mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-05-07 20:26:11 UTC (rev 4481) @@ -83,6 +83,50 @@ #define SPAWN_MODE 0 #endif +#if not HAS_FPCLASSIFY +#ifndef FP_INFINITE +#define FP_INFINITE 1 +#endif +#ifndef FP_NAN +#define FP_NAN 0 +#endif +#ifndef FP_NORMAL +#define FP_NORMAL 4 +#endif +#ifndef FP_SUBNORMAL +#define FP_SUBNORMAL 3 +#endif +#ifndef FP_ZERO +#define FP_ZERO 2 +#endif +#endif + +#define FE_NOSUPPORT -1 + +/* Can't handle undefined rounding modes with code like the following. + * #ifndef FE_TONEAREST + * #define FE_TONEAREST FE_NOSUPPORT + * #endif + * On some platforms, FE_* are defined via an enum, not the + * preprocessor, and hence don't show up as #defined. In that case, + * the below code overwrites them. + */ + +#if not HAS_FEROUND +#ifndef FE_TONEAREST +#define FE_TONEAREST 0 +#endif +#ifndef FE_DOWNWARD +#define FE_DOWNWARD 1 +#endif +#ifndef FE_UPWARD +#define FE_UPWARD 2 +#endif +#ifndef FE_TOWARDZERO +#define FE_TOWARDZERO 3 +#endif +#endif + #include "ml-types.h" #include "c-types.h" #include "basis-ffi.h" |
|
From: Stephen W. <sw...@ml...> - 2006-05-07 13:01:53
|
Defined all of the _PC and _SC constants with #ifndef in the
platform-independent code, so that each platform doesn't have to
define the missing ones.
There were a bunch missing on Solaris, and I see there were already a
bunch missing on Cygwin and MinGW, which I took out in favor of the
general definitions in the -consts.c files.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/FileSys/FileSys-consts.c
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/sysconf-consts.c
U mlton/branches/on-20050822-x86_64-branch/runtime/platform/cygwin.h
U mlton/branches/on-20050822-x86_64-branch/runtime/platform/mingw.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/FileSys/FileSys-consts.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/FileSys/FileSys-consts.c 2006-05-07 19:59:55 UTC (rev 4479)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/FileSys/FileSys-consts.c 2006-05-07 20:01:49 UTC (rev 4480)
@@ -29,25 +29,85 @@
const C_Int_t Posix_FileSys_O_TEXT = O_TEXT;
const C_Int_t Posix_FileSys_O_TRUNC = O_TRUNC;
+#ifndef _PC_FILESIZEBITS
+#define _PC_FILESIZEBITS -1
+#endif
const C_Int_t Posix_FileSys_PC_FILESIZEBITS = _PC_FILESIZEBITS;
+#ifndef _PC_LINK_MAX
+#define _PC_LINK_MAX -1
+#endif
+#ifndef _PC_LINK_MAX
+#define _PC_LINK_MAX -1
+#endif
const C_Int_t Posix_FileSys_PC_LINK_MAX = _PC_LINK_MAX;
+#ifndef _PC_MAX_CANON
+#define _PC_MAX_CANON -1
+#endif
const C_Int_t Posix_FileSys_PC_MAX_CANON = _PC_MAX_CANON;
+#ifndef _PC_MAX_INPUT
+#define _PC_MAX_INPUT -1
+#endif
const C_Int_t Posix_FileSys_PC_MAX_INPUT = _PC_MAX_INPUT;
+#ifndef _PC_NAME_MAX
+#define _PC_NAME_MAX -1
+#endif
const C_Int_t Posix_FileSys_PC_NAME_MAX = _PC_NAME_MAX;
+#ifndef _PC_PATH_MAX
+#define _PC_PATH_MAX -1
+#endif
const C_Int_t Posix_FileSys_PC_PATH_MAX = _PC_PATH_MAX;
+#ifndef _PC_PIPE_BUF
+#define _PC_PIPE_BUF -1
+#endif
const C_Int_t Posix_FileSys_PC_PIPE_BUF = _PC_PIPE_BUF;
// const C_Int_t Posix_FileSys_PC_2_SYMLINKS = _PC_2_SYMLINKS;
+#ifndef _PC_ALLOC_SIZE_MIN
+#define _PC_ALLOC_SIZE_MIN -1
+#endif
const C_Int_t Posix_FileSys_PC_ALLOC_SIZE_MIN = _PC_ALLOC_SIZE_MIN;
+#ifndef _PC_REC_INCR_XFER_SIZE
+#define _PC_REC_INCR_XFER_SIZE -1
+#endif
const C_Int_t Posix_FileSys_PC_REC_INCR_XFER_SIZE = _PC_REC_INCR_XFER_SIZE;
+#ifndef _PC_REC_MAX_XFER_SIZE
+#define _PC_REC_MAX_XFER_SIZE -1
+#endif
const C_Int_t Posix_FileSys_PC_REC_MAX_XFER_SIZE = _PC_REC_MAX_XFER_SIZE;
+#ifndef _PC_REC_MIN_XFER_SIZE
+#define _PC_REC_MIN_XFER_SIZE -1
+#endif
const C_Int_t Posix_FileSys_PC_REC_MIN_XFER_SIZE = _PC_REC_MIN_XFER_SIZE;
+#ifndef _PC_REC_XFER_ALIGN
+#define _PC_REC_XFER_ALIGN -1
+#endif
const C_Int_t Posix_FileSys_PC_REC_XFER_ALIGN = _PC_REC_XFER_ALIGN;
+#ifndef _PC_SYMLINK_MAX
+#define _PC_SYMLINK_MAX -1
+#endif
const C_Int_t Posix_FileSys_PC_SYMLINK_MAX = _PC_SYMLINK_MAX;
+#ifndef _PC_CHOWN_RESTRICTED
+#define _PC_CHOWN_RESTRICTED -1
+#endif
const C_Int_t Posix_FileSys_PC_CHOWN_RESTRICTED = _PC_CHOWN_RESTRICTED;
+#ifndef _PC_NO_TRUNC
+#define _PC_NO_TRUNC -1
+#endif
const C_Int_t Posix_FileSys_PC_NO_TRUNC = _PC_NO_TRUNC;
+#ifndef _PC_VDISABLE
+#define _PC_VDISABLE -1
+#endif
const C_Int_t Posix_FileSys_PC_VDISABLE = _PC_VDISABLE;
+#ifndef _PC_ASYNC_IO
+#define _PC_ASYNC_IO -1
+#endif
const C_Int_t Posix_FileSys_PC_ASYNC_IO = _PC_ASYNC_IO;
+#ifndef _PC_PRIO_IO
+#define _PC_PRIO_IO -1
+#endif
const C_Int_t Posix_FileSys_PC_PRIO_IO = _PC_PRIO_IO;
+#ifndef _PC_SYNC_IO
+#define _PC_SYNC_IO -1
+#endif
const C_Int_t Posix_FileSys_PC_SYNC_IO = _PC_SYNC_IO;
const C_Mode_t Posix_FileSys_S_IFBLK = S_IFBLK;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/sysconf-consts.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/sysconf-consts.c 2006-05-07 19:59:55 UTC (rev 4479)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Posix/ProcEnv/sysconf-consts.c 2006-05-07 20:01:49 UTC (rev 4480)
@@ -1,80 +1,284 @@
#include "platform.h"
+#ifndef _SC_AIO_LISTIO_MAX
+#define _SC_AIO_LISTIO_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_AIO_LISTIO_MAX = _SC_AIO_LISTIO_MAX;
+#ifndef _SC_AIO_MAX
+#define _SC_AIO_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_AIO_MAX = _SC_AIO_MAX;
+#ifndef _SC_AIO_PRIO_DELTA_MAX
+#define _SC_AIO_PRIO_DELTA_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_AIO_PRIO_DELTA_MAX = _SC_AIO_PRIO_DELTA_MAX;
+#ifndef _SC_ARG_MAX
+#define _SC_ARG_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_ARG_MAX = _SC_ARG_MAX;
+#ifndef _SC_ATEXIT_MAX
+#define _SC_ATEXIT_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_ATEXIT_MAX = _SC_ATEXIT_MAX;
+#ifndef _SC_BC_BASE_MAX
+#define _SC_BC_BASE_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_BC_BASE_MAX = _SC_BC_BASE_MAX;
+#ifndef _SC_BC_DIM_MAX
+#define _SC_BC_DIM_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_BC_DIM_MAX = _SC_BC_DIM_MAX;
+#ifndef _SC_BC_SCALE_MAX
+#define _SC_BC_SCALE_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_BC_SCALE_MAX = _SC_BC_SCALE_MAX;
+#ifndef _SC_BC_STRING_MAX
+#define _SC_BC_STRING_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_BC_STRING_MAX = _SC_BC_STRING_MAX;
+#ifndef _SC_CHILD_MAX
+#define _SC_CHILD_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_CHILD_MAX = _SC_CHILD_MAX;
+#ifndef _SC_CLK_TCK
+#define _SC_CLK_TCK -1
+#endif
const C_Int_t Posix_ProcEnv_SC_CLK_TCK = _SC_CLK_TCK;
+#ifndef _SC_COLL_WEIGHTS_MAX
+#define _SC_COLL_WEIGHTS_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_COLL_WEIGHTS_MAX = _SC_COLL_WEIGHTS_MAX;
+#ifndef _SC_DELAYTIMER_MAX
+#define _SC_DELAYTIMER_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_DELAYTIMER_MAX = _SC_DELAYTIMER_MAX;
+#ifndef _SC_EXPR_NEST_MAX
+#define _SC_EXPR_NEST_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_EXPR_NEST_MAX = _SC_EXPR_NEST_MAX;
+#ifndef _SC_HOST_NAME_MAX
+#define _SC_HOST_NAME_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_HOST_NAME_MAX = _SC_HOST_NAME_MAX;
+#ifndef _SC_IOV_MAX
+#define _SC_IOV_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_IOV_MAX = _SC_IOV_MAX;
+#ifndef _SC_LINE_MAX
+#define _SC_LINE_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_LINE_MAX = _SC_LINE_MAX;
+#ifndef _SC_LOGIN_NAME_MAX
+#define _SC_LOGIN_NAME_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_LOGIN_NAME_MAX = _SC_LOGIN_NAME_MAX;
+#ifndef _SC_NGROUPS_MAX
+#define _SC_NGROUPS_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_NGROUPS_MAX = _SC_NGROUPS_MAX;
+#ifndef _SC_GETGR_R_SIZE_MAX
+#define _SC_GETGR_R_SIZE_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_GETGR_R_SIZE_MAX = _SC_GETGR_R_SIZE_MAX;
+#ifndef _SC_GETPW_R_SIZE_MAX
+#define _SC_GETPW_R_SIZE_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_GETPW_R_SIZE_MAX = _SC_GETPW_R_SIZE_MAX;
+#ifndef _SC_MQ_OPEN_MAX
+#define _SC_MQ_OPEN_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_MQ_OPEN_MAX = _SC_MQ_OPEN_MAX;
+#ifndef _SC_MQ_PRIO_MAX
+#define _SC_MQ_PRIO_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_MQ_PRIO_MAX = _SC_MQ_PRIO_MAX;
+#ifndef _SC_OPEN_MAX
+#define _SC_OPEN_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_OPEN_MAX = _SC_OPEN_MAX;
+#ifndef _SC_ADVISORY_INFO
+#define _SC_ADVISORY_INFO -1
+#endif
const C_Int_t Posix_ProcEnv_SC_ADVISORY_INFO = _SC_ADVISORY_INFO;
+#ifndef _SC_BARRIERS
+#define _SC_BARRIERS -1
+#endif
const C_Int_t Posix_ProcEnv_SC_BARRIERS = _SC_BARRIERS;
+#ifndef _SC_ASYNCHRONOUS_IO
+#define _SC_ASYNCHRONOUS_IO -1
+#endif
const C_Int_t Posix_ProcEnv_SC_ASYNCHRONOUS_IO = _SC_ASYNCHRONOUS_IO;
+#ifndef _SC_CLOCK_SELECTION
+#define _SC_CLOCK_SELECTION -1
+#endif
const C_Int_t Posix_ProcEnv_SC_CLOCK_SELECTION = _SC_CLOCK_SELECTION;
+#ifndef _SC_CPUTIME
+#define _SC_CPUTIME -1
+#endif
const C_Int_t Posix_ProcEnv_SC_CPUTIME = _SC_CPUTIME;
+#ifndef _SC_FSYNC
+#define _SC_FSYNC -1
+#endif
const C_Int_t Posix_ProcEnv_SC_FSYNC = _SC_FSYNC;
// const C_Int_t Posix_ProcEnv_SC_IPV6 = _SC_IPV6;
+#ifndef _SC_JOB_CONTROL
+#define _SC_JOB_CONTROL -1
+#endif
const C_Int_t Posix_ProcEnv_SC_JOB_CONTROL = _SC_JOB_CONTROL;
+#ifndef _SC_MAPPED_FILES
+#define _SC_MAPPED_FILES -1
+#endif
const C_Int_t Posix_ProcEnv_SC_MAPPED_FILES = _SC_MAPPED_FILES;
+#ifndef _SC_MEMLOCK
+#define _SC_MEMLOCK -1
+#endif
const C_Int_t Posix_ProcEnv_SC_MEMLOCK = _SC_MEMLOCK;
+#ifndef _SC_MEMLOCK_RANGE
+#define _SC_MEMLOCK_RANGE -1
+#endif
const C_Int_t Posix_ProcEnv_SC_MEMLOCK_RANGE = _SC_MEMLOCK_RANGE;
+#ifndef _SC_MEMORY_PROTECTION
+#define _SC_MEMORY_PROTECTION -1
+#endif
const C_Int_t Posix_ProcEnv_SC_MEMORY_PROTECTION = _SC_MEMORY_PROTECTION;
+#ifndef _SC_MESSAGE_PASSING
+#define _SC_MESSAGE_PASSING -1
+#endif
const C_Int_t Posix_ProcEnv_SC_MESSAGE_PASSING = _SC_MESSAGE_PASSING;
+#ifndef _SC_MONOTONIC_CLOCK
+#define _SC_MONOTONIC_CLOCK -1
+#endif
const C_Int_t Posix_ProcEnv_SC_MONOTONIC_CLOCK = _SC_MONOTONIC_CLOCK;
+#ifndef _SC_PRIORITIZED_IO
+#define _SC_PRIORITIZED_IO -1
+#endif
const C_Int_t Posix_ProcEnv_SC_PRIORITIZED_IO = _SC_PRIORITIZED_IO;
+#ifndef _SC_PRIORITY_SCHEDULING
+#define _SC_PRIORITY_SCHEDULING -1
+#endif
const C_Int_t Posix_ProcEnv_SC_PRIORITY_SCHEDULING = _SC_PRIORITY_SCHEDULING;
// const C_Int_t Posix_ProcEnv_SC_RAW_SOCKETS = _SC_RAW_SOCKETS;
+#ifndef _SC_READER_WRITER_LOCKS
+#define _SC_READER_WRITER_LOCKS -1
+#endif
const C_Int_t Posix_ProcEnv_SC_READER_WRITER_LOCKS = _SC_READER_WRITER_LOCKS;
+#ifndef _SC_REALTIME_SIGNALS
+#define _SC_REALTIME_SIGNALS -1
+#endif
const C_Int_t Posix_ProcEnv_SC_REALTIME_SIGNALS = _SC_REALTIME_SIGNALS;
+#ifndef _SC_REGEXP
+#define _SC_REGEXP -1
+#endif
const C_Int_t Posix_ProcEnv_SC_REGEXP = _SC_REGEXP;
+#ifndef _SC_SAVED_IDS
+#define _SC_SAVED_IDS -1
+#endif
const C_Int_t Posix_ProcEnv_SC_SAVED_IDS = _SC_SAVED_IDS;
+#ifndef _SC_SEMAPHORES
+#define _SC_SEMAPHORES -1
+#endif
const C_Int_t Posix_ProcEnv_SC_SEMAPHORES = _SC_SEMAPHORES;
+#ifndef _SC_SHARED_MEMORY_OBJECTS
+#define _SC_SHARED_MEMORY_OBJECTS -1
+#endif
const C_Int_t Posix_ProcEnv_SC_SHARED_MEMORY_OBJECTS = _SC_SHARED_MEMORY_OBJECTS;
+#ifndef _SC_SHELL
+#define _SC_SHELL -1
+#endif
const C_Int_t Posix_ProcEnv_SC_SHELL = _SC_SHELL;
+#ifndef _SC_SPAWN
+#define _SC_SPAWN -1
+#endif
const C_Int_t Posix_ProcEnv_SC_SPAWN = _SC_SPAWN;
+#ifndef _SC_SPIN_LOCKS
+#define _SC_SPIN_LOCKS -1
+#endif
const C_Int_t Posix_ProcEnv_SC_SPIN_LOCKS = _SC_SPIN_LOCKS;
+#ifndef _SC_SPORADIC_SERVER
+#define _SC_SPORADIC_SERVER -1
+#endif
const C_Int_t Posix_ProcEnv_SC_SPORADIC_SERVER = _SC_SPORADIC_SERVER;
#ifndef _SC_SS_REPL_MAX
#define _SC_SS_REPL_MAX -1
#endif
+#ifndef _SC_SS_REPL_MAX
+#define _SC_SS_REPL_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_SS_REPL_MAX = _SC_SS_REPL_MAX;
+#ifndef _SC_SYNCHRONIZED_IO
+#define _SC_SYNCHRONIZED_IO -1
+#endif
const C_Int_t Posix_ProcEnv_SC_SYNCHRONIZED_IO = _SC_SYNCHRONIZED_IO;
+#ifndef _SC_THREAD_ATTR_STACKADDR
+#define _SC_THREAD_ATTR_STACKADDR -1
+#endif
const C_Int_t Posix_ProcEnv_SC_THREAD_ATTR_STACKADDR = _SC_THREAD_ATTR_STACKADDR;
+#ifndef _SC_THREAD_ATTR_STACKSIZE
+#define _SC_THREAD_ATTR_STACKSIZE -1
+#endif
const C_Int_t Posix_ProcEnv_SC_THREAD_ATTR_STACKSIZE = _SC_THREAD_ATTR_STACKSIZE;
+#ifndef _SC_THREAD_CPUTIME
+#define _SC_THREAD_CPUTIME -1
+#endif
const C_Int_t Posix_ProcEnv_SC_THREAD_CPUTIME = _SC_THREAD_CPUTIME;
+#ifndef _SC_THREAD_PRIO_INHERIT
+#define _SC_THREAD_PRIO_INHERIT -1
+#endif
const C_Int_t Posix_ProcEnv_SC_THREAD_PRIO_INHERIT = _SC_THREAD_PRIO_INHERIT;
+#ifndef _SC_THREAD_PRIO_PROTECT
+#define _SC_THREAD_PRIO_PROTECT -1
+#endif
const C_Int_t Posix_ProcEnv_SC_THREAD_PRIO_PROTECT = _SC_THREAD_PRIO_PROTECT;
+#ifndef _SC_THREAD_PRIORITY_SCHEDULING
+#define _SC_THREAD_PRIORITY_SCHEDULING -1
+#endif
const C_Int_t Posix_ProcEnv_SC_THREAD_PRIORITY_SCHEDULING = _SC_THREAD_PRIORITY_SCHEDULING;
+#ifndef _SC_THREAD_PROCESS_SHARED
+#define _SC_THREAD_PROCESS_SHARED -1
+#endif
const C_Int_t Posix_ProcEnv_SC_THREAD_PROCESS_SHARED = _SC_THREAD_PROCESS_SHARED;
+#ifndef _SC_THREAD_SAFE_FUNCTIONS
+#define _SC_THREAD_SAFE_FUNCTIONS -1
+#endif
const C_Int_t Posix_ProcEnv_SC_THREAD_SAFE_FUNCTIONS = _SC_THREAD_SAFE_FUNCTIONS;
+#ifndef _SC_THREAD_SPORADIC_SERVER
+#define _SC_THREAD_SPORADIC_SERVER -1
+#endif
const C_Int_t Posix_ProcEnv_SC_THREAD_SPORADIC_SERVER = _SC_THREAD_SPORADIC_SERVER;
+#ifndef _SC_THREADS
+#define _SC_THREADS -1
+#endif
const C_Int_t Posix_ProcEnv_SC_THREADS = _SC_THREADS;
+#ifndef _SC_TIMEOUTS
+#define _SC_TIMEOUTS -1
+#endif
const C_Int_t Posix_ProcEnv_SC_TIMEOUTS = _SC_TIMEOUTS;
+#ifndef _SC_TIMERS
+#define _SC_TIMERS -1
+#endif
const C_Int_t Posix_ProcEnv_SC_TIMERS = _SC_TIMERS;
+#ifndef _SC_TRACE
+#define _SC_TRACE -1
+#endif
const C_Int_t Posix_ProcEnv_SC_TRACE = _SC_TRACE;
+#ifndef _SC_TRACE_EVENT_FILTER
+#define _SC_TRACE_EVENT_FILTER -1
+#endif
const C_Int_t Posix_ProcEnv_SC_TRACE_EVENT_FILTER = _SC_TRACE_EVENT_FILTER;
#ifndef _SC_TRACE_EVENT_NAME_MAX
#define _SC_TRACE_EVENT_NAME_MAX -1
#endif
+#ifndef _SC_TRACE_EVENT_NAME_MAX
+#define _SC_TRACE_EVENT_NAME_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_TRACE_EVENT_NAME_MAX = _SC_TRACE_EVENT_NAME_MAX;
+#ifndef _SC_TRACE_INHERIT
+#define _SC_TRACE_INHERIT -1
+#endif
const C_Int_t Posix_ProcEnv_SC_TRACE_INHERIT = _SC_TRACE_INHERIT;
+#ifndef _SC_TRACE_LOG
+#define _SC_TRACE_LOG -1
+#endif
const C_Int_t Posix_ProcEnv_SC_TRACE_LOG = _SC_TRACE_LOG;
#ifndef _SC_TRACE_NAME_MAX
#define _SC_TRACE_NAME_MAX -1
@@ -87,57 +291,210 @@
#ifndef _SC_TRACE_USER_EVENT_MAX
#define _SC_TRACE_USER_EVENT_MAX -1
#endif
+#ifndef _SC_TRACE_USER_EVENT_MAX
+#define _SC_TRACE_USER_EVENT_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_TRACE_USER_EVENT_MAX = _SC_TRACE_USER_EVENT_MAX;
+#ifndef _SC_TYPED_MEMORY_OBJECTS
+#define _SC_TYPED_MEMORY_OBJECTS -1
+#endif
const C_Int_t Posix_ProcEnv_SC_TYPED_MEMORY_OBJECTS = _SC_TYPED_MEMORY_OBJECTS;
+#ifndef _SC_VERSION
+#define _SC_VERSION -1
+#endif
const C_Int_t Posix_ProcEnv_SC_VERSION = _SC_VERSION;
+#ifndef _SC_V6_ILP32_OFF32
+#define _SC_V6_ILP32_OFF32 -1
+#endif
const C_Int_t Posix_ProcEnv_SC_V6_ILP32_OFF32 = _SC_V6_ILP32_OFF32;
+#ifndef _SC_V6_ILP32_OFFBIG
+#define _SC_V6_ILP32_OFFBIG -1
+#endif
const C_Int_t Posix_ProcEnv_SC_V6_ILP32_OFFBIG = _SC_V6_ILP32_OFFBIG;
+#ifndef _SC_V6_LP64_OFF64
+#define _SC_V6_LP64_OFF64 -1
+#endif
const C_Int_t Posix_ProcEnv_SC_V6_LP64_OFF64 = _SC_V6_LP64_OFF64;
+#ifndef _SC_V6_LPBIG_OFFBIG
+#define _SC_V6_LPBIG_OFFBIG -1
+#endif
const C_Int_t Posix_ProcEnv_SC_V6_LPBIG_OFFBIG = _SC_V6_LPBIG_OFFBIG;
+#ifndef _SC_2_C_BIND
+#define _SC_2_C_BIND -1
+#endif
const C_Int_t Posix_ProcEnv_SC_2_C_BIND = _SC_2_C_BIND;
+#ifndef _SC_2_C_DEV
+#define _SC_2_C_DEV -1
+#endif
const C_Int_t Posix_ProcEnv_SC_2_C_DEV = _SC_2_C_DEV;
+#ifndef _SC_2_CHAR_TERM
+#define _SC_2_CHAR_TERM -1
+#endif
const C_Int_t Posix_ProcEnv_SC_2_CHAR_TERM = _SC_2_CHAR_TERM;
+#ifndef _SC_2_FORT_DEV
+#define _SC_2_FORT_DEV -1
+#endif
const C_Int_t Posix_ProcEnv_SC_2_FORT_DEV = _SC_2_FORT_DEV;
+#ifndef _SC_2_FORT_RUN
+#define _SC_2_FORT_RUN -1
+#endif
const C_Int_t Posix_ProcEnv_SC_2_FORT_RUN = _SC_2_FORT_RUN;
+#ifndef _SC_2_LOCALEDEF
+#define _SC_2_LOCALEDEF -1
+#endif
const C_Int_t Posix_ProcEnv_SC_2_LOCALEDEF = _SC_2_LOCALEDEF;
+#ifndef _SC_2_PBS
+#define _SC_2_PBS -1
+#endif
const C_Int_t Posix_ProcEnv_SC_2_PBS = _SC_2_PBS;
+#ifndef _SC_2_PBS_ACCOUNTING
+#define _SC_2_PBS_ACCOUNTING -1
+#endif
const C_Int_t Posix_ProcEnv_SC_2_PBS_ACCOUNTING = _SC_2_PBS_ACCOUNTING;
+#ifndef _SC_2_PBS_CHECKPOINT
+#define _SC_2_PBS_CHECKPOINT -1
+#endif
const C_Int_t Posix_ProcEnv_SC_2_PBS_CHECKPOINT = _SC_2_PBS_CHECKPOINT;
+#ifndef _SC_2_PBS_LOCATE
+#define _SC_2_PBS_LOCATE -1
+#endif
const C_Int_t Posix_ProcEnv_SC_2_PBS_LOCATE = _SC_2_PBS_LOCATE;
+#ifndef _SC_2_PBS_MESSAGE
+#define _SC_2_PBS_MESSAGE -1
+#endif
const C_Int_t Posix_ProcEnv_SC_2_PBS_MESSAGE = _SC_2_PBS_MESSAGE;
+#ifndef _SC_2_PBS_TRACK
+#define _SC_2_PBS_TRACK -1
+#endif
const C_Int_t Posix_ProcEnv_SC_2_PBS_TRACK = _SC_2_PBS_TRACK;
+#ifndef _SC_2_SW_DEV
+#define _SC_2_SW_DEV -1
+#endif
const C_Int_t Posix_ProcEnv_SC_2_SW_DEV = _SC_2_SW_DEV;
+#ifndef _SC_2_UPE
+#define _SC_2_UPE -1
+#endif
const C_Int_t Posix_ProcEnv_SC_2_UPE = _SC_2_UPE;
+#ifndef _SC_2_VERSION
+#define _SC_2_VERSION -1
+#endif
const C_Int_t Posix_ProcEnv_SC_2_VERSION = _SC_2_VERSION;
+#ifndef _SC_PAGE_SIZE
+#define _SC_PAGE_SIZE -1
+#endif
const C_Int_t Posix_ProcEnv_SC_PAGE_SIZE = _SC_PAGE_SIZE;
+#ifndef _SC_PAGESIZE
+#define _SC_PAGESIZE -1
+#endif
const C_Int_t Posix_ProcEnv_SC_PAGESIZE = _SC_PAGESIZE;
+#ifndef _SC_THREAD_DESTRUCTOR_ITERATIONS
+#define _SC_THREAD_DESTRUCTOR_ITERATIONS -1
+#endif
const C_Int_t Posix_ProcEnv_SC_THREAD_DESTRUCTOR_ITERATIONS = _SC_THREAD_DESTRUCTOR_ITERATIONS;
+#ifndef _SC_THREAD_KEYS_MAX
+#define _SC_THREAD_KEYS_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_THREAD_KEYS_MAX = _SC_THREAD_KEYS_MAX;
+#ifndef _SC_THREAD_STACK_MIN
+#define _SC_THREAD_STACK_MIN -1
+#endif
const C_Int_t Posix_ProcEnv_SC_THREAD_STACK_MIN = _SC_THREAD_STACK_MIN;
+#ifndef _SC_THREAD_THREADS_MAX
+#define _SC_THREAD_THREADS_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_THREAD_THREADS_MAX = _SC_THREAD_THREADS_MAX;
+#ifndef _SC_RE_DUP_MAX
+#define _SC_RE_DUP_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_RE_DUP_MAX = _SC_RE_DUP_MAX;
+#ifndef _SC_RTSIG_MAX
+#define _SC_RTSIG_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_RTSIG_MAX = _SC_RTSIG_MAX;
+#ifndef _SC_SEM_NSEMS_MAX
+#define _SC_SEM_NSEMS_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_SEM_NSEMS_MAX = _SC_SEM_NSEMS_MAX;
+#ifndef _SC_SEM_VALUE_MAX
+#define _SC_SEM_VALUE_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_SEM_VALUE_MAX = _SC_SEM_VALUE_MAX;
+#ifndef _SC_SIGQUEUE_MAX
+#define _SC_SIGQUEUE_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_SIGQUEUE_MAX = _SC_SIGQUEUE_MAX;
+#ifndef _SC_STREAM_MAX
+#define _SC_STREAM_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_STREAM_MAX = _SC_STREAM_MAX;
+#ifndef _SC_SYMLOOP_MAX
+#define _SC_SYMLOOP_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_SYMLOOP_MAX = _SC_SYMLOOP_MAX;
+#ifndef _SC_TIMER_MAX
+#define _SC_TIMER_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_TIMER_MAX = _SC_TIMER_MAX;
+#ifndef _SC_TTY_NAME_MAX
+#define _SC_TTY_NAME_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_TTY_NAME_MAX = _SC_TTY_NAME_MAX;
+#ifndef _SC_TZNAME_MAX
+#define _SC_TZNAME_MAX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_TZNAME_MAX = _SC_TZNAME_MAX;
+#ifndef _SC_XBS5_ILP32_OFF32
+#define _SC_XBS5_ILP32_OFF32 -1
+#endif
const C_Int_t Posix_ProcEnv_SC_XBS5_ILP32_OFF32 = _SC_XBS5_ILP32_OFF32;
+#ifndef _SC_XBS5_ILP32_OFFBIG
+#define _SC_XBS5_ILP32_OFFBIG -1
+#endif
const C_Int_t Posix_ProcEnv_SC_XBS5_ILP32_OFFBIG = _SC_XBS5_ILP32_OFFBIG;
+#ifndef _SC_XBS5_LP64_OFF64
+#define _SC_XBS5_LP64_OFF64 -1
+#endif
const C_Int_t Posix_ProcEnv_SC_XBS5_LP64_OFF64 = _SC_XBS5_LP64_OFF64;
+#ifndef _SC_XBS5_LPBIG_OFFBIG
+#define _SC_XBS5_LPBIG_OFFBIG -1
+#endif
const C_Int_t Posix_ProcEnv_SC_XBS5_LPBIG_OFFBIG = _SC_XBS5_LPBIG_OFFBIG;
+#ifndef _SC_XOPEN_CRYPT
+#define _SC_XOPEN_CRYPT -1
+#endif
const C_Int_t Posix_ProcEnv_SC_XOPEN_CRYPT = _SC_XOPEN_CRYPT;
+#ifndef _SC_XOPEN_ENH_I18N
+#define _SC_XOPEN_ENH_I18N -1
+#endif
const C_Int_t Posix_ProcEnv_SC_XOPEN_ENH_I18N = _SC_XOPEN_ENH_I18N;
+#ifndef _SC_XOPEN_LEGACY
+#define _SC_XOPEN_LEGACY -1
+#endif
const C_Int_t Posix_ProcEnv_SC_XOPEN_LEGACY = _SC_XOPEN_LEGACY;
+#ifndef _SC_XOPEN_REALTIME
+#define _SC_XOPEN_REALTIME -1
+#endif
const C_Int_t Posix_ProcEnv_SC_XOPEN_REALTIME = _SC_XOPEN_REALTIME;
+#ifndef _SC_XOPEN_REALTIME_THREADS
+#define _SC_XOPEN_REALTIME_THREADS -1
+#endif
const C_Int_t Posix_ProcEnv_SC_XOPEN_REALTIME_THREADS = _SC_XOPEN_REALTIME_THREADS;
+#ifndef _SC_XOPEN_SHM
+#define _SC_XOPEN_SHM -1
+#endif
const C_Int_t Posix_ProcEnv_SC_XOPEN_SHM = _SC_XOPEN_SHM;
#ifndef __SC_XOPEN_STREAMS
#define _SC_XOPEN_STREAMS -1
#endif
+#ifndef _SC_XOPEN_STREAMS
+#define _SC_XOPEN_STREAMS -1
+#endif
const C_Int_t Posix_ProcEnv_SC_XOPEN_STREAMS = _SC_XOPEN_STREAMS;
+#ifndef _SC_XOPEN_UNIX
+#define _SC_XOPEN_UNIX -1
+#endif
const C_Int_t Posix_ProcEnv_SC_XOPEN_UNIX = _SC_XOPEN_UNIX;
+#ifndef _SC_XOPEN_VERSION
+#define _SC_XOPEN_VERSION -1
+#endif
const C_Int_t Posix_ProcEnv_SC_XOPEN_VERSION = _SC_XOPEN_VERSION;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform/cygwin.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform/cygwin.h 2006-05-07 19:59:55 UTC (rev 4479)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform/cygwin.h 2006-05-07 20:01:49 UTC (rev 4480)
@@ -31,21 +31,6 @@
#define HAS_SPAWN TRUE
#define HAS_TIME_PROFILING FALSE
-#define _SC_BOGUS 0xFFFFFFFF
-#define _SC_2_FORT_DEV _SC_BOGUS
-#define _SC_2_FORT_RUN _SC_BOGUS
-#define _SC_2_SW_DEV _SC_BOGUS
-#define _SC_2_VERSION _SC_BOGUS
-#define _SC_BC_BASE_MAX _SC_BOGUS
-#define _SC_BC_DIM_MAX _SC_BOGUS
-#define _SC_BC_SCALE_MAX _SC_BOGUS
-#define _SC_BC_STRING_MAX _SC_BOGUS
-#define _SC_COLL_WEIGHTS_MAX _SC_BOGUS
-#define _SC_EXPR_NEST_MAX _SC_BOGUS
-#define _SC_LINE_MAX _SC_BOGUS
-#define _SC_RE_DUP_MAX _SC_BOGUS
-#define _SC_STREAM_MAX _SC_BOGUS
-
#define MSG_DONTWAIT 0
#define PF_INET6 0
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform/mingw.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform/mingw.h 2006-05-07 19:59:55 UTC (rev 4479)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform/mingw.h 2006-05-07 20:01:49 UTC (rev 4480)
@@ -212,28 +212,13 @@
/* Posix.ProcEnv */
/* ------------------------------------------------- */
-#define _SC_BOGUS 0xFFFFFFFF
-#define _SC_2_FORT_DEV _SC_BOGUS
-#define _SC_2_FORT_RUN _SC_BOGUS
-#define _SC_2_SW_DEV _SC_BOGUS
-#define _SC_2_VERSION _SC_BOGUS
#define _SC_ARG_MAX 0
-#define _SC_BC_BASE_MAX _SC_BOGUS
-#define _SC_BC_DIM_MAX _SC_BOGUS
-#define _SC_BC_SCALE_MAX _SC_BOGUS
-#define _SC_BC_STRING_MAX _SC_BOGUS
#define _SC_CHILD_MAX 1
#define _SC_CLK_TCK 2
-#define _SC_COLL_WEIGHTS_MAX _SC_BOGUS
-#define _SC_EXPR_NEST_MAX _SC_BOGUS
#define _SC_JOB_CONTROL 5
-#define _SC_LINE_MAX _SC_BOGUS
#define _SC_NGROUPS_MAX 3
#define _SC_OPEN_MAX 4
-#define _SC_RE_DUP_MAX _SC_BOGUS
#define _SC_SAVED_IDS 6
-#define _SC_STREAM_MAX _SC_BOGUS
-#define _SC_TZNAME_MAX 20
#define _SC_VERSION 7
struct tms {
|
|
From: Stephen W. <sw...@ml...> - 2006-05-07 12:59:56
|
Defined HAS_FPCLASSIFY32 on Solaris. ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h 2006-05-07 19:06:46 UTC (rev 4478) +++ mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h 2006-05-07 19:59:55 UTC (rev 4479) @@ -31,6 +31,7 @@ #define HAS_FEROUND TRUE #define HAS_FPCLASSIFY FALSE +#define HAS_FPCLASSIFY32 TRUE #define HAS_FPCLASSIFY64 TRUE #define HAS_REMAP FALSE #define HAS_SIGALTSTACK TRUE |
|
From: Stephen W. <sw...@ml...> - 2006-05-07 12:06:47
|
Fixed __atribute__ ((noreturn)), which goes at the very front of a
function definition.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Process/spawne.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Process/spawnp.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Process/spawne.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Process/spawne.c 2006-05-07 18:48:45 UTC (rev 4477)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Process/spawne.c 2006-05-07 19:06:46 UTC (rev 4478)
@@ -1,6 +1,7 @@
#include "platform.h"
#if HAS_SPAWN
+
C_Errno_t(C_Int_t) MLton_Process_spawne (NullString8_t p, NullString8Array_t a, NullString8Array_t e) {
const char *path;
const char *asaved;
@@ -27,14 +28,12 @@
env[en] = esaved;
return res;
}
+
#else
+__attribute__ ((noreturn))
C_Errno_t(C_Int_t) MLton_Process_spawne (__attribute__ ((unused)) NullString8_t p,
__attribute__ ((unused)) NullString8Array_t a,
- __attribute__ ((unused)) NullString8Array_t e) __attribute__ ((noreturn));
-
-C_Errno_t(C_Int_t) MLton_Process_spawne (__attribute__ ((unused)) NullString8_t p,
- __attribute__ ((unused)) NullString8Array_t a,
__attribute__ ((unused)) NullString8Array_t e) {
die ("MLton_Process_spawne not implemented");
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Process/spawnp.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Process/spawnp.c 2006-05-07 18:48:45 UTC (rev 4477)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Process/spawnp.c 2006-05-07 19:06:46 UTC (rev 4478)
@@ -1,6 +1,7 @@
#include "platform.h"
#if HAS_SPAWN
+
C_Errno_t(C_Int_t) MLton_Process_spawnp (NullString8_t p, NullString8Array_t a) {
const char *file;
const char *asaved;
@@ -18,12 +19,13 @@
args[an] = asaved;
return res;
}
+
#else
-C_Errno_t(C_Int_t) MLton_Process_spawnp (__attribute__ ((unused)) NullString8_t p,
- __attribute__ ((unused)) NullString8Array_t a) __attribute__ ((noreturn));
+__attribute__ ((noreturn))
C_Errno_t(C_Int_t) MLton_Process_spawnp (__attribute__ ((unused)) NullString8_t p,
__attribute__ ((unused)) NullString8Array_t a) {
die ("MLton_Process_spawnp not implemented");
}
+
#endif
|
|
From: Stephen W. <sw...@ml...> - 2006-05-07 11:48:46
|
#define PRIxPTR in solaris.h for now. ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h 2006-05-07 17:06:17 UTC (rev 4476) +++ mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h 2006-05-07 18:48:45 UTC (rev 4477) @@ -48,3 +48,6 @@ int signbit32 (float f); int signbit64 (double f); +#ifndef PRIxPTR +#define PRIxPTR "x" +#endif |
|
From: Stephen W. <sw...@ml...> - 2006-05-07 10:06:18
|
Added __attribute__ ((noreturn)) for spawn functions. I didn't know
how to syntactically do that without duplicating the prototype. If
anyone does, please fix it.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Process/spawne.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Process/spawnp.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Process/spawne.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Process/spawne.c 2006-05-07 02:11:27 UTC (rev 4475)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Process/spawne.c 2006-05-07 17:06:17 UTC (rev 4476)
@@ -28,9 +28,15 @@
return res;
}
#else
+
C_Errno_t(C_Int_t) MLton_Process_spawne (__attribute__ ((unused)) NullString8_t p,
__attribute__ ((unused)) NullString8Array_t a,
+ __attribute__ ((unused)) NullString8Array_t e) __attribute__ ((noreturn));
+
+C_Errno_t(C_Int_t) MLton_Process_spawne (__attribute__ ((unused)) NullString8_t p,
+ __attribute__ ((unused)) NullString8Array_t a,
__attribute__ ((unused)) NullString8Array_t e) {
die ("MLton_Process_spawne not implemented");
}
+
#endif
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Process/spawnp.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Process/spawnp.c 2006-05-07 02:11:27 UTC (rev 4475)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/Process/spawnp.c 2006-05-07 17:06:17 UTC (rev 4476)
@@ -20,6 +20,9 @@
}
#else
C_Errno_t(C_Int_t) MLton_Process_spawnp (__attribute__ ((unused)) NullString8_t p,
+ __attribute__ ((unused)) NullString8Array_t a) __attribute__ ((noreturn));
+
+C_Errno_t(C_Int_t) MLton_Process_spawnp (__attribute__ ((unused)) NullString8_t p,
__attribute__ ((unused)) NullString8Array_t a) {
die ("MLton_Process_spawnp not implemented");
}
|
|
From: Stephen W. <sw...@ml...> - 2006-05-06 19:11:27
|
Fixed feround.h. ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/platform/feround.h U mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform/feround.h =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/platform/feround.h 2006-05-07 02:09:37 UTC (rev 4474) +++ mlton/branches/on-20050822-x86_64-branch/runtime/platform/feround.h 2006-05-07 02:11:27 UTC (rev 4475) @@ -1,3 +1,2 @@ - -int fegetround (); +int fegetround (void); void fesetround (int mode); Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h 2006-05-07 02:09:37 UTC (rev 4474) +++ mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h 2006-05-07 02:11:27 UTC (rev 4475) @@ -21,14 +21,13 @@ #include <termios.h> #include <ucontext.h> +#include "feround.h" #include "setenv.h" #define FE_TONEAREST 0 #define FE_DOWNWARD 1 #define FE_UPWARD 2 #define FE_TOWARDZERO 3 -int fegetround (void); -void fesetround (int mode); #define HAS_FEROUND TRUE #define HAS_FPCLASSIFY FALSE |
|
From: Stephen W. <sw...@ml...> - 2006-05-06 19:09:37
|
Eliminated duplicate prototype for fpclassify64. Fixed fegetround prototype. ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h 2006-05-07 01:23:01 UTC (rev 4473) +++ mlton/branches/on-20050822-x86_64-branch/runtime/platform/solaris.h 2006-05-07 02:09:37 UTC (rev 4474) @@ -27,9 +27,8 @@ #define FE_DOWNWARD 1 #define FE_UPWARD 2 #define FE_TOWARDZERO 3 -int fegetround (); +int fegetround (void); void fesetround (int mode); -int fpclassify64 (double d); #define HAS_FEROUND TRUE #define HAS_FPCLASSIFY FALSE |
|
From: Stephen W. <sw...@ml...> - 2006-05-06 18:23:02
|
Added #if to get socklen_t on Solaris. ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h 2006-05-07 01:22:00 UTC (rev 4472) +++ mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h 2006-05-07 01:23:01 UTC (rev 4473) @@ -71,6 +71,10 @@ #include <sys/stat.h> #include <sys/time.h> +#if (defined (__sun__)) +#include <sys/socket.h> +#endif + #include "gmp.h" #endif /* _MLTON_CENV_H_ */ |
|
From: Stephen W. <sw...@ml...> - 2006-05-06 18:22:01
|
Added directories for more platforms. ---------------------------------------------------------------------- A mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/sparc-solaris/ A mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-cygwin/ A mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-freebsd/ A mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-mingw/ A mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-netbsd/ A mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-openbsd/ ---------------------------------------------------------------------- |
|
From: Stephen W. <sw...@ml...> - 2006-05-06 17:51:57
|
stdint.h is missing on some platforms. I took the #ifdef from the old types.h. ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h 2006-05-06 20:37:29 UTC (rev 4470) +++ mlton/branches/on-20050822-x86_64-branch/runtime/cenv.h 2006-05-07 00:51:54 UTC (rev 4471) @@ -38,7 +38,13 @@ #include <stdarg.h> #include <stdbool.h> #include <stddef.h> +#if (defined(__hpux__) || defined (__OpenBSD__)) +#include <inttypes.h> +#elif (defined (__sun__)) +#include <sys/int_types.h> +#else #include <stdint.h> +#endif #include <stdio.h> #include <stdlib.h> #include <string.h> |
|
From: Matthew F. <fl...@ml...> - 2006-05-06 13:37:29
|
Documentation ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/man/mlton.1 ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/man/mlton.1 =================================================================== --- mlton/branches/on-20050822-x86_64-branch/man/mlton.1 2006-05-06 20:24:53 UTC (rev 4469) +++ mlton/branches/on-20050822-x86_64-branch/man/mlton.1 2006-05-06 20:37:29 UTC (rev 4470) @@ -84,6 +84,16 @@ Defaults may be overridden by an annotation in an ML Basis file. .TP +\fB-default-type \fItype\fP\fR +Specify the default binding for a primitive type. For example, +\fB-default-type word64\fP causes the top-level type \fBword\fP and +the top-level structure \fBWord\fP in the Basis Library to be equal to +\fBWord64.word\fP and \fBWord64:WORD\fP, respectively. Similarly, +\fB-default-type intinf\fP causes the top-level type \fBint\fP and +the top-level structure \fBInt\fP in the Basis Library to be equal to +\fBIntInf.int\fP and \fBIntInf:INTEGER\fP, respectively. + +.TP \fB-disable-ann \fIann\fP\fR Ignore the specified ML Basis annotation in every ML Basis File. For example, to see \fIall\fP match and unused warnings, compile with |
|
From: Matthew F. <fl...@ml...> - 2006-05-06 13:24:55
|
Elaborate constants to default types
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/mlton/ast/char-size.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/ast/char-size.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/ast/int-size.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/ast/int-size.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-core.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.fun
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/char-size.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/char-size.fun 2006-05-06 18:44:35 UTC (rev 4468)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/char-size.fun 2006-05-06 20:24:53 UTC (rev 4469)
@@ -21,8 +21,6 @@
| C2 => 16
| C4 => 32)
-val default = C1
-
val equals = op =
fun fromBits b =
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/char-size.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/char-size.sig 2006-05-06 18:44:35 UTC (rev 4468)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/char-size.sig 2006-05-06 20:24:53 UTC (rev 4469)
@@ -17,7 +17,6 @@
val all: t list
val bits: t -> Bits.t
- val default: t
val equals: t * t -> bool
val fromBits: Bits.t -> t
val isInRange: t * IntInf.t -> bool
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/int-size.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/int-size.fun 2006-05-06 18:44:35 UTC (rev 4468)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/int-size.fun 2006-05-06 20:24:53 UTC (rev 4469)
@@ -40,17 +40,15 @@
then SOME (make (Bits.fromInt i))
else NONE)
-fun I (b: Bits.t): t =
+fun fromBits (b: Bits.t): t =
case Vector.sub (allVector, Bits.toInt b) handle Subscript => NONE of
- NONE => Error.bug (concat ["IntSize.I: strange int size: ", Bits.toString b])
+ NONE => Error.bug (concat ["IntSize.fromBits: strange int size: ", Bits.toString b])
| SOME s => s
-val all = List.map (sizes, I)
+val all = List.map (sizes, fromBits)
-val prims = List.map ([8, 16, 32, 64], I o Bits.fromInt)
+val prims = List.map ([8, 16, 32, 64], fromBits o Bits.fromInt)
-val default = I Bits.inWord
-
val memoize: (t -> 'a) -> t -> 'a =
fn f =>
let
@@ -73,7 +71,7 @@
then 64
else Error.bug "IntSize.roundUpToPrim"
in
- I (Bits.fromInt bits)
+ fromBits (Bits.fromInt bits)
end
val bytes: t -> Bytes.t = Bits.toBytes o bits
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/int-size.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/int-size.sig 2006-05-06 18:44:35 UTC (rev 4468)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/int-size.sig 2006-05-06 20:24:53 UTC (rev 4469)
@@ -22,9 +22,8 @@
val bytes: t -> Bytes.t
val cardinality: t -> IntInf.t
val compare: t * t -> Relation.t
- val default: t
val equals: t * t -> bool
- val I : Bits.t -> t
+ val fromBits : Bits.t -> t
val layout: t -> Layout.t
val memoize: (t -> 'a) -> t -> 'a
datatype prim = I8 | I16 | I32 | I64
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.fun 2006-05-06 18:44:35 UTC (rev 4468)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.fun 2006-05-06 20:24:53 UTC (rev 4469)
@@ -38,7 +38,6 @@
fun 'a make (prefix: string,
all: 'a list,
bits: 'a -> Bits.t,
- default: 'a,
equalsA: 'a * 'a -> bool,
memo: ('a -> t) -> ('a -> t),
admitsEquality: AdmitsEquality.t) =
@@ -58,35 +57,60 @@
Vector.toListMap (all, fn (tycon, _) =>
(tycon, Arity 0, admitsEquality))
in
- (fromSize default, fromSize, all, is, prims)
+ (fromSize, all, is, prims)
end
in
- val (defaultChar, char, _, isCharX, primChars) =
+ val (char, _, isCharX, primChars) =
let
open CharSize
in
- make ("char", all, bits, default, equals, memoize, Sometimes)
+ make ("char", all, bits, equals, memoize, Sometimes)
end
- val (defaultInt, int, ints, isIntX, primInts) =
+ val (int, ints, isIntX, primInts) =
let
open IntSize
in
- make ("int", all, bits, default, equals, memoize, Sometimes)
+ make ("int", all, bits, equals, memoize, Sometimes)
end
- val (defaultReal, real, reals, isRealX, primReals) =
+ val (real, reals, isRealX, primReals) =
let
open RealSize
in
- make ("real", all, bits, default, equals, memoize, Never)
+ make ("real", all, bits, equals, memoize, Never)
end
- val (defaultWord, word, words, isWordX, primWords) =
+ val (word, words, isWordX, primWords) =
let
open WordSize
in
- make ("word", all, bits, default, equals, memoize, Sometimes)
+ make ("word", all, bits, equals, memoize, Sometimes)
end
end
+val defaultChar = fn () =>
+ case !Control.defaultChar of
+ "char8" => char CharSize.C1
+ | _ => Error.bug "PrimTycons.defaultChar"
+val defaultInt = fn () =>
+ case !Control.defaultInt of
+ "int8" => int (IntSize.fromBits (Bits.fromInt 8))
+ | "int16" => int (IntSize.fromBits (Bits.fromInt 16))
+ | "int32" => int (IntSize.fromBits (Bits.fromInt 32))
+ | "int64" => int (IntSize.fromBits (Bits.fromInt 64))
+ | "intinf" => intInf
+ | _ => Error.bug "PrimTycons.defaultInt"
+val defaultReal = fn () =>
+ case !Control.defaultReal of
+ "real32" => real RealSize.R32
+ | "real64" => real RealSize.R64
+ | _ => Error.bug "PrimTycons.defaultReal"
+val defaultWord = fn () =>
+ case !Control.defaultWord of
+ "word8" => word (WordSize.fromBits (Bits.fromInt 8))
+ | "word16" => word (WordSize.fromBits (Bits.fromInt 16))
+ | "word32" => word (WordSize.fromBits (Bits.fromInt 32))
+ | "word64" => word (WordSize.fromBits (Bits.fromInt 64))
+ | _ => Error.bug "PrimTycons.defaultWord"
+
val isIntX = fn c => equals (c, intInf) orelse isIntX c
val prims =
@@ -122,7 +146,7 @@
let
val ({isChar}, lay) =
case Vector.length args of
- 0 => ({isChar = equals (c, defaultChar)}, layout c)
+ 0 => ({isChar = equals (c, defaultChar ())}, layout c)
| 1 => ({isChar = false},
seq [maybe (Vector.sub (args, 0)), str " ", layout c])
| _ => ({isChar = false},
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.sig 2006-05-06 18:44:35 UTC (rev 4468)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.sig 2006-05-06 20:24:53 UTC (rev 4469)
@@ -37,10 +37,10 @@
val arrow: tycon
val bool: tycon
val char: CharSize.t -> tycon
- val defaultChar: tycon
- val defaultInt: tycon
- val defaultReal: tycon
- val defaultWord: tycon
+ val defaultChar: unit -> tycon
+ val defaultInt: unit -> tycon
+ val defaultReal: unit -> tycon
+ val defaultWord: unit -> tycon
val exn: tycon
val int: IntSize.t -> tycon
val ints: (tycon * IntSize.t) vector
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-core.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-core.fun 2006-05-06 18:44:35 UTC (rev 4468)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-core.fun 2006-05-06 20:24:53 UTC (rev 4469)
@@ -745,7 +745,7 @@
in
[Int8, Int16, Int32]
end)
- @ sized (Tycon.int o IntSize.I,
+ @ sized (Tycon.int o IntSize.fromBits,
let
open CType
in
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.fun 2006-05-06 18:44:35 UTC (rev 4468)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.fun 2006-05-06 20:24:53 UTC (rev 4469)
@@ -426,10 +426,10 @@
| Word => Tycon.isWordX c
val defaultTycon: t -> Tycon.t =
- fn Char => Tycon.defaultChar
- | Int => Tycon.defaultInt
- | Real => Tycon.defaultReal
- | Word => Tycon.defaultWord
+ fn Char => Tycon.defaultChar ()
+ | Int => Tycon.defaultInt ()
+ | Real => Tycon.defaultReal ()
+ | Word => Tycon.defaultWord ()
end
(* Tuples of length <> 1 are always represented as records.
@@ -1284,18 +1284,15 @@
val () = setSynonym (Tycon.pointer, Tycon.word (WordSize.pointer ()))
- val defaultChar = con (Tycon.char CharSize.default, Vector.new0 ())
- val defaultInt = con (Tycon.int IntSize.default, Vector.new0 ())
-
structure Overload =
struct
open Overload
val defaultType =
- fn Char => defaultChar
- | Int => defaultInt
- | Real => defaultReal
- | Word => defaultWord
+ fn Char => con (Tycon.defaultChar (), Vector.new0 ())
+ | Int => con (Tycon.defaultInt (), Vector.new0 ())
+ | Real => con (Tycon.defaultReal (), Vector.new0 ())
+ | Word => con (Tycon.defaultWord (), Vector.new0 ())
end
fun 'a simpleHom {con: t * Tycon.t * 'a vector -> 'a,
|
|
From: Matthew F. <fl...@ml...> - 2006-05-06 11:44:58
|
Merge and drop .refactor
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/Makefile
U mlton/branches/on-20050822-x86_64-branch/basis-library/Makefile
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array-slice.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array2.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/mono-array.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/mono.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.fun
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/slice.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector-slice.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/build/
A mlton/branches/on-20050822-x86_64-branch/basis-library/config/bind/
U mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/errno.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/position.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/sys-word.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/test/
U mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-linux/c-types.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/config/choose.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/config/default/
A mlton/branches/on-20050822-x86_64-branch/basis-library/config/header/
A mlton/branches/on-20050822-x86_64-branch/basis-library/config/objptr/
A mlton/branches/on-20050822-x86_64-branch/basis-library/config/seqindex/
U mlton/branches/on-20050822-x86_64-branch/basis-library/general/general.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/general/option.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/embed-int.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/embed-word.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-global.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf0.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf1.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int0.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int1.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/integer.sig
A mlton/branches/on-20050822-x86_64-branch/basis-library/integer/pack-word.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library/integer/pack-word32.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library/integer/patch.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/integer/word-global.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/word.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/word.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/integer/word0.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/integer/word1.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/io/bin-io.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/io/imperative-io.fun
U mlton/branches/on-20050822-x86_64-branch/basis-library/io/io.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/io/prim-io.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/io/text-io.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-2002/top-level/basis.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/list/list.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/maps/
D mlton/branches/on-20050822-x86_64-branch/basis-library/misc/
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/call-stack.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/cont.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exit.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exn.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/ffi.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/ffi.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/finalizable.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/gc.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/int-inf.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/itimer.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/mlton.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/pointer.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/pointer.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/proc-env.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/process.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/profile.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/random.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rusage.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/signal.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/socket.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/socket.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/thread.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/vector.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/word.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/world.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/generic-sock.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/inet-sock.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-host-db.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-host-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-prot-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-serv-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/net.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/net.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/unix-sock.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/file-sys.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/file-sys.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/flags.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/flags.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/io.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/posix.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/proc-env.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/process.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/stub-mingw.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/sys-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/tty.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/check-pack-real.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/check-pack-word.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/check-real.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-basis.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-char.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-int-inf.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-int.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-mlton.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-nullstring.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-pack-real.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-pack-word.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-real.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-seq.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-string.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-word.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim1.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim2.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.mlb
D mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/real/IEEE-real.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/real/IEEE-real.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/real/pack-real.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/real/real-global.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.fun
U mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.sig
A mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library/real/real32.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library/real/real64.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/sml-nj/unsafe.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/command-line.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/date.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/file-sys.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/io.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/pre-os.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/process.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/process.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/text/byte.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/text/char-global.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/text/char.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/text/char0.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/text/nullstring.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/text/string-cvt.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/text/string-global.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/text/string.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/text/string0.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/text/substring-global.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/text/substring.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/top-level/infixes-unsafe.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/util/
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/
U mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml
U mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
U mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/Makefile 2006-05-06 18:13:28 UTC (rev 4467)
+++ mlton/branches/on-20050822-x86_64-branch/Makefile 2006-05-06 18:44:35 UTC (rev 4468)
@@ -69,7 +69,7 @@
basis-no-check:
mkdir -p $(LIB)/sml
rm -rf $(LIB)/sml/basis
- $(CP) $(SRC)/basis-library.refactor/. $(LIB)/sml/basis
+ $(CP) $(SRC)/basis-library/. $(LIB)/sml/basis
find $(LIB)/sml/basis -type d -name .svn | xargs rm -rf
find $(LIB)/sml/basis -type f -name .ignore | xargs rm -rf
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/Makefile 2006-05-06 18:13:28 UTC (rev 4467)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/Makefile 2006-05-06 18:44:35 UTC (rev 4468)
@@ -6,9 +6,58 @@
# See the file MLton-LICENSE for details.
##
+SRC = $(shell cd .. && pwd)
+BUILD = $(SRC)/build
+BIN = $(BUILD)/bin
+MLTON = mlton
+PATH = $(BIN):$(shell echo $$PATH)
+
all:
.PHONY: clean
clean:
find . -type f | egrep '.(old|ast|core-ml)$$' | xargs rm -f
../bin/clean
+
+
+OBJPTR_MAPS = objptr-rep32.map objptr-rep64.map
+HEADER_MAPS = header-word32.map header-word64.map
+SEQINDEX_MAPS = seqindex-int32.map seqindex-int64.map
+TARGET_ARCH = x86 amd64
+TARGET_OS = linux
+DEFAULT_CHAR = char8
+DEFAULT_INT = int32 int64 intinf
+DEFAULT_REAL = real32 real64
+DEFAULT_WORD = word32 word64
+
+.PHONY: type-check-def
+type-check-def:
+ $(MLTON) -disable-ann deadCode -stop tc -show-types true \
+ libs/all.mlb; \
+
+.PHONY: type-check-all
+type-check-all:
+ for objptrrep in $(OBJPTR_MAPS); do \
+ for header in $(HEADER_MAPS); do \
+ for seqindex in $(SEQINDEX_MAPS); do \
+ for targetarch in $(TARGET_ARCH); do \
+ for targetos in $(TARGET_OS); do \
+ for defchar in $(DEFAULT_CHAR); do \
+ for defint in $(DEFAULT_INT); do \
+ for defreal in $(DEFAULT_REAL); do \
+ for defword in $(DEFAULT_WORD); do \
+ if [ ! -r config/c/$$targetarch-$$targetos/c-types.sml ]; then \
+ break; \
+ fi; \
+ echo "Type checking: $$objptrrep $$header $$seqindex $$targetarch $$targetos $$defchar $$defint $$defreal $$defword"; \
+ $(MLTON) -disable-ann deadCode -stop tc -show-types true \
+ -mlb-path-map "maps/$$objptrrep" \
+ -mlb-path-map "maps/$$header" \
+ -mlb-path-map "maps/$$seqindex" \
+ -mlb-path-map "maps/c-types.$$targetarch-$$targetos.map" \
+ -default-type "$$defchar" \
+ -default-type "$$defint" \
+ -default-type "$$defreal" \
+ -default-type "$$defword" \
+ libs/all.mlb; \
+ done; done; done; done; done; done; done; done; done
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array-slice.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array-slice.sig 2006-05-06 18:13:28 UTC (rev 4467)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array-slice.sig 2006-05-06 18:44:35 UTC (rev 4468)
@@ -1,3 +1,8 @@
+structure Array =
+ struct
+ type 'a array = 'a array
+ end
+
signature ARRAY_SLICE_GLOBAL =
sig
end
@@ -43,8 +48,15 @@
val concat: 'a slice list -> 'a array
val toList: 'a slice -> 'a list
+ val slice': 'a array * SeqIndex.int * SeqIndex.int option -> 'a slice
+ val unsafeSlice': 'a array * SeqIndex.int * SeqIndex.int option -> 'a slice
val unsafeSlice: 'a array * int * int option -> 'a slice
+ val sub': 'a slice * SeqIndex.int -> 'a
+ val unsafeSub': 'a slice * SeqIndex.int -> 'a
val unsafeSub: 'a slice * int -> 'a
+ val unsafeSubslice': 'a slice * SeqIndex.int * SeqIndex.int option -> 'a slice
val unsafeSubslice: 'a slice * int * int option -> 'a slice
+ val update': 'a slice * SeqIndex.int * 'a -> unit
+ val unsafeUpdate': 'a slice * SeqIndex.int * 'a -> unit
val unsafeUpdate: 'a slice * int * 'a -> unit
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array.sig 2006-05-06 18:13:28 UTC (rev 4467)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array.sig 2006-05-06 18:44:35 UTC (rev 4468)
@@ -40,11 +40,16 @@
structure ArraySlice: ARRAY_SLICE_EXTRA
+ val arrayUninit': SeqIndex.int -> 'a array
+ val arrayUninit: int -> 'a array
+ val array': SeqIndex.int * 'a -> 'a array
+ val unsafeSub': 'a array * SeqIndex.int -> 'a
+ val unsafeSub: 'a array * int -> 'a
+ val unsafeUpdate': 'a array * SeqIndex.int * 'a -> unit
+ val unsafeUpdate: 'a array * int * 'a -> unit
+
val concat: 'a array list -> 'a array
val duplicate: 'a array -> 'a array
- val rawArray: int -> 'a array
val toList: 'a array -> 'a list
val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a array * 'b
- val unsafeSub: 'a array * int -> 'a
- val unsafeUpdate: 'a array * int * 'a -> unit
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array.sml 2006-05-06 18:13:28 UTC (rev 4467)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array.sml 2006-05-06 18:44:35 UTC (rev 4468)
@@ -13,28 +13,43 @@
val fromArray = fn a => a
val isMutable = true
val length = Primitive.Array.length
- val sub = Primitive.Array.sub)
+ val subUnsafe = Primitive.Array.subUnsafe)
open A
- open Primitive.Int
+ val op +? = Int.+?
+ val op + = Int.+
+ val op -? = Int.-?
+ val op - = Int.-
+ val op < = Int.<
+ val op <= = Int.<=
+ val op > = Int.>
+ val op >= = Int.>=
+
+ fun wrap2 f = fn (i, x) => f (SeqIndex.toIntUnsafe i, x)
+
type 'a array = 'a array
type 'a vector = 'a Vector.vector
structure ArraySlice =
struct
open Slice
+ fun update' (arr, i, x) =
+ updateMk' Primitive.Array.updateUnsafe (arr, i, x)
fun update (arr, i, x) =
- update' Primitive.Array.update (arr, i, x)
+ updateMk Primitive.Array.updateUnsafe (arr, i, x)
+ fun unsafeUpdate' (arr, i, x) =
+ unsafeUpdateMk' Primitive.Array.updateUnsafe (arr, i, x)
fun unsafeUpdate (arr, i, x) =
- unsafeUpdate' Primitive.Array.update (arr, i, x)
- fun vector sl = create Vector.tabulate (fn x => x) sl
- fun modifyi f sl =
- appi (fn (i, x) => unsafeUpdate (sl, i, f (i, x))) sl
+ unsafeUpdateMk Primitive.Array.updateUnsafe (arr, i, x)
+ fun vector sl = create Vector.tabulate' (fn x => x) sl
+ fun modifyi' f sl =
+ appi' (fn (i, x) => unsafeUpdate' (sl, i, f (i, x))) sl
+ fun modifyi f sl = modifyi' (wrap2 f) sl
fun modify f sl = modifyi (f o #2) sl
local
- fun make (length, sub) {src, dst, di} =
- modifyi (fn (i, _) => sub (src, i))
- (slice (dst, di, SOME (length src)))
+ fun make (length, sub') {src, dst, di} =
+ modifyi' (fn (i, _) => sub' (src, i))
+ (slice (dst, di, SOME (length src)))
in
fun copy (arg as {src, dst, di}) =
let val (src', si', len') = base src
@@ -42,25 +57,23 @@
if src' = dst andalso si' < di andalso si' +? len' >= di
then let val sl = slice (dst, di, SOME (length src))
in
- foldri (fn (i, _, _) =>
- unsafeUpdate (sl, i, unsafeSub (src, i)))
+ foldri' (fn (i, _, _) =>
+ unsafeUpdate' (sl, i, unsafeSub' (src, i)))
() sl
end
- else make (length, unsafeSub) arg
+ else make (length, unsafeSub') arg
end
fun copyVec arg =
- make (Vector.VectorSlice.length, Vector.VectorSlice.unsafeSub) arg
+ make (Vector.VectorSlice.length, Vector.VectorSlice.unsafeSub') arg
end
end
- val rawArray = Primitive.Array.array
- val array = new
-
local
fun make f arr = f (ArraySlice.full arr)
in
fun vector arr = make (ArraySlice.vector) arr
+ fun modifyi' f = make (ArraySlice.modifyi' f)
fun modifyi f = make (ArraySlice.modifyi f)
fun modify f = make (ArraySlice.modify f)
fun copy {src, dst, di} = ArraySlice.copy {src = ArraySlice.full src,
@@ -69,9 +82,15 @@
dst = dst, di = di}
end
- val unsafeSub = Primitive.Array.sub
- fun update (arr, i, x) = update' Primitive.Array.update (arr, i, x)
- val unsafeUpdate = Primitive.Array.update
+ val arrayUninit' = newUninit'
+ val arrayUninit = newUninit
+ val array' = new'
+ val array = new
+
+ fun update' (arr, i, x) = updateMk' Primitive.Array.updateUnsafe (arr, i, x)
+ fun update (arr, i, x) = updateMk Primitive.Array.updateUnsafe (arr, i, x)
+ fun unsafeUpdate' (arr, i, x) = unsafeUpdateMk' Primitive.Array.updateUnsafe (arr, i, x)
+ fun unsafeUpdate (arr, i, x) = unsafeUpdateMk Primitive.Array.updateUnsafe (arr, i, x)
end
structure ArraySlice: ARRAY_SLICE_EXTRA = Array.ArraySlice
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array2.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array2.sml 2006-05-06 18:13:28 UTC (rev 4467)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array2.sml 2006-05-06 18:44:35 UTC (rev 4468)
@@ -6,86 +6,183 @@
* See the file MLton-LICENSE for details.
*)
-structure Array2: ARRAY2 =
+structure Array2 (* : ARRAY2 *) =
struct
- open Primitive.Int
- (* I am careful to use a type here instead of a datatype so that
- * 'a array will be an equality type irrespective of whether 'a is.
- * This is probably just an NJ-ism, but I don't want to think about it.
- *)
- type 'a array = {rows: int,
- cols: int,
- array: 'a Array.array}
+ val op +? = SeqIndex.+?
+ val op + = SeqIndex.+
+ val op -? = SeqIndex.-?
+ val op - = SeqIndex.-
+ val op *? = SeqIndex.*?
+ val op * = SeqIndex.*
+ val op < = SeqIndex.<
+ val op <= = SeqIndex.<=
+ val op > = SeqIndex.>
+ val op >= = SeqIndex.>=
+ val ltu = SeqIndex.ltu
+ val leu = SeqIndex.leu
+ val gtu = SeqIndex.gtu
+ val geu = SeqIndex.geu
- fun dimensions ({rows, cols, ...}: 'a array) = (rows, cols)
- fun nRows ({rows, ...}: 'a array) = rows
- fun nCols ({cols, ...}: 'a array) = cols
+ type 'a array = {array: 'a Array.array,
+ rows: SeqIndex.int,
+ cols: SeqIndex.int}
+ fun dimensions' ({rows, cols, ...}: 'a array) = (rows, cols)
+ fun dimensions ({rows, cols, ...}: 'a array) =
+ (SeqIndex.toIntUnsafe rows, SeqIndex.toIntUnsafe cols)
+ fun nRows' ({rows, ...}: 'a array) = rows
+ fun nRows ({rows, ...}: 'a array) = SeqIndex.toIntUnsafe rows
+ fun nCols' ({cols, ...}: 'a array) = cols
+ fun nCols ({cols, ...}: 'a array) = SeqIndex.toIntUnsafe cols
+
type 'a region = {base: 'a array,
row: int,
col: int,
nrows: int option,
ncols: int option}
- fun checkSliceMax (start: int, num: int option, max: int): int =
- case num of
- NONE =>
- if Primitive.safe andalso (start < 0 orelse start > max) then
- raise Subscript
- else
- max
- | SOME num =>
- if Primitive.safe
- andalso (start < 0
- orelse num < 0
- orelse start > max -? num) then
- raise Subscript
- else
- start +? num
+ local
+ fun checkSliceMax' (start: int,
+ num: SeqIndex.int option,
+ max: SeqIndex.int): SeqIndex.int * SeqIndex.int =
+ case num of
+ NONE => if Primitive.Controls.safe
+ then let
+ val start =
+ (SeqIndex.fromInt start)
+ handle Overflow => raise Subscript
+ in
+ if gtu (start, max)
+ then raise Subscript
+ else (start, max)
+ end
+ else (SeqIndex.fromIntUnsafe start, max)
+ | SOME num => if Primitive.Controls.safe
+ then let
+ val start =
+ (SeqIndex.fromInt start)
+ handle Overflow => raise Subscript
+ in
+ if (start < 0 orelse num < 0
+ orelse start +? num > max)
+ then raise Subscript
+ else (start, start +? num)
+ end
+ else (SeqIndex.fromIntUnsafe start,
+ SeqIndex.fromIntUnsafe start +? num)
+ fun checkSliceMax (start: int,
+ num: int option,
+ max: SeqIndex.int): SeqIndex.int * SeqIndex.int =
+ if Primitive.Controls.safe
+ then (checkSliceMax' (start, Option.map SeqIndex.fromInt num, max))
+ handle Overflow => raise Subscript
+ else checkSliceMax' (start, Option.map SeqIndex.fromIntUnsafe num, max)
+ in
+ fun checkRegion' {base, row, col, nrows, ncols} =
+ let
+ val (rows, cols) = dimensions' base
+ val (startRow, stopRow) = checkSliceMax' (row, nrows, rows)
+ val (startCol, stopCol) = checkSliceMax' (col, ncols, cols)
+ in
+ {startRow = startRow, stopRow = stopRow,
+ startCol = startCol, stopCol = stopCol}
+ end
+ fun checkRegion {base, row, col, nrows, ncols} =
+ let
+ val (rows, cols) = dimensions' base
+ val (startRow, stopRow) = checkSliceMax (row, nrows, rows)
+ val (startCol, stopCol) = checkSliceMax (col, ncols, cols)
+ in
+ {startRow = startRow, stopRow = stopRow,
+ startCol = startCol, stopCol = stopCol}
+ end
+ end
- fun checkRegion {base, row, col, nrows, ncols} =
- let
- val (rows, cols) = dimensions base
- in
- {stopRow = checkSliceMax (row, nrows, rows),
- stopCol = checkSliceMax (col, ncols, cols)}
- end
-
- fun wholeRegion (a: 'a array): 'a region =
+ fun wholeRegion (a as {rows, cols, ...}: 'a array): 'a region =
{base = a, row = 0, col = 0, nrows = NONE, ncols = NONE}
datatype traversal = RowMajor | ColMajor
local
fun make (rows, cols, doit) =
- if Primitive.safe andalso (rows < 0 orelse cols < 0)
+ if Primitive.Controls.safe
+ andalso (rows < 0 orelse cols < 0)
then raise Size
- else {rows = rows,
- cols = cols,
- array = doit (rows * cols handle Overflow => raise Size)}
+ else {array = doit (rows * cols handle Overflow => raise Size),
+ rows = rows,
+ cols = cols}
in
+ fun arrayUninit' (rows, cols) =
+ make (rows, cols, Array.arrayUninit')
+ fun array' (rows, cols, init) =
+ make (rows, cols, fn size => Array.array' (size, init))
+ end
+ local
+ fun make (rows, cols, doit) =
+ if Primitive.Controls.safe
+ then let
+ val rows =
+ (SeqIndex.fromInt rows)
+ handle Overflow => raise Size
+ val cols =
+ (SeqIndex.fromInt cols)
+ handle Overflow => raise Size
+ in
+ doit (rows, cols)
+ end
+ else doit (SeqIndex.fromIntUnsafe rows,
+ SeqIndex.fromIntUnsafe cols)
+ in
fun arrayUninit (rows, cols) =
- make (rows, cols, Primitive.Array.array)
+ make (rows, cols, fn (rows, cols) => arrayUninit' (rows, cols))
fun array (rows, cols, init) =
- make (rows, cols, fn size => Array.array (size, init))
+ make (rows, cols, fn (rows, cols) => array' (rows, cols, init))
end
fun array0 (): 'a array =
- {rows = 0,
- cols = 0,
- array = Primitive.Array.array 0}
+ {array = Array.arrayUninit' 0,
+ rows = 0,
+ cols = 0}
- fun spot ({rows, cols, ...}: 'a array, r, c) =
- if Primitive.safe andalso (geu (r, rows) orelse geu (c, cols))
+ fun unsafeSpot' (a as {cols, ...}: 'a array, r, c) =
+ r *? cols +? c
+ fun spot' (a as {rows, cols, ...}: 'a array, r, c) =
+ if Primitive.Controls.safe
+ andalso (geu (r, rows) orelse geu (c, cols))
then raise Subscript
- else r *? cols +? c
+ else unsafeSpot' (a, r, c)
- fun sub (a as {array, ...}: 'a array, r, c) =
- Primitive.Array.sub (array, spot (a, r, c))
+ fun unsafeSub' (a as {array, ...}: 'a array, r, c) =
+ Array.unsafeSub' (array, unsafeSpot' (a, r, c))
+ fun sub' (a as {array, ...}: 'a array, r, c) =
+ Array.unsafeSub' (array, spot' (a, r, c))
+ fun unsafeUpdate' (a as {array, ...}: 'a array, r, c, x) =
+ Array.unsafeUpdate' (array, unsafeSpot' (a, r, c), x)
+ fun update' (a as {array, ...}: 'a array, r, c, x) =
+ Array.unsafeUpdate' (array, spot' (a, r, c), x)
- fun update (a as {array, ...}: 'a array, r, c, x) =
- Primitive.Array.update (array, spot (a, r, c), x)
+ local
+ fun make (r, c, doit) =
+ if Primitive.Controls.safe
+ then let
+ val r =
+ (SeqIndex.fromInt r)
+ handle Overflow => raise Subscript
+ val c =
+ (SeqIndex.fromInt c)
+ handle Overflow => raise Subscript
+ in
+ doit (r, c)
+ end
+ else doit (SeqIndex.fromIntUnsafe r,
+ SeqIndex.fromIntUnsafe c)
+ in
+ fun sub (a, r, c) =
+ make (r, c, fn (r, c) => sub' (a, r, c))
+ fun update (a, r, c, x) =
+ make (r, c, fn (r, c) => update' (a, r, c, x))
+ end
fun 'a fromList (rows: 'a list list): 'a array =
case rows of
@@ -93,18 +190,19 @@
| row1 :: _ =>
let
val cols = length row1
- val a as {array, ...} = arrayUninit (length rows, cols)
+ val a as {array, rows = rows', cols = cols', ...} =
+ arrayUninit (length rows, cols)
val _ =
List.foldl
(fn (row: 'a list, i) =>
let
- val max = i +? cols
+ val max = i +? cols'
val i' =
List.foldl (fn (x: 'a, i) =>
(if i >= max
then raise Size
- else (Primitive.Array.update (array, i, x)
- ; i + 1)))
+ else (Array.unsafeUpdate' (array, i, x)
+ ; i +? 1)))
i row
in if i' = max
then i'
@@ -115,37 +213,77 @@
a
end
- fun row ({rows, cols, array}, r) =
- if Primitive.safe andalso geu (r, rows)
+ fun row' ({array, rows, cols}, r) =
+ if Primitive.Controls.safe andalso geu (r, rows)
then raise Subscript
else
- ArraySlice.vector (ArraySlice.slice (array, r *? cols, SOME cols))
-
- fun column (a as {rows, cols, ...}: 'a array, c) =
- if Primitive.safe andalso geu (c, cols)
+ ArraySlice.vector (ArraySlice.slice' (array, r *? cols, SOME cols))
+ fun row (a, r) =
+ if Primitive.Controls.safe
+ then let
+ val r =
+ (SeqIndex.fromInt r)
+ handle Overflow => raise Subscript
+ in
+ row' (a, r)
+ end
+ else row' (a, SeqIndex.fromIntUnsafe r)
+ fun column' (a as {rows, cols, ...}: 'a array, c) =
+ if Primitive.Controls.safe andalso geu (c, cols)
then raise Subscript
else
- Vector.tabulate (rows, fn r => sub(a, r, c))
+ Vector.tabulate' (rows, fn r => unsafeSub' (a, r, c))
+ fun column (a, c) =
+ if Primitive.Controls.safe
+ then let
+ val c =
+ (SeqIndex.fromInt c)
+ handle Overflow => raise Subscript
+ in
+ column' (a, c)
+ end
+ else column' (a, SeqIndex.fromIntUnsafe c)
- fun foldi trv f b (region as {base, row, col, ...}) =
+ fun foldi' trv f b (region as {base, row, col, ...}) =
let
- val {stopRow, stopCol} = checkRegion region
+ val {startRow, stopRow, startCol, stopCol} = checkRegion region
in
case trv of
RowMajor =>
- Util.naturalFoldStartStop
- (row, stopRow, b, fn (r, b) =>
- Util.naturalFoldStartStop
- (col, stopCol, b, fn (c, b) =>
- f (r, c, sub (base, r, c), b)))
+ let
+ fun loopRow (r, b) =
+ if r >= stopRow then b
+ else let
+ fun loopCol (c, b) =
+ if c >= stopCol then b
+ else loopCol (c +? 1, f (r, c, sub' (base, r, c), b))
+ in
+ loopRow (r +? 1, loopCol (startCol, b))
+ end
+ in
+ loopRow (startRow, b)
+ end
| ColMajor =>
- Util.naturalFoldStartStop
- (col, stopCol, b, fn (c, b) =>
- Util.naturalFoldStartStop
- (row, stopRow, b, fn (r, b) =>
- f (r, c, sub (base, r, c), b)))
+ let
+ fun loopCol (c, b) =
+ if c >= stopCol then b
+ else let
+ fun loopRow (r, b) =
+ if r >= stopRow then b
+ else loopRow (r +? 1, f (r, c, sub' (base, r, c), b))
+ in
+ loopCol (c +? 1, loopRow (startRow, b))
+ end
+ in
+ loopCol (startCol, b)
+ end
end
+ fun foldi trv f b a =
+ foldi' trv (fn (r, c, x, b) =>
+ f (SeqIndex.toIntUnsafe r,
+ SeqIndex.toIntUnsafe c,
+ x, b)) b a
fun fold trv f b a =
foldi trv (fn (_, _, x, b) => f (x, b)) b (wholeRegion a)
@@ -160,22 +298,24 @@
fun modify trv f a = modifyi trv (f o #3) (wholeRegion a)
fun tabulate trv (rows, cols, f) =
- let
+ let
val a = arrayUninit (rows, cols)
val () = modifyi trv (fn (r, c, _) => f (r, c)) (wholeRegion a)
- in
+ in
a
end
- fun copy {src = src as {base, row, col, ...}: 'a region,
+ fun copy {src = src as {base, ...}: 'a region,
dst, dst_row, dst_col} =
let
- val {stopRow, stopCol} = checkRegion src
- val nrows = stopRow -? row
- val ncols = stopCol -? col
- val _ = checkRegion {base = dst, row = dst_row, col = dst_col,
- nrows = SOME nrows, ncols = SOME ncols}
- fun for (start, stop, f: int -> unit) =
+ val {startRow, stopRow, startCol, stopCol} = checkRegion src
+ val nrows = stopRow -? startRow
+ val ncols = stopCol -? startCol
+ val {startRow = dst_row, startCol = dst_col, ...} =
+ checkRegion' {base = dst, row = dst_row, col = dst_col,
+ nrows = SOME nrows,
+ ncols = SOME ncols}
+ fun forUp (start, stop, f: SeqIndex.int -> unit) =
let
fun loop i =
if i >= stop
@@ -183,7 +323,7 @@
else (f i; loop (i + 1))
in loop start
end
- fun forDown (start, stop, f: int -> unit) =
+ fun forDown (start, stop, f: SeqIndex.int -> unit) =
let
fun loop i =
if i < start
@@ -191,11 +331,11 @@
else (f i; loop (i - 1))
in loop (stop -? 1)
end
- val forRows = if row <= dst_row then forDown else for
- val forCols = if col <= dst_col then for else forDown
+ val forRows = if startRow <= dst_row then forDown else forUp
+ val forCols = if startCol <= dst_col then forUp else forDown
in forRows (0, nrows, fn r =>
- forCols (0, ncols, fn c =>
- update (dst, dst_row +? r, dst_col +? c,
- sub (base, row +? r, col +? c))))
+ forCols (0, ncols, fn c =>
+ unsafeUpdate' (dst, dst_row +? r, dst_col +? c,
+ unsafeSub' (base, startRow +? r, startCol +? c))))
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/mono-array.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/mono-array.sig 2006-05-06 18:13:28 UTC (rev 4467)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/mono-array.sig 2006-05-06 18:44:35 UTC (rev 4468)
@@ -39,10 +39,11 @@
and type vector = vector
and type vector_slice = vector_slice
+ val arrayUninit: int -> array
+
val concat: array list -> array
val duplicate: array -> array
val fromPoly: elem Array.array -> array
- val rawArray: int -> array
val toList: array -> elem list
val toPoly: array -> elem Array.array
val unfoldi: int * 'a * (int * 'a -> elem * 'a) -> array * 'a
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/mono.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/mono.sml 2006-05-06 18:13:28 UTC (rev 4467)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/mono.sml 2006-05-06 18:44:35 UTC (rev 4468)
@@ -44,7 +44,7 @@
end
local
- structure S = EqMono (type elem = Bool.bool)
+ structure S = EqMono (type elem = Primitive.Bool.bool)
open S
in
structure BoolVector = Vector
@@ -54,24 +54,9 @@
structure BoolArray2 = Array2
end
local
- structure S:>
- EQ_MONO
- where type Array.elem = char
- where type Vector.vector = string
- = EqMono (type elem = char)
+ structure S = EqMono (type elem = Primitive.Int8.int)
open S
in
- structure CharArray = Array
- structure CharArray2 = Array2
- structure CharArraySlice = ArraySlice
- structure CharVector = Vector
- structure CharVectorSlice = VectorSlice
- val _ = CharVector.fromArray: CharArray.array -> CharVector.vector
-end
-local
- structure S = EqMono (type elem = Int8.int)
- open S
-in
structure Int8Vector = Vector
structure Int8VectorSlice = VectorSlice
structure Int8Array = Array
@@ -79,7 +64,7 @@
structure Int8Array2 = Array2
end
local
- structure S = EqMono (type elem = Int16.int)
+ structure S = EqMono (type elem = Primitive.Int16.int)
open S
in
structure Int16Vector = Vector
@@ -89,7 +74,7 @@
structure Int16Array2 = Array2
end
local
- structure S = EqMono (type elem = Int32.int)
+ structure S = EqMono (type elem = Primitive.Int32.int)
open S
in
structure Int32Vector = Vector
@@ -99,7 +84,7 @@
structure Int32Array2 = Array2
end
local
- structure S = EqMono (type elem = Int64.int)
+ structure S = EqMono (type elem = Primitive.Int64.int)
open S
in
structure Int64Vector = Vector
@@ -109,7 +94,7 @@
structure Int64Array2 = Array2
end
local
- structure S = EqMono (type elem = IntInf.int)
+ structure S = EqMono (type elem = Primitive.IntInf.int)
open S
in
structure IntInfVector = Vector
@@ -119,7 +104,7 @@
structure IntInfArray2 = Array2
end
local
- structure S = Mono (type elem = Real32.real)
+ structure S = Mono (type elem = Primitive.Real32.real)
open S
in
structure Real32Vector = Vector
@@ -129,7 +114,7 @@
structure Real32Array2 = Array2
end
local
- structure S = Mono (type elem = Real64.real)
+ structure S = Mono (type elem = Primitive.Real64.real)
open S
in
structure Real64Vector = Vector
@@ -139,10 +124,7 @@
structure Real64Array2 = Array2
end
local
- structure S:>
- EQ_MONO
- where type Array.elem = Word8.word
- = EqMono (type elem = Word8.word)
+ structure S = EqMono (type elem = Primitive.Word8.word)
open S
in
structure Word8Vector = Vector
@@ -152,7 +134,7 @@
structure Word8Array2 = Array2
end
local
- structure S = EqMono (type elem = Word16.word)
+ structure S = EqMono (type elem = Primitive.Word16.word)
open S
in
structure Word16Vector = Vector
@@ -162,7 +144,7 @@
structure Word16Array2 = Array2
end
local
- structure S = EqMono (type elem = Word32.word)
+ structure S = EqMono (type elem = Primitive.Word32.word)
open S
in
structure Word32Vector = Vector
@@ -172,7 +154,7 @@
structure Word32Array2 = Array2
end
local
- structure S = EqMono (type elem = Word64.word)
+ structure S = EqMono (type elem = Primitive.Word64.word)
open S
in
structure Word64Vector = Vector
@@ -182,38 +164,74 @@
structure Word64Array2 = Array2
end
-structure IntVector = Int32Vector
-structure IntVectorSlice = Int32VectorSlice
-structure IntArray = Int32Array
-structure IntArraySlice = Int32ArraySlice
-structure IntArray2 = Int32Array2
-structure LargeIntVector = IntInfVector
-structure LargeIntVectorSlice = IntInfVectorSlice
-structure LargeIntArray = IntInfArray
-structure LargeIntArraySlice = IntInfArraySlice
-structure LargeIntArray2 = IntInfArray2
-
-structure RealVector = Real64Vector
-structure RealVectorSlice = Real64VectorSlice
-structure RealArray = Real64Array
-structure RealArraySlice = Real64ArraySlice
-structure RealArray2 = Real64Array2
-
-structure LargeRealVector = Real64Vector
-structure LargeRealVectorSlice = Real64VectorSlice
-structure LargeRealArray = Real64Array
-structure LargeRealArraySlice = Real64ArraySlice
-structure LargeRealArray2 = Real64Array2
-
-structure WordVector = Word32Vector
-structure WordVectorSlice = Word32VectorSlice
-structure WordArray = Word32Array
-structure WordArraySlice = Word32ArraySlice
-structure WordArray2 = Word32Array2
-
-structure LargeWordVector = Word64Vector
-structure LargeWordVectorSlice = Word64VectorSlice
-structure LargeWordArray = Word64Array
-structure LargeWordArraySlice = Word64ArraySlice
-structure LargeWordArray2 = Word64Array2
+local
+ structure S = EqMono (type elem = Char.char)
+ open S
+in
+ structure CharArray = Array
+ structure CharArray2 = Array2
+ structure CharArraySlice = ArraySlice
+ structure CharVector = Vector
+ structure CharVectorSlice = VectorSlice
+end
+local
+ structure S = EqMono (type elem = Int.int)
+ open S
+in
+ structure IntVector = Vector
+ structure IntVectorSlice = VectorSlice
+ structure IntArray = Array
+ structure IntArraySlice = ArraySlice
+ structure IntArray2 = Array2
+end
+local
+ structure S = EqMono (type elem = LargeInt.int)
+ open S
+in
+ structure LargeIntVector = Vector
+ structure LargeIntVectorSlice = VectorSlice
+ structure LargeIntArray = Array
+ structure LargeIntArraySlice = ArraySlice
+ structure LargeIntArray2 = Array2
+end
+local
+ structure S = Mono (type elem = Real.real)
+ open S
+in
+ structure RealVector = Vector
+ structure RealVectorSlice = VectorSlice
+ structure RealArray = Array
+ structure RealArraySlice = ArraySlice
+ structure RealArray2 = Array2
+end
+local
+ structure S = Mono (type elem = LargeReal.real)
+ open S
+in
+ structure LargeRealVector = Vector
+ structure LargeRealVectorSlice = VectorSlice
+ structure LargeRealArray = Array
+ structure LargeRealArraySlice = ArraySlice
+ structure LargeRealArray2 = Array2
+end
+local
+ structure S = EqMono (type elem = Word.word)
+ open S
+in
+ structure WordVector = Vector
+ structure WordVectorSlice = VectorSlice
+ structure WordArray = Array
+ structure WordArraySlice = ArraySlice
+ structure WordArray2 = Array2
+end
+local
+ structure S = EqMono (type elem = LargeWord.word)
+ open S
+in
+ structure LargeWordVector = Vector
+ structure LargeWordVectorSlice = VectorSlice
+ structure LargeWordArray = Array
+ structure LargeWordArraySlice = ArraySlice
+ structure LargeWordArray2 = Array2
+end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.fun 2006-05-06 18:13:28 UTC (rev 4467)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.fun 2006-05-06 18:44:35 UTC (rev 4468)
@@ -12,165 +12,329 @@
(* fromArray should be constant time. *)
val fromArray: 'a elt array -> 'a sequence
val isMutable: bool
- val length: 'a sequence -> int
- val sub: 'a sequence * int -> 'a elt
+ val length: 'a sequence -> SeqIndex.int
+ val subUnsafe: 'a sequence * SeqIndex.int -> 'a elt
end
): SEQUENCE =
struct
- open S
-
structure Array = Primitive.Array
- open Primitive.Int
+ val op +? = SeqIndex.+?
+ val op + = SeqIndex.+
+ val op -? = SeqIndex.-?
+ val op - = SeqIndex.-
+ val op < = SeqIndex.<
+ val op <= = SeqIndex.<=
+ val op > = SeqIndex.>
+ val op >= = SeqIndex.>=
+ val ltu = SeqIndex.ltu
+ val leu = SeqIndex.leu
+ val gtu = SeqIndex.gtu
+ val geu = SeqIndex.geu
- val maxLen = Array.maxLen
+ fun wrap1 f = fn (i) => f (SeqIndex.toIntUnsafe i)
+ fun wrap2 f = fn (i, x) => f (SeqIndex.toIntUnsafe i, x)
+ fun wrap3 f = fn (i, x, y) => f (SeqIndex.toIntUnsafe i, x, y)
+ fun unwrap1 f = fn (i) => f (SeqIndex.fromIntUnsafe i)
+ fun unwrap2 f = fn (i, x) => f (SeqIndex.fromIntUnsafe i, x)
- fun array n =
- if not isMutable andalso n = 0
+ type 'a sequence = 'a S.sequence
+ type 'a elt = 'a S.elt
+
+ (*
+ * In general, *' values are in terms of SeqIndex.int,
+ * while * values are in terms of Int.int.
+ *)
+
+ local
+ fun doit (toInt, fromInt, maxInt') =
+ (Array.maxLen', toInt Array.maxLen')
+ handle Overflow => (fromInt maxInt', maxInt')
+ structure S =
+ Int_ChooseInt
+ (type 'a t = SeqIndex.int * 'a
+ val fInt8 = doit (SeqIndex.toInt8, SeqIndex.fromInt8,
+ Primitive.Int8.maxInt')
+ val fInt16 = doit (SeqIndex.toInt16, SeqIndex.fromInt16,
+ Primitive.Int16.maxInt')
+ val fInt32 = doit (SeqIndex.toInt32, SeqIndex.fromInt32,
+ Primitive.Int32.maxInt')
+ val fInt64 = doit (SeqIndex.toInt64, SeqIndex.fromInt64,
+ Primitive.Int64.maxInt')
+ val fIntInf = (Array.maxLen', SeqIndex.toIntInf Array.maxLen'))
+ in
+ val (maxLen', maxLen) = S.f
+ end
+
+ fun fromIntForLength n =
+ if Primitive.Controls.safe
+ then (SeqIndex.fromInt n) handle Overflow => raise Size
+ else SeqIndex.fromIntUnsafe n
+
+ fun length' s = S.length s
+ fun length s =
+ if Primitive.Controls.safe
+ then (SeqIndex.toInt (length' s))
+ handle Overflow => raise Fail "Sequence.length"
+ else SeqIndex.toIntUnsafe (length' s)
+
+ fun arrayUninit' n =
+ if not S.isMutable andalso n = 0
then Array.array0Const ()
- else Array.array n
+ else if Primitive.Controls.safe
+ andalso (n < 0 orelse n > maxLen')
+ then raise Size
+ else Array.arrayUnsafe n
+ fun arrayUninit n = arrayUninit' (fromIntForLength n)
- fun seq0 () = fromArray (array 0)
+ fun newUninit' n = S.fromArray (arrayUninit' n)
+ fun newUninit n = S.fromArray (arrayUninit n)
- (* unfoldi depends on the fact that the runtime system fills in the array
- * with reasonable bogus values.
- *)
- fun unfoldi (n, b, f) =
+ fun seq0 () = S.fromArray (arrayUninit' 0)
+
+ fun generate' (n, f) =
let
- val a = array n
+ val a = arrayUninit' n
+ val subLim = ref 0
+ fun sub i =
+ if Primitive.Controls.safe andalso geu (i, !subLim)
+ then raise Subscript
+ else Array.subUnsafe (a, i)
+ val updateLim = ref 0
+ fun update (i, x) =
+ if Primitive.Controls.safe andalso geu (i, !updateLim)
+ then raise Subscript
+ else Array.updateUnsafe (a, i, x)
+ val (tab, finish) = f {sub = sub, update = update}
+ fun loop i =
+ if i >= n
+ then ()
+ else let
+ val () = Array.updateUnsafe (a, i, tab i)
+ val () = subLim := i +? 1
+ val () = updateLim := i +? 1
+ in
+ loop (i +? 1)
+ end
+ val () = loop 0
+ val () = finish ()
+ val () = updateLim := 0
+ in
+ S.fromArray a
+ end
+ fun generate (n, f) =
+ generate' (fromIntForLength n,
+ fn {sub, update} =>
+ let
+ val (tab, finish) =
+ f {sub = unwrap1 sub, update = unwrap2 update}
+ in
+ (wrap1 tab, finish)
+ end)
+
+ fun unfoldi' (n, b, f) =
+ let
+ val a = arrayUninit' n
fun loop (i, b) =
- if i >= n then
- b
+ if i >= n
+ then b
else
let
val (x, b') = f (i, b)
- val () = Array.update (a, i, x)
+ val () = Array.updateUnsafe (a, i, x)
in
loop (i +? 1, b')
end
val b = loop (0, b)
in
- (fromArray a, b)
+ (S.fromArray a, b)
end
+ fun unfoldi (n, b, f) = unfoldi' (fromIntForLength n, b, wrap2 f)
+ fun unfold (n, b, f) = unfoldi (n, b, f o #2)
- fun tabulate (n, f) = #1 (unfoldi (n, (), fn (i, ()) => (f i, ())))
+ fun tabulate' (n, f) =
+ #1 (unfoldi' (n, (), fn (i, ()) => (f i, ())))
+ fun tabulate (n, f) =
+ #1 (unfoldi (n, (), fn (i, ()) => (f i, ())))
+ fun new' (n, x) = tabulate' (n, fn _ => x)
fun new (n, x) = tabulate (n, fn _ => x)
fun fromList l =
let
- val a = array (List.length l)
+ val a = arrayUninit (List.length l)
val _ =
- List.foldl (fn (c, i) => (Array.update (a, i, c) ; i +? 1)) 0 l
+ List.foldl (fn (x, i) => (Array.updateUnsafe (a, i, x) ; (i +? 1))) 0 l
in
- fromArray a
+ S.fromArray a
end
structure Slice =
struct
- type 'a sequence = 'a sequence
- type 'a elt = 'a elt
- datatype 'a t = T of {seq: 'a sequence, start: int, len: int}
+ type 'a sequence = 'a S.sequence
+ type 'a elt = 'a S.elt
+ datatype 'a t = T of {seq: 'a sequence,
+ start: SeqIndex.int, len: SeqIndex.int}
type 'a slice = 'a t
- fun length (T {len, ...}) = len
- fun unsafeSub (T {seq, start, ...}, i) =
- S.sub (seq, start +? i)
- fun sub (sl as T {len, ...}, i) =
- if Primitive.safe andalso Primitive.Int.geu (i, len)
+ fun length' (T {len, ...}) = len
+ fun length sl =
+ if Primitive.Controls.safe
+ then (SeqIndex.toInt (length' sl))
+ handle Overflow => raise Fail "Sequence.Slice.length"
+ else SeqIndex.toIntUnsafe (length' sl)
+ fun unsafeSub' (T {seq, start, ...}, i) =
+ S.subUnsafe (seq, start +? i)
+ fun unsafeSub (sl, i) =
+ unsafeSub' (sl, SeqIndex.fromIntUnsafe i)
+ fun sub' (sl as T {len, ...}, i) =
+ if Primitive.Controls.safe andalso geu (i, len)
then raise Subscript
- else unsafeSub (sl, i)
- fun unsafeUpdate' update (T {seq, start, ...}, i, x) =
- update (seq, start +? i, x)
- fun update' update (sl as T {len, ...}, i, x) =
- if Primitive.safe andalso Primitive.Int.geu (i, len)
+ else unsafeSub' (sl, i)
+ fun sub (sl, i) =
+ if Primitive.Controls.safe
+ then let
+ val i =
+ (SeqIndex.fromInt i)
+ handle Overflow => raise Subscript
+ in
+ sub' (sl, i)
+ end
+ else unsafeSub (sl, i)
+ fun unsafeUpdateMk' updateUnsafe (T {seq, start, ...}, i, x) =
+ updateUnsafe (seq, start +? i, x)
+ fun unsafeUpdateMk updateUnsafe (sl, i, x) =
+ unsafeUpdateMk' updateUnsafe (sl, SeqIndex.fromIntUnsafe i, x)
+ fun updateMk' updateUnsafe (sl as T {len, ...}, i, x) =
+ if Primitive.Controls.safe andalso geu (i, len)
then raise Subscript
- else unsafeUpdate' update (sl, i, x)
+ else unsafeUpdateMk' updateUnsafe (sl, i, x)
+ fun updateMk updateUnsafe (sl, i, x) =
+ if Primitive.Controls.safe
+ then let
+ val i =
+ (SeqIndex.fromInt i)
+ handle Overflow => raise Subscript
+ in
+ updateMk' updateUnsafe (sl, i, x)
+ end
+ else unsafeUpdateMk updateUnsafe (sl, i, x)
fun full (seq: 'a sequence) : 'a slice =
T {seq = seq, start = 0, len = S.length seq}
- fun subslice (T {seq, start, len}, start', len') =
- case len' of
- NONE => if Primitive.safe andalso
- (start' < 0 orelse start' > len)
- then raise Subscript
- else T {seq = seq,
- start = start +? start',
- len = len -? start'}
- | SOME len' => if Primitive.safe andalso
- (start' < 0 orelse start' > len orelse
- len' < 0 orelse len' > len -? start')
- then raise Subscript
- else T {seq = seq,
- start = start +? start',
- len = len'}
- fun unsafeSubslice (T {seq, start, len}, start', len') =
+ fun unsafeSubslice' (T {seq, start, len}, start', len') =
T {seq = seq,
start = start +? start',
len = (cas...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2006-05-06 11:13:30
|
Preparing for merging .refactor ---------------------------------------------------------------------- D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml ---------------------------------------------------------------------- Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml =================================================================== --- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-05-06 18:06:38 UTC (rev 4466) +++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-05-06 18:13:28 UTC (rev 4467) @@ -1,20 +0,0 @@ -(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh - * Jagannathan, and Stephen Weeks. - * Copyright (C) 1997-2000 NEC Research Institute. - * - * MLton is released under a BSD-style license. - * See the file MLton-LICENSE for details. - *) - -(* Primitive names are special -- see atoms/prim.fun. *) - -structure Primitive = - struct - - structure Cygwin = - struct - val toFullWindowsPath = - _import "Cygwin_toFullWindowsPath": NullString.t -> CString.t; - end - - end |
|
From: Matthew F. <fl...@ml...> - 2006-05-06 11:06:39
|
Preparing for merging .refactor ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-char8.map D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int32.map D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int64.map D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-intinf.map D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-real32.map D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-real64.map D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-word32.map D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-word64.map D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/ ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile =================================================================== --- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-05-06 17:44:55 UTC (rev 4465) +++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-05-06 18:06:38 UTC (rev 4466) @@ -23,52 +23,41 @@ OBJPTR_MAPS = objptr-rep32.map objptr-rep64.map HEADER_MAPS = header-word32.map header-word64.map SEQINDEX_MAPS = seqindex-int32.map seqindex-int64.map -CTYPES_MAPS = c-types.test-amd64-m32-linux.map c-types.test-amd64-m64-linux.map c-types.test-weird-weird.map c-types.amd64-linux.map c-types.x86-linux.map -DEFAULT_CHAR_MAPS = default-char8.map -DEFAULT_INT_MAPS = default-int32.map default-int64.map default-intinf.map -DEFAULT_REAL_MAPS = default-real32.map default-real64.map -DEFAULT_WORD_MAPS = default-word32.map default-word64.map +TARGET_ARCH = x86 amd64 +TARGET_OS = linux +DEFAULT_CHAR = char8 +DEFAULT_INT = int32 int64 intinf +DEFAULT_REAL = real32 real64 +DEFAULT_WORD = word32 word64 -.PHONY: type-check-one -type-check-one: - for objptrrep in objptr-rep32.map; do \ - for header in header-word32.map; do \ - for seqindex in seqindex-int32.map; do \ - for defchar in default-char8.map; do \ - for defint in default-int32.map; do \ - for defreal in default-real64.map; do \ - for defword in default-word32.map; do \ - echo "Type checking: $$objptrrep $$header $$seqindex $$ctypes $$defchar $$defint $$defreal $$defword"; \ +.PHONY: type-check-def +type-check-def: $(MLTON) -disable-ann deadCode -stop tc -show-types true \ - -mlb-path-map "maps/$$objptrrep" \ - -mlb-path-map "maps/$$header" \ - -mlb-path-map "maps/$$seqindex" \ - -mlb-path-map "maps/$$defchar" \ - -mlb-path-map "maps/$$defint" \ - -mlb-path-map "maps/$$defreal" \ - -mlb-path-map "maps/$$defword" \ libs/all.mlb; \ - done; done; done; done; done; done; done -.PHONY: type-check -type-check: +.PHONY: type-check-all +type-check-all: for objptrrep in $(OBJPTR_MAPS); do \ for header in $(HEADER_MAPS); do \ for seqindex in $(SEQINDEX_MAPS); do \ - for ctypes in $(CTYPES_MAPS); do \ - for defchar in $(DEFAULT_CHAR_MAPS); do \ - for defint in $(DEFAULT_INT_MAPS); do \ - for defreal in $(DEFAULT_REAL_MAPS); do \ - for defword in $(DEFAULT_WORD_MAPS); do \ - echo "Type checking: $$objptrrep $$header $$seqindex $$ctypes $$defchar $$defint $$defreal $$defword"; \ + for targetarch in $(TARGET_ARCH); do \ + for targetos in $(TARGET_OS); do \ + for defchar in $(DEFAULT_CHAR); do \ + for defint in $(DEFAULT_INT); do \ + for defreal in $(DEFAULT_REAL); do \ + for defword in $(DEFAULT_WORD); do \ + if [ ! -r config/c/$$targetarch-$$targetos/c-types.sml ]; then \ + break; \ + fi; \ + echo "Type checking: $$objptrrep $$header $$seqindex $$targetarch $$targetos $$defchar $$defint $$defreal $$defword"; \ $(MLTON) -disable-ann deadCode -stop tc -show-types true \ -mlb-path-map "maps/$$objptrrep" \ -mlb-path-map "maps/$$header" \ -mlb-path-map "maps/$$seqindex" \ - -mlb-path-map "maps/$$ctypes" \ - -mlb-path-map "maps/$$defchar" \ - -mlb-path-map "maps/$$defint" \ - -mlb-path-map "maps/$$defreal" \ - -mlb-path-map "maps/$$defword" \ + -mlb-path-map "maps/c-types.$$targetarch-$$targetos.map" \ + -default-type "$$defchar" \ + -default-type "$$defint" \ + -default-type "$$defreal" \ + -default-type "$$defword" \ libs/all.mlb; \ - done; done; done; done; done; done; done; done + done; done; done; done; done; done; done; done; done Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-char8.map =================================================================== --- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-char8.map 2006-05-06 17:44:55 UTC (rev 4465) +++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-char8.map 2006-05-06 18:06:38 UTC (rev 4466) @@ -1 +0,0 @@ -DEFAULT_CHAR default-char8.sml Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int32.map =================================================================== --- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int32.map 2006-05-06 17:44:55 UTC (rev 4465) +++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int32.map 2006-05-06 18:06:38 UTC (rev 4466) @@ -1 +0,0 @@ -DEFAULT_INT default-int32.sml Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int64.map =================================================================== --- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int64.map 2006-05-06 17:44:55 UTC (rev 4465) +++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int64.map 2006-05-06 18:06:38 UTC (rev 4466) @@ -1 +0,0 @@ -DEFAULT_INT default-int64.sml Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-intinf.map =================================================================== --- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-intinf.map 2006-05-06 17:44:55 UTC (rev 4465) +++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-intinf.map 2006-05-06 18:06:38 UTC (rev 4466) @@ -1 +0,0 @@ -DEFAULT_INT default-intinf.sml Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-real32.map =================================================================== --- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-real32.map 2006-05-06 17:44:55 UTC (rev 4465) +++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-real32.map 2006-05-06 18:06:38 UTC (rev 4466) @@ -1 +0,0 @@ -DEFAULT_REAL default-real32.sml Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-real64.map =================================================================== --- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-real64.map 2006-05-06 17:44:55 UTC (rev 4465) +++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-real64.map 2006-05-06 18:06:38 UTC (rev 4466) @@ -1 +0,0 @@ -DEFAULT_REAL default-real64.sml Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-word32.map =================================================================== --- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-word32.map 2006-05-06 17:44:55 UTC (rev 4465) +++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-word32.map 2006-05-06 18:06:38 UTC (rev 4466) @@ -1 +0,0 @@ -DEFAULT_WORD default-word32.sml Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-word64.map =================================================================== --- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-word64.map 2006-05-06 17:44:55 UTC (rev 4465) +++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-word64.map 2006-05-06 18:06:38 UTC (rev 4466) @@ -1 +0,0 @@ -DEFAULT_WORD default-word64.sml |
|
From: Matthew F. <fl...@ml...> - 2006-05-06 10:44:56
|
Added -default-type '<ty><N>' option
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/Makefile
U mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml
U mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/Makefile 2006-05-06 17:25:08 UTC (rev 4464)
+++ mlton/branches/on-20050822-x86_64-branch/Makefile 2006-05-06 17:44:55 UTC (rev 4465)
@@ -222,14 +222,7 @@
mlbpathmap:
touch $(MLBPATHMAP)
( echo 'MLTON_ROOT $$(LIB_MLTON_DIR)/sml'; \
- echo 'SML_LIB $$(LIB_MLTON_DIR)/sml'; \
- echo 'OBJPTR_REP objptr-rep32.sml'; \
- echo 'HEADER_WORD header-word32.sml'; \
- echo 'SEQ_INDEX seqindex-int32.sml'; \
- echo 'DEFAULT_CHAR default-char8.sml'; \
- echo 'DEFAULT_INT default-int32.sml'; \
- echo 'DEFAULT_REAL default-real64.sml'; \
- echo 'DEFAULT_WORD default-word32.sml'; ) \
+ echo 'SML_LIB $$(LIB_MLTON_DIR)/sml'; ) \
>>$(MLBPATHMAP).tmp
mv $(MLBPATHMAP).tmp $(MLBPATHMAP)
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig 2006-05-06 17:25:08 UTC (rev 4464)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig 2006-05-06 17:44:55 UTC (rev 4465)
@@ -47,6 +47,11 @@
(* Generate an executable with debugging info. *)
val debug: bool ref
+ val defaultChar: string ref
+ val defaultInt: string ref
+ val defaultReal: string ref
+ val defaultWord: string ref
+
(* List of pass names to keep diagnostic info on. *)
val diagPasses: Regexp.Compiled.t list ref
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml 2006-05-06 17:25:08 UTC (rev 4464)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml 2006-05-06 17:44:55 UTC (rev 4465)
@@ -81,6 +81,19 @@
default = false,
toString = Bool.toString}
+val defaultChar = control {name = "defaultChar",
+ default = "default-char8.sml",
+ toString = fn s => s}
+val defaultInt = control {name = "defaultInt",
+ default = "default-int32.sml",
+ toString = fn s => s}
+val defaultReal = control {name = "defaultReal",
+ default = "default-real64.sml",
+ toString = fn s => s}
+val defaultWord = control {name = "defaultWord",
+ default = "default-word32.sml",
+ toString = fn s => s}
+
val diagPasses =
control {name = "diag passes",
default = [],
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun 2006-05-06 17:25:08 UTC (rev 4464)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun 2006-05-06 17:44:55 UTC (rev 4465)
@@ -107,7 +107,21 @@
(!Control.targetArch))},
{var = "TARGET_OS",
path = String.toLower (MLton.Platform.OS.toString
- (!Control.targetOS))}],
+ (!Control.targetOS))},
+ {var = "OBJPTR_REP",
+ path = "objptr-rep32.sml"},
+ {var = "HEADER_WORD",
+ path = "header-word32.sml"},
+ {var = "SEQINDEX_INT",
+ path = "seqindex-int32.sml"},
+ {var = "DEFAULT_CHAR",
+ path = !Control.defaultChar},
+ {var = "DEFAULT_INT",
+ path = !Control.defaultInt},
+ {var = "DEFAULT_REAL",
+ path = !Control.defaultReal},
+ {var = "DEFAULT_WORD",
+ path = !Control.defaultWord}],
List.concat (List.map (!Control.mlbPathMaps, make))])
fun peekPathMap var' =
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun 2006-05-06 17:25:08 UTC (rev 4464)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun 2006-05-06 17:44:55 UTC (rev 4465)
@@ -194,6 +194,22 @@
(fn s => reportAnnotation (s, flag,
Control.Elaborate.processDefault s)))
end,
+ (Normal, "default-type", " '<ty><N>'", "set default type",
+ SpaceString
+ (fn s => (case s of
+ "char8" => Control.defaultChar := "default-char8.sml"
+ | "int8" => Control.defaultInt := "default-int8.sml"
+ | "int16" => Control.defaultInt := "default-int16.sml"
+ | "int32" => Control.defaultInt := "default-int32.sml"
+ | "int64" => Control.defaultInt := "default-int64.sml"
+ | "intinf" => Control.defaultInt := "default-intinf.sml"
+ | "real32" => Control.defaultReal := "default-real32.sml"
+ | "real64" => Control.defaultReal := "default-real64.sml"
+ | "word8" => Control.defaultWord := "default-word8.sml"
+ | "word16" => Control.defaultWord := "default-word16.sml"
+ | "word32" => Control.defaultWord := "default-word32.sml"
+ | "word64" => Control.defaultWord := "default-word64.sml"
+ | _ => usage (concat ["invalid -default-type flag: ", s])))),
(Expert, "diag-pass", " <pass>", "keep diagnostic info for pass",
SpaceString
(fn s =>
|
|
From: Matthew F. <fl...@ml...> - 2006-05-06 10:25:09
|
Naming schemes
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int-inf.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-intinf.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int-inf.map
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-intinf.map
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seqindex-int32.map
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seqindex-int64.map
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-05-06 16:28:46 UTC (rev 4463)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-05-06 17:25:08 UTC (rev 4464)
@@ -25,7 +25,7 @@
SEQINDEX_MAPS = seqindex-int32.map seqindex-int64.map
CTYPES_MAPS = c-types.test-amd64-m32-linux.map c-types.test-amd64-m64-linux.map c-types.test-weird-weird.map c-types.amd64-linux.map c-types.x86-linux.map
DEFAULT_CHAR_MAPS = default-char8.map
-DEFAULT_INT_MAPS = default-int32.map default-int64.map default-int-inf.map
+DEFAULT_INT_MAPS = default-int32.map default-int64.map default-intinf.map
DEFAULT_REAL_MAPS = default-real32.map default-real64.map
DEFAULT_WORD_MAPS = default-word32.map default-word64.map
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-05-06 16:28:46 UTC (rev 4463)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-05-06 17:25:08 UTC (rev 4464)
@@ -27,7 +27,7 @@
in ann "forceUsed" in
../config/objptr/$(OBJPTR_REP)
../config/header/$(HEADER_WORD)
- ../config/seqindex/$(SEQ_INDEX)
+ ../config/seqindex/$(SEQINDEX_INT)
../config/c/$(TARGET_ARCH)-$(TARGET_OS)/c-types.sml
../config/c/position.sml
../config/c/sys-word.sml
@@ -77,7 +77,7 @@
local
../config/bind/int-prim.sml
in ann "forceUsed" in
- ../config/seqindex/$(SEQ_INDEX)
+ ../config/seqindex/$(SEQINDEX_INT)
end end
../arrays-and-vectors/slice.sig
../arrays-and-vectors/sequence.sig
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int-inf.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int-inf.sml 2006-05-06 16:28:46 UTC (rev 4463)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int-inf.sml 2006-05-06 17:25:08 UTC (rev 4464)
@@ -1,13 +0,0 @@
-(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure Int = IntInf
-type int = Int.int
-
-functor Int_ChooseInt (A: CHOOSE_INT_ARG) :
- sig val f : Int.int A.t end =
- ChooseInt_IntInf (A)
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-intinf.sml (from rev 4448, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int-inf.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int-inf.map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int-inf.map 2006-05-06 16:28:46 UTC (rev 4463)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int-inf.map 2006-05-06 17:25:08 UTC (rev 4464)
@@ -1 +0,0 @@
-DEFAULT_INT default-int-inf.sml
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-intinf.map (from rev 4448, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int-inf.map)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int-inf.map 2006-05-04 15:26:50 UTC (rev 4448)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-intinf.map 2006-05-06 17:25:08 UTC (rev 4464)
@@ -0,0 +1 @@
+DEFAULT_INT default-intinf.sml
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seqindex-int32.map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seqindex-int32.map 2006-05-06 16:28:46 UTC (rev 4463)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seqindex-int32.map 2006-05-06 17:25:08 UTC (rev 4464)
@@ -1 +1 @@
-SEQ_INDEX seqindex-int32.sml
+SEQINDEX_INT seqindex-int32.sml
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seqindex-int64.map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seqindex-int64.map 2006-05-06 16:28:46 UTC (rev 4463)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seqindex-int64.map 2006-05-06 17:25:08 UTC (rev 4464)
@@ -1 +1 @@
-SEQ_INDEX seqindex-int64.sml
+SEQINDEX_INT seqindex-int64.sml
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb 2006-05-06 16:28:46 UTC (rev 4463)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb 2006-05-06 17:25:08 UTC (rev 4464)
@@ -44,7 +44,7 @@
in ann "forceUsed" in
../config/objptr/$(OBJPTR_REP)
../config/header/$(HEADER_WORD)
- ../config/seqindex/$(SEQ_INDEX)
+ ../config/seqindex/$(SEQINDEX_INT)
../config/c/$(TARGET_ARCH)-$(TARGET_OS)/c-types.sml
../config/c/errno.sml
../config/c/position.sml
|
|
From: Matthew F. <fl...@ml...> - 2006-05-06 09:28:47
|
Refactor MLton.Socket
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis-sigs.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/socket.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/socket.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/inet-sock.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Net.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-05-06 16:28:46 UTC (rev 4463)
@@ -340,8 +340,8 @@
(* ../mlton/ptrace.sml *)
../mlton/rlimit.sig
../mlton/rlimit.sml
- (* ../mlton/socket.sig *)
- (* ../mlton/socket.sml *)
+ ../mlton/socket.sig
+ ../mlton/socket.sml
../mlton/syslog.sig
../mlton/syslog.sml
../mlton/vector.sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis-sigs.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis-sigs.sml 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis-sigs.sml 2006-05-06 16:28:46 UTC (rev 4463)
@@ -101,7 +101,7 @@
signature MLTON_RLIMIT = MLTON_RLIMIT
signature MLTON_RUSAGE = MLTON_RUSAGE
signature MLTON_SIGNAL = MLTON_SIGNAL
-(* signature MLTON_SOCKET = MLTON_SOCKET *)
+signature MLTON_SOCKET = MLTON_SOCKET
signature MLTON_SYSLOG = MLTON_SYSLOG
signature MLTON_TEXT_IO = MLTON_TEXT_IO
signature MLTON_THREAD = MLTON_THREAD
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sig 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sig 2006-05-06 16:28:46 UTC (rev 4463)
@@ -42,7 +42,7 @@
structure Rlimit: MLTON_RLIMIT
structure Rusage: MLTON_RUSAGE
structure Signal: MLTON_SIGNAL
-(* structure Socket: MLTON_SOCKET *)
+ structure Socket: MLTON_SOCKET
structure Syslog: MLTON_SYSLOG
structure TextIO: MLTON_TEXT_IO
structure Thread: MLTON_THREAD
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml 2006-05-06 16:28:46 UTC (rev 4463)
@@ -63,7 +63,7 @@
structure Rlimit = MLtonRlimit
structure Rusage = MLtonRusage
structure Signal = MLtonSignal
-(* structure Socket = MLtonSocket *)
+structure Socket = MLtonSocket
structure Syslog = MLtonSyslog
structure TextIO = MLtonIO (TextIO)
structure Thread = MLtonThread
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/socket.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/socket.sig 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/socket.sig 2006-05-06 16:28:46 UTC (rev 4463)
@@ -6,14 +6,11 @@
* See the file MLton-LICENSE for details.
*)
-type int = Int.int
-type word = Word.word
-
signature MLTON_SOCKET =
sig
structure Address:
sig
- type t = word
+ type t
end
structure Ctl:
@@ -33,7 +30,7 @@
structure Port:
sig
- type t = int
+ type t
end
type t
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/socket.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/socket.sml 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/socket.sml 2006-05-06 16:28:46 UTC (rev 4463)
@@ -16,7 +16,7 @@
structure Address =
struct
- type t = word
+ type t = NetHostDB.in_addr
end
structure Host =
@@ -26,7 +26,7 @@
val get: NetHostDB.entry option -> t option =
Option.map (fn entry => {name = NetHostDB.name entry})
- val getByAddress = get o NetHostDB.getByAddr o NetHostDB.wordToInAddr
+ val getByAddress = get o NetHostDB.getByAddr
val getByName = get o NetHostDB.getByName
end
@@ -75,7 +75,7 @@
val (in_addr: NetHostDB.in_addr, port: int) = INetSock.fromAddr addr
val (ins, out) = sockToIO sock
in
- (NetHostDB.inAddrToWord in_addr, port, ins, out)
+ (in_addr, port, ins, out)
end
fun connect (host, port) =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton.mlb 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton.mlb 2006-05-06 16:28:46 UTC (rev 4463)
@@ -33,7 +33,7 @@
signature MLTON_RLIMIT
signature MLTON_RUSAGE
signature MLTON_SIGNAL
- (* signature MLTON_SOCKET *)
+ signature MLTON_SOCKET
signature MLTON_SYSLOG
signature MLTON_TEXT_IO
signature MLTON_THREAD
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/inet-sock.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/inet-sock.sml 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/inet-sock.sml 2006-05-06 16:28:46 UTC (rev 4463)
@@ -18,23 +18,29 @@
val inetAF = PrimitiveFFI.Socket.AF.INET
fun toAddr (in_addr, port) =
- if port < 0 orelse port >= 0x10000
- then PosixError.raiseSys PosixError.inval
- else let
- val port = Net.C_Int.hton (C_Int.fromInt port)
- val (sa, salen, finish) = Socket.new_sock_addr ()
- val _ = Prim.toAddr (NetHostDB.inAddrToWord8Vector in_addr,
- port, sa, salen)
- in
- finish ()
- end
+ let
+ val port = C_Int.fromInt port
+ val port = Net.C_Int.hton port
+ in
+ if C_Int.< (port, 0) orelse C_Int.>= (port, 0x10000)
+ then PosixError.raiseSys PosixError.inval
+ else let
+ val (sa, salen, finish) = Socket.new_sock_addr ()
+ val _ = Prim.toAddr (NetHostDB.inAddrToWord8Vector in_addr,
+ port, sa, salen)
+ in
+ finish ()
+ end
+ end
fun any port = toAddr (NetHostDB.any (), port)
fun fromAddr sa =
let
- val _ = Prim.fromAddr (Socket.unpackSockAddr sa)
- val port = C_Int.toInt (Net.C_Int.ntoh (Prim.getPort ()))
+ val () = Prim.fromAddr (Socket.unpackSockAddr sa)
+ val port = Prim.getPort ()
+ val port = Net.C_Int.ntoh port
+ val port = C_Int.toInt port
val (ia, finish) = NetHostDB.new_in_addr ()
val _ = Prim.getInAddr (NetHostDB.preInAddrToWord8Array ia)
in
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Net.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Net.c 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Net.c 2006-05-06 16:28:46 UTC (rev 4463)
@@ -1,17 +1,33 @@
#include "platform.h"
+#ifndef DEBUG
+#define DEBUG FALSE
+#endif
+
Word32_t Net_htonl (Word32_t w) {
- return htonl (w);
+ Word32_t r = htonl (w);
+ if (DEBUG)
+ printf ("%"PRIx32" = Net_htonl (%"PRIx32")\n", r, w);
+ return r;
}
Word32_t Net_ntohl (Word32_t w) {
- return ntohl (w);
+ Word32_t r = ntohl (w);
+ if (DEBUG)
+ printf ("%"PRIx32" = Net_ntohl (%"PRIx32")\n", r, w);
+ return r;
}
Word16_t Net_htons (Word16_t w) {
- return htons (w);
+ Word16_t r = htons (w);
+ if (DEBUG)
+ printf ("%"PRIx16" = Net_htonl (%"PRIx16")\n", r, w);
+ return r;
}
Word16_t Net_ntohs (Word16_t w) {
- return ntohs (w);
+ Word16_t r = ntohs (w);
+ if (DEBUG)
+ printf ("%"PRIx16" = Net_ntohl (%"PRIx16")\n", r, w);
+ return r;
}
|
|
From: Matthew F. <fl...@ml...> - 2006-05-06 08:35:56
|
Bugfixes for signal masks
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/process.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml 2006-05-06 02:31:26 UTC (rev 4461)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml 2006-05-06 15:35:55 UTC (rev 4462)
@@ -29,7 +29,11 @@
val validSignals =
Array.tabulate
(C_Int.toInt Prim.NSIG, fn i =>
- (C_Errno.check (Prim.sigismember(fromInt i))) <> (C_Int.fromInt ~1))
+ SysCall.syscallErr
+ ({clear = false, restart = false, errVal = C_Int.fromInt ~1}, fn () =>
+ {return = Prim.sigismember (fromInt i),
+ post = fn _ => true,
+ handlers = [(Error.inval, fn () => false)]}))
structure Mask =
struct
@@ -48,9 +52,16 @@
(Array.foldri
(fn (i, b, sigs) =>
if b
- then if (C_Errno.check (Prim.sigismember(fromInt i))) = (C_Int.fromInt ~1)
- then sigs
- else (fromInt i)::sigs
+ then let
+ val s = fromInt i
+ val res =
+ SysCall.simpleResult
+ (fn () => Prim.sigismember s)
+ in
+ if res = C_Int.fromInt 1
+ then s::sigs
+ else sigs
+ end
else sigs)
[]
validSignals)
@@ -101,11 +112,11 @@
val r = ref false
in
fun initHandler (s: signal): Handler.t =
- if C_Errno.check (Prim.isDefault (s, r)) = C_Int.fromInt 0
- then if !r
- then Default
- else Ignore
- else InvalidSignal
+ SysCall.syscallErr
+ ({clear = false, restart = false, errVal = C_Int.fromInt ~1}, fn () =>
+ {return = Prim.isDefault (s, r),
+ post = fn _ => if !r then Default else Ignore,
+ handlers = [(Error.inval, fn () => InvalidSignal)]})
end
val (getHandler, setHandler, handlers) =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/process.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/process.sml 2006-05-06 02:31:26 UTC (rev 4461)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/process.sml 2006-05-06 15:35:55 UTC (rev 4462)
@@ -168,7 +168,7 @@
handle Overflow => Error.raiseSys Error.inval)))
in
val alarm = wrap Prim.alarm
-(* val sleep = wrap Prim.sleep *)
+ (* val sleep = wrap Prim.sleep *)
end
fun sleep (t: Time.time): Time.time =
|
|
From: Matthew F. <fl...@ml...> - 2006-05-05 19:31:27
|
Relaxing type constraints
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis.sig 2006-05-05 02:48:10 UTC (rev 4460)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis.sig 2006-05-06 02:31:26 UTC (rev 4461)
@@ -362,10 +362,6 @@
sharing type list = List.list
*)
- sharing type int = Int32.int
- (* sharing type real = Real64.real *)
- sharing type word = Word32.word
-
(* Required structures *)
(*
sharing type BinIO.StreamIO.elem = Word8.word
@@ -644,11 +640,13 @@
where type 'a vector = 'a vector
where type char = char
where type exn = exn
+ where type int = int
where type order = order
where type real = real
where type string = string
where type substring = substring
where type unit = unit
+ where type word = word
(* Types referenced in signatures by structure name *)
(*
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis.sml 2006-05-05 02:48:10 UTC (rev 4460)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis.sml 2006-05-06 02:31:26 UTC (rev 4461)
@@ -256,7 +256,6 @@
OptionGlobal
RealGlobal
StringGlobal
- RealGlobal
SubstringGlobal
TextIOGlobal
VectorGlobal
|
|
From: Matthew F. <fl...@ml...> - 2006-05-04 19:48:12
|
Relaxing type sharing constraints; not working completely yet
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-2002/top-level/basis.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-05-05 01:03:36 UTC (rev 4459)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-05-05 02:48:10 UTC (rev 4460)
@@ -47,7 +47,7 @@
-mlb-path-map "maps/$$defint" \
-mlb-path-map "maps/$$defreal" \
-mlb-path-map "maps/$$defword" \
- build/sources.mlb; \
+ libs/all.mlb; \
done; done; done; done; done; done; done
.PHONY: type-check
@@ -70,5 +70,5 @@
-mlb-path-map "maps/$$defint" \
-mlb-path-map "maps/$$defreal" \
-mlb-path-map "maps/$$defword" \
- build/sources.mlb; \
+ libs/all.mlb; \
done; done; done; done; done; done; done; done
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-05-05 01:03:36 UTC (rev 4459)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-05-05 02:48:10 UTC (rev 4460)
@@ -21,7 +21,7 @@
../integer/word0.sml
local
../config/bind/int-prim.sml
- (* ../config/bind/pointer-prim.sml *)
+ ../config/bind/pointer-prim.sml
../config/bind/real-prim.sml
../config/bind/word-prim.sml
in ann "forceUsed" in
@@ -113,7 +113,7 @@
../integer/word.sml
local
../config/bind/int-top.sml
- (* ../config/bind/pointer-prim.sml *)
+ ../config/bind/pointer-prim.sml
../config/bind/real-prim.sml
../config/bind/word-top.sml
in ann "forceUsed" in
@@ -146,7 +146,7 @@
../integer/pack-word.sml
local
../config/bind/int-top.sml
- (* ../config/bind/pointer-prim.sml *)
+ ../config/bind/pointer-prim.sml
../config/bind/real-prim.sml
../config/bind/word-top.sml
in ann "forceUsed" in
@@ -191,7 +191,7 @@
../real/pack-real.sml
local
../config/bind/int-top.sml
- (* ../config/bind/pointer-prim.sml *)
+ ../config/bind/pointer-prim.sml
../config/bind/real-top.sml
../config/bind/word-top.sml
in ann "forceUsed" in
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml 2006-05-05 01:03:36 UTC (rev 4459)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml 2006-05-05 02:48:10 UTC (rev 4460)
@@ -6,7 +6,7 @@
* See the file MLton-LICENSE for details.
*)
-functor Integer (I: PRE_INTEGER_EXTRA) : INTEGER_EXTRA =
+functor Integer (I: PRE_INTEGER_EXTRA): INTEGER_EXTRA =
struct
open I
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-2002/top-level/basis.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-2002/top-level/basis.sig 2006-05-05 01:03:36 UTC (rev 4459)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-2002/top-level/basis.sig 2006-05-05 02:48:10 UTC (rev 4460)
@@ -328,29 +328,31 @@
(* Can't use sharing on type array or vector, because they are rigid tycons.
* Don't need it anyways, since it's built into the ARRAY and VECTOR signatures.
*)
-(* sharing type array = Array.array *)
-(* sharing type vector = Vector.vector *)
- (*
+(*
+ sharing type array = Array.array
+ sharing type vector = Vector.vector
+*)
+(*
sharing type ref = General.ref
- *)
- (*
+*)
+(*
sharing type bool = Bool.bool
- *)
+*)
sharing type option = Option.option
sharing type order = General.order
- (*
+(*
sharing type list = List.list
- *)
+*)
- sharing type int = Int32.int
- sharing type real = Real64.real
- sharing type word = Word32.word
-
(* Required structures *)
-(* sharing type BinIO.StreamIO.elem = Word8.word *)
+(*
+ sharing type BinIO.StreamIO.elem = Word8.word
+*)
sharing type BinIO.StreamIO.reader = BinPrimIO.reader
sharing type BinIO.StreamIO.pos = BinPrimIO.pos
-(* sharing type BinIO.StreamIO.vector = Word8Vector.vector *)
+(*
+ sharing type BinIO.StreamIO.vector = Word8Vector.vector
+*)
sharing type BinIO.StreamIO.writer = BinPrimIO.writer
sharing type BinPrimIO.array = Word8Array.array
sharing type BinPrimIO.array_slice = Word8ArraySlice.slice
@@ -387,15 +389,18 @@
sharing type Text.CharArray.array = CharArray.array
sharing type Text.CharArraySlice.slice = CharArraySlice.slice
sharing type Text.CharVectorSlice.slice = CharVectorSlice.slice
-(* redundant *)
-(* sharing type TextIO.elem = char *)
-(* sharing type TextIO.vector = string *)
+ (* redundant *)
+(*
+ sharing type TextIO.elem = char
+ sharing type TextIO.vector = string
+*)
sharing type TextPrimIO.array = CharArray.array
sharing type TextPrimIO.array_slice = CharArraySlice.slice
sharing type TextPrimIO.elem = Char.char
sharing type TextPrimIO.pos = Position.int
sharing type TextPrimIO.vector = CharVector.vector
sharing type TextPrimIO.vector_slice = CharVectorSlice.slice
+ sharing type Word.word = word
sharing type Word8Array.elem = Word8.word
sharing type Word8Array.vector = Word8Vector.vector
sharing type Word8ArraySlice.elem = Word8.word
@@ -450,7 +455,6 @@
sharing type Int16VectorSlice.vector = Int16Vector.vector
sharing type Int16Array2.elem = Int16.int
sharing type Int16Array2.vector = Int16Vector.vector
- sharing type Int32.int = Int.int
sharing type Int32Array.elem = Int32.int
sharing type Int32Array.vector = Int32Vector.vector
sharing type Int32ArraySlice.elem = Int32.int
@@ -574,7 +578,6 @@
sharing type Word16VectorSlice.vector = Word16Vector.vector
sharing type Word16Array2.elem = Word16.word
sharing type Word16Array2.vector = Word16Vector.vector
- sharing type Word32.word = Word.word
sharing type Word32Array.elem = Word32.word
sharing type Word32Array.vector = Word32Vector.vector
sharing type Word32ArraySlice.elem = Word32.word
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis.sig 2006-05-05 01:03:36 UTC (rev 4459)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis.sig 2006-05-05 02:48:10 UTC (rev 4460)
@@ -363,7 +363,7 @@
*)
sharing type int = Int32.int
- sharing type real = Real64.real
+ (* sharing type real = Real64.real *)
sharing type word = Word32.word
(* Required structures *)
@@ -411,7 +411,7 @@
sharing type Text.CharArray.array = CharArray.array
sharing type Text.CharArraySlice.slice = CharArraySlice.slice
sharing type Text.CharVectorSlice.slice = CharVectorSlice.slice
-(* redundant *)
+ (* redundant *)
(*
sharing type TextIO.elem = char
sharing type TextIO.vector = string
@@ -422,6 +422,7 @@
sharing type TextPrimIO.pos = Position.int
sharing type TextPrimIO.vector = CharVector.vector
sharing type TextPrimIO.vector_slice = CharVectorSlice.slice
+ sharing type Word.word = word
sharing type Word8Array.elem = Word8.word
sharing type Word8Array.vector = Word8Vector.vector
sharing type Word8ArraySlice.elem = Word8.word
@@ -476,7 +477,6 @@
sharing type Int16VectorSlice.vector = Int16Vector.vector
sharing type Int16Array2.elem = Int16.int
sharing type Int16Array2.vector = Int16Vector.vector
- sharing type Int32.int = Int.int
sharing type Int32Array.elem = Int32.int
sharing type Int32Array.vector = Int32Vector.vector
sharing type Int32ArraySlice.elem = Int32.int
@@ -600,7 +600,6 @@
sharing type Word16VectorSlice.vector = Word16Vector.vector
sharing type Word16Array2.elem = Word16.word
sharing type Word16Array2.vector = Word16Vector.vector
- sharing type Word32.word = Word.word
sharing type Word32Array.elem = Word32.word
sharing type Word32Array.vector = Word32Vector.vector
sharing type Word32ArraySlice.elem = Word32.word
@@ -740,6 +739,7 @@
where type Int64.int = Int64.int
where type IntInf.int = IntInf.int
where type Real32.real = Real32.real
+ where type Real64.real = Real64.real
where type Word1.word = Word1.word
where type Word2.word = Word2.word
where type Word3.word = Word3.word
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml 2006-05-05 01:03:36 UTC (rev 4459)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml 2006-05-05 02:48:10 UTC (rev 4460)
@@ -72,7 +72,7 @@
structure World = MLtonWorld
structure Word =
struct
- open Word32
+ open Word
type t = word
end
structure Word8 =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb 2006-05-05 01:03:36 UTC (rev 4459)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb 2006-05-05 02:48:10 UTC (rev 4460)
@@ -38,7 +38,7 @@
local
../config/bind/int-prim.sml
- (* ../config/bind/pointer-prim.sml *)
+ ../config/bind/pointer-prim.sml
../config/bind/real-prim.sml
../config/bind/word-prim.sml
in ann "forceUsed" in
|
|
From: Matthew F. <fl...@ml...> - 2006-05-04 18:03:38
|
Declare MLton.Pointer.t to be the primitive pointer tycon; needed for _import * and _symbol * type checking
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-basis.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/CUtil.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/CUtil.sml
U mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/ffi-export.c
U mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/ffi-import.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-05-05 01:03:36 UTC (rev 4459)
@@ -29,6 +29,27 @@
DEFAULT_REAL_MAPS = default-real32.map default-real64.map
DEFAULT_WORD_MAPS = default-word32.map default-word64.map
+.PHONY: type-check-one
+type-check-one:
+ for objptrrep in objptr-rep32.map; do \
+ for header in header-word32.map; do \
+ for seqindex in seqindex-int32.map; do \
+ for defchar in default-char8.map; do \
+ for defint in default-int32.map; do \
+ for defreal in default-real64.map; do \
+ for defword in default-word32.map; do \
+ echo "Type checking: $$objptrrep $$header $$seqindex $$ctypes $$defchar $$defint $$defreal $$defword"; \
+ $(MLTON) -disable-ann deadCode -stop tc -show-types true \
+ -mlb-path-map "maps/$$objptrrep" \
+ -mlb-path-map "maps/$$header" \
+ -mlb-path-map "maps/$$seqindex" \
+ -mlb-path-map "maps/$$defchar" \
+ -mlb-path-map "maps/$$defint" \
+ -mlb-path-map "maps/$$defreal" \
+ -mlb-path-map "maps/$$defword" \
+ build/sources.mlb; \
+ done; done; done; done; done; done; done
+
.PHONY: type-check
type-check:
for objptrrep in $(OBJPTR_MAPS); do \
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml 2006-05-05 01:03:36 UTC (rev 4459)
@@ -208,9 +208,10 @@
let
val cs = strError n
in
- if Primitive.MLton.Pointer.isNull cs
+ if Primitive.MLton.Pointer.isNull
+ (Primitive.MLton.Pointer.fromWord cs)
then "Unknown error"
- else CUtil.C_String.toString cs
+ else CUtil.C_String.toString cs
end
fun raiseSys n = raise SysErr (errorMsg n, SOME n)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-05-05 01:03:36 UTC (rev 4459)
@@ -70,7 +70,8 @@
let
val res =
SysCall.syscallErr
- ({clear = true, restart = false, errVal = Primitive.MLton.Pointer.null}, fn () =>
+ ({clear = true, restart = false,
+ errVal = CUtil.C_Pointer.null}, fn () =>
{return = Prim.readDir d,
post = fn cs => SOME cs,
handlers = [(Error.cleared, fn () => NONE),
@@ -132,7 +133,8 @@
let
val res =
SysCall.syscallErr
- ({clear = false, restart = false, errVal = Primitive.MLton.Pointer.null}, fn () =>
+ ({clear = false, restart = false,
+ errVal = CUtil.C_Pointer.null}, fn () =>
{return = Prim.getcwd (!buffer, C_Size.fromInt (!size)),
post = fn _ => true,
handlers = [(Error.range, fn _ => false)]})
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml 2006-05-05 01:03:36 UTC (rev 4459)
@@ -53,7 +53,7 @@
fun getlogin () =
SysCall.syscall'
- ({errVal = Primitive.MLton.Pointer.null}, fn () =>
+ ({errVal = CUtil.C_Pointer.null}, fn () =>
(Prim.getlogin (), fn cs =>
CS.toString cs))
@@ -242,7 +242,7 @@
let
val cs = Prim.getenv (NullString.nullTerm name)
in
- if Primitive.MLton.Pointer.isNull cs
+ if CUtil.C_Pointer.isNull cs
then NONE
else SOME (CS.toString cs)
end
@@ -253,7 +253,7 @@
fun ttyname fd =
SysCall.syscall'
- ({errVal = Primitive.MLton.Pointer.null}, fn () =>
+ ({errVal = CUtil.C_Pointer.null}, fn () =>
(Prim.ttyname fd, fn cs =>
CS.toString cs))
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-basis.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-basis.sml 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-basis.sml 2006-05-05 01:03:36 UTC (rev 4459)
@@ -432,12 +432,10 @@
end
(* Primitive Basis (MLton Extensions) *)
-(*
structure Pointer =
struct
type t = pointer
end
-*)
structure Thread =
struct
type t = thread
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml 2006-05-05 01:03:36 UTC (rev 4459)
@@ -25,42 +25,6 @@
val installSignalHandler =
_prim "MLton_installSignalHandler": unit -> unit;
-structure Pointer =
- struct
- (* open Pointer *)
- type t = C_Pointer.t
-
- val fromWord = fn x => x
- val toWord = fn x => x
-
- val null: t = fromWord 0w0
-
- fun isNull p = p = null
-
- val getInt8 = _prim "Pointer_getWord8": t * C_Ptrdiff.t -> Int8.int;
- val getInt16 = _prim "Pointer_getWord16": t * C_Ptrdiff.t -> Int16.int;
- val getInt32 = _prim "Pointer_getWord32": t * C_Ptrdiff.t -> Int32.int;
- val getInt64 = _prim "Pointer_getWord64": t * C_Ptrdiff.t -> Int64.int;
- val getPointer = _prim "Pointer_getPointer": t * C_Ptrdiff.t -> 'a;
- val getReal32 = _prim "Pointer_getReal32": t * C_Ptrdiff.t -> Real32.real;
- val getReal64 = _prim "Pointer_getReal64": t * C_Ptrdiff.t -> Real64.real;
- val getWord8 = _prim "Pointer_getWord8": t * C_Ptrdiff.t -> Word8.word;
- val getWord16 = _prim "Pointer_getWord16": t * C_Ptrdiff.t -> Word16.word;
- val getWord32 = _prim "Pointer_getWord32": t * C_Ptrdiff.t -> Word32.word;
- val getWord64 = _prim "Pointer_getWord64": t * C_Ptrdiff.t -> Word64.word;
- val setInt8 = _prim "Pointer_setWord8": t * C_Ptrdiff.t * Int8.int -> unit;
- val setInt16 = _prim "Pointer_setWord16": t * C_Ptrdiff.t * Int16.int -> unit;
- val setInt32 = _prim "Pointer_setWord32": t * C_Ptrdiff.t * Int32.int -> unit;
- val setInt64 = _prim "Pointer_setWord64": t * C_Ptrdiff.t * Int64.int -> unit;
- val setPointer = _prim "Pointer_setPointer": t * C_Ptrdiff.t * 'a -> unit;
- val setReal32 = _prim "Pointer_setReal32": t * C_Ptrdiff.t * Real32.real -> unit;
- val setReal64 = _prim "Pointer_setReal64": t * C_Ptrdiff.t * Real64.real -> unit;
- val setWord8 = _prim "Pointer_setWord8": t * C_Ptrdiff.t * Word8.word -> unit;
- val setWord16 = _prim "Pointer_setWord16": t * C_Ptrdiff.t * Word16.word -> unit;
- val setWord32 = _prim "Pointer_setWord32": t * C_Ptrdiff.t * Word32.word -> unit;
- val setWord64 = _prim "Pointer_setWord64": t * C_Ptrdiff.t * Word64.word -> unit;
- end
-
structure GCState =
struct
type t = Pointer.t
@@ -224,6 +188,62 @@
end
end
+structure Pointer =
+ struct
+ open Pointer
+ type pointer = t
+
+ local
+ structure S =
+ C_Pointer_ChooseWordN
+ (type 'a t = 'a -> t
+ val fWord8 = _prim "WordU8_toWord8": Primitive.Word8.word -> pointer;
+ val fWord16 = _prim "WordU16_toWord16": Primitive.Word16.word -> pointer;
+ val fWord32 = _prim "WordU32_toWord32": Primitive.Word32.word -> pointer;
+ val fWord64 = _prim "WordU64_toWord64": Primitive.Word64.word -> pointer;)
+ in
+ val fromWord = S.f
+ end
+ local
+ structure S =
+ C_Pointer_ChooseWordN
+ (type 'a t = t -> 'a
+ val fWord8 = _prim "WordU8_toWord8": pointer -> Primitive.Word8.word;
+ val fWord16 = _prim "WordU16_toWord16": pointer -> Primitive.Word16.word;
+ val fWord32 = _prim "WordU32_toWord32": pointer -> Primitive.Word32.word;
+ val fWord64 = _prim "WordU64_toWord64": pointer -> Primitive.Word64.word;)
+ in
+ val toWord = S.f
+ end
+
+ val null: t = fromWord 0w0
+
+ fun isNull p = p = null
+
+ val getInt8 = _prim "Pointer_getWord8": t * C_Ptrdiff.t -> Int8.int;
+ val getInt16 = _prim "Pointer_getWord16": t * C_Ptrdiff.t -> Int16.int;
+ val getInt32 = _prim "Pointer_getWord32": t * C_Ptrdiff.t -> Int32.int;
+ val getInt64 = _prim "Pointer_getWord64": t * C_Ptrdiff.t -> Int64.int;
+ val getPointer = _prim "Pointer_getPointer": t * C_Ptrdiff.t -> 'a;
+ val getReal32 = _prim "Pointer_getReal32": t * C_Ptrdiff.t -> Real32.real;
+ val getReal64 = _prim "Pointer_getReal64": t * C_Ptrdiff.t -> Real64.real;
+ val getWord8 = _prim "Pointer_getWord8": t * C_Ptrdiff.t -> Word8.word;
+ val getWord16 = _prim "Pointer_getWord16": t * C_Ptrdiff.t -> Word16.word;
+ val getWord32 = _prim "Pointer_getWord32": t * C_Ptrdiff.t -> Word32.word;
+ val getWord64 = _prim "Pointer_getWord64": t * C_Ptrdiff.t -> Word64.word;
+ val setInt8 = _prim "Pointer_setWord8": t * C_Ptrdiff.t * Int8.int -> unit;
+ val setInt16 = _prim "Pointer_setWord16": t * C_Ptrdiff.t * Int16.int -> unit;
+ val setInt32 = _prim "Pointer_setWord32": t * C_Ptrdiff.t * Int32.int -> unit;
+ val setInt64 = _prim "Pointer_setWord64": t * C_Ptrdiff.t * Int64.int -> unit;
+ val setPointer = _prim "Pointer_setPointer": t * C_Ptrdiff.t * 'a -> unit;
+ val setReal32 = _prim "Pointer_setReal32": t * C_Ptrdiff.t * Real32.real -> unit;
+ val setReal64 = _prim "Pointer_setReal64": t * C_Ptrdiff.t * Real64.real -> unit;
+ val setWord8 = _prim "Pointer_setWord8": t * C_Ptrdiff.t * Word8.word -> unit;
+ val setWord16 = _prim "Pointer_setWord16": t * C_Ptrdiff.t * Word16.word -> unit;
+ val setWord32 = _prim "Pointer_setWord32": t * C_Ptrdiff.t * Word32.word -> unit;
+ val setWord64 = _prim "Pointer_setWord64": t * C_Ptrdiff.t * Word64.word -> unit;
+ end
+
structure Profile =
struct
val isOn = _build_const "MLton_Profile_isOn": bool;
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/CUtil.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/CUtil.sig 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/CUtil.sig 2006-05-05 01:03:36 UTC (rev 4459)
@@ -8,6 +8,14 @@
signature C_UTIL =
sig
+ structure C_Pointer :
+ sig
+ type t = C_Pointer.t
+
+ val null: t
+ val isNull: t -> bool
+ end
+
(* C char* *)
structure C_String :
sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/CUtil.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/CUtil.sml 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/CUtil.sml 2006-05-05 01:03:36 UTC (rev 4459)
@@ -9,6 +9,8 @@
structure CUtil: C_UTIL =
struct
open Int
+
+ structure Pointer = Primitive.MLton.Pointer
fun makeLength (sub, term) p =
let
@@ -34,17 +36,26 @@
a
end
+ structure C_Pointer =
+ struct
+ type t = C_Pointer.t
+ val null = Pointer.toWord Pointer.null
+ fun isNull p = p = null
+ end
+
structure C_String =
struct
type t = C_String.t
fun sub (cs, i) =
Primitive.Char8.fromWord8Unsafe
- (Primitive.MLton.Pointer.getWord8 (cs, C_Ptrdiff.fromInt i))
+ (Pointer.getWord8
+ (Pointer.fromWord cs, C_Ptrdiff.fromInt i))
fun update (cs, i, c) =
- Primitive.MLton.Pointer.setWord8
- (cs, C_Ptrdiff.fromInt i, Primitive.Char8.toWord8Unsafe c)
+ Pointer.setWord8
+ (Pointer.fromWord cs, C_Ptrdiff.fromInt i,
+ Primitive.Char8.toWord8Unsafe c)
fun toCharArrayOfLength (cs, n) = toArrayOfLength (cs, sub, n)
@@ -61,9 +72,10 @@
type t = C_StringArray.t
fun sub (css: t, i) =
- Primitive.MLton.Pointer.getPointer (css, C_Ptrdiff.fromInt i)
+ Pointer.getPointer
+ (Pointer.fromWord css, C_Ptrdiff.fromInt i)
- val length = makeLength (sub, Primitive.MLton.Pointer.isNull)
+ val length = makeLength (sub, Pointer.isNull)
val toArrayOfLength =
fn (css, n) => toArrayOfLength (css, C_String.toString o sub, n)
Modified: mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/ffi-export.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/ffi-export.c 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/ffi-export.c 2006-05-05 01:03:36 UTC (rev 4459)
@@ -2,7 +2,7 @@
#include "export.h"
void g () {
- Char c;
+ Char8 c;
fprintf (stderr, "g starting\n");
c = f (13, 17.15, 'a');
@@ -23,7 +23,7 @@
fprintf (stderr, "g3 done\n");
}
-void g4 (Int i) {
+void g4 (Int32 i) {
fprintf (stderr, "g4 (%d)\n", i);
f4 (i);
}
Modified: mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/ffi-import.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/ffi-import.c 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/ffi-import.c 2006-05-05 01:03:36 UTC (rev 4459)
@@ -1,18 +1,18 @@
#include "platform.h"
-Int FFI_INT = 13;
-Word FFI_WORD = 0xFF;
+Int32 FFI_INT = 13;
+Word32 FFI_WORD = 0xFF;
Bool FFI_BOOL = TRUE;
-Real FFI_REAL = 3.14159;
+Real64 FFI_REAL = 3.14159;
-Char ffi (Pointer a1, Pointer a2, Int n) {
+Char8 ffi (Pointer a1, Pointer a2, Int32 n) {
double *ds = (double*)a1;
int *p = (int*)a2;
int i;
double sum;
sum = 0.0;
- for (i = 0; i < GC_arrayNumElements (a1); ++i) {
+ for (i = 0; i < GC_getArrayLength (a1); ++i) {
sum += ds[i];
ds[i] += n;
}
|
