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
(2) |
Oct
(3) |
Nov
|
Dec
|
|
From: Matthew F. <fl...@ml...> - 2006-12-19 10:08:42
|
Fixed an assertion failure in GC_arrayAllocate with -align 8:
fenrir:~/devel/mlton/mlton.svn.trunk/regression fluet$ ../build/bin/mlton -debug true -align 8 flat-array.2.sml
fenrir:~/devel/mlton/mlton.svn.trunk/regression fluet$ ./flat-array.2
gc/array-allocate.c:91: assert(next <= last) failed.
Abort trap
With -align 8, we may need to leave an extra 32-bit word at the end of
the array in order to properly align the next object. Hence, last
(where last = frontier + arraySize and where arraySize =
align(bytesPerElement * numElements + GC_ARRAY_HEADER_SIZE)) may
correspond to an address beyond the end of the array proper. The
loops to initialize all pointers in an array with BOGUS_OBJPTR use p <
last as a termination condition. Hence, the loops could access
addresses beyond the end of the array proper.
When the array has only object pointers, at worst, we could access one
extra 32-bit word beyond the end of the array proper, but that extra
32-bit word had already been accounted for in the bytesRequested and
the heap check; so, while we may access an address beyond the end of
the array proper, that address "belongs" to the array and is certainly
within the heap.
On the other hand, when the array has both non object pointers and
object pointers and last correspondst to an address beyond the end of
the array proper, then we attempt to initialize an extra array
element. Since there will be at least one word or non object pointer
data, we will access at least one object pointer at an address that is
strictly beyond the space allocated for the array and may even be
outside the heap.
The solution is simple: compute last according to the size of the
array proper, but bump the frontier (or oldGenSize and
cumulativeStatistics.bytesAllocated) by the aligned size.
----------------------------------------------------------------------
U mlton/trunk/runtime/gc/array-allocate.c
----------------------------------------------------------------------
Modified: mlton/trunk/runtime/gc/array-allocate.c
===================================================================
--- mlton/trunk/runtime/gc/array-allocate.c 2006-12-19 16:14:45 UTC (rev 4987)
+++ mlton/trunk/runtime/gc/array-allocate.c 2006-12-19 18:08:40 UTC (rev 4988)
@@ -10,66 +10,74 @@
size_t ensureBytesFree,
GC_arrayLength numElements,
GC_header header) {
- uintmax_t arraySizeMax;
- size_t arraySize;
+ uintmax_t arraySizeMax, arraySizeAlignedMax;
+ size_t arraySize, arraySizeAligned;
size_t bytesPerElement;
uint16_t bytesNonObjptrs;
uint16_t numObjptrs;
pointer frontier;
pointer last;
- pointer res;
+ pointer result;
splitHeader(s, header, NULL, NULL, &bytesNonObjptrs, &numObjptrs);
if (DEBUG)
fprintf (stderr, "GC_arrayAllocate (%zu, "FMTARRLEN", "FMTHDR")\n",
ensureBytesFree, numElements, header);
bytesPerElement = bytesNonObjptrs + (numObjptrs * OBJPTR_SIZE);
- arraySizeMax =
- alignMax ((uintmax_t)bytesPerElement * (uintmax_t)numElements + GC_ARRAY_HEADER_SIZE,
- s->alignment);
- if (arraySizeMax >= (uintmax_t)SIZE_MAX)
+ arraySizeMax =
+ (uintmax_t)bytesPerElement * (uintmax_t)numElements + GC_ARRAY_HEADER_SIZE;
+ arraySizeAlignedMax = alignMax (arraySizeMax, s->alignment);
+ if (arraySizeAlignedMax >= (uintmax_t)SIZE_MAX)
die ("Out of memory: cannot allocate array with %s bytes.",
- uintmaxToCommaString(arraySizeMax));
+ uintmaxToCommaString(arraySizeAlignedMax));
arraySize = (size_t)arraySizeMax;
- if (arraySize < GC_ARRAY_HEADER_SIZE + OBJPTR_SIZE)
+ arraySizeAligned = (size_t)arraySizeAlignedMax;
+ if (arraySizeAligned < GC_ARRAY_HEADER_SIZE + OBJPTR_SIZE) {
/* Create space for forwarding pointer. */
- arraySize = GC_ARRAY_HEADER_SIZE + OBJPTR_SIZE;
+ arraySize = GC_ARRAY_HEADER_SIZE;
+ arraySizeAligned = align(GC_ARRAY_HEADER_SIZE + OBJPTR_SIZE, s->alignment);
+ }
if (DEBUG_ARRAY)
- fprintf (stderr, "array with "FMTARRLEN" elts of size %zu and total size %s. Ensure %s bytes free.\n",
+ fprintf (stderr,
+ "Array with "FMTARRLEN" elts of size %zu and size %s and aligned size %s. "
+ "Ensure %s bytes free.\n",
numElements, bytesPerElement,
uintmaxToCommaString(arraySize),
+ uintmaxToCommaString(arraySizeAligned),
uintmaxToCommaString(ensureBytesFree));
- if (arraySize >= s->controls.oldGenArraySize) {
- if (not hasHeapBytesFree (s, arraySize, ensureBytesFree)) {
+ if (arraySizeAligned >= s->controls.oldGenArraySize) {
+ if (not hasHeapBytesFree (s, arraySizeAligned, ensureBytesFree)) {
enter (s);
- performGC (s, arraySize, ensureBytesFree, FALSE, TRUE);
+ performGC (s, arraySizeAligned, ensureBytesFree, FALSE, TRUE);
leave (s);
}
frontier = s->heap.start + s->heap.oldGenSize;
- last = frontier + arraySize;
- s->heap.oldGenSize += arraySize;
- s->cumulativeStatistics.bytesAllocated += arraySize;
+ s->heap.oldGenSize += arraySizeAligned;
+ s->cumulativeStatistics.bytesAllocated += arraySizeAligned;
} else {
size_t bytesRequested;
+ pointer newFrontier;
- bytesRequested = arraySize + ensureBytesFree;
+ bytesRequested = arraySizeAligned + ensureBytesFree;
if (not hasHeapBytesFree (s, 0, bytesRequested)) {
enter (s);
performGC (s, 0, bytesRequested, FALSE, TRUE);
leave (s);
}
frontier = s->frontier;
- last = frontier + arraySize;
- assert (isFrontierAligned (s, last));
- s->frontier = last;
+ newFrontier = frontier + arraySizeAligned;
+ assert (isFrontierAligned (s, newFrontier));
+ s->frontier = newFrontier;
}
+ last = frontier + arraySize;
*((GC_arrayCounter*)(frontier)) = 0;
frontier = frontier + GC_ARRAY_COUNTER_SIZE;
*((GC_arrayLength*)(frontier)) = numElements;
frontier = frontier + GC_ARRAY_LENGTH_SIZE;
*((GC_header*)(frontier)) = header;
frontier = frontier + GC_HEADER_SIZE;
- res = frontier;
+ result = frontier;
+ assert (isAligned ((size_t)result, s->alignment));
/* Initialize all pointers with BOGUS_OBJPTR. */
if (1 <= numObjptrs and 0 < numElements) {
pointer p;
@@ -94,10 +102,10 @@
}
}
}
- GC_profileAllocInc (s, arraySize);
+ GC_profileAllocInc (s, arraySizeAligned);
if (DEBUG_ARRAY) {
- fprintf (stderr, "GC_arrayAllocate done. res = "FMTPTR" frontier = "FMTPTR"\n",
- (uintptr_t)res, (uintptr_t)s->frontier);
+ fprintf (stderr, "GC_arrayAllocate done. result = "FMTPTR" frontier = "FMTPTR"\n",
+ (uintptr_t)result, (uintptr_t)s->frontier);
displayGCState (s, stderr);
}
assert (ensureBytesFree <= (size_t)(s->limitPlusSlop - s->frontier));
@@ -105,5 +113,5 @@
* unless we did the GC, we never set s->currentThread->stack->used
* to reflect what the mutator did with stackTop.
*/
- return res;
+ return result;
}
|
|
From: Vesa K. <ve...@ml...> - 2006-12-19 08:14:46
|
Added minimal support for compiler specific annotations.
----------------------------------------------------------------------
U mlton/trunk/ide/emacs/esml-mlb-mode.el
----------------------------------------------------------------------
Modified: mlton/trunk/ide/emacs/esml-mlb-mode.el
===================================================================
--- mlton/trunk/ide/emacs/esml-mlb-mode.el 2006-12-19 02:59:11 UTC (rev 4986)
+++ mlton/trunk/ide/emacs/esml-mlb-mode.el 2006-12-19 16:14:45 UTC (rev 4987)
@@ -242,21 +242,23 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Syntax and highlighting
-(defconst esml-mlb-string-continue-regexp "\\(\\\\[ \t\n]+\\\\\\)")
+(defconst esml-mlb-string-continue-regexp "\\(?:\\\\[ \t\n]+\\\\\\)")
(defconst esml-mlb-string-char-regexp
- (concat "\\(" esml-mlb-string-continue-regexp
- "*\\([^\n\"\\]\\|\\\\[^ \t\n]\\)\\)"))
+ (concat "\\(?:" esml-mlb-string-continue-regexp
+ "*\\(?:[^\n\"\\]\\|\\\\[^ \t\n]\\)\\)"))
(defconst esml-mlb-inside-string-regexp
(concat "\"" esml-mlb-string-char-regexp "*"
esml-mlb-string-continue-regexp "*"))
(defconst esml-mlb-string-regexp (concat esml-mlb-inside-string-regexp "\""))
-(defconst esml-mlb-inside-comment-regexp "(\\*\\([^*]\\|\\*[^)]\\)*")
+(defconst esml-mlb-inside-comment-regexp "(\\*\\(?:[^*]\\|\\*[^)]\\)*")
(defconst esml-mlb-comment-regexp
(concat esml-mlb-inside-comment-regexp "\\*)"))
(defconst esml-mlb-path-var-chars "A-Za-z0-9_")
(defconst esml-mlb-unquoted-path-chars "-A-Za-z0-9_/.")
(defconst esml-mlb-unquoted-path-or-ref-chars
(concat esml-mlb-unquoted-path-chars "()$"))
+(defconst esml-mlb-compiler-ann-prefix
+ (concat "\\(?:" esml-mlb-string-char-regexp "*:[ \t]*\\)"))
(defun esml-mlb-<token>-to-regexp (<token>)
(let* ((<token>-to-regexp
@@ -309,7 +311,7 @@
;; annotations
(,(apply
'concat
- "\"[ \t]*\\("
+ "\"[ \t]*" esml-mlb-compiler-ann-prefix "?\\("
(reduce
(function
(lambda (regexps name-values)
@@ -484,7 +486,7 @@
;; annotation values
((esml-point-preceded-by
- (concat "\"[ \t\n]*\\("
+ (concat "\"[ \t\n]*" esml-mlb-compiler-ann-prefix "?\\("
(regexp-opt (mapcar 'car esml-mlb-annotations))
"\\)[ \t\n]+\\(" esml-mlb-string-char-regexp "*\\)"))
(let* ((annot (assoc (match-string 1) esml-mlb-annotations))
@@ -511,7 +513,8 @@
(concat "\\<ann[ \t\n]+\\([ \t\n]+\\|" esml-mlb-string-regexp
"\\|" esml-mlb-comment-regexp "\\)*\"[^\"]*"))
(esml-point-preceded-by
- (concat "\"[ \t\n]*\\(" esml-mlb-string-char-regexp "*\\)")))
+ (concat "\"[ \t\n]*" esml-mlb-compiler-ann-prefix "?\\("
+ esml-mlb-string-char-regexp "*\\)")))
(let* ((name-prefix (match-string 1))
(name-completion (try-completion name-prefix esml-mlb-annotations))
(name (if (eq t name-completion) name-prefix name-completion)))
|
|
From: Wesley T. <we...@ml...> - 2006-12-18 18:59:20
|
import didn't work, try adding and commiting
----------------------------------------------------------------------
A mltonlib/trunk/ca/terpstra/math/README
A mltonlib/trunk/ca/terpstra/math/algebra.fun
A mltonlib/trunk/ca/terpstra/math/algebra.sig
A mltonlib/trunk/ca/terpstra/math/c.fun
A mltonlib/trunk/ca/terpstra/math/c.sml
A mltonlib/trunk/ca/terpstra/math/factor.fun
A mltonlib/trunk/ca/terpstra/math/factor.sml
A mltonlib/trunk/ca/terpstra/math/galois.fun
A mltonlib/trunk/ca/terpstra/math/galois.sml
A mltonlib/trunk/ca/terpstra/math/gcd.fun
A mltonlib/trunk/ca/terpstra/math/groups.fun
A mltonlib/trunk/ca/terpstra/math/groups.sig
A mltonlib/trunk/ca/terpstra/math/log.fun
A mltonlib/trunk/ca/terpstra/math/math.mlb
A mltonlib/trunk/ca/terpstra/math/mersenne.fun
A mltonlib/trunk/ca/terpstra/math/mersenne.sml
A mltonlib/trunk/ca/terpstra/math/ops.sig
A mltonlib/trunk/ca/terpstra/math/ops.sml
A mltonlib/trunk/ca/terpstra/math/order.sml
A mltonlib/trunk/ca/terpstra/math/permutation.sml
A mltonlib/trunk/ca/terpstra/math/polynomial.fun
A mltonlib/trunk/ca/terpstra/math/q.fun
A mltonlib/trunk/ca/terpstra/math/q.sml
A mltonlib/trunk/ca/terpstra/math/r.fun
A mltonlib/trunk/ca/terpstra/math/r.sml
A mltonlib/trunk/ca/terpstra/math/rings.fun
A mltonlib/trunk/ca/terpstra/math/rings.sig
A mltonlib/trunk/ca/terpstra/math/test/
A mltonlib/trunk/ca/terpstra/math/test/test.mlb
A mltonlib/trunk/ca/terpstra/math/test/test.sml
A mltonlib/trunk/ca/terpstra/math/test/test2.sml
A mltonlib/trunk/ca/terpstra/math/test/test3.mlb
A mltonlib/trunk/ca/terpstra/math/test/test3.sml
A mltonlib/trunk/ca/terpstra/math/test/test4.mlb
A mltonlib/trunk/ca/terpstra/math/test/test4.sml
A mltonlib/trunk/ca/terpstra/math/z.fun
A mltonlib/trunk/ca/terpstra/math/z.sml
----------------------------------------------------------------------
Added: mltonlib/trunk/ca/terpstra/math/README
===================================================================
--- mltonlib/trunk/ca/terpstra/math/README 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/README 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,44 @@
+This is an incomplete library for number theory.
+
+What there is:
+ small-size galois fields
+ mersenne fields
+ polynomials with Karatsuba (no FFT)
+ permutations
+ generic methods (gcd, discrete logarithm, ...)
+ a reasonably fast integer factorization algorithm
+
+Basically, it's a framework in which I dumped any algorithms or mathematical
+structures I needed as I needed them.
+
+Using it is pretty nice, since you can bind any structure to an operation.
+Generally, one combines functors to create the desired mathematical object.
+
+Some objects already exist (Z = integers, Galois8 = GF(8))
+Some need to be created, eg: ComplexOfField(FieldOfReal(LargeReal))
+
+Structures contain their mathematical operations and substructures.
+The structure Z includes substructures Z.Addition (an abelian group) and
+Z.Multiplication (an abelian monoid). These include relevant operations.
+
+Once a structure has been created, it can be bound to an operation.
+For example:
+ structure Binding = AbelianGroupAddPercent(Z.Addition)
+ open Binding
+will bind =%, +%, -%, ~%, and ++% operations for manipulating Z elements.
+
+To bind the entire structure of Z, one can use:
+ structure Binding = EuclideanDomainDollar(Z)
+ open Binding
+This binds operations: =$, !=$, *$, **$, /$, %$, //$, +$, -$, ~$
+
+There are also some generic algorithms, for example:
+ structure G = GCD(Z)
+This gives you a GCD method that works over integers.
+
+Another example:
+ structure P = PolynomialOverField(ComplexOfField(FieldOfReal(LargeReal)))
+ structure B = Polynomial(P)
+ open B
+Here, the operations with % on the end operate on complex values, while $
+operates on polynomials over the complex numbers.
Added: mltonlib/trunk/ca/terpstra/math/algebra.fun
===================================================================
--- mltonlib/trunk/ca/terpstra/math/algebra.fun 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/algebra.fun 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,69 @@
+(****************************************************************** Algebra ops *)
+
+functor ScalarMultiply(S : SCALAR_MULTIPLY) =
+ struct
+ val (op *&) = S.MUL
+ end
+
+functor Module(M : MODULE) =
+ struct
+ local structure S = RingPercent(M.Base) in open S end
+ local structure S = AbelianGroupAddDollar(M.Addition) in open S end
+ local structure S = ScalarMultiply(M.ScalarMultiplication) in open S end
+ end
+
+functor UnitaryModule(U : UNITARY_MODULE) =
+ struct
+ local structure S = UnitaryRingPercent(U.Base) in open S end
+ local structure S = AbelianGroupAddDollar(U.Addition) in open S end
+ local structure S = ScalarMultiply(U.ScalarMultiplication) in open S end
+ end
+
+functor VectorSpace(V : VECTOR_SPACE) =
+ struct
+ local structure S = FieldPercent(V.Base) in open S end
+ local structure S = AbelianGroupAddDollar(V.Addition) in open S end
+ local structure S = ScalarMultiply(V.ScalarMultiplication) in open S end
+ end
+
+functor Algebra(A : ALGEBRA) =
+ struct
+ local structure S = CommutativeRingPercent(A.Base) in open S end
+ local structure S = NonAssociativeRingDollar(A) in open S end
+ local structure S = ScalarMultiply(A.ScalarMultiplication) in open S end
+ end
+
+functor FieldAlgebra(A : FIELD_ALGEBRA) =
+ struct
+ local structure S = FieldPercent(A.Base) in open S end
+ local structure S = NonAssociativeRingDollar(A) in open S end
+ local structure S = ScalarMultiply(A.ScalarMultiplication) in open S end
+ end
+
+functor AssociativeAlgebra(A : ASSOCIATIVE_ALGEBRA) =
+ struct
+ local structure S = CommutativeRingPercent(A.Base) in open S end
+ local structure S = RingDollar(A) in open S end
+ local structure S = ScalarMultiply(A.ScalarMultiplication) in open S end
+ end
+
+functor AssociativeFieldAlgebra(A : ASSOCIATIVE_FIELD_ALGEBRA) =
+ struct
+ local structure S = FieldPercent(A.Base) in open S end
+ local structure S = RingDollar(A) in open S end
+ local structure S = ScalarMultiply(A.ScalarMultiplication) in open S end
+ end
+
+functor UnitaryAssociativeAlgebra(A : UNITARY_ASSOCIATIVE_ALGEBRA) =
+ struct
+ local structure S = CommutativeRingPercent(A.Base) in open S end
+ local structure S = UnitaryRingDollar(A) in open S end
+ local structure S = ScalarMultiply(A.ScalarMultiplication) in open S end
+ end
+
+functor UnitaryAssociativeFieldAlgebra(A : UNITARY_ASSOCIATIVE_FIELD_ALGEBRA) =
+ struct
+ local structure S = FieldPercent(A.Base) in open S end
+ local structure S = UnitaryRingDollar(A) in open S end
+ local structure S = ScalarMultiply(A.ScalarMultiplication) in open S end
+ end
Added: mltonlib/trunk/ca/terpstra/math/algebra.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/math/algebra.sig 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/algebra.sig 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,103 @@
+signature SCALAR_MULTIPLY =
+ sig
+ type e
+ type t
+
+ (* if one exists: one*v = v*one = v *)
+ val MUL: e * t -> t
+
+ (* a*(b*v) = (a*.b)*v *)
+ val associative : unit
+
+ (* c*(v+w) = c*v + v*w
+ * (c+.d)*v = c*v + d*v
+ *)
+ val distributive : unit
+ end
+
+(* All MODULEs here are left modules *)
+signature MODULE =
+ sig
+ type e
+ type t
+ structure Base : RING where type t = e
+ structure Addition : ABELIAN_GROUP where type t = t
+ structure ScalarMultiplication : SCALAR_MULTIPLY where type e = e and type t = t
+ end
+
+signature UNITARY_MODULE =
+ sig
+ type e
+ type t
+ structure Base : UNITARY_RING where type t = e
+ structure Addition : ABELIAN_GROUP where type t = t
+ structure ScalarMultiplication : SCALAR_MULTIPLY where type e = e and type t = t
+ end
+
+(* same as a UNITARY_MODULE, but over a field *)
+signature VECTOR_SPACE =
+ sig
+ type e
+ type t
+ structure Base : FIELD where type t = e
+ structure Addition : ABELIAN_GROUP where type t = t
+ structure ScalarMultiplication : SCALAR_MULTIPLY where type e = e and type t = t
+ end
+
+signature ALGEBRA =
+ sig
+ include NON_ASSOCIATIVE_RING
+ type e
+ structure Base : COMMUTATIVE_RING where type t = e
+ structure ScalarMultiplication : SCALAR_MULTIPLY where type e = e and type t = t
+
+ (* (ax)y = a(xy)
+ * a(xy) = x(ay)
+ *)
+ val bilinear : unit
+ end
+
+signature FIELD_ALGEBRA =
+ sig
+ include NON_ASSOCIATIVE_RING
+ type e
+ structure Base : FIELD where type t = e
+ structure ScalarMultiplication : SCALAR_MULTIPLY where type e = e and type t = t
+ val bilinear : unit
+ end
+
+signature ASSOCIATIVE_ALGEBRA =
+ sig
+ include RING
+ type e
+ structure Base : COMMUTATIVE_RING where type t = e
+ structure ScalarMultiplication : SCALAR_MULTIPLY where type e = e and type t = t
+ val bilinear : unit
+ end
+
+signature ASSOCIATIVE_FIELD_ALGEBRA =
+ sig
+ include RING
+ type e
+ structure Base : FIELD where type t = e
+ structure ScalarMultiplication : SCALAR_MULTIPLY where type e = e and type t = t
+ val bilinear : unit
+ end
+
+signature UNITARY_ASSOCIATIVE_ALGEBRA =
+ sig
+ include UNITARY_RING
+ type e
+ structure Base : COMMUTATIVE_RING where type t = e
+ structure ScalarMultiplication : SCALAR_MULTIPLY where type e = e and type t = t
+ val bilinear : unit
+ end
+
+signature UNITARY_ASSOCIATIVE_FIELD_ALGEBRA =
+ sig
+ include UNITARY_RING
+ type e
+ structure Base : FIELD where type t = e
+ structure ScalarMultiplication : SCALAR_MULTIPLY where type e = e and type t = t
+ val bilinear : unit
+ end
Added: mltonlib/trunk/ca/terpstra/math/c.fun
===================================================================
--- mltonlib/trunk/ca/terpstra/math/c.fun 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/c.fun 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,47 @@
+(* This is still a field only if (x^2 + 1) is irreducible *)
+functor ComplexOfField(F : FIELD) : FIELD =
+ struct
+ local
+ structure B = FieldPercent(F)
+ structure O = EuclideanDomainDollar(Order)
+ open B
+ open O
+ in
+ type t = F.t * F.t
+ val characteristic = F.characteristic
+
+ structure Addition =
+ struct
+ type t = F.t * F.t
+ val order = F.Addition.order *$ F.Addition.order
+
+ val associative = ()
+ val commutative = ()
+ val one = (#%0, #%0)
+
+ val EQ = fn ((ar, ai), (br, bi)) => (ar =% br) andalso (ai =% bi)
+ val MUL = fn ((ar, ai), (br, bi)) => (ar +% br, ai +% bi)
+ val DIV = fn ((ar, ai), (br, bi)) => (ar -% br, ai -% bi)
+ val INV = fn (a, b) => (~%a, ~%b)
+ end
+
+ structure Multiplication =
+ struct
+ type t = F.t * F.t
+ val order = F.Addition.order *$ F.Addition.order -$ #$1
+
+ val associative = ()
+ val commutative = ()
+ val one = (#%1, #%0)
+
+ val EQ = fn ((ar, ai), (br, bi)) => (ar =% br) andalso (ai =% bi)
+ val INV = fn (r, i) =>
+ let val e = !%(r*%r +% i*%i) in (r*%e, ~%i*%e) end
+ val MUL = fn ((ar, ai), (br, bi)) => (ar*%br -% ai*%bi, ar*%bi +% ai*%br)
+ val DIV = fn (a, c) => MUL (a, INV c)
+ end
+
+ val distributive = ()
+ val no_zero_divisors = ()
+ end
+ end
Added: mltonlib/trunk/ca/terpstra/math/c.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/math/c.sml 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/c.sml 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,4 @@
+structure C = ComplexOfField(R)
+
+structure C32 = ComplexOfField(R32)
+structure C64 = ComplexOfField(R64)
Added: mltonlib/trunk/ca/terpstra/math/factor.fun
===================================================================
--- mltonlib/trunk/ca/terpstra/math/factor.fun 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/factor.fun 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,22 @@
+functor Factor(E : EUCLIDEAN_DOMAIN) =
+ struct
+ local
+ structure B = EuclideanDomainPercent(E)
+ open B
+
+ fun push (z, l) =
+ case l of
+ nil => (z, #%1) :: nil
+ | (y, e) :: l =>
+ if y =% z
+ then (y, e +% #%1) :: l
+ else (z, #%1) :: (y, e) :: l
+
+ fun niaveFactor (z, l) a =
+ if z <% a*%a then push (z, l) else
+ if z %% a =% #%0 then niaveFactor (z /% a, push (a, l)) a else
+ niaveFactor (z, l) (a +% #%1)
+ in
+ fun factor z = niaveFactor (z, nil) (#%2)
+ end
+ end
Added: mltonlib/trunk/ca/terpstra/math/factor.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/math/factor.sml 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/factor.sml 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,54 @@
+structure Factor =
+ struct
+ local
+ open LargeInt
+ in
+ fun isPrime n =
+ let
+ fun chop (c, e) = if c mod 2 = 0 then chop (c div 2, e+1) else (c, e)
+ val (c, e) = chop (n-1, 0)
+
+ fun exp (x, 0) = 1
+ | exp (x, 1) = x
+ | exp (x, e) =
+ let val y = exp (x*x mod n, e div 2)
+ in if e mod 2 = 0 then y else y * x mod n end
+
+ fun checkPow (w, e) =
+ e > 0 andalso (w+1 = n orelse checkPow (w*w mod n, e-1))
+ fun millerRabin w =
+ let val v = exp (w, c)
+ in v = 1 orelse checkPow (v, e) end
+ in
+ List.foldl (fn (w, a) => a andalso millerRabin (1 + w mod (n-1)))
+ true [62151, 7444, 40814, 49239, 71708759, 4481, 665652934 ]
+ end
+
+ fun factor n =
+ let
+ fun sort nil = nil
+ | sort (p :: r) =
+ let val (s, b) = List.partition (fn x => x < p) r
+ in sort s @ p :: sort b end
+
+ fun gcd (a, b) = if a = 0 then b else gcd (b mod a, a)
+
+ fun findafactor n =
+ let
+ val start = Word.toLargeInt (MLton.Random.rand ()) mod n
+ fun f x = (x*x + 2) mod n
+ fun loop x y =
+ let val g = gcd (n, n+x-y)
+ in if g = 1 then loop (f x) (f (f y)) else g end
+ in loop start (f start) end
+
+ fun suck n l =
+ if n = 1 then l else
+ if isPrime n then n :: l else
+ let val x = findafactor n
+ in suck x (suck (n div x) l) end
+ in
+ sort (suck n [])
+ end
+ end
+ end
Added: mltonlib/trunk/ca/terpstra/math/galois.fun
===================================================================
--- mltonlib/trunk/ca/terpstra/math/galois.fun 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/galois.fun 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,93 @@
+signature GaloisParam =
+ sig
+ structure W : WORD
+ val base : W.word
+ end
+
+functor GaloisFromTable(P : GaloisParam) : FIELD =
+ struct
+ local
+ open P.W
+ open Int
+
+ val fromInt = P.W.fromInt
+ val toInt = P.W.toInt
+
+ val zero = fromInt 0
+ val one = fromInt 1
+
+ val msize = toInt (notb zero)
+ val size = msize + 1
+ val highbit = << (one, Word.-(Word.fromInt wordSize, 0w1))
+
+ fun nastymul x y =
+ if y = zero then zero else
+ if y = one then x else
+ let val h = nastymul x (>> (y, 0w1))
+ val x = if andb (y, one) = one then x else zero
+ val b = if andb (h, highbit) = highbit then P.base else zero
+ in xorb( << (h, 0w1), xorb(x, b)) end
+
+ val gen = orb (one, << (one, 0w1)) (* x^1 + x^0 <- a generator *)
+
+ val log = Array.array (size, zero)
+ fun set _ l ~1 = l
+ | set a l i = (
+ Array.update (log, toInt a, fromInt i)
+ ; set (nastymul a gen) (a :: l) (i - 1))
+
+ val exp = Vector.fromList (set gen nil (msize + msize - 1))
+ val log = Array.vector log
+(*
+ val _ = Vector.app (fn x => print (P.W.toString x ^ " ")) exp
+ val _ = print "\n"
+ val _ = Vector.app (fn x => print (P.W.toString x ^ " ")) log
+ val _ = print "\n"
+*)
+ val exp = fn x => Vector.sub (exp, x)
+ val log = fn x => toInt (Vector.sub (log, toInt x))
+ in
+ type t = word
+ val characteristic = LargeInt.fromInt 2
+
+ structure Addition =
+ struct
+ type t = word
+ val order = FINITE (Int.toLarge msize)
+
+ val associative = ()
+ val commutative = ()
+ val one = fromInt 0
+
+ val EQ = (op =)
+ val MUL = fn (x, y) => xorb (x, y)
+ val DIV = MUL
+ val INV = fn x => x
+ end
+
+ structure Multiplication =
+ struct
+ type t = word
+ val order = FINITE (Int.toLarge size)
+
+ val associative = ()
+ val commutative = ()
+ val one = fromInt 1
+
+ val EQ = (op =)
+ val MUL = fn (x, y) =>
+ if x = zero orelse y = zero then zero else
+ let val (lx, ly) = (log x, log y)
+ in exp (lx + ly) end
+ val DIV = fn (x, y) =>
+ let val (lx, ly) = (log x, log y)
+ in exp (lx + msize - ly) end
+ val INV = fn x =>
+ let val lx = log x
+ in exp (msize - lx) end
+ end
+
+ val distributive = ()
+ val no_zero_divisors = ()
+ end
+ end
Added: mltonlib/trunk/ca/terpstra/math/galois.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/math/galois.sml 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/galois.sml 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,21 @@
+local
+ structure P4 =
+ struct
+ structure W = Word4
+ val base : W.word = 0wx3
+ end
+ structure P5 =
+ struct
+ structure W = Word5
+ val base : W.word = 0wx9
+ end
+ structure P8 =
+ struct
+ structure W = Word8
+ val base : W.word = 0wx1B
+ end
+in
+ structure Galois4 = GaloisFromTable(P4)
+ structure Galois5 = GaloisFromTable(P5)
+ structure Galois8 = GaloisFromTable(P8)
+end
Added: mltonlib/trunk/ca/terpstra/math/gcd.fun
===================================================================
--- mltonlib/trunk/ca/terpstra/math/gcd.fun 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/gcd.fun 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,49 @@
+exception NoSolution
+
+functor GCD(E : EUCLIDEAN_DOMAIN) =
+ struct
+ local
+ structure B = EuclideanDomainPercent(E)
+ open B
+ in
+ (* (g, i, j, x) = egcd(a, b)
+ * gcd(a,b) = g = a*i + b*j
+ * x = -1 -> i <= 0 and j >= 0
+ * x = +1 -> j <= 0 and i >= 0
+ *)
+ fun egcd (a, b) =
+ if (b =% #%0) then (a, #%1, #%0, #%1) else
+ let
+ val (q, r) = a //% b
+ val (g, i, j, x) = egcd (b, r)
+ in
+ (g, j, i -% q*%j, ~%x)
+ end
+
+ fun gcd (a, b) = case egcd (a, b) of (g, _, _, _) => g
+ fun lcm (a, b) = a*%b /% gcd(a, b)
+
+ fun gcdinv (n, m) =
+ let
+ val (g, ni, mi, x) = egcd(n, m)
+ in
+ if x =% #%1
+ then (g, ni, n+%mi)
+ else (g, m+%ni, mi)
+ end
+
+ fun inv (a, n) = case gcdinv (n, a) of (_, _, ai) => ai
+
+ fun crt nil = (#%0, #%1)
+ | crt ((a, n) :: x) =
+ let
+ val (b, m) = crt x
+ val (g, ni, mi) = gcdinv (n, m)
+ val l = n*%m/%g
+ in
+ if a %% g =% b %% g
+ then ((a*%m*%mi +% b*%n*%ni)/%g %% l, l)
+ else raise NoSolution
+ end
+ end
+ end
Added: mltonlib/trunk/ca/terpstra/math/groups.fun
===================================================================
--- mltonlib/trunk/ca/terpstra/math/groups.fun 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/groups.fun 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,149 @@
+(****************************************************************** Group ops *)
+
+exception ImpossibleConstant
+
+functor SetPercent(S : BINARY_OPERATION) =
+ struct
+ val (op =% ) = S.EQ
+ val (op !=%) = not o S.EQ
+ end
+
+functor SetDollar(S : BINARY_OPERATION) =
+ struct
+ val (op =$ ) = S.EQ
+ val (op !=$) = not o S.EQ
+ end
+
+functor BinaryOperationMulPercent(B : BINARY_OPERATION) =
+ struct
+ local structure S = SetPercent(B) in open S end
+ val (op *% ) = B.MUL
+ local open LargeInt in
+ fun _ **% 0 = raise ImpossibleConstant
+ | x **% 1 = x
+ | x **% e =
+ let val h = x **% (e div 2)
+ in if (e mod 2) = 0 then h *% h else h *% h *% x end
+ end
+ end
+functor BinaryOperationAddPercent(B : BINARY_OPERATION) =
+ struct
+ local structure S = SetPercent(B) in open S end
+ val (op +% ) = B.MUL
+ local open LargeInt in
+ fun _ ++% 0 = raise ImpossibleConstant
+ | x ++% 1 = x
+ | x ++% e =
+ let val h = x ++% (e div 2)
+ in if (e mod 2) = 0 then h +% h else h +% h +% x end
+ end
+ end
+
+functor BinaryOperationMulDollar(B : BINARY_OPERATION) =
+ struct
+ local structure S = SetDollar(B) in open S end
+ val (op *$ ) = B.MUL
+ local open LargeInt in
+ fun _ **$ 0 = raise ImpossibleConstant
+ | x **$ 1 = x
+ | x **$ e =
+ let val h = x **$ (e div 2)
+ in if (e mod 2) = 0 then h *$ h else h *$ h *$ x end
+ end
+ end
+functor BinaryOperationAddDollar(B : BINARY_OPERATION) =
+ struct
+ local structure S = SetDollar(B) in open S end
+ val (op +$ ) = B.MUL
+ local open LargeInt in
+ fun _ ++$ 0 = raise ImpossibleConstant
+ | x ++$ 1 = x
+ | x ++$ e =
+ let val h = x ++$ (e div 2)
+ in if (e mod 2) = 0 then h +$ h else h +$ h +$ x end
+ end
+ end
+
+functor SemiGroupMulPercent(S : SEMIGROUP) = BinaryOperationMulPercent(S)
+functor SemiGroupAddPercent(S : SEMIGROUP) = BinaryOperationAddPercent(S)
+functor SemiGroupMulDollar (S : SEMIGROUP) = BinaryOperationMulDollar (S)
+functor SemiGroupAddDollar (S : SEMIGROUP) = BinaryOperationAddDollar (S)
+
+functor MonoidMulPercent(M : MONOID) =
+ struct
+ local structure S = SemiGroupMulPercent(M) in open S end
+ val (op **%) = fn (_, 0) => M.one | (x, e) => x **% e
+ val #% = fn 1 => M.one | _ => raise ImpossibleConstant
+ end
+functor MonoidAddPercent(M : MONOID) =
+ struct
+ local structure S = SemiGroupAddPercent(M) in open S end
+ val (op ++%) = fn (_, 0) => M.one | (x, e) => x ++% e
+ val #% = fn 0 => M.one | _ => raise ImpossibleConstant
+ end
+
+functor MonoidMulDollar(M : MONOID) =
+ struct
+ local structure S = SemiGroupMulDollar(M) in open S end
+ val (op **$) = fn (_, 0) => M.one | (x, e) => x **$ e
+ val #$ = fn 1 => M.one | _ => raise ImpossibleConstant
+ end
+functor MonoidAddDollar(M : MONOID) =
+ struct
+ local structure S = SemiGroupAddDollar(M) in open S end
+ val (op ++$) = fn (_, 0) => M.one | (x, e) => x ++$ e
+ val #$ = fn 0 => M.one | _ => raise ImpossibleConstant
+ end
+
+functor AbelianMonoidMulPercent(A : ABELIAN_MONOID) = MonoidMulPercent(A)
+functor AbelianMonoidAddPercent(A : ABELIAN_MONOID) = MonoidAddPercent(A)
+functor AbelianMonoidMulDollar (A : ABELIAN_MONOID) = MonoidMulDollar (A)
+functor AbelianMonoidAddDollar (A : ABELIAN_MONOID) = MonoidAddDollar (A)
+
+functor GroupMulPercent(G : GROUP) =
+ struct
+ local structure S = MonoidMulPercent(G) in open S end
+ val (op !% ) = G.INV
+ val (op **%) = fn (x, e) => if e < 0 then !%x **% ~e else x **% e
+ end
+functor GroupAddPercent(G : GROUP) =
+ struct
+ local structure S = MonoidAddPercent(G) in open S end
+ val (op ~% ) = G.INV
+ val (op ++%) = fn (x, e) => if e < 0 then ~%x ++% ~e else x ++% e
+ end
+
+functor GroupMulDollar(G : GROUP) =
+ struct
+ local structure S = MonoidMulDollar(G) in open S end
+ val (op !$ ) = G.INV
+ val (op **$) = fn (x, e) => if e < 0 then !$x **$ ~e else x **$ e
+ end
+functor GroupAddDollar(G : GROUP) =
+ struct
+ local structure S = MonoidAddDollar(G) in open S end
+ val (op ~$ ) = G.INV
+ val (op ++$) = fn (x, e) => if e < 0 then ~$x ++$ ~e else x ++$ e
+ end
+
+functor AbelianGroupMulPercent(A : ABELIAN_GROUP) =
+ struct
+ local structure S = GroupMulPercent(A) in open S end
+ val (op /%) = A.DIV
+ end
+functor AbelianGroupAddPercent(A : ABELIAN_GROUP) =
+ struct
+ local structure S = GroupAddPercent(A) in open S end
+ val (op -%) = A.DIV
+ end
+
+functor AbelianGroupMulDollar(A : ABELIAN_GROUP) =
+ struct
+ local structure S = GroupMulDollar(A) in open S end
+ val (op /$) = A.DIV
+ end
+functor AbelianGroupAddDollar(A : ABELIAN_GROUP) =
+ struct
+ local structure S = GroupAddDollar(A) in open S end
+ val (op -$) = A.DIV
+ end
Added: mltonlib/trunk/ca/terpstra/math/groups.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/math/groups.sig 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/groups.sig 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,65 @@
+signature SEMIGROUP =
+ sig
+ include BINARY_OPERATION
+ (* a*(b*c) = (a*b)*c *)
+ val associative : unit
+ end
+
+signature MONOID =
+ sig
+ include SEMIGROUP
+
+ (* one*x = x*one = x *)
+ val one : t
+ end
+
+signature ABELIAN_MONOID =
+ sig
+ include MONOID
+
+ (* a*b = b*a *)
+ val commutative : unit
+ end
+
+signature GROUP =
+ sig
+ include MONOID
+ (* y * (y^-1) = (y^-1) * y = one *)
+ val INV : t -> t
+ end
+
+signature PERMUTATION =
+ sig
+ include GROUP
+ (* include ENDOFUNCTION *)
+ type v
+ val EVAL: t -> v -> v
+ end
+signature AUTOFUNCTION = PERMUTATION
+
+signature ABELIAN_GROUP =
+ sig
+ include GROUP
+
+ (* a*b = b*a *)
+ val commutative : unit
+
+ (* x/y = x*(y^-1)) -- could be defined in GROUP, but is confusing *)
+ val DIV : (t * t) -> t
+ end
+
+signature CYCLIC_GROUP =
+ sig
+ include ABELIAN_GROUP
+ (* x = g^i *)
+ val generator : t
+ end
+
+(****************************************************************** Unity *)
+
+signature FINITE_SUBGROUPS =
+ sig
+ type t
+ (* !!! Somehow figure out how to grab unity roots *)
+ end
+
Added: mltonlib/trunk/ca/terpstra/math/log.fun
===================================================================
--- mltonlib/trunk/ca/terpstra/math/log.fun 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/log.fun 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,28 @@
+(*
+functor DiscreteLogarithm(G : GROUP) =
+ struct
+ local
+ structure B = GroupMulPercent(G)
+ structure D = GCD(Z)
+ open B D Factor LargeInt
+
+ exception NotDiscrete
+ val order =
+ case G.order of
+ FINITE x => x
+ | _ => raise NotDiscrete
+
+ datatype Factorization =
+ PRIME of LargeInt.int
+ | POWER of Order * LargeInt.int
+ | COPRIME of Order * Order
+ withtype Order = LargeInt.int * Factorization
+
+ val factors = factor order
+
+ fun log (n, f)
+ in
+ fun log = crtLog
+ end
+ end
+*)
Added: mltonlib/trunk/ca/terpstra/math/math.mlb
===================================================================
--- mltonlib/trunk/ca/terpstra/math/math.mlb 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/math.mlb 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,44 @@
+ann
+ "deadCode true"
+ "sequenceNonUnit warn"
+in
+ local
+ $(MLTON_ROOT)/basis/mlton.mlb
+ $(MLTON_ROOT)/basis/basis.mlb
+ in
+ (* base types *)
+ ops.sig
+ ops.sml
+ groups.sig
+ groups.fun
+ rings.sig
+ rings.fun
+ algebra.sig
+ algebra.fun
+
+ polynomial.fun
+
+ (* generic algorithms need for construction *)
+ gcd.fun
+
+ (* concrete constructions *)
+ order.sml
+ z.fun
+ z.sml
+ r.fun
+ r.sml
+ c.fun
+ c.sml
+ q.fun
+ q.sml
+ mersenne.fun
+ mersenne.sml
+ galois.fun
+ galois.sml
+ permutation.sml
+
+ (* other algorithms *)
+ factor.sml
+ log.fun
+ end
+end
Added: mltonlib/trunk/ca/terpstra/math/mersenne.fun
===================================================================
--- mltonlib/trunk/ca/terpstra/math/mersenne.fun 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/mersenne.fun 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,77 @@
+signature MERSENNE_BASE =
+ sig
+ structure Z : WORD (* fits the numbers with 1 bit to spare *)
+ structure ZZ : WORD (* fits the product *)
+ val bits : word
+ end
+
+exception MersenneOverflow
+
+functor Mersenne(M : MERSENNE_BASE) : FIELD =
+ struct
+ local
+ structure Z = M.Z
+ structure ZZ = M.ZZ
+ structure O = EuclideanDomainDollar(Order)
+ structure G = GCD(EuclideanDomainOfWord(Z))
+ open Z
+ open O
+ open G
+
+ val mbits = M.bits
+ val mmbits = Word.+ (mbits, mbits)
+ val rbits = Word.fromInt wordSize
+ val rrbits = Word.fromInt ZZ.wordSize
+ val rbitsm1 = Word.- (rbits, 0w1)
+
+ val _ = if Word.>= ( mbits, rbits) then raise MersenneOverflow else ()
+ val _ = if Word.>= (mmbits, rrbits) then raise MersenneOverflow else ()
+
+ val mmask = << (fromInt 1, mbits) - fromInt 1
+ in
+ type t = word
+ val characteristic = toLargeInt mmask
+
+ structure Addition =
+ struct
+ type t = word
+ val order = FINITE characteristic
+
+ val associative = ()
+ val commutative = ()
+ val one = fromInt 0
+
+ val EQ = (op =)
+ val MUL = fn (x, y) =>
+ let val z = x + y in andb (z, mmask) + >> (z, mbits) end
+ val DIV = fn (x, y) =>
+ let val z = x - y in andb (z, mmask) - >> (z, rbitsm1) end
+ val INV = fn x => mmask - x
+ end
+
+ structure Multiplication =
+ struct
+ type t = word
+ val order = Addition.order -$ #$1
+
+ val associative = ()
+ val commutative = ()
+ val one = fromInt 1
+
+ val EQ = (op =)
+ val MUL = fn (x, y) =>
+ let
+ val ZZ = ZZ.fromLarge o toLarge
+ val Z = fromLarge o ZZ.toLarge
+ val z = ZZ.* (ZZ x, ZZ y)
+ in
+ Addition.MUL (Z (ZZ.>> (z, mbits)), andb (Z z, mmask))
+ end
+ val INV = fn x => inv (x, mmask)
+ val DIV = fn (x, y) => MUL (x, INV y)
+ end
+
+ val distributive = ()
+ val no_zero_divisors = ()
+ end
+ end
Added: mltonlib/trunk/ca/terpstra/math/mersenne.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/math/mersenne.sml 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/mersenne.sml 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,27 @@
+(* all Mersenne primes up to 64 bits: 2, 3, 5, 7, 13, 17, 19, 31, 61 *)
+(* In order to use 61 we need a Word128 on 64bit machines *)
+
+local
+ structure P7 =
+ struct
+ structure Z = Word8
+ structure ZZ = Word16
+ val bits = 0w7
+ end
+ structure P13 =
+ struct
+ structure Z = Word16
+ structure ZZ = Word32
+ val bits = 0w13
+ end
+ structure P31 =
+ struct
+ structure Z = Word32
+ structure ZZ = Word64
+ val bits = 0w31
+ end
+in
+ structure Mersenne7 = Mersenne(P7)
+ structure Mersenne13 = Mersenne(P13)
+ structure Mersenne31 = Mersenne(P31)
+end
Added: mltonlib/trunk/ca/terpstra/math/ops.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/math/ops.sig 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/ops.sig 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,23 @@
+(****************************************************************** Groups *)
+
+datatype order = FINITE of LargeInt.int | COUNTABLE | UNCOUNTABLE
+
+signature SET =
+ sig
+ type t
+ val order: order
+ val EQ: (t * t) -> bool
+ end
+
+signature BINARY_OPERATION =
+ sig
+ include SET
+ val MUL: (t * t) -> t
+ end
+
+signature ENDOFUNCTION =
+ sig
+ include BINARY_OPERATION
+ type v
+ val EVAL: t -> v -> v
+ end
Added: mltonlib/trunk/ca/terpstra/math/ops.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/math/ops.sml 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/ops.sml 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,16 @@
+(****************************************************************** Operators *)
+
+infix 8 ++% **% (* additive and multiplicative exponentiation *)
+infix 7 *% /% %% //% (* //% = (/%, %%) = (div, mod) *)
+infix 6 +% -%
+infix 4 =% !=% <% (* <>% would imply <% which does not always exist *)
+nonfix ~% !% #%
+
+(* the operators in an algebra are always these (above for scalars) *)
+infix 8 ++$ **$
+infix 7 *$ /$ %$ //$
+infix 6 +$ -$
+infix 4 =$ !=$ <$
+nonfix ~$ !$ #$
+
+infix 7 *& (* for scalar operations with a vector *)
Added: mltonlib/trunk/ca/terpstra/math/order.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/math/order.sml 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/order.sml 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,59 @@
+structure Order : EUCLIDEAN_DOMAIN =
+ struct
+ local
+ exception Undefined
+ open LargeInt
+ in
+ type t = order
+ val characteristic = LargeInt.fromInt 0
+
+ structure Addition =
+ struct
+ type t = order
+ val order = UNCOUNTABLE
+
+ val associative = ()
+ val commutative = ()
+ val one = FINITE 0
+
+ val EQ = (op =)
+ fun MUL (FINITE x, FINITE y) = FINITE (x+y)
+ | MUL (UNCOUNTABLE, _) = UNCOUNTABLE
+ | MUL (_, UNCOUNTABLE) = UNCOUNTABLE
+ | MUL _ = COUNTABLE
+ fun INV (FINITE x) = FINITE (~x)
+ | INV _ = raise Undefined
+ fun DIV (x, y) = MUL (x, INV y)
+ end
+
+ structure Multiplication =
+ struct
+ type t = order
+ val order = UNCOUNTABLE
+
+ val associative = ()
+ val commutative = ()
+ val one = FINITE 1
+
+ val EQ = (op =)
+ fun MUL (FINITE x, FINITE y) = FINITE (x*y)
+ | MUL (_, FINITE 0) = raise Undefined
+ | MUL (FINITE 0, _) = raise Undefined
+ | MUL (UNCOUNTABLE, _) = UNCOUNTABLE
+ | MUL (_, UNCOUNTABLE) = UNCOUNTABLE
+ | MUL _ = COUNTABLE
+ end
+
+ val distributive = ()
+ val no_zero_divisors = ()
+
+ fun QUO (FINITE a, FINITE b) = (FINITE (a div b), FINITE (a mod b))
+ | QUO _ = raise Undefined
+
+ fun LT (UNCOUNTABLE, _) = false
+ | LT (_, UNCOUNTABLE) = true
+ | LT (COUNTABLE, _) = false
+ | LT (_, COUNTABLE) = true
+ | LT (FINITE x, FINITE y) = x < y
+ end
+ end
Added: mltonlib/trunk/ca/terpstra/math/permutation.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/math/permutation.sml 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/permutation.sml 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,210 @@
+signature FINITE_PERMUTATION =
+ sig
+ include PERMUTATION
+
+ (* a bijection exists between naturals and permutations *)
+ val toInt: t -> int
+ val fromInt: int -> t
+ val toLargeInt: t -> LargeInt.int
+ val fromLargeInt: LargeInt.int -> t
+
+ (* an alternate representation exists as cycles *)
+ val fromCycle: int list -> t
+ val fromCycles: int list list -> t
+ val toCycles: t -> int list list
+ end
+
+structure FinitePermutation : FINITE_PERMUTATION =
+ struct
+ type v = int
+ type t = int Vector.vector
+ val order = COUNTABLE
+
+ val associative = ()
+ val one = Vector.tabulate (0, fn _ => 0)
+
+ fun EVAL f x =
+ if x >= Vector.length f then x else
+ Vector.sub (f, x)
+
+ fun EQ (x, y) =
+ let
+ val lx = Vector.length x
+ val ly = Vector.length y
+ in
+ if lx < ly
+ then Vector.foldli (fn (i, v, a) => a andalso v = EVAL x i) true y
+ else Vector.foldli (fn (i, v, a) => a andalso v = EVAL y i) true x
+ end
+
+ fun MUL (x, y) =
+ let
+ val lx = Vector.length x
+ val ly = Vector.length y
+ val l = if lx < ly then ly else lx
+ in
+ Vector.tabulate (l, fn i => EVAL x (EVAL y i))
+ end
+
+ fun INV x =
+ let
+ val y = Array.array (Vector.length x, 0)
+ in
+ Vector.appi (fn (i, v) => Array.update (y, v, i)) x;
+ Array.vector y
+ end
+
+ fun toInt p =
+ let
+ fun helper p =
+ let
+ val l = Vector.length p
+ in
+ if l < 2 then (1, 0) else
+ let
+ val i = l - 1
+ val s = VectorSlice.slice (p, 0, SOME i)
+ val x = Vector.sub (p, i)
+ val v = VectorSlice.map (fn y => if y > x then y-1 else y) s
+ val (fact, out) = helper v
+ in
+ (fact * l, out + (i - x) * fact)
+ end
+ end
+ in
+ #2 (helper p)
+ end
+
+ fun toLargeInt p =
+ let
+ fun helper p =
+ let
+ val l = Vector.length p
+ in
+ if l < 2 then (1, 0) else
+ let
+ val i = l - 1
+ val s = VectorSlice.slice (p, 0, SOME i)
+ val x = Vector.sub (p, i)
+ val v = VectorSlice.map (fn y => if y > x then y-1 else y) s
+ val (fact, out) = helper v
+ val y = i - x
+ open LargeInt
+ in
+ (fact * fromInt l, out + fromInt y * fact)
+ end
+ end
+ in
+ #2 (helper p)
+ end
+
+ fun fromInt x =
+ if x = 0 then Vector.tabulate (0, fn _ => 0) else
+ let
+ fun grow (l, f) =
+ if f > x then (l, f) else
+ grow (l+1, f*(l+1))
+ val (l, f) = grow (0, 1)
+ fun helper (1, _, _) = Vector.tabulate (1, fn _ => 0)
+ | helper (l, f, x) =
+ let
+ val (l1, f) = (l - 1, f div l)
+ val (q, r) = (x div f, x mod f)
+ val p = helper (l1, f, r)
+ val z = (l1 - q)
+ fun build i =
+ if i = l1 then z else
+ let val y = Vector.sub (p, i) in
+ if y >= z then y+1 else y end
+ in
+ Vector.tabulate (l, build)
+ end
+ in
+ helper (l, f, x)
+ end
+
+ fun fromLargeInt x =
+ if x = 0 then Vector.tabulate (0, fn _ => 0) else
+ let
+ fun grow (l, f) =
+ if f > x then (l, f) else
+ grow (l + 1, LargeInt.* (f, LargeInt.fromInt (l + 1)))
+ val (l, f) = grow (0, 1)
+ fun helper (1, _, _) = Vector.tabulate (1, fn _ => 0)
+ | helper (l, f, x) =
+ let
+ val (l1, f) = (l - 1, LargeInt.div (f, LargeInt.fromInt l))
+ val (q, r) = IntInf.quotRem (x, f)
+ val p = helper (l1, f, r)
+ val z = (l1 - LargeInt.toInt q)
+ fun build i =
+ if i = l1 then z else
+ let val y = Vector.sub (p, i) in
+ if y >= z then y+1 else y end
+ in
+ Vector.tabulate (l, build)
+ end
+ in
+ helper (l, f, x)
+ end
+
+ fun fromCycle c =
+ let
+ val m = List.foldl (fn (x, a) => if x < a then a else x) 0 c
+ val a = Array.tabulate (m+1, fn i => i)
+ fun helper [] = ()
+ | helper (x :: []) = Array.update (a, x, List.hd c)
+ | helper (x :: y :: r) = (
+ Array.update (a, x, y);
+ helper (y :: r))
+ in
+ helper c;
+ Array.vector a
+ end
+
+ fun fromCycles l =
+ List.foldl (fn (x, a) => MUL (fromCycle x, a)) one l
+
+ fun toCycles p =
+ let
+ val a = Array.tabulate (Vector.length p, fn i => false)
+ fun trace i =
+ if Array.sub (a, i) then [] else
+ (Array.update (a, i, true);
+ i :: trace (Vector.sub (p, i)))
+ fun scan (i, l) =
+ if i = l then [] else
+ case trace i of
+ [] => scan (i+1, l)
+ | _ :: [] => scan (i+1, l)
+ | x => x :: scan (i+1, l)
+ in
+ scan (0, Vector.length p)
+ end
+ end
+
+(*
+fun test (x, e) =
+ if x = e then () else
+ let
+ val p = FinitePermutation.fromLargeInt (LargeInt.fromInt x)
+ val y = FinitePermutation.toLargeInt p
+ in
+ print (LargeInt.toString y ^ ":");
+ Vector.app (fn y => print (" " ^ Int.toString y)) p;
+ print "\n";
+ test (x+1, e)
+ end
+
+val () = test (0, 720)
+
+val p = FinitePermutation.fromCycles [[5, 4], [3], [], [2, 6, 3]]
+val () = Vector.app (fn y => print (" " ^ Int.toString y)) p
+val () = print "\n"
+
+val p = FinitePermutation.fromCycles [[5, 4], [3], [], [2, 6, 3]]
+val cs = FinitePermutation.toCycles p
+val pc = List.app (fn y => print (" " ^ Int.toString y))
+val pcs = List.app (fn y => (pc y; print "\n"))
+val () = pcs cs
+*)
Added: mltonlib/trunk/ca/terpstra/math/polynomial.fun
===================================================================
--- mltonlib/trunk/ca/terpstra/math/polynomial.fun 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/polynomial.fun 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,311 @@
+signature POLYNOMIAL =
+ sig
+ include EUCLIDEAN_DOMAIN
+ (* include UNITARY_ASSOCIATIVE_FIELD_ALGEBRA: *)
+ type e
+ structure Base : FIELD where type t = e
+ structure ScalarMultiplication : SCALAR_MULTIPLY where type e = e and type t = t
+ val bilinear : unit
+
+ val fromList: e list -> t
+ val eval: t -> e -> e
+ val primitive: t -> bool
+ end
+
+functor PolynomialOverField(F : FIELD) : POLYNOMIAL =
+ struct
+ local
+ structure B = FieldPercent(F)
+ structure V = Vector
+ open B
+ open V
+ open VectorSlice
+
+ val zero = #%0
+ val one = #%1
+
+ fun constant c = full (tabulate (1, fn _ => c))
+ fun trim p n = subslice (p, 0, if n < length p then SOME n else NONE)
+ fun smul (x, y) = map (fn a => x *% a) y
+
+ (* reverse the polnomial's coeffs; p(1/x)*x^deg(p) *)
+ fun rev p =
+ let
+ val b = length p - 1
+ in
+ full (tabulate (length p, fn i => sub (p, b - i)))
+ end
+
+ fun normalize p =
+ let
+ val (v, s, l) = base p
+ fun lastzero i =
+ if i = s then 0 else
+ let
+ val i1 = i - 1
+ in
+ if V.sub (v, i1) =% zero then lastzero i1 else i-s
+ end
+ in
+ subslice (p, 0, SOME (lastzero (s+l)))
+ end
+
+ fun padd (x, y) =
+ let
+ val (v1, v2) =
+ if length x < length y then (x, y) else (y, x)
+ val len1 = length v1 (* shorter length *)
+ val len2 = length v2
+ fun add i =
+ if i < len1
+ then sub (v1, i) +% sub (v2, i)
+ else sub (v2, i)
+ in
+ full (tabulate (len2, add))
+ end
+
+ fun psub (x, y) =
+ let
+ val tab =
+ if length x < length y
+ then (length y,
+ let
+ val len = length x
+ in
+ fn i =>
+ if i < len
+ then sub (x, i) -% sub (y, i)
+ else ~% (sub (y, i))
+ end)
+ else (length x,
+ let
+ val len = length y
+ in
+ fn i =>
+ if i < len
+ then sub (x, i) -% sub (y, i)
+ else sub (x, i)
+ end)
+ in
+ full (tabulate tab)
+ end
+
+ (* long multiplication *)
+ fun long (x, y) = (* length x < length y *)
+ if length x = 1 then smul (sub (x, 0), y) else
+ let
+ val l = smul (sub (x, 0), y)
+ val hx = subslice (x, 1, NONE)
+ val h = long (hx, y)
+ fun join i =
+ if i = 0 then V.sub (l, 0) else
+ if i >= V.length l then V.sub (h, i-1) else
+ V.sub (l, i) +% V.sub (h, i-1)
+ in
+ tabulate (length x + length y - 1, join)
+ end
+
+ (* karatsuba's trick *)
+ fun kara (x, y) = (* length x < length y *)
+ let val (lx, ly) = (length x, length y) (* example: 5, 8 *) in
+ if lx < 5 then long (x, y) else
+ (* (a*x+b)*(c*x+d) = a*c*x + (a*d+b*c)*x + b*d
+ * (a+b)*(c+d) = (a*c + (a*d + b*c) + b*d)
+ *)
+ let
+ (* lx2 <= rx <= ry *)
+ val lx2 = lx div 2 (* example: 2 *)
+ val (rx, ry) = (lx - lx2, ly - lx2) (* example: 3, 6 *)
+ val lxy = lx + ly - 1 (* example: 12 *)
+ val lxh = lx2 + lx2 (* example: 4 *)
+ val lxf = lxh - 1 (* example: 3 *)
+ val rxy = rx + ry - 1 (* example: 8 *)
+ val lx2r = lx2 + rxy (* example: 10 *)
+
+ val a = subslice (x, lx2, NONE) (* length = rx (3) *)
+ val b = subslice (x, 0, SOME lx2) (* length = lx2 (2) *)
+ val c = subslice (y, lx2, NONE) (* length = ry (6) *)
+ val d = subslice (y, 0, SOME lx2) (* length = lx2 (2) *)
+
+ val ab = padd (a, b) (* length = rx (3) *)
+ val cd = padd (c, d) (* length = ry (6) *)
+ val abcd = kara (ab, cd) (* length = rxy (8) *)
+ val ac = kara (a, c) (* length = rxy (8) *)
+ val bd = kara (b, d) (* length = lxf (3) *)
+
+ val (adbc, _, _) =
+ base (psub(
+ full abcd, padd(full ac, full bd)))
+
+ (* v-- lxh
+ * ---ac---
+ * ^--adbc--
+ * | ^bd-
+ * | |^ 0
+ * | |lx2
+ * lx2r lxf
+ *)
+ (*!!! all these tests are grossly inefficient *)
+ fun join i =
+ case Int.compare (i, lxf) of
+ LESS => if i < lx2
+ then V.sub (bd, i)
+ else V.sub (adbc, i-lx2) +% V.sub (bd, i)
+ | EQUAL => V.sub (adbc, i-lx2)
+ | GREATER =>
+ if i < lx2r
+ then V.sub (ac, i-lxh) +% V.sub (adbc, i-lx2)
+ else V.sub (ac, i-lxh)
+ in
+ V.tabulate (lxy, join)
+ end end
+
+ (* !!! No FFT yet *)
+ fun pmul (x, y) =
+ if length x < length y
+ then if length x = 0 then x else full (kara (x, y))
+ else if length y = 0 then y else full (kara (y, x))
+
+ (* !!! write an inner product method *)
+
+ (* !!! don't be stupid; actually use the shortcut *)
+ fun pmuls (x, y, l) =
+ let
+ val xs = trim x l
+ val ys = trim y l
+ val z = pmul (xs, ys)
+ in
+ trim z l
+ end
+
+ (* p(x)*q(x) = 1 + r(x)*x^2^n
+ * => 2-p(x)*q(x) = 1 - r(x)*x^2^n
+ * => (2-p(x)*q(x))*p(x)*q(x) = 1 - r(x)^2*x^2^(n+1)
+ * => q' = (2-pq)q
+ *)
+ fun invmodn p n =
+ let
+ val init = constant (!% (sub (p, 0)))
+ val two = constant (#%2)
+ fun grow q =
+ if length q >= n then q else
+ let
+ val nl = length q + length q
+ val ps = trim p nl
+ val pq = pmul (q, ps) (* !!! we don't need high terms... *)
+ val neg = psub (two, pq)
+ (* !!! use inner product; we know low terms and don't need high *)
+ val nq = pmul (neg, q)
+ in
+ if length p = 1 then init else grow (trim nq nl)
+ end
+ in
+ trim (grow init) n
+ end
+ in
+ type e = F.t
+ type t = e slice
+ val characteristic = F.characteristic
+
+ fun eval p x = foldr (fn (a, out) => out *% x +% a) zero p
+ val fromList = normalize o full o fromList
+ fun primitive p = sub (p, length p - 1) =% one
+
+ structure Base = F
+
+ structure Addition =
+ struct
+ type t = t
+ val order = case Base.Addition.order of
+ UNCOUNTABLE => UNCOUNTABLE
+ | _ => COUNTABLE
+
+ val associative = ()
+ val commutative = ()
+ val one = full (tabulate (0, fn _ => #%0))
+
+ val EQ = fn (x, y) =>
+ let
+ val (v1, s1, l1) = base x
+ val (v2, s2, l2) = base y
+ val e1 = l1 + s1
+ fun compare (i1, i2) =
+ if i1 = e1 then true else
+ if V.sub (v1, i1) =% V.sub (v2, i2)
+ then compare (i1 + 1, i2 + 1)
+ else false
+ in
+ if l1 <> l2 then false else
+ compare (s1, s2)
+ end
+
+ val MUL = normalize o padd
+ val DIV = normalize o psub
+ val INV = fn x => full (map (fn a => ~%a) x)
+ end
+
+ structure Multiplication =
+ struct
+ type t = t
+ val order = Addition.order
+
+ val associative = ()
+ val commutative = ()
+ val one = full (tabulate (1, fn _ => #%1))
+
+ val EQ = Addition.EQ
+ val MUL = normalize o pmul
+ end
+
+ structure ScalarMultiplication =
+ struct
+ type e = e
+ type t = t
+
+ val associative = ()
+ val distributive = ()
+
+ val MUL = normalize o full o smul
+ end
+
+ val QUO = fn (z, y) =>
+ let
+ (* q*y + r = z, where deg(r) < deg(y) and deg(q)+deg(y)=deg(z)
+ * => rev(q*y + r) = rev(z)
+ * => rev(q)rev(y) + rev(r)*x^(deg(z)-deg(r)) = rev(z)
+ * => rev(q)rev(y) = rev(z) mod x^(1+deg(z)-deg(y))
+ * => rev(q) = rev(z)/rev(y) mod x^(1+deg(q))
+ *)
+ val degz = length z - 1
+ val degy = length y - 1
+ in
+ if degz < degy then (Addition.one, z) else
+ let
+ val degq = degz - degy
+ val lenq = degq + 1
+ val ry = rev y
+ val iry = invmodn ry lenq
+ val rz = rev z
+ val rq = pmuls (rz, iry, lenq)
+ val q = rev rq
+ val qy = pmuls (q, y, degy)
+ val r = psub (trim z degy, qy)
+ in
+ (q, normalize r)
+ end
+ end
+
+ fun LT (x, y) = length x < length y
+
+ val distributive = ()
+ val no_zero_divisors = ()
+ val bilinear = ()
+ end
+ end
+
+functor Polynomial(P : POLYNOMIAL) =
+ struct
+ local structure S = FieldPercent(P.Base) in open S end
+ local structure S = EuclideanDomainDollar(P) in open S end
+ local structure S = ScalarMultiply(P.ScalarMultiplication) in open S end
+ end
Added: mltonlib/trunk/ca/terpstra/math/q.fun
===================================================================
--- mltonlib/trunk/ca/terpstra/math/q.fun 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/q.fun 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,97 @@
+functor QuotientOfIntegralDomain(I : INTEGRAL_DOMAIN) : FIELD =
+ struct
+ local
+ structure B = IntegralDomainPercent(I)
+ structure O = EuclideanDomainDollar(Order)
+ open B
+ open O
+ in
+ type t = I.t * I.t
+ val characteristic = I.characteristic
+
+ structure Addition =
+ struct
+ type t = I.t * I.t
+ val order = COUNTABLE (* !!! no idea how to compute ... *)
+
+ val associative = ()
+ val commutative = ()
+ val one = (#%0, #%1)
+
+ val MUL = fn ((an, ad), (bn, bd)) =>
+ (an *% bd +% bn *% ad, ad *% bd)
+ val DIV = fn ((an, ad), (bn, bd)) =>
+ (an *% bd -% bn *% ad, ad *% bd)
+ val INV = fn (an, ad) => (~%an, ad)
+
+ val EQ = fn ((an, ad), (bn, bd)) =>
+ an *% bd =% bn *% ad
+ end
+
+ structure Multiplication =
+ struct
+ type t = I.t * I.t
+ val order = COUNTABLE (* !!! no idea *)
+
+ val associative = ()
+ val commutative = ()
+ val one = (#%1, #%1)
+
+ val EQ = Addition.EQ
+ val MUL = fn ((an, ad), (bn, bd)) =>
+ (an *% bn, ad *% bd)
+ val INV = fn (an, ad) => (ad, an)
+ val DIV = fn (a, b) => MUL (a, INV b)
+ end
+
+ val distributive = ()
+ val no_zero_divisors = ()
+ end
+ end
+
+functor QuotientOfEuclideanDomain(E : EUCLIDEAN_DOMAIN) : FIELD =
+ struct
+ local
+ structure B = EuclideanDomainPercent(E)
+ structure G = GCD(E)
+ structure Q = QuotientOfIntegralDomain(E)
+ open B
+ open G
+ in
+ type t = E.t * E.t
+ val characteristic = E.characteristic
+
+ fun simplify (n, d) =
+ if d =% #%0 then Q.Addition.one else
+ let
+ val g = gcd (n, d);
+ in
+ (n /% g, d /% g)
+ end
+
+ structure Addition =
+ struct
+ open Q.Addition
+
+ (* easier to compute *)
+ val EQ = fn ((an, ad), (bn, bd)) =>
+ ((an =% bn) andalso (ad =% bd)) orelse
+ ((an =% ~%bn) andalso (ad =% ~%bd))
+
+ val MUL = simplify o MUL
+ val DIV = simplify o DIV
+ end
+
+ structure Multiplication =
+ struct
+ open Q.Multiplication
+
+ val EQ = Addition.EQ
+ val MUL = simplify o MUL
+ val DIV = simplify o DIV
+ end
+
+ val distributive = ()
+ val no_zero_divisors = ()
+ end
+ end
Added: mltonlib/trunk/ca/terpstra/math/q.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/math/q.sml 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/q.sml 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,7 @@
+structure Q = QuotientOfEuclideanDomain(Z)
+
+(* these are vulnerable to overflow *)
+structure Q64 = QuotientOfEuclideanDomain(Z64)
+structure Q32 = QuotientOfEuclideanDomain(Z32)
+structure Q16 = QuotientOfEuclideanDomain(Z16)
+structure Q8 = QuotientOfEuclideanDomain(Z8)
Added: mltonlib/trunk/ca/terpstra/math/r.fun
===================================================================
--- mltonlib/trunk/ca/terpstra/math/r.fun 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/r.fun 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,38 @@
+functor FieldOfReal(Real : REAL) : FIELD =
+ struct
+ type t = Real.real
+ val characteristic = LargeInt.fromInt 0
+
+ structure Addition =
+ struct
+ type t = Real.real
+ val order = UNCOUNTABLE
+
+ val associative = ()
+ val commutative = ()
+ val one = Real.fromInt 0
+
+ val EQ = Real.==
+ val MUL = Real.+
+ val DIV = Real.-
+ val INV = Real.~
+ end
+
+ structure Multiplication =
+ struct
+ type t = Real.real
+ val order = UNCOUNTABLE
+
+ val associative = ()
+ val commutative = ()
+ val one = Real.fromInt 1
+
+ val EQ = Real.==
+ val MUL = Real.*
+ val DIV = Real./
+ val INV = fn x => DIV (one, x)
+ end
+
+ val distributive = ()
+ val no_zero_divisors = ()
+ end
Added: mltonlib/trunk/ca/terpstra/math/r.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/math/r.sml 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/r.sml 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,4 @@
+structure R = FieldOfReal(LargeReal)
+
+structure R32 = FieldOfReal(Real32)
+structure R64 = FieldOfReal(Real64)
Added: mltonlib/trunk/ca/terpstra/math/rings.fun
===================================================================
--- mltonlib/trunk/ca/terpstra/math/rings.fun 2006-12-19 02:58:00 UTC (rev 4985)
+++ mltonlib/trunk/ca/terpstra/math/rings.fun 2006-12-19 02:59:11 UTC (rev 4986)
@@ -0,0 +1,86 @@
+(****************************************************************** Ring ops *)
+
+functor NonAssociativeRingPercent(R : NON_ASSOCIATIVE_RING) =
+ struct
+ local structure S = BinaryOperationMulPercent(R.Multiplication) in open S end
+ local structure S = AbelianGroupAddPercent(R.Addition) in open S end
+ end
+functor NonAssociativeRingDollar(R : NON_ASSOCIATIVE_RING) =
+ struct
+ local structure S = BinaryOperationMulDollar(R.Multiplication) in open S end
+ local structure S = AbelianGroupAddDollar(R.Addition) in open S end
+ end
+
+functor RingPercent(R : RING) =
+ struct
+ local structure S = SemiGroupMulPercent(R.Multiplication) in open S end
+ local structure S = AbelianGroupAddPercent(R.Addition) in open S end
+ end
+functor RingDollar(R : RING) =
+ struct
+ local structure S = SemiGroupMulDollar(R.Multiplication) in open S end
+ local structure S = AbelianGroupAddDollar(R.Addition) in open S end
+ end
+
+functor UnitaryRingPercent(U : UNITARY_RING) =
+ struct
+ local structure S = MonoidMulPercent(U.Multiplication) in open S end
+ local structure S = AbelianGroupAddPercent(U.Addition) in open S end
+ val #% = fn e => U.Multiplication.one ++% e
+ end
+functor UnitaryRingDollar(U : UNITARY_RING) =
+ struct
+ local structure S = MonoidMulDollar(U.Multiplication) in open S end
+ local structure S = AbelianGroupAddDollar(U.Addition) in open S end
+ val #$ = fn e => U.Multiplication.one ++$ e
+ end
+
+functor CommutativeRingPercent(C : COMMUTATIVE_RING) =
+ struct
+ local structure S = AbelianMonoidMulPercent(C.Multiplication) in open S end
+ local structure S = AbelianGroupAddPercent(C.Addition) in open S end
+ val #% = fn e => C.Multiplication.one ++% e
+ end
+functor CommutativeRingDollar(C : COMMUTATIVE_RING) =
+ struct
+ local structure S = AbelianMonoidMulDollar(C.Multiplication) in open S end
+ local structure S = AbelianGroupAddDollar(C.Addition) in open S end
+ val #$ = fn e => C.Multiplication.one ++$ e
+ end
+
+functor IntegralDomainPercent(I : INTEGRAL_DOMAIN) = CommutativeRingPercent(I)
+functor IntegralDomainDollar (I : INTEGRAL_DOMAIN) = CommutativeRingDollar (I)
+
+functor EuclideanDomainPercent(E : EUCLIDEAN_DOMAIN) =
+ struct
+ local structure S = AbelianMonoidMulPercent(E.Multiplication) in open S end
+ local structure S = AbelianGroupAddPercent(E.Addition) in open S end
+ val #% = fn e => E.Multiplication.one ++% e
+ val (op /%) = #1 o E.QUO
+ val (op %%) = #2 o E.QUO
+ val ...
[truncated message content] |
|
From: Wesley T. <we...@ml...> - 2006-12-18 18:58:01
|
my collection of SML libs, only half finished mostly ---------------------------------------------------------------------- A mltonlib/trunk/ca/terpstra/math/ ---------------------------------------------------------------------- |
|
From: Wesley T. <we...@ml...> - 2006-12-18 18:56:35
|
my collection of SML libs, only half finished mostly
----------------------------------------------------------------------
A mltonlib/trunk/ca/terpstra/pickle/
A mltonlib/trunk/ca/terpstra/pickle/Makefile
A mltonlib/trunk/ca/terpstra/pickle/README
A mltonlib/trunk/ca/terpstra/pickle/ast.sml
A mltonlib/trunk/ca/terpstra/pickle/export.sml
A mltonlib/trunk/ca/terpstra/pickle/gen.sml
A mltonlib/trunk/ca/terpstra/pickle/import.sml
A mltonlib/trunk/ca/terpstra/pickle/lib/
A mltonlib/trunk/ca/terpstra/pickle/lib/binary.sml
A mltonlib/trunk/ca/terpstra/pickle/lib/pickle.mlb
A mltonlib/trunk/ca/terpstra/pickle/lib/pickle.sig
A mltonlib/trunk/ca/terpstra/pickle/lib/pickle.sml
A mltonlib/trunk/ca/terpstra/pickle/lib/text.sml
A mltonlib/trunk/ca/terpstra/pickle/main.sml
A mltonlib/trunk/ca/terpstra/pickle/method.sml
A mltonlib/trunk/ca/terpstra/pickle/pickle.mlb
A mltonlib/trunk/ca/terpstra/pickle/tag.sml
A mltonlib/trunk/ca/terpstra/pickle/tests/
A mltonlib/trunk/ca/terpstra/pickle/tests/Makefile
A mltonlib/trunk/ca/terpstra/pickle/tests/double.test
A mltonlib/trunk/ca/terpstra/pickle/tests/rebind.test
A mltonlib/trunk/ca/terpstra/pickle/tests/recursive.test
A mltonlib/trunk/ca/terpstra/pickle/tests/scope.test
A mltonlib/trunk/ca/terpstra/pickle/tests/tree.test
A mltonlib/trunk/ca/terpstra/pickle/tml.grm
A mltonlib/trunk/ca/terpstra/pickle/tml.lex
A mltonlib/trunk/ca/terpstra/pickle/tree.sml
A mltonlib/trunk/ca/terpstra/pickle/type.sml
----------------------------------------------------------------------
Added: mltonlib/trunk/ca/terpstra/pickle/Makefile
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/Makefile 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/Makefile 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,22 @@
+TARGETS = pickle
+
+all: $(TARGETS)
+
+clean:
+ rm -f *.grm.* *.lex.* *.dep $(TARGETS)
+
+%.dep: %.mlb
+ echo -en "$(basename $@) $@:\t" > $@.tmp
+ mlton -stop f $< | sed 's/^/ /;s/$$/ \\/' >> $@.tmp
+ mv $@.tmp $@
+
+%: %.mlb
+ mlton -output $@ $<
+
+%.grm.sml %.grm.sig %.grm.desc: %.grm
+ mlyacc $<
+
+%.lex.sml: %.lex
+ mllex $<
+
+-include $(patsubst %.mlb,%.dep,$(wildcard *.mlb))
Added: mltonlib/trunk/ca/terpstra/pickle/README
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/README 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/README 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,10 @@
+Since MLton has no automatic serialization capability, this attempts to
+build one as a library. The idea was that a protocol could be specified as
+a SML type and the compiled into a serializer for C and SML.
+
+The serializers are built as functors. This way they can be instantiated on
+a binary or text serializer for basic types.
+
+Compile the compiler with:
+ make
+The test directory includes example SML types suitable for compilation
Added: mltonlib/trunk/ca/terpstra/pickle/ast.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/ast.sml 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/ast.sml 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,34 @@
+type tyvar = string
+type tag = string
+
+(* Types which can be written down without a declaration: *)
+datatype inline_typ = RECORD of (string * inline_typ) vector
+ | RECURSIVE of string * (inline_typ * tag) vector * tag
+ | TUPLE of inline_typ vector
+ | TYVAR of tyvar * tag * tag
+
+(* At the top-level, the most general declaration looks like:
+ *
+ * datatype d1 = C of d1 | D of d2 | E of t1
+ * and d2 = F of d1 | G of d2 | F of t2
+ * withtypes t1 = string * d2
+ * and t2 = t1 (* the OLD binding of t1, not the one above *)
+ *
+ * The datatypes are evaluated within the scope of the withtypes and
+ * the other datatypes.
+ *
+ * The withtypes are evaluated within the scope of the datatypes (but
+ * not of the other withtypes).
+ *
+ * An entire such clause is a 'toplevel_typ' below
+ *)
+
+type data_typ = tag * tag * (string * inline_typ option) vector
+
+type 'a bind_typ = { name : string,
+ reader : string,
+ writer : string,
+ tyvars : (tyvar * tag) vector,
+ typ : 'a }
+
+type toplevel_typ = data_typ bind_typ vector * inline_typ bind_typ vector
Added: mltonlib/trunk/ca/terpstra/pickle/export.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/export.sml 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/export.sml 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,22 @@
+fun export ((data, bind), (l, scope)) =
+ let
+ fun decl { name, reader=_, writer=_, tyvars, typ=_ } l =
+ l && " type " ++ tuple (#1, tyvars) && name && "\n"
+ fun binder ({ name, reader=_, writer=_, tyvars=_, typ=_ }, m) =
+ Map.insert m (name, { reader = "", writer = "" })
+
+ val l = l ++ foldl (decl, bind)
+ val scope = Vector.foldl binder scope bind
+ val (l, scope) = dtype ((data, Vector.fromList []), (l, scope))
+
+ fun typack rw (t, _) l = l && t && " Base." && rw
+ fun tyfun rw v l =
+ if Vector.length v = 0 then l else
+ l ++ sfoldl (typack rw, " * ", v) && " -> " ++ tuple (#1, v)
+ fun methods {name, reader=_, writer=_, tyvars, typ=_} l =
+ l && " val " && name
+ && ": { r: " ++ tyfun "r" tyvars && name && " Base.r, w: "
+ ++ tyfun "w" tyvars && name && " Base.w }\n"
+ in
+ (l ++ foldl (methods, data) ++ foldl (methods, bind), scope)
+ end
Added: mltonlib/trunk/ca/terpstra/pickle/gen.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/gen.sml 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/gen.sml 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,30 @@
+ structure Order = struct type k = string val order = String.compare end
+structure Set = Set(Order)
+structure Map = Map(Order)
+
+infix 5 && ++
+fun l && x = x :: l
+fun l ++ f = f l
+
+fun foldl (f, v) l = Vector.foldl (fn (x, l) => f x l) l v
+fun foldli (f, v) l = Vector.foldli (fn (i, x, l) => f (i, x) l) l v
+fun sfoldl (f, s, v) l =
+ let
+ fun sep (0, s) = ""
+ | sep (_, s) = s
+ fun gen (i, x, l) = l && sep (i, s) ++ f x
+ in
+ Vector.foldli gen l v
+ end
+
+fun tuple (f, v) l =
+ if Vector.length v = 0 then l else
+ l && "(" ++ sfoldl (fn x => fn l => l && f x, ", ", v) && ") "
+
+local
+ fun bindToKey { name, reader, writer, tyvars=_, typ=_ } =
+ (name, { reader = reader, writer = writer })
+in
+ fun defd (bind:'a bind_typ vector) =
+ Map.fromVector (Vector.map bindToKey bind)
+end
Added: mltonlib/trunk/ca/terpstra/pickle/import.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/import.sml 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/import.sml 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,58 @@
+fun import ((data, bind) : toplevel_typ, (l, scope)) =
+ let
+ val withscope = Map.union (scope, defd data)
+ val datascope = Map.union (withscope, defd bind)
+ val imports = ref Set.empty
+
+ fun refd (typ, map) =
+ case typ of
+ (RECORD v) => Vector.foldl refd map (Vector.map #2 v)
+ | (TUPLE v) => Vector.foldl refd map v
+ | (TYVAR _) => map
+ | (RECURSIVE (n, v, _)) =>
+ Vector.foldl refd
+ (Map.insert map (n, Vector.length v))
+ (Vector.map #1 v)
+
+ fun prune scope map =
+ let
+ fun filter ((k, v), m) =
+ case Map.fetch scope k of
+ NONE => Map.insert m (k, v)
+ | SOME _ => m
+ in
+ Map.foldl filter Map.empty map
+ end
+
+ val withtyp = Vector.map #typ bind
+ val datatyp = Vector.map #typ data
+ val withref = prune withscope (Vector.foldl refd Map.empty withtyp)
+ fun constr ((_, NONE), m) = m
+ | constr ((_, SOME typ), m) = refd (typ, m)
+ fun datav ((_, _, v), m) = Vector.foldl constr m v
+ val dataref = prune datascope (Vector.foldl datav Map.empty datatyp)
+
+ val import = Map.union (dataref, withref)
+
+ fun fakescope ((k, _), m) = Map.insert m (k, {reader = "", writer = ""})
+ val outscope = Map.foldl fakescope datascope import
+
+ fun tyvar 1 l = l && "'a1"
+ | tyvar i l = l && "'a" && Int.toString i && ", " ++ tyvar (i - 1)
+ fun tyvars n l =
+ if n = 0 then l else
+ l && "(" ++ tyvar n && ") "
+ fun tyarg rw 1 l = l && "'a1 Base." && rw
+ | tyarg rw i l = l && "'a" && Int.toString i && " Base." && rw && " * "
+ ++ tyarg rw (i - 1)
+ fun tyfun rw n l =
+ if n = 0 then l else
+ l ++ tyarg rw n && " -> " ++ tyvars n
+
+ fun declare ((k, v), l) =
+ l && " type " ++ tyvars v && k && "\n"
+ && " val " && k && ": { r: " ++ tyfun "r" v && k
+ && " Base.r, w: " ++ tyfun "w" v && k && " Base.w }\n"
+ in
+ (Map.foldl declare l import, outscope)
+ end
Added: mltonlib/trunk/ca/terpstra/pickle/lib/binary.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/lib/binary.sml 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/lib/binary.sml 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,66 @@
+structure Binary : PICKLER =
+ struct
+ exception Corrupt
+
+ structure Base =
+ struct
+ type wt = Word8.word list
+ type rt = Word8.word list
+ type 'a r = rt -> rt * 'a
+ type 'a w = wt * 'a -> wt
+
+ val opts = { r = fn _ => fn (a :: r) => (r, Word8.toInt a) | _ => raise Corrupt,
+ w = fn _ => fn (l, i) => Word8.fromInt i :: l }
+ end
+
+ type t = Word8Vector.vector
+ val eof = []
+ val convert = { w = Word8Vector.fromList o rev,
+ r = fn v => List.tabulate
+ (Word8Vector.length v, fn i => Word8Vector.sub (v, i)) }
+
+ type unit = unit
+ type bool = bool
+ type char = char
+ type word = word
+ type int = int
+ type string = string
+ type 'a vector = 'a vector
+
+ val unit = { r = fn l => (l, ()), w = fn (l, _) => l }
+ val bool = { r = fn ((a:Word8.word) :: r) => (r, 0w0 <> a) | _ => raise Corrupt,
+ w = fn (l, b) => (if b then (0w1:Word8.word) else 0w0) :: l }
+ val char = { r = fn (a :: r) => (r, Char.chr (Word8.toInt a)) | _ => raise Corrupt,
+ w = fn (l, c) => Word8.fromInt (Char.ord c) :: l }
+
+ val (w2s, s2w) = (Word8.fromInt o Word.toInt, Word.fromInt o Word8.toInt)
+ val (<<, >>, orb) = (Word.<<, Word.>>, Word.orb)
+ infix 5 << >>
+ infix 4 orb
+ val word = { r = fn (w0 :: w1 :: w2 :: w3 :: r) =>
+ (r, s2w w0 << 0w24 orb s2w w1 << 0w16 orb s2w w2 << 0w8 orb s2w w3)
+ | _ => raise Corrupt,
+ w = fn (l, w) =>
+ w2s w :: w2s (w >> 0w8) :: w2s (w >> 0w16) :: w2s (w >> 0w24) :: l }
+ val int = { r = fn l => let val (r, w) = #r word l in (r, Word.toInt w) end,
+ w = fn (l, i) => #w word (l, Word.fromInt i) }
+
+ fun rstring l =
+ let
+ val (l, i) = #r int l
+ val (s, l) = (List.take (l, i), List.drop (l, i))
+ val s = List.map (Char.chr o Word8.toInt) s
+ val s = implode s
+ in
+ (l, s)
+ end
+ fun wstring (l, s) =
+ List.map (Word8.fromInt o Char.ord) (rev (explode s))
+ @ #w int (l, String.size s)
+
+ fun rvector f l = (l, Vector.fromList [])
+ fun wvector f (l, v) = l (*!!! buggy *)
+
+ val string = { r = rstring, w = wstring }
+ val vector = { r = rvector, w = wvector }
+ end
Added: mltonlib/trunk/ca/terpstra/pickle/lib/pickle.mlb
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/lib/pickle.mlb 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/lib/pickle.mlb 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,8 @@
+local
+ $(SML_LIB)/basis/basis.mlb
+in
+ pickle.sig
+ pickle.sml
+ binary.sml
+ text.sml
+end
Added: mltonlib/trunk/ca/terpstra/pickle/lib/pickle.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/lib/pickle.sig 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/lib/pickle.sig 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,56 @@
+signature PICKLER_BASE =
+ sig
+ type rt
+ type wt
+ type 'a r = rt -> rt * 'a
+ type 'a w = wt * 'a -> wt
+ val opts: { r: int -> int r, w: int -> int w }
+ end
+
+signature PICKLER_SIMPLE =
+ sig
+ structure Base : PICKLER_BASE
+ type t
+
+ val eof: Base.wt
+ val convert: { r: t -> Base.rt, w: Base.wt -> t }
+ end
+
+signature PICKLER =
+ sig
+ include PICKLER_SIMPLE
+
+ type unit = unit
+ type bool = bool
+ type char = char
+ type word = word
+ type int = int
+ type string = string
+ type 'a vector = 'a vector
+
+ (* real, substring, exn, 'a array, 'a list, 'a ref, 'a array, order, 'a option *)
+ val unit: { r: unit Base.r, w: unit Base.w }
+ val bool: { r: bool Base.r, w: bool Base.w }
+ val char: { r: char Base.r, w: char Base.w }
+ val word: { r: word Base.r, w: word Base.w }
+ val int: { r: int Base.r, w: int Base.w }
+ val string: { r: string Base.r, w: string Base.w }
+ val vector: { r: 'a Base.r -> 'a vector Base.r,
+ w: 'a Base.w -> 'a vector Base.w }
+ end
+
+signature PICKLE =
+ sig
+ structure Base : PICKLER_BASE
+
+ type t
+ type 'a pickle = { r: 'a Base.r, w: 'a Base.w }
+
+ val compose1: { r: 'a Base.r -> 'b Base.r, w: 'a Base.w -> 'b Base.w }
+ -> 'a pickle -> 'b pickle
+ val compose2: { r: 'a1 Base.r * 'a2 Base.r -> 'b Base.r,
+ w: 'a1 Base.w * 'a2 Base.w -> 'b Base.w }
+ -> 'a1 pickle * 'a2 pickle -> 'b pickle
+
+ val pickle: 'a pickle -> { r: t -> 'a, w: 'a -> t }
+ end
Added: mltonlib/trunk/ca/terpstra/pickle/lib/pickle.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/lib/pickle.sml 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/lib/pickle.sml 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,14 @@
+functor Pickle(P : PICKLER_SIMPLE) :> PICKLE =
+ struct
+ structure Base = P.Base
+ type 'a pickle = { r: 'a Base.r, w: 'a Base.w }
+ type t = P.t
+
+ fun compose1 {r=rf, w=wf} {r=r1, w=w1} = {r=rf r1, w=wf w1}
+ fun compose2 {r=rf, w=wf} ({r=r1, w=w1}, {r=r2, w=w2}) = {r=rf(r1,r2), w=wf(w1,w2)}
+
+ fun pickle ({r, w}: 'a pickle) =
+ { r = fn t => (#2 o r o (#r P.convert)) t,
+ w = fn x => (#w P.convert) (w (P.eof, x)) }
+ end
+
\ No newline at end of file
Added: mltonlib/trunk/ca/terpstra/pickle/lib/text.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/lib/text.sml 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/lib/text.sml 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,66 @@
+structure Binary : PICKLER =
+ struct
+ exception Corrupt
+
+ structure Base =
+ struct
+ type wt = Word8.word list
+ type rt = Word8.word list
+ type 'a r = rt -> rt * 'a
+ type 'a w = wt * 'a -> wt
+
+ val opts = { r = fn _ => fn (a :: r) => (r, Word8.toInt a) | _ => raise Corrupt,
+ w = fn _ => fn (l, i) => Word8.fromInt i :: l }
+ end
+
+ type t = Word8Vector.vector
+ val eof = []
+ val convert = { w = Word8Vector.fromList o rev,
+ r = fn v => List.tabulate
+ (Word8Vector.length v, fn i => Word8Vector.sub (v, i)) }
+
+ type unit = unit
+ type bool = bool
+ type char = char
+ type word = word
+ type int = int
+ type string = string
+ type 'a vector = 'a vector
+
+ val unit = { r = fn l => (l, ()), w = fn (l, _) => l }
+ val bool = { r = fn ((a:Word8.word) :: r) => (r, 0w0 <> a) | _ => raise Corrupt,
+ w = fn (l, b) => (if b then (0w1:Word8.word) else 0w0) :: l }
+ val char = { r = fn (a :: r) => (r, Char.chr (Word8.toInt a)) | _ => raise Corrupt,
+ w = fn (l, c) => Word8.fromInt (Char.ord c) :: l }
+
+ val (w2s, s2w) = (Word8.fromInt o Word.toInt, Word.fromInt o Word8.toInt)
+ val (<<, >>, orb) = (Word.<<, Word.>>, Word.orb)
+ infix 5 << >>
+ infix 4 orb
+ val word = { r = fn (w0 :: w1 :: w2 :: w3 :: r) =>
+ (r, s2w w0 << 0w24 orb s2w w1 << 0w16 orb s2w w2 << 0w8 orb s2w w3)
+ | _ => raise Corrupt,
+ w = fn (l, w) =>
+ w2s w :: w2s (w >> 0w8) :: w2s (w >> 0w16) :: w2s (w >> 0w24) :: l }
+ val int = { r = fn l => let val (r, w) = #r word l in (r, Word.toInt w) end,
+ w = fn (l, i) => #w word (l, Word.fromInt i) }
+
+ fun rstring l =
+ let
+ val (l, i) = #r int l
+ val (s, l) = (List.take (l, i), List.drop (l, i))
+ val s = List.map (Char.chr o Word8.toInt) s
+ val s = implode s
+ in
+ (l, s)
+ end
+ fun wstring (l, s) =
+ List.map (Word8.fromInt o Char.ord) (rev (explode s))
+ @ #w int (l, String.size s)
+
+ fun rvector f l = (l, Vector.fromList [])
+ fun wvector f (l, v) = l (*!!! buggy *)
+
+ val string = { r = rstring, w = wstring }
+ val vector = { r = rvector, w = wvector }
+ end
Added: mltonlib/trunk/ca/terpstra/pickle/main.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/main.sml 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/main.sml 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,66 @@
+fun prerr s =
+ TextIO.outputSubstr (TextIO.stdErr, Substring.full s)
+fun help () = (
+ prerr "Usage: pickle {functor-name} < {input-file} > {output-file}\n";
+ OS.Process.exit OS.Process.failure)
+
+structure LrVals = TMLLrValsFun(structure Token = LrParser.Token)
+structure Lex = TMLLexFun(structure Tokens = LrVals.Tokens)
+structure Parse = Join(structure ParserData = LrVals.ParserData
+ structure Lex = Lex
+ structure LrParser = LrParser)
+
+val name =
+ case CommandLine.arguments () of
+ (x :: []) => x
+ | (x :: r) => ""
+ | [] => ""
+val () = if name = "" then help () else ()
+
+fun signame s =
+ let
+ fun chr (i, c, t) =
+ if i <> 0 andalso Char.isUpper c andalso
+ not (Char.isUpper (String.sub (s, i - 1)))
+ then #"_" :: Char.toUpper c :: t
+ else Char.toUpper c :: t
+ in
+ implode (CharVector.foldri chr [] s)
+ end
+
+val argname = signame name ^ "_ARG"
+val signame = signame name
+
+fun error (s, (), ()) = print ("Error: " ^ s ^ "\n")
+fun reader _ =
+ case TextIO.inputLine TextIO.stdIn of
+ SOME x => x
+ | NONE => ""
+
+val stream = Parse.makeLexer reader
+val lookahead = 30
+val ast = #1 (Parse.parse (lookahead, stream, error, ()))
+val (start, ast) = tag ast
+
+fun dump l = List.app print (List.rev l)
+fun rungen f = #1 (List.foldl f ([], Map.empty) ast)
+
+val () = (
+ print ("signature " ^ argname ^ " =\n");
+ print (" sig\n");
+ print (" structure Base : SERIAL_BASE\n");
+ dump (rungen import);
+ print (" end\n\n");
+ print ("signature " ^ signame ^ " =\n");
+ print (" sig\n");
+ print (" structure Base : SERIAL_BASE\n");
+ print (" structure Arg : " ^ argname ^ "\n");
+ dump (rungen export);
+ print (" end\n\n");
+ print ("functor " ^ name ^ "(Arg : " ^ argname ^ ") : " ^ signame ^ " =\n");
+ print (" struct\n");
+ print (" structure Base = Arg.Base\n");
+ print (" structure Arg = Arg\n");
+ print (" exception Corrupt\n");
+ dump (rungen (method start));
+ print (" end\n"))
Added: mltonlib/trunk/ca/terpstra/pickle/method.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/method.sml 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/method.sml 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,126 @@
+local
+ fun record (n, typ) l = l && n && "=" ++ inline typ
+ and inline node l =
+ case node of
+ (RECORD v) =>
+ l && "{ " ++ sfoldl (record, ", ", v) && " }"
+ | (RECURSIVE (_, _, t)) => l && t
+ | (TUPLE v) =>
+ l && "(" ++ sfoldl (inline, ", ", v) && ")"
+ | (TYVAR (_, t, _)) => l && t
+in
+ val pattern = inline
+end
+
+fun method start (arg as ((data, bind), (l, scope))) =
+ let
+ val withscope = Map.union (scope, defd data)
+ val datascope = Map.union (withscope, defd bind)
+ exception Undefined
+
+ fun mapOpt (f, NONE) l = l
+ | mapOpt (f, SOME x) l = l ++ f x
+
+ fun data_opts { typ = (ropt, wopt, v), ... } l =
+ l && "val (" && ropt && ", " && wopt && ") = ((#r Base.opts) "
+ && Int.toString (Vector.length v) && ", (#w Base.opts) "
+ && Int.toString (Vector.length v) && ")\n"
+
+ fun write_inline scope =
+ let
+ fun fnhelper (typ, f) l =
+ l && " fun " && f && " (a, " ++ pattern typ && ") =\n"
+ && " let\n val a = a\n" ++ inline typ
+ && " in\n a\n end\n"
+ and invoke n l =
+ case Map.fetch scope n of
+ NONE => l && "(#w Arg." && n && ")"
+ | (SOME {reader=_, writer}) => l && writer
+ and inline node l =
+ case node of
+ (RECORD v) => l ++ foldl (inline o #2, v)
+ | (TUPLE v) => l ++ foldl (inline, v)
+ | (TYVAR (_, t, f)) =>
+ l && " val a = " && f && " (a, " && t && ")\n"
+ | (RECURSIVE (n, v, t)) =>
+ l ++ foldl (fnhelper, v) && " val a = "
+ ++ invoke n && " "
+ ++ tuple (#2, v) && "(a, " && t && ")\n"
+ in
+ inline
+ end
+
+ fun write_bind { name=_, reader=_, writer, tyvars, typ } l =
+ l && "and " && writer ++ tuple (#2, tyvars)
+ && " (a, " ++ pattern typ && ") =\n"
+ && " let\n val a = a\n" ++ write_inline withscope typ
+ && " in\n a\n end\n"
+
+ fun write_data { name=_, reader=_, writer, tyvars, typ = (_, wopt, v) } l =
+ let
+ fun constr (opt, (constr, typo)) l =
+ l && (if opt = 0 then " " else "| ")
+ && "(" && constr && " " ++ mapOpt (pattern, typo) && ") =>\n"
+ && " let\n val a = " && wopt && " (a, " && Int.toString opt && ")\n"
+ ++ mapOpt (write_inline datascope, typo) && " in\n a\n end\n"
+ in
+ l && "and " && writer && " " ++ tuple (#2, tyvars)
+ && "(a, x) = case x of\n"
+ ++ foldli (constr, v)
+ end
+
+ fun read_inline scope =
+ let
+ fun fnhelper (typ, f) l =
+ l && " fun " && f && " a =\n let\n"
+ && " val a = a\n" ++ inline typ && " in\n (a, "
+ ++ pattern typ && ")\n end\n"
+ and invoke n l =
+ case Map.fetch scope n of
+ NONE => l && "(#r Arg." && n && ")"
+ | (SOME {reader, writer=_}) => l && reader
+ and inline node l =
+ case node of
+ (RECORD v) => l ++ foldl (inline o #2, v)
+ | (TUPLE v) => l ++ foldl (inline, v)
+ | (TYVAR (_, t, f)) =>
+ l && " val (a, " && t && ") = " && f && " a\n"
+ | (RECURSIVE (n, v, t)) =>
+ l ++ foldl (fnhelper, v) && " val (a, " && t
+ && ") = " ++ invoke n && " " ++ tuple (#2, v) && "a\n"
+ in
+ inline
+ end
+
+ fun read_bind { name=_, reader, writer=_, tyvars, typ } l =
+ l && "and " && reader && " " ++ tuple (#2, tyvars) && "a =\n"
+ && " let\n val a = a\n" ++ read_inline withscope typ && " in\n"
+ && " (a, " ++ pattern typ && ")\n end\n"
+
+ fun read_data { name=_, reader, writer=_, tyvars, typ = (ropt, _, v) } l =
+ let
+ fun constr (opt, (constr, typo)) l =
+ l && (if opt = 0 then " " else "| ")
+ && "(a, " && Int.toString opt && ") =>\n"
+ && " let\n val a = a\n"
+ ++ mapOpt (read_inline datascope, typo)
+ && " in\n (a, " && constr && " "
+ ++ mapOpt (pattern, typo) && ")\n end\n"
+ in
+ l && "and " && reader && " " ++ tuple (#2, tyvars) && "a =\n"
+ && "case " && ropt && " a of\n"
+ ++ foldli (constr, v) && "| (a, _) => raise Corrupt\n"
+ end
+
+ fun binds {name, reader, writer, tyvars=_, typ=_} l =
+ l && "val " && name && " = "
+ && " { r = " && reader && ", w = " && writer && " }\n"
+ in
+ (#1 (dtype arg)
+ ++ foldl (data_opts, data)
+ && "fun " && start && " x = x\n"
+ ++ foldl (write_bind, bind) ++ foldl (write_data, data)
+ ++ foldl ( read_bind, bind) ++ foldl ( read_data, data)
+ ++ foldl (binds, bind) ++ foldl (binds, data),
+ datascope)
+ end
Added: mltonlib/trunk/ca/terpstra/pickle/pickle.mlb
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/pickle.mlb 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/pickle.mlb 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,17 @@
+local
+ $(SML_LIB)/basis/basis.mlb
+ $(SML_LIB)/mlyacc-lib/mlyacc-lib.mlb
+in
+ tree.sml
+ ast.sml
+ tml.grm.sig
+ tml.lex.sml
+ tml.grm.sml
+ gen.sml
+ tag.sml
+ type.sml
+ import.sml
+ export.sml
+ method.sml
+ main.sml
+end
Added: mltonlib/trunk/ca/terpstra/pickle/tag.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/tag.sml 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/tag.sml 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,57 @@
+fun tag ast =
+ let
+ fun topdefd ((data, bind), m) =
+ Map.union (Map.union (m, defd bind), defd data)
+ fun toSet m = Map.foldl (fn ((k, _), s) => Set.insert s k) Set.empty m
+ val ids = ref (toSet (List.foldl topdefd Map.empty ast))
+
+ val c = ref 0
+ fun pick pfx () =
+ let
+ val id = pfx ^ Int.toString (!c)
+ val () = c := (!c) + 1
+ in
+ if Set.member (!ids) id then pick pfx () else
+ id before ids := Set.insert (!ids) id
+ end
+ val pickId = pick "v_"
+ val pickFn = pick "f_"
+
+ fun tymap tyvars = Vector.map (fn (x, _) => (x, pickFn ())) tyvars
+ fun findFn tyvars n =
+ let
+ exception UnboundTyvar
+ val x = Vector.find (fn (m, _) => n = m) tyvars
+ in
+ case x of
+ NONE => raise UnboundTyvar
+ | SOME (_, f) => f
+ end
+
+ fun inline tyvars typ =
+ case typ of
+ (RECORD v) =>
+ RECORD (Vector.map (fn (n, t) => (n, inline tyvars t)) v)
+ | (TUPLE v) =>
+ TUPLE (Vector.map (inline tyvars) v)
+ | (TYVAR (tyvar, _, _)) =>
+ TYVAR (tyvar, pickId (), findFn tyvars tyvar)
+ | (RECURSIVE (name, tyv, _)) =>
+ RECURSIVE (name, Vector.map (maprec tyvars) tyv, pickId ())
+ and maprec tyvars (ty, _) = (inline tyvars ty, pickFn ())
+
+ fun bindtyp f { name, reader, writer, tyvars, typ } =
+ let val tyvars = tymap tyvars
+ in { name = name, reader = pickFn (), writer = pickFn (),
+ tyvars = tyvars, typ = f tyvars typ } end
+
+ fun datatyp tyvars (_, _, v) =
+ (pickFn (), pickFn (), Vector.map
+ (fn (name, inlineo) => (name, Option.map (inline tyvars) inlineo))
+ v)
+
+ fun process (data, bind) =
+ (Vector.map (bindtyp datatyp) data, Vector.map (bindtyp inline) bind)
+ in
+ (pickFn (), List.map process ast)
+ end
Added: mltonlib/trunk/ca/terpstra/pickle/tests/Makefile
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/tests/Makefile 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/tests/Makefile 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,13 @@
+TARGETS = $(patsubst %.test,%,$(wildcard *.test))
+
+all: $(TARGETS)
+clean:
+ rm -f *.sml $(TARGETS)
+
+%.sml: %.test
+ cp ../sb.sig $@.tmp
+ ../pickle Test < $< >> $@.tmp
+ mv $@.tmp $@
+
+%: %.sml
+ mlton $<
Added: mltonlib/trunk/ca/terpstra/pickle/tests/double.test
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/tests/double.test 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/tests/double.test 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,2 @@
+datatype ('a, 'b) union = LEFT of 'a | RIGHT of 'b
+type ('a, 'b) pair = 'a * 'b
Added: mltonlib/trunk/ca/terpstra/pickle/tests/rebind.test
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/tests/rebind.test 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/tests/rebind.test 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,10 @@
+(* use old binding *)
+type pair = string * int
+
+(* flip bindings *)
+type int = string
+and string = int
+
+datatype opt =
+ VECTOR of opt * string * int
+ | NADA of opt * pair
Added: mltonlib/trunk/ca/terpstra/pickle/tests/recursive.test
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/tests/recursive.test 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/tests/recursive.test 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1 @@
+type 'a x = 'a vector list set
Added: mltonlib/trunk/ca/terpstra/pickle/tests/scope.test
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/tests/scope.test 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/tests/scope.test 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,7 @@
+(* Note that {} and unit are different because unit can be rebound *)
+datatype d1 = C of { baz : d1 * int } list | D of {} | E of t1
+and d2 = F of d1 | G of d2 | Q of t2
+withtype t1 = string * d2
+and t2 = string * unit
+
+datatype 'a d3 = datatype list
Added: mltonlib/trunk/ca/terpstra/pickle/tests/tree.test
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/tests/tree.test 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/tests/tree.test 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,2 @@
+datatype color = RED | BLACK
+datatype 'a tree = LEAF | NODE of color * 'a tree * 'a * 'a tree
Added: mltonlib/trunk/ca/terpstra/pickle/tml.grm
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/tml.grm 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/tml.grm 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,143 @@
+%%
+
+(* bugs: no functor, structure, or abstype support *)
+
+%term LONGID of string
+ | TYVAR of string
+ | AND | ASTERISK | BAR | COLON | COMMA | DATATYPE | EOF | EQUALOP
+ | EQTYPE | LBRACE | LPAREN | OF | OP | RBRACE | RPAREN | TYPE | WITHTYPE
+
+%nonterm file of toplevel_typ list
+ | node of toplevel_typ
+ | typBind of toplevel_typ
+ | typBind' of inline_typ bind_typ list
+ | typBind'' of inline_typ bind_typ list
+ | tyvars of (tyvar * tag) vector
+ | tyvar_pc of (tyvar * tag) list
+ | datatypeRhs of toplevel_typ
+ | db of data_typ bind_typ
+ | dbs of data_typ bind_typ list
+ | withtypes of inline_typ bind_typ list
+ | constrs of (string * inline_typ option) list
+ | constr of string * inline_typ option
+ | opcon of string
+ | con of string
+ | longid of string
+ | longidnA of string
+ | id of string
+ | idnA of string
+ | tyvar of tyvar
+ | tycon of string
+ | longtycon of string
+ | ty of inline_typ
+ | ty' of inline_typ
+ | tlabels of (string * inline_typ) list
+ | tlabel of string * inline_typ
+ | ty0_pc of (inline_typ * tag) list
+ | tuple_ty of inline_typ list
+
+%pos unit
+%verbose
+%eop EOF
+%noshift EOF
+%name TML
+%keyword AND DATATYPE EQTYPE OF OP TYPE WITHTYPE
+
+%value LONGID ("bogus")
+%value TYVAR ("'a")
+
+%%
+
+file : ([])
+ | node file (node :: file)
+
+node : DATATYPE datatypeRhs (datatypeRhs)
+ | TYPE typBind (typBind)
+ | EQTYPE typBind (typBind)
+
+(* ==================== Type ============ *)
+
+typBind : typBind' ((Vector.fromList [], Vector.fromList typBind'))
+
+typBind' : tyvars tycon EQUALOP ty typBind''
+ ({ name = tycon, reader = "", writer = "", tyvars = tyvars,
+ typ = ty } :: typBind'')
+
+typBind'' : ([])
+ | AND typBind' (typBind')
+
+tyvars : (Vector.fromList [])
+ | tyvar (Vector.fromList [(tyvar, "")])
+ | LPAREN tyvar_pc RPAREN (Vector.fromList tyvar_pc)
+
+tyvar_pc : tyvar ([(tyvar, "")])
+ | tyvar COMMA tyvar_pc ((tyvar, "") :: tyvar_pc)
+
+(* ==================== DataType ============ *)
+
+datatypeRhs : tyvars tycon EQUALOP DATATYPE longtycon
+ (Vector.fromList [], Vector.fromList
+ [{ name = tycon, reader = "", writer = "", tyvars = tyvars,
+ typ = RECURSIVE (longtycon,
+ Vector.map (fn (x, y) => (TYVAR (x, "", ""), y))
+ tyvars, "")}])
+ | dbs withtypes
+ ((Vector.fromList dbs, Vector.fromList withtypes))
+
+dbs : db ([db])
+ | db AND dbs (db :: dbs)
+
+db : tyvars tycon EQUALOP constrs
+ ({ name = tycon, reader = "", writer = "", tyvars = tyvars,
+ typ = ("", "", Vector.fromList constrs) })
+
+constrs : constr ([constr])
+ | constr BAR constrs (constr :: constrs)
+
+constr : opcon (opcon, NONE)
+ | opcon OF ty (opcon, SOME ty)
+
+opcon : con (con)
+ | OP con (con)
+
+withtypes : ([])
+ | WITHTYPE typBind' (typBind')
+
+(* ==================== Terminals ============ *)
+
+longidnA : LONGID (LONGID)
+longid : longidnA (longidnA)
+ | ASTERISK ("*")
+
+id : longid (longid) (* forbid '.' in name !!! *)
+idnA : longidnA (longidnA) (* forbid '.' in name !!! *)
+
+con : id (id)
+tycon : idnA (idnA)
+longtycon : idnA (idnA)
+
+tyvar : TYVAR (TYVAR)
+
+(* ==================== Types ================ *)
+
+ty : tuple_ty (TUPLE (Vector.fromList tuple_ty))
+ | ty' (ty')
+
+ty' : tyvar (TYVAR (tyvar, "", ""))
+ | LBRACE tlabels RBRACE (RECORD (Vector.fromList tlabels))
+ | LBRACE RBRACE (RECORD (Vector.fromList []))
+ | LPAREN ty0_pc RPAREN longtycon (RECURSIVE (longtycon, Vector.fromList ty0_pc, ""))
+ | LPAREN ty RPAREN (ty)
+ | ty' longtycon (RECURSIVE (longtycon, Vector.fromList [(ty', "")], ""))
+ | longtycon (RECURSIVE (longtycon, Vector.fromList [], ""))
+
+tlabel : id COLON ty (id, ty)
+
+tlabels : tlabel COMMA tlabels (tlabel :: tlabels)
+ | tlabel ([tlabel])
+
+tuple_ty : ty' ASTERISK tuple_ty (ty' :: tuple_ty)
+ | ty' ASTERISK ty' ([ty'1, ty'2])
+
+ty0_pc : ty COMMA ty ([(ty1, ""), (ty2, "")])
+ | ty COMMA ty0_pc ((ty, "") :: ty0_pc)
Added: mltonlib/trunk/ca/terpstra/pickle/tml.lex
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/tml.lex 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/tml.lex 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,71 @@
+val nix = ((), ())
+fun eof () = Tokens.EOF nix
+
+type svalue = Tokens.svalue
+type ('a, 'b) token = ('a, 'b) Tokens.token
+type lexresult = (svalue, unit) token
+type arg = unit
+type pos = unit
+
+val commentLevel = ref 0
+
+%%
+
+%reject
+%s A;
+%header (functor TMLLexFun (structure Tokens : TML_TOKENS));
+
+alphanum=[A-Za-z'_0-9]*;
+alphanumId=[A-Za-z]{alphanum};
+sym=[-!%&$+/:<=>?@~`^|#*]|"\\";
+symId={sym}+;
+id={alphanumId}|{symId};
+longid={id}("."{id})*;
+ws=("\012"|[\t\ ])*;
+nrws=("\012"|[\t\ ])+;
+cr="\013";
+nl="\010";
+eol=({cr}{nl}|{nl}|{cr});
+num=[0-9]+;
+frac="."{num};
+exp=[eE](~?){num};
+real=(~?)(({num}{frac}?{exp})|({num}{frac}{exp}?));
+hexDigit=[0-9a-fA-F];
+hexnum={hexDigit}+;
+
+%%
+<INITIAL>{ws} => (continue ());
+<INITIAL>{eol} => (continue ());
+<INITIAL>"," => (Tokens.COMMA nix);
+<INITIAL>"{" => (Tokens.LBRACE nix);
+<INITIAL>"}" => (Tokens.RBRACE nix);
+<INITIAL>"(" => (Tokens.LPAREN nix);
+<INITIAL>")" => (Tokens.RPAREN nix);
+<INITIAL>"|" => (Tokens.BAR nix);
+<INITIAL>":" => (Tokens.COLON nix);
+<INITIAL>"=" => (Tokens.EQUALOP nix);
+<INITIAL>"and" => (Tokens.AND nix);
+<INITIAL>"datatype" => (Tokens.DATATYPE nix);
+<INITIAL>"eqtype" => (Tokens.EQTYPE nix);
+<INITIAL>"of" => (Tokens.OF nix);
+<INITIAL>"op" => (Tokens.OP nix);
+<INITIAL>"type" => (Tokens.TYPE nix);
+<INITIAL>"withtype" => (Tokens.WITHTYPE nix);
+<INITIAL>"'"{alphanum}? => (Tokens.TYVAR (yytext, (), ()));
+<INITIAL>{longid} =>
+ (case yytext of
+ "*" => Tokens.ASTERISK nix
+ | _ => Tokens.LONGID (yytext, (), ()));
+<INITIAL>"(*" => (YYBEGIN A
+ ; commentLevel := 1
+ ; continue ());
+<INITIAL>. => (print ("parsing: illegal token\n") ;
+ continue ());
+
+<A>"(*" => (commentLevel := !commentLevel + 1; continue ());
+<A>"*)" => (commentLevel := !commentLevel - 1
+ ; if 0 = !commentLevel then YYBEGIN INITIAL else ()
+ ; continue ());
+<A>. => (continue ());
+<A>{ws} => (continue ());
+<A>{eol} => (continue ());
Added: mltonlib/trunk/ca/terpstra/pickle/tree.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/tree.sml 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/tree.sml 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,173 @@
+signature MAP =
+ sig
+ type k
+ type 'a t
+
+ val empty: 'a t
+
+ val app: (k * 'a -> unit) -> 'a t -> unit
+ val filter: (k * 'a -> bool) -> 'a t -> 'a t
+ val map: (k * 'a -> k * 'b) -> 'a t -> 'b t
+
+ val foldl: ((k * 'a) * 'b -> 'b) -> 'b -> 'a t -> 'b
+ val foldr: ((k * 'a) * 'b -> 'b) -> 'b -> 'a t -> 'b
+
+ val fromList: (k * 'a) list -> 'a t
+ val fromVector: (k * 'a) vector -> 'a t
+
+ val fetch: 'a t -> k -> 'a option
+ val insert: 'a t -> k * 'a -> 'a t
+
+ (* put smaller set on the right *)
+ val union: 'a t * 'a t -> 'a t
+ val intersection: 'a t * 'a t -> 'a t
+ val difference: 'a t * 'a t -> 'a t
+ end
+
+signature SET =
+ sig
+ type k
+ type t
+
+ val empty: t
+
+ val app: (k -> unit) -> t -> unit
+ val filter: (k -> bool) -> t -> t
+ val map: (k -> k ) -> t -> t
+
+ val foldl: (k * 'a -> 'a) -> 'a -> t -> 'a
+ val foldr: (k * 'a -> 'a) -> 'a -> t -> 'a
+
+ val fromList: k list -> t
+ val fromVector: k vector -> t
+
+ val member: t -> k -> bool
+ val insert: t -> k -> t
+
+ (* put smaller set on the right *)
+ val union: t * t -> t
+ val intersection: t * t -> t
+ val difference: t * t -> t
+ end
+
+signature TREE_ORDER =
+ sig
+ type 'a member
+ val order: 'a member * 'a member -> order
+ end
+
+functor Tree(O : TREE_ORDER) =
+ struct
+ open O
+ datatype colour = Red | Black
+ datatype 'a tree = Node of colour * 'a tree * 'a member * 'a tree | Leaf
+
+ val empty = Leaf
+
+ fun app f Leaf = ()
+ | app f (Node (_, l, v, r)) =
+ (app f l; f v; app f r)
+
+ fun map f Leaf = Leaf
+ | map f (Node (c, l, v, r)) =
+ Node (c, map f l, f v, map f r)
+
+ fun foldl f b Leaf = b
+ | foldl f b (Node (c, l, v, r)) =
+ foldl f (f (v, foldl f b l)) r
+
+ fun foldr f b Leaf = b
+ | foldr f b (Node (c, l, v, r)) =
+ foldr f (f (v, foldr f b r)) l
+
+ fun member Leaf _ = false
+ | member (Node (_, l, v, r)) x =
+ case order (x, v) of
+ LESS => member l x
+ | GREATER => member r x
+ | EQUAL => true
+
+ fun balance x = case x of
+ (Black, Node (Red, Node (Red, a, x, b), y, c), z, d) =>
+ Node (Red, Node (Black, a, x, b), y, Node (Black, c, z, d))
+ | (Black, Node (Red, a, x, Node (Red, b, y, c)), z, d) =>
+ Node (Red, Node (Black, a, x, b), y, Node (Black, c, z, d))
+ | (Black, a, x, Node (Red, Node (Red, b, y, c), z, d)) =>
+ Node (Red, Node (Black, a, x, b), y, Node (Black, c, z, d))
+ | (Black, a, x, Node (Red, b, y, Node (Red, c, z, d))) =>
+ Node (Red, Node (Black, a, x, b), y, Node (Black, c, z, d))
+ | (a, b, c, d) =>
+ Node (a, b, c, d)
+
+ fun insert t x =
+ let
+ fun ins Leaf = Node (Red, Leaf, x, Leaf)
+ | ins (Node (c, a, y, b)) =
+ case order (x, y) of
+ LESS => balance (c, ins a, y, b)
+ | GREATER => balance (c, a, y, ins b)
+ | EQUAL => Node (c, a, x, b)
+ in
+ case ins t of
+ Node (_, a, y, b) => Node (Black, a, y, b)
+ | Leaf => Leaf
+ end
+
+ fun fromList l =
+ List.foldl (fn (v, t) => insert t v) empty l
+ fun fromVector v =
+ Vector.foldl (fn (v, t) => insert t v) empty v
+
+ fun filter f t =
+ foldl (fn (v, t) => if f v then insert t v else t) empty t
+
+ fun union (x, y) =
+ foldl (fn (v, t) => insert t v) x y
+ fun intersection (x, y) =
+ filter (member x) y
+ fun difference (x, y) =
+ filter (not o member y) x
+ end
+
+signature KEY_ORDER =
+ sig
+ type k
+ val order: k * k -> order
+ end
+
+functor Set(O : KEY_ORDER) :> SET where type k = O.k =
+ struct
+ structure TO =
+ struct
+ type 'a member = O.k
+ val order = O.order
+ end
+
+ structure Tree = Tree(TO)
+ open Tree
+
+ type k = O.k
+ type t = unit tree
+ end
+
+functor Map(O : KEY_ORDER) :> MAP where type k = O.k =
+ struct
+ structure TO =
+ struct
+ type 'a member = O.k * 'a
+ fun order ((x, _), (y, _)) = O.order (x, y)
+ end
+
+ structure Tree = Tree(TO)
+ open Tree
+
+ type k = O.k
+ type 'a t = 'a tree
+
+ fun fetch Leaf _ = NONE
+ | fetch (Node (_, l, (k, v), r)) x =
+ case O.order (x, k) of
+ LESS => fetch l x
+ | GREATER => fetch r x
+ | EQUAL => SOME v
+ end
Added: mltonlib/trunk/ca/terpstra/pickle/type.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/pickle/type.sml 2006-12-19 02:56:05 UTC (rev 4983)
+++ mltonlib/trunk/ca/terpstra/pickle/type.sml 2006-12-19 02:56:32 UTC (rev 4984)
@@ -0,0 +1,41 @@
+fun dtype ((data, bind), (l, scope)) =
+ let
+ val withscope = Map.union (scope, defd data)
+ val datascope = Map.union (withscope, defd bind)
+
+ fun dump scope =
+ let
+ fun record (n, typ) l = l && n && ": " ++ inline typ
+ and tyvars v l =
+ if Vector.length v = 0 then l else
+ l && "(" ++ sfoldl (inline o #1, ", ", v) && ") "
+ and invoke n l =
+ case Map.fetch scope n of
+ NONE => l && "Arg." && n
+ | SOME _ => l && n
+ and inline node l =
+ case node of
+ (RECORD v) => l && "{ " ++ sfoldl (record, ", ", v) && " }"
+ | (RECURSIVE (n, v, _)) => l ++ tyvars v ++ invoke n
+ | (TUPLE v) => l ++ sfoldl (inline, " * ", v)
+ | (TYVAR (tyvar, _, _)) => l && tyvar
+ in
+ inline
+ end
+
+ fun withtyp (i, { name, reader=_, writer=_, tyvars, typ }) l =
+ l && (if i = 0 then "type " else "and ")
+ ++ tuple (#1, tyvars) && name && " = " ++ dump withscope typ && "\n"
+
+ fun const (n, NONE) l = l && n && "\n"
+ | const (n, SOME typ) l = l && n && " of " ++ dump datascope typ && "\n"
+ fun datatyp (i, { name, reader=_, writer=_, tyvars, typ = (_, _, v) }) l =
+ l && (if i = 0 then " datatype " else " and ")
+ ++ tuple (#1, tyvars) && name && " = " ++ sfoldl (const, "\t| ", v)
+ in
+ (l ++ foldli (datatyp, data)
+ && (if Vector.length data <> 0 andalso
+ Vector.length bind <> 0 then "with" else "")
+ ++ foldli (withtyp, bind),
+ datascope)
+ end
|
|
From: Wesley T. <we...@ml...> - 2006-12-18 18:56:07
|
my collection of SML libs, only half finished mostly
----------------------------------------------------------------------
A mltonlib/trunk/ca/terpstra/regexp/
A mltonlib/trunk/ca/terpstra/regexp/README
A mltonlib/trunk/ca/terpstra/regexp/automata.fun
A mltonlib/trunk/ca/terpstra/regexp/automata.mlb
A mltonlib/trunk/ca/terpstra/regexp/automata.sig
A mltonlib/trunk/ca/terpstra/regexp/btree.sml
A mltonlib/trunk/ca/terpstra/regexp/compare.dot
A mltonlib/trunk/ca/terpstra/regexp/compare.mlb
A mltonlib/trunk/ca/terpstra/regexp/compare.sml
A mltonlib/trunk/ca/terpstra/regexp/todot.mlb
A mltonlib/trunk/ca/terpstra/regexp/todot.sml
A mltonlib/trunk/ca/terpstra/regexp/ztree.sml
----------------------------------------------------------------------
Added: mltonlib/trunk/ca/terpstra/regexp/README
===================================================================
--- mltonlib/trunk/ca/terpstra/regexp/README 2006-12-19 02:52:52 UTC (rev 4982)
+++ mltonlib/trunk/ca/terpstra/regexp/README 2006-12-19 02:56:05 UTC (rev 4983)
@@ -0,0 +1,21 @@
+This is just a quick implementation of finite automata.
+
+It includes:
+ a binary tree implementation
+ a "z-tree" which stores intervals instead of point values
+ a regular expression parser
+ methods for converting regular expressions to NFAs to DFAs
+
+It's fairly self-documenting in the file automata.sig.
+
+Included examples are:
+
+1. a program which compiles a regular expression to a minimal DFA
+ represented as a file suitable for consumption by dot.
+
+2. a program comparing two regular expressions to each other.
+ it provides example strings matched by one and/or not the other.
+
+Compile with:
+ mlton compare.mlb
+ mlton todot.mlb
Added: mltonlib/trunk/ca/terpstra/regexp/automata.fun
===================================================================
--- mltonlib/trunk/ca/terpstra/regexp/automata.fun 2006-12-19 02:52:52 UTC (rev 4982)
+++ mltonlib/trunk/ca/terpstra/regexp/automata.fun 2006-12-19 02:56:05 UTC (rev 4983)
@@ -0,0 +1,665 @@
+signature ALPHABET =
+ sig
+ eqtype char
+ eqtype string
+
+ val ord: char -> int
+ val chr: int -> char
+
+ val < : (char * char) -> bool
+ val foldl: (char * 'a -> 'a) -> 'a -> string -> 'a
+ end
+
+structure Alphabet =
+ struct
+ type char = char
+ type string = string
+
+ val ord = Char.ord
+ val chr = Char.chr
+
+ val (op <) = Char.<
+ fun foldl f a s = Substring.foldl f a (Substring.full s)
+ end
+
+functor Automata(Alphabet : ALPHABET) : AUTOMATA
+ where type char = Alphabet.char
+ and type ZTree.key = Alphabet.char
+ and type string = Alphabet.string =
+ struct
+ structure AlphaOrder =
+ struct
+ type t = Alphabet.char
+ val (op <) = Alphabet.<
+ end
+ structure StateOrder =
+ struct
+ type t = int
+ val (op <) = Int.<
+ end
+ structure ZTree = ZTree(AlphaOrder)
+ structure BTree = BTree(StateOrder)
+ open Alphabet
+
+ fun printSML (f, i, ZTree.Leaf v, tail) = f v :: tail
+ | printSML (f, i, ZTree.Node (l, k, r), tail) =
+ "\n" :: i :: "if c < chr " :: Int.toString (ord k) :: " then " ::
+ printSML (f, i ^ " ", l,
+ "\n" :: i :: "else " ::
+ printSML (f, i ^ " ", r, tail))
+
+ fun toString c = "state" ^ Int.toString c
+ fun printC (i, ZTree.Leaf v, tail) = "goto " :: toString v :: ";" :: tail
+ | printC (i, ZTree.Node (l, k, r), tail) =
+ "\n" :: i ::
+ "if (*s < " :: (Int.toString o ord) k :: ") " ::
+ printC (i ^ "\t", l,
+ "\n" :: i :: "else " ::
+ printC (i ^ "\t", r, tail))
+
+ fun dotNode (i, (b, _), tail) =
+ "\t" :: Int.toString i :: " [label=\"\"" ::
+ (if i = 0 then ",shape=diamond" else "") ::
+ (if b then ",fillcolor=green" else "") ::
+ "]\n" :: tail
+
+ structure Deterministic =
+ struct
+ type state = int
+ type t = (bool * state ZTree.t) vector
+
+ fun size a = Vector.length a
+ fun start _ = 0
+ fun accepts a x = case Vector.sub (a, x) of (b, _) => b
+ fun step a (c, x) = ZTree.lookup (#2 (Vector.sub (a, x))) c
+ fun multistep a (s, x) = foldl (step a) x s
+ fun test a s = accepts a (multistep a (s, start a))
+
+ val empty = Vector.fromList [
+ (true, ZTree.uniform 1),
+ (false, ZTree.uniform 1) ]
+ val any = Vector.fromList [
+ (false, ZTree.uniform 1),
+ (true, ZTree.uniform 2),
+ (false, ZTree.uniform 2) ]
+ fun char t = Vector.fromList [
+ (false, ZTree.map (fn true => 1 | false => 2) t),
+ (true, ZTree.uniform 2),
+ (false, ZTree.uniform 2) ]
+
+ fun mapPair f (x, y) = (f x, f y)
+
+ (* f maps old state to new, n is the number of cells to keep *)
+ fun mapStates (f, n) a =
+ let
+ open ZTree
+ val v = Array.tabulate (Vector.length a, fn _ => (true, uniform 0))
+ val fixtree = fromFront o uniq (op =) o imap f o front
+ fun map (i, (b, t)) = Array.update (v, f i, (b, fixtree t))
+ val () = Vector.appi map a
+ in
+ Vector.tabulate (n, fn i => Array.sub (v, i))
+ end
+
+ (* eliminate unreachable states -- and put states in canonical order *)
+ fun unreachable a =
+ let
+ val l = Vector.length a
+ val v = Array.tabulate (l, fn _ => false)
+ val m = Array.tabulate (l, fn _ => l - 1)
+ val e = ref 0
+ fun dfs i =
+ if Array.sub (v, i) then () else (
+ Array.update (v, i, true);
+ Array.update (m, i, !e);
+ e := (!e + 1);
+ ZTree.app dfs (#2 (Vector.sub (a, i)))
+ )
+ val () = dfs 0
+ in
+ mapStates (fn i => Array.sub (m, i), !e) a
+ end
+
+ (* detect and merge duplicate states *)
+ fun finddups a =
+ let
+ val len = size a
+ fun toPair i = (i mod len, i div len)
+ fun ofPair (r, c) = len * c + r
+ fun agree (r, c) = accepts a r = accepts a c
+ val v = Array.tabulate (len*len, agree o toPair)
+
+ open ZTree
+ fun tree i = #2 (Vector.sub (a, i))
+ fun fold a (Iter (b, NONE, _)) = b andalso a
+ | fold a (Iter (b, SOME _, iter)) = fold (b andalso a) (iter ())
+ fun match (r, c) = Array.sub (v, ofPair (r, c))
+ fun distinct (i, b) = b andalso
+ (fold true o merge match o mapPair (front o tree) o toPair) i
+
+ val changed = ref true
+ fun update (i, b) = let val n = distinct (i, b) in
+ (changed := (!changed orelse (n <> b)); n) end
+ fun pass () = Array.modifyi update v
+ val () = while (!changed) do (changed := false; pass ())
+
+ (* m stores new state name *)
+ val m = Array.tabulate (len, fn _ => 0)
+ val e = ref 0
+ fun whoAmI (i, j) =
+ if Array.sub (v, ofPair (i, j)) then j else whoAmI (i, j+1)
+ fun setState (i, _) =
+ let val j = whoAmI (i, 0) in
+ if i = j then (!e before e := (!e + 1))
+ else Array.sub (m, j)
+ end
+ val () = Array.modifyi setState m
+ in
+ mapStates (fn i => Array.sub (m, i), !e) a
+ end
+
+ (* the second unreachable step puts the DFA in canonical order *)
+ val optimize = unreachable o finddups o unreachable
+
+ (* more interesting would be to output an example difference *)
+ fun equal (v1, v2) = Vector.foldli
+ (fn (i, (b1, t1), a) =>
+ case Vector.sub (v2, i) of (b2, t2) =>
+ a andalso b1 = b2 andalso ZTree.equal (op =) (t1, t2))
+ true v1
+
+ fun crossproduct (a, b, f) =
+ let
+ open ZTree
+ val (rows, cols) = (Vector.length a, Vector.length b)
+ fun toPair i = (i mod rows, i div rows)
+ fun ofPair (r, c) = rows * c + r
+ fun getState (r, c) = (Vector.sub (a, r), Vector.sub (b, c))
+ val tree = fromFront o uniq (op =) o merge ofPair o mapPair front
+ fun cross ((b1, t1), (b2, t2)) = (f (b1, b2), tree (t1, t2))
+ in
+ Vector.tabulate (rows*cols, cross o getState o toPair)
+ end
+
+ fun complement a = Vector.map (fn (b, t) => (not b, t)) a
+ fun union (a, b) = crossproduct (a, b, fn (a, b) => a orelse b)
+ fun intersect (a, b) = crossproduct (a, b, fn (a, b) => a andalso b)
+
+ (* Find the lowest weight string which matches the expression *)
+ fun shortestMatch edgeweight a =
+ let
+ val n = Vector.length a
+ val parent = Array.tabulate (n, fn _ => (0, chr 0))
+ val weight = Array.tabulate (n, fn _ => 1999999999)
+ val visited = Array.tabulate (n, fn _ => false)
+ val () = Array.update(weight, 0, 0) (* start at empty string *)
+
+ val nextNode = Array.foldli
+ (fn (i, w, (bi, bw)) =>
+ if not (Array.sub (visited, i)) andalso Int.< (w, bw)
+ then (i, w) else (bi, bw))
+ (~1, 1999999999)
+
+ fun relaxEdges (i, vw) = ZTree.fold
+ (fn (l, j, r, ()) => case edgeweight (l, r) of (ew, c) =>
+ if vw + ew >= Array.sub (weight, j) then () else (
+ Array.update (weight, j, vw + ew);
+ Array.update (parent, j, (i, c))))
+ ()
+ (case Vector.sub (a, i) of (_, t) => t)
+
+ val working = ref true
+ val () = while (!working) do
+ let
+ val (i, w) = nextNode weight
+ in
+ if i = ~1 then working := false else (
+ Array.update (visited, i, true);
+ relaxEdges (i, w))
+ end
+
+ val shortestAccept = Array.foldli
+ (fn (i, w, (bi, bw)) =>
+ if #1 (Vector.sub (a, i)) andalso Int.< (w, bw)
+ then (i, w) else (bi, bw))
+ (~1, 1999999999) weight
+
+ fun followTrail (0, tail) = tail
+ | followTrail (i, tail) =
+ case Array.sub (parent, i) of (p, c) =>
+ followTrail (p, c :: tail)
+ in
+ if #1 shortestAccept = ~1 then NONE else
+ SOME (followTrail (#1 shortestAccept, []))
+ end
+
+ fun dotEdge (i, (_, t), tail) =
+ let
+ val toString = String.toCString o Char.toString o Char.chr o ord
+ fun pred NONE = NONE | pred (SOME x) = SOME (chr (ord x - 1))
+ fun fmt NONE = "" | fmt (SOME x) = toString x
+ fun fmtp (SOME x, SOME y) =
+ if x = y then toString x else toString x ^ "-" ^ toString y
+ | fmtp (x, y) = fmt x ^ "-" ^ fmt y
+ fun append (l, v, r, tree) =
+ case BTree.get tree v of
+ NONE => BTree.insert tree (v, [fmtp (l, pred r)])
+ | SOME x => BTree.insert tree (v, fmtp (l, pred r) :: x)
+ val edges = BTree.map (String.concatWith ",")
+ (ZTree.foldr append BTree.empty t)
+ fun print (j, l, tail) =
+ "\t" ::Int.toString i :: "->" :: Int.toString j ::
+ " [label=\"" :: l :: "\"]\n" :: tail
+ in
+ BTree.foldr print tail edges
+ end
+
+ fun toDot (n, a) = String.concat (
+ "strict digraph " :: n :: " {\n" ::
+ "\tnode [style=filled,fillcolor=grey,shape=circle]\n" ::
+ Vector.foldri dotNode
+ (Vector.foldri dotEdge ["}\n"] a) a)
+
+ fun toSML (n, a) = String.concat (
+ "fun step s =\n" ::
+ " let\n" ::
+ " datatype x = F of (char -> x)\n" ::
+ " fun eval s = foldl (fn (c, F f) => f c) (F step0) s" ::
+ Vector.foldri
+ (fn (i, (b, t), tail) =>
+ "\n and step" :: Int.toString i :: " c = " ::
+ printSML (fn i => ("F step" ^ Int.toString i), " ", t, tail))
+ ("\n" ::
+ " in\n" ::
+ " case eval s of F f => f\n" ::
+ " end\n" ::
+ nil)
+ a)
+
+ fun bodyC (i, (b, t), tail) =
+ "\n" :: toString i :: ":\n" ::
+ "\tif (++s == e) return " ::
+ (if b then "1" else "0") :: ";\n\t" ::
+ printC ("\t", t, tail)
+ fun caseC (i, (b, ZTree.Leaf v), tail) =
+ if i = v then
+ "\n" :: toString i :: ": return " ::
+ (if b then "1" else "0") :: ";\n" :: tail
+ else bodyC (i, (b, ZTree.Leaf v), tail)
+ | caseC (i, (b, t), tail) = bodyC (i, (b, t), tail)
+ fun toC (n, a) = String.concat (
+ "int " :: n :: "(const unsigned char* s, const unsigned char* e) {\n" ::
+ "\t--s;" ::
+ Vector.foldri caseC
+ ["\n}\n"]
+ a)
+ end
+
+ structure NonDeterministic =
+ struct
+ type state = Deterministic.state
+ type t = state list vector * Deterministic.t
+
+ (* note: the output is sorted b/c it was in a btree *)
+ fun dfs e q =
+ let
+ open BTree
+ fun touch (t, []) = t
+ | touch (t, a :: r) =
+ if isSome (get t a) then touch (t, r) else
+ touch (insert t (a, ()), Vector.sub (e, a) @ r)
+ in
+ fold (fn (k, _, l) => k :: l) [] (touch (empty, q))
+ end
+
+ fun size (_, a) = Vector.length a
+ fun start _ = 0
+ fun accepts (_, a) x = Deterministic.accepts a x
+ fun step (e, a) (c, l) = dfs e
+ (List.map (fn x => Deterministic.step a (c, x)) l)
+ fun multistep a (s, x) = foldl (step a) x s
+ fun test a s = List.exists (accepts a) (multistep a (s, [start a]))
+
+ (* set all accept states to have epsilon transitions to s *)
+ fun mapAccept s (e, a) =
+ let
+ fun mapEpsilon (i, l) = if accepts (e, a) i then s :: l else l
+ fun noAccept a = Vector.map (fn (_, x) => (false, x)) a
+ in
+ (Vector.mapi mapEpsilon e, noAccept a)
+ end
+
+ fun mapRenumber x (e, a) =
+ let
+ val e = Vector.map (List.map (fn i => i + x)) e
+ fun stateRelabel (b, t) = (b, ZTree.map (fn i => i + x) t)
+ in
+ (e, Vector.map stateRelabel a)
+ end
+
+ (* Scheme: new start state s accepts and -> all old starts, accepts -> s*)
+ fun power (e, a) =
+ let
+ val (e, a) = (mapAccept 0 o mapRenumber 2) (e, a)
+ val e0 = Vector.fromList [[2], []]
+ val a0 = Vector.fromList [(true, ZTree.uniform 1),
+ (false, ZTree.uniform 1)]
+ in
+ (Vector.concat [e0, e], Vector.concat [a0, a])
+ end
+
+ (* Scheme: s1 = start states, v1 accept states -> s2 start states *)
+ fun concat ((e1, a1), (e2, a2)) =
+ let
+ val l1 = Vector.length a1
+ val (e1, a1) = mapAccept l1 (e1, a1)
+ val (e2, a2) = mapRenumber l1 (e2, a2)
+ in
+ (Vector.concat [e1, e2], Vector.concat [a1, a2])
+ end
+
+ fun fromDFA a = (Vector.tabulate (Vector.length a, fn _ => []), a)
+
+ (* The general NFA->DFA conversion algorithm works as follows:
+ * - we start by calling getName (dfs e [0])
+ * - getName checks for an existing integer mapping for the list
+ * if one exists, the integer is returned
+ * otherwise:
+ * - the next available integer is allocated to this list
+ * - we merge all trees for the named states in the list
+ * via a hierachical combination of ZTree.merge
+ * - the new int list ZTree.iterator is imap'd with dfs
+ * - then we uniq the operation, and imap mapName it
+ * (this recursively explores other reachable subset states)
+ * - the new iterator is fromFront'd to create the tree.
+ * - if any of the states in the list accept, this accepts too
+ *)
+ structure Names =
+ struct
+ type t = int vector
+ fun < (l, r) = Vector.collate Int.compare (l, r) = LESS
+ end
+ structure NTree = BTree(Names)
+ fun toDFA (e, a) =
+ let
+ val names = ref NTree.empty
+ val number = ref 0
+
+ fun buildTree v =
+ let
+ open ZTree
+ datatype tree = Leaf of int | Node of tree * tree
+ fun flatten tail (Leaf i) = i :: tail
+ | flatten tail (Node (l, r)) = flatten (flatten tail r) l
+
+ fun getIter i = front (#2 (Vector.sub (a, Vector.sub (v, i))))
+
+ fun grow (l, r) =
+ if l + 1 = r then imap Leaf (getIter l) else
+ let val m = (l+r) div 2 in
+ merge Node (grow (l, m), grow (m, r))
+ end
+ in
+ (fromFront o uniq (op =) o imap (mapName o dfs e o flatten []) o grow)
+ (0, Vector.length v)
+ end
+ and mapName l =
+ let
+ val v = Vector.fromList l
+ in
+ case NTree.get (!names) v of
+ SOME (i, _, _) => i
+ | NONE =>
+ let
+ val me = !number before (number := !number + 1)
+ val () = names := NTree.insert (!names)
+ (v, (me, false, ZTree.uniform 0)) (* store name *)
+ val value =
+ (me, List.exists (accepts (e, a)) l, buildTree v)
+ val () = names := NTree.insert (!names) (v, value)
+ in
+ me
+ end
+ end
+
+ val _ = mapName (dfs e [0])
+ val d = Array.tabulate (!number, fn _ => (false, ZTree.uniform 0))
+ val () = NTree.app
+ (fn (i, b, t) => Array.update (d, i, (b, t))) (!names)
+
+(*
+ fun fmt NONE = ()
+ | fmt (SOME c) = (print o Char.toString o Char.chr o ord) c
+ fun treedump (l, v, r, ()) = (
+ fmt l; print "-"; fmt r; print ":";
+ print (Int.toString v ^ " "))
+ fun debug (v, (i, b, t)) = (
+ print "States ";
+ Vector.map (print o Int.toString) v;
+ print (": (" ^ Int.toString i ^ ", " ^ Bool.toString b ^ ", ");
+ ZTree.fold treedump () t;
+ print ")\n")
+ val () = NTree.appk debug (!names)
+*)
+ in
+ Array.vector d
+ end
+
+ fun dotEpsilon (i, [], tail) = tail
+ | dotEpsilon (i, h :: r, tail) =
+ "\t" :: Int.toString i :: "->" :: Int.toString h :: "\n" :: tail
+ fun toDot (n, (e, a)) = String.concat (
+ "digraph " :: n :: " {\n" ::
+ "\tnode [style=filled,fillcolor=grey,shape=circle]\n" ::
+ Vector.foldri dotNode
+ (Vector.foldri Deterministic.dotEdge
+ ("\tedge [style=dashed]\n" ::
+ Vector.foldri dotEpsilon ["}\n"] e) a) a)
+ end
+
+ structure Expression =
+ struct
+ datatype t =
+ Empty | Any | Char of bool ZTree.t | Not of t | Star of t |
+ Concat of t * t | Union of t * t | Intersect of t * t
+
+ structure DFA = Deterministic
+ structure NFA = NonDeterministic
+
+ fun toDFA Empty = DFA.empty
+ | toDFA Any = DFA.any
+ | toDFA (Char t) = DFA.char t
+ | toDFA (Not e) = DFA.complement (toDFA e)
+ | toDFA (Star e) =
+ (DFA.optimize o NFA.toDFA o NFA.power o NFA.fromDFA o toDFA) e
+ | toDFA (Concat (e1, e2)) =
+ (DFA.optimize o NFA.toDFA o NFA.concat)
+ (NFA.fromDFA (toDFA e1), NFA.fromDFA (toDFA e2))
+ | toDFA (Union (e1, e2)) =
+ (DFA.optimize o DFA.union) (toDFA e1, toDFA e2)
+ | toDFA (Intersect (e1, e2)) =
+ (DFA.optimize o DFA.intersect) (toDFA e1, toDFA e2)
+
+(*
+ fun toString Empty = ""
+ | toString Any = "."
+ | toString (Char c) = Char.toString (Char.chr (ord c))
+ | toString (Not e) = "^(" ^ toString e ^ ")"
+ | toString (Star e) = "(" ^ toString e ^ ")*"
+ | toString (Concat (e1, e2)) = toString e1 ^ toString e2
+ | toString (Union (e1, e2)) = "(" ^ toString e1 ^ ")+(" ^ toString e2 ^ ")"
+ | toString (Intersect (e1, e2)) = "(" ^ toString e1 ^ ")-(" ^ toString e2 ^ ")"
+*)
+ end
+
+ structure RegularExpression =
+ struct
+ structure E = Expression
+ type char = Char.char
+ (* BNF:
+ exp = branch
+ branch '|' exp
+ branch = empty
+ piece
+ piece branch
+ piece = atom ('*' | '+' | '?' | bound)?
+ bound = '{' int (',' int?)? '}'
+ atom = '(' exp ')'
+ bracket
+ '^'
+ '$'
+ '\' char
+ char
+ '{' (* if not followed by integer... *)
+ bracket = '[' '^'? (']')? (col | equiv | class | range | char)* ']'
+ col = '[.' chars '.]'
+ equiv = '[=' chars '=]'
+ class = '[:' chars ':]'
+ range = char '-' char
+ *)
+
+ datatype bracket =
+ Elt of char | End | Not of bracket | Range of char * char |
+ Alt of bracket * bracket
+
+ datatype t =
+ Union of t * t | Star of t | Plus of t | Option of t | Paran of t |
+ Concat of t * t | Char of char | Any | Empty |
+ Bound of t * int * int option | Bracket of bracket
+
+ fun cvtBound (e, 0, NONE) = E.Star e
+ | cvtBound (e, i, NONE) = E.Concat (e, cvtBound (e, i-1, NONE))
+ | cvtBound (e, 0, SOME 0) = E.Empty
+ | cvtBound (e, 0, SOME j) = E.Union (E.Empty, cvtBound (e, 1, SOME j))
+ | cvtBound (e, i, SOME j) = E.Concat (e, cvtBound (e, i-1, SOME (j-1)))
+
+ fun cvtBracket (Elt c) = cvtBracket (Range (c, c))
+ | cvtBracket (Not b) = ZTree.map not (cvtBracket b)
+ | cvtBracket End = ZTree.uniform false
+ | cvtBracket (Range (l, h)) =
+ ZTree.range (false, chr (Char.ord l), chr (Char.ord h + 1), true)
+ | cvtBracket (Alt (b1, b2)) =
+ (ZTree.fromFront o ZTree.uniq (op =) o
+ ZTree.merge (fn (x,y) => x orelse y))
+ (ZTree.front (cvtBracket b1), ZTree.front (cvtBracket b2))
+
+ fun exp (Union (e1, e2)) = E.Union (exp e1, exp e2)
+ | exp (Concat (e1, e2)) = E.Concat (exp e1, exp e2)
+ | exp (Star e) = E.Star (exp e)
+ | exp (Plus e) = let val e = exp e in E.Concat (e, E.Star e) end
+ | exp (Option e) = E.Union (E.Empty, exp e)
+ | exp (Paran e) = exp e
+ | exp (Char c) = E.Char (cvtBracket (Elt c))
+ | exp (Bound (e, l, r)) = cvtBound (exp e, l, r)
+ | exp (Bracket b) = E.Char (cvtBracket b)
+ | exp Any = E.Any
+ | exp Empty = E.Empty
+ val toExpression = exp
+
+ fun fromString s =
+ case parse_exp (String.explode s) of
+ (e, []) => e
+ | (e, l) => (
+ print ("Failed to parse: " ^ String.implode l ^ "\n");
+ e)
+ and parse_exp ts =
+ case parse_branch ts of
+ (branch, #"|" :: ts') =>
+ let val (exp, ts'') = parse_exp ts'
+ in (Union (branch, exp), ts'') end
+ | (branch, ts'') => (branch, ts'')
+ and parse_branch ts =
+ case parse_piece ts of
+ (SOME p, ts') =>
+ let val (r, ts'') = parse_branch ts'
+ in (Concat (p, r), ts'') end
+ | (NONE, _) => (Empty, ts)
+ and parse_piece ts =
+ case parse_atom ts of
+ (SOME a, #"*" :: ts') => (SOME (Star a), ts')
+ | (SOME a, #"+" :: ts') => (SOME (Plus a), ts')
+ | (SOME a, #"?" :: ts') => (SOME (Option a), ts')
+ | (SOME a, #"{" :: ts') =>
+ (case parse_bound a ts' of
+ (SOME b, ts'') => (SOME b, ts'')
+ | (NONE, _) => (SOME a, #"{" :: ts'))
+ | (SOME a, ts') => (SOME a, ts')
+ | (NONE, _) => (NONE, ts)
+ and parse_bound a ts =
+ case parse_int ts of
+ (SOME i, _, #"," :: #"}" :: ts') =>
+ (SOME (Bound (a, i, NONE)), ts')
+ | (SOME i, _, #"," :: ts') =>
+ (case parse_int ts' of
+ (SOME j, _, #"}"::ts'') =>
+ if i <= j then
+ (SOME (Bound (a, i, SOME j)), ts'')
+ else (NONE, ts)
+ | (SOME j, _, _) => (NONE, ts)
+ | (NONE, _, _) => (NONE, ts))
+ | (SOME i, _, #"}" :: ts') => (SOME (Bound (a, i, SOME i)), ts')
+ | (SOME i, _, _) => (NONE, ts)
+ | (NONE, _, _) => (NONE, ts)
+ and parse_int ts =
+ case parse_digit ts of
+ (SOME i, ts') =>
+ (case parse_int ts' of
+ (SOME j, p, ts'') => (SOME (i*p+j), p*10, ts'')
+ | (NONE, _, _) => (SOME i, 10, ts'))
+ | (NONE, _) => (NONE, 1, ts)
+ and parse_digit ts =
+ case ts of
+ (#"0" :: ts') => (SOME 0, ts')
+ | (#"1" :: ts') => (SOME 1, ts')
+ | (#"2" :: ts') => (SOME 2, ts')
+ | (#"3" :: ts') => (SOME 3, ts')
+ | (#"4" :: ts') => (SOME 4, ts')
+ | (#"5" :: ts') => (SOME 5, ts')
+ | (#"6" :: ts') => (SOME 6, ts')
+ | (#"7" :: ts') => (SOME 7, ts')
+ | (#"8" :: ts') => (SOME 8, ts')
+ | (#"9" :: ts') => (SOME 9, ts')
+ | _ => (NONE, ts)
+ and parse_atom ts =
+ case ts of
+ (#"(" :: ts') =>
+ (case parse_exp ts' of
+ (exp, #")" :: ts'') => (SOME (Paran exp), ts'')
+ | (exp, _) => (NONE, #"(" :: ts')) (* warn!!! *)
+ | (#"\\" :: x :: ts'') => (SOME (Char x), ts'')
+ | (#"." :: ts'') => (SOME Any, ts'')
+ | (#"[" :: ts') =>
+ (case parse_bnot ts' of
+ (bracket, #"]" :: ts'') => (SOME (Bracket bracket), ts'')
+ | (_, _) => (NONE, #"[" :: ts')) (* warn!!! *)
+ | (#")" :: ts') => (NONE, #")" :: ts')
+ | (#"|" :: ts') => (NONE, #"|" :: ts')
+ | (x :: ts') => (SOME (Char x), ts')
+ | [] => (NONE, ts)
+ and parse_bnot ts =
+ case ts of
+ (#"^" :: ts') =>
+ let val (r, ts'') = parse_bclose ts'
+ in (Not r, ts'') end
+ | _ => parse_bclose ts
+ and parse_bclose ts =
+ case ts of
+ (#"]" :: ts') =>
+ let val (r, ts'') = parse_blist ts'
+ in (Alt (Elt #"]", r), ts'') end
+ | _ => parse_blist ts
+ and parse_blist ts =
+ case parse_batom ts of
+ (SOME a, ts') =>
+ let val (r, ts'') = parse_blist ts'
+ in (Alt (a, r), ts'') end
+ | (NONE, _) => (End, ts)
+ and parse_batom ts =
+ case ts of
+ (c :: #"-" :: #"]" :: ts') => (SOME (Elt c), tl ts)
+ | (#"]" :: ts') => (NONE, ts)
+ | (c :: #"-" :: d :: ts') => (SOME (Range (c, d)), ts')
+ | (c :: ts') => (SOME (Elt c), ts')
+ | _ => (NONE, ts) (* warn!!! *)
+ end
+ end
Added: mltonlib/trunk/ca/terpstra/regexp/automata.mlb
===================================================================
--- mltonlib/trunk/ca/terpstra/regexp/automata.mlb 2006-12-19 02:52:52 UTC (rev 4982)
+++ mltonlib/trunk/ca/terpstra/regexp/automata.mlb 2006-12-19 02:56:05 UTC (rev 4983)
@@ -0,0 +1,8 @@
+local
+ $(SML_LIB)/basis/basis.mlb
+in
+ ztree.sml
+ btree.sml
+ automata.sig
+ automata.fun
+end
Added: mltonlib/trunk/ca/terpstra/regexp/automata.sig
===================================================================
--- mltonlib/trunk/ca/terpstra/regexp/automata.sig 2006-12-19 02:52:52 UTC (rev 4982)
+++ mltonlib/trunk/ca/terpstra/regexp/automata.sig 2006-12-19 02:56:05 UTC (rev 4983)
@@ -0,0 +1,80 @@
+signature AUTOMATA =
+ sig
+ eqtype char
+ eqtype string
+
+ structure ZTree : ZTREE
+
+ structure Deterministic :
+ sig
+ eqtype state
+ type t
+
+ val size: t -> int
+ val start: t -> state
+ val accepts: t -> state -> bool
+ val step: t -> (char * state) -> state
+ val multistep: t -> (string * state) -> state
+ val test: t -> string -> bool
+
+ val any: t
+ val empty: t
+ val char: bool ZTree.t -> t
+
+ (* minimizes states and puts in canonical order *)
+ val optimize: t -> t
+ (* compares two minimal, canonical DFAs for equality *)
+ val equal: (t * t) -> bool
+
+ val complement: t -> t
+ val union: (t * t) -> t
+ val intersect: (t * t) -> t
+
+ (* The passed function is the 'cost' of a character in length *)
+ val shortestMatch: (char option * char option -> int * char) -> t
+ -> char list option
+
+ val toDot: (String.string * t) -> String.string
+ val toSML: (String.string * t) -> String.string
+ val toC: (String.string * t) -> String.string
+ end
+
+ structure NonDeterministic :
+ sig
+ eqtype state
+ type t
+
+ val size: t -> int
+ val start: t -> state
+ val accepts: t -> state -> bool
+ val step: t -> (char * state list) -> state list
+ val multistep: t -> (string * state list) -> state list
+ val test: t -> string -> bool
+
+ val power: t -> t
+ val concat: (t * t) -> t
+
+ val toDFA: t -> Deterministic.t
+ val fromDFA: Deterministic.t -> t
+
+ val toDot: (String.string * t) -> String.string
+ end
+
+ structure Expression :
+ sig
+ datatype t =
+ Empty | Any | Char of bool ZTree.t | Not of t | Star of t |
+ Concat of t * t | Union of t * t | Intersect of t * t
+
+ (* val toString: t -> String.string *)
+ val toDFA: t -> Deterministic.t
+ end
+
+ structure RegularExpression :
+ sig
+ type t
+
+ val fromString: String.string -> t
+ val toExpression: t -> Expression.t
+ end
+ end
Added: mltonlib/trunk/ca/terpstra/regexp/btree.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/regexp/btree.sml 2006-12-19 02:52:52 UTC (rev 4982)
+++ mltonlib/trunk/ca/terpstra/regexp/btree.sml 2006-12-19 02:56:05 UTC (rev 4983)
@@ -0,0 +1,105 @@
+signature BTREE =
+ sig
+ type key
+ type 'val t
+
+ val empty: 'val t
+
+ val app: ('val -> unit) -> 'val t -> unit
+ val appk: ((key * 'val) -> unit) -> 'val t -> unit
+ val map: ('val -> 'new) -> 'val t -> 'new t
+ val mapk: ((key * 'val) -> 'new) -> 'val t -> 'new t
+
+ val fold: (key * 'val * 'a -> 'a) -> 'a -> 'val t -> 'a
+ val foldr: (key * 'val * 'a -> 'a) -> 'a -> 'val t -> 'a
+
+ val get: 'val t -> key -> 'val option
+ val insert: 'val t -> (key * 'val) -> 'val t
+
+ datatype 'val iterator =
+ Iter of key * 'val * (unit -> 'val iterator) option
+ val front: 'val t -> (unit -> 'val iterator) option
+ end
+
+functor BTree(Order : ORDER) : BTREE =
+ struct
+ open Order
+
+ type key = Order.t
+ datatype colour = Red | Black
+ datatype 'val t = Node of colour * 'val t * (key * 'val) * 'val t | Leaf
+
+ val empty = Leaf
+
+ fun app f Leaf = ()
+ | app f (Node (c, l, (y, v), r)) =
+ (app f l; f v; app f r)
+
+ fun appk f Leaf = ()
+ | appk f (Node (c, l, (y, v), r)) =
+ (appk f l; f (y, v); appk f r)
+
+ fun map f Leaf = Leaf
+ | map f (Node (c, l, (y, v), r)) =
+ Node (c, map f l, (y, f v), map f r)
+
+ fun mapk f Leaf = Leaf
+ | mapk f (Node (c, l, (y, v), r)) =
+ Node (c, mapk f l, (y, f (y, v)), mapk f r)
+
+ fun fold f a Leaf = a
+ | fold f a (Node (c, l, (y, v), r)) =
+ fold f (f (y, v, fold f a l)) r
+
+ fun foldr f a Leaf = a
+ | foldr f a (Node (c, l, (y, v), r)) =
+ foldr f (f (y, v, foldr f a r)) l
+
+ fun get Leaf x = NONE
+ | get (Node (_, l, (y, v), r)) x =
+ if x < y then get l x
+ else if y < x then get r x
+ else SOME v
+
+ fun balance x = case x of
+ (Black, Node (Red, Node (Red, a, x, b), y, c), z, d) =>
+ Node (Red, Node (Black, a, x, b), y, Node (Black, c, z, d))
+ | (Black, Node (Red, a, x, Node (Red, b, y, c)), z, d) =>
+ Node (Red, Node (Black, a, x, b), y, Node (Black, c, z, d))
+ | (Black, a, x, Node (Red, Node (Red, b, y, c), z, d)) =>
+ Node (Red, Node (Black, a, x, b), y, Node (Black, c, z, d))
+ | (Black, a, x, Node (Red, b, y, Node (Red, c, z, d))) =>
+ Node (Red, Node (Black, a, x, b), y, Node (Black, c, z, d))
+ | (a, b, c, d) =>
+ Node (a, b, c, d)
+
+ fun insert t (x, v) =
+ let
+ fun ins Leaf = Node (Red, Leaf, (x, v), Leaf)
+ | ins (Node (c, a, (y, v'), b)) =
+ if x < y then balance (c, ins a, (y, v'), b)
+ else if y < x then balance (c, a, (y, v'), ins b)
+ else balance (c, a, (x, v), b)
+ in
+ case ins t of
+ Node (_, a, y, b) => Node (Black, a, y, b)
+ | Leaf => Leaf
+ end
+
+ datatype 'val iterator =
+ Iter of key * 'val * (unit -> 'val iterator) option
+
+ fun front t =
+ let
+ datatype 'val stack = Parent of key * 'val * 'val t
+ fun goleft (Leaf, []) = NONE
+ | goleft (Leaf, stack) = SOME (spit stack)
+ | goleft (Node (_, l, (k, v), r), stack) =
+ goleft (l, Parent (k, v, r) :: stack)
+ and spit [] () = raise Overflow (* unreachable *)
+ | spit (Parent (k, v, r) :: stack) () =
+ Iter (k, v, goleft (r, stack))
+ in
+ goleft (t, [])
+ end
+ end
Added: mltonlib/trunk/ca/terpstra/regexp/compare.dot
===================================================================
--- mltonlib/trunk/ca/terpstra/regexp/compare.dot 2006-12-19 02:52:52 UTC (rev 4982)
+++ mltonlib/trunk/ca/terpstra/regexp/compare.dot 2006-12-19 02:56:05 UTC (rev 4983)
@@ -0,0 +1,427 @@
+digraph "compare call-stack graph" {
+label = "compare call-stack graph"
+n0 [shape = "box", label = "examine.max\n", color = "Black"]
+n1 [shape = "box", label = "examine.length\n", color = "Black"]
+n2 [shape = "box", label = "examine.biggest\n", color = "Black"]
+n2 -> n1 []
+n2 -> n0 []
+n3 [shape = "box", label = "Automata.RegularExpression.fromString\n", color = "Black"]
+n3 -> n4 []
+n3 -> n5 []
+n3 -> n6 []
+n3 -> n7 []
+n3 -> n8 []
+n3 -> n9 []
+n10 [shape = "box", label = "examine\n", color = "Black"]
+n10 -> n3 []
+n10 -> n11 []
+n10 -> n2 []
+n10 -> n0 []
+n10 -> n12 []
+n10 -> n13 []
+n10 -> n4 []
+n10 -> n14 []
+n10 -> n15 []
+n10 -> n16 []
+n10 -> n5 []
+n10 -> n6 []
+n10 -> n7 []
+n10 -> n8 []
+n10 -> n17 []
+n10 -> n18 []
+n10 -> n19 []
+n10 -> n20 []
+n10 -> n21 []
+n10 -> n22 []
+n10 -> n23 []
+n10 -> n24 []
+n10 -> n25 []
+n10 -> n26 []
+n12 [shape = "box", label = "examine.format\n", color = "Black"]
+n12 -> n4 []
+n12 -> n27 []
+n12 -> n24 []
+n26 [shape = "box", label = "examine.entry\n", color = "Black"]
+n26 -> n4 []
+n25 [shape = "box", label = "examine.dashes\n", color = "Black"]
+n25 -> n25 []
+n25 -> n4 []
+n24 [shape = "box", label = "examine.whitespace\n", color = "Black"]
+n24 -> n24 []
+n24 -> n4 []
+n28 [shape = "box", label = "Automata.Deterministic.shortestMatch.anon\n", color = "Black"]
+n29 [shape = "box", label = "Automata.Deterministic.shortestMatch.anon.anon\n", color = "Black"]
+n30 [shape = "box", label = "Automata.Deterministic.shortestMatch.anon\n", color = "Black"]
+n30 -> n29 []
+n23 [shape = "box", label = "Option.map.anon\n", color = "Black"]
+n31 [shape = "box", label = "Automata.Deterministic.shortestMatch.followTrail\n", color = "Black"]
+n32 [shape = "box", label = "ZTree.fold\n", color = "Black"]
+n32 -> n33 []
+n34 [shape = "box", label = "Automata.Deterministic.shortestMatch.relaxEdges\n", color = "Black"]
+n34 -> n32 []
+n35 [shape = "box", label = "Automata.Deterministic.shortestMatch\n", color = "Black"]
+n35 -> n34 []
+n35 -> n31 []
+n35 -> n30 []
+n35 -> n28 []
+n36 [shape = "box", label = "pick\n", color = "Black"]
+n37 [shape = "box", label = "overlap\n", color = "Black"]
+n38 [shape = "box", label = "edgeLength.match\n", color = "Black"]
+n38 -> n37 []
+n39 [shape = "box", label = "edgeLength\n", color = "Black"]
+n39 -> n38 []
+n39 -> n36 []
+n40 [shape = "box", label = "Automata.Deterministic.shortestMatch.relaxEdges.anon\n", color = "Black"]
+n40 -> n39 []
+n33 [shape = "box", label = "ZTree.fold.deep\n", color = "Black"]
+n33 -> n40 []
+n33 -> n33 []
+n41 [shape = "box", label = "C.toArrayOfLength.loop\n", color = "Black"]
+n42 [shape = "box", label = "Automata.RegularExpression.parse_bclose\n", color = "Black"]
+n42 -> n43 []
+n44 [shape = "box", label = "Automata.RegularExpression.parse_bnot\n", color = "Black"]
+n44 -> n42 []
+n44 -> n43 []
+n45 [shape = "box", label = "Automata.RegularExpression.parse_bound\n", color = "Black"]
+n45 -> n46 []
+n47 [shape = "box", label = "Automata.RegularExpression.parse_atom\n", color = "Black"]
+n47 -> n44 []
+n47 -> n9 []
+n48 [shape = "box", label = "Automata.RegularExpression.parse_piece\n", color = "Black"]
+n48 -> n47 []
+n48 -> n45 []
+n49 [shape = "box", label = "Automata.RegularExpression.parse_branch\n", color = "Black"]
+n49 -> n48 []
+n49 -> n49 []
+n9 [shape = "box", label = "Automata.RegularExpression.parse_exp\n", color = "Black"]
+n9 -> n9 []
+n9 -> n49 []
+n50 [shape = "box", label = "Automata.RegularExpression.parse_digit\n", color = "Black"]
+n46 [shape = "box", label = "Automata.RegularExpression.parse_int\n", color = "Black"]
+n46 -> n50 []
+n46 -> n46 []
+n51 [shape = "box", label = "Automata.RegularExpression.parse_batom\n", color = "Black"]
+n43 [shape = "box", label = "Automata.RegularExpression.parse_blist\n", color = "Black"]
+n43 -> n51 []
+n43 -> n43 []
+n21 [shape = "box", label = "Automata.RegularExpression.exp\n", color = "Black"]
+n21 -> n52 []
+n21 -> n53 []
+n21 -> n54 []
+n21 -> n21 []
+n21 -> n22 []
+n55 [shape = "box", label = "ZTree.range\n", color = "Black"]
+n52 [shape = "box", label = "Automata.RegularExpression.cvtBracket\n", color = "Black"]
+n52 -> n55 []
+n52 -> n56 []
+n52 -> n57 []
+n52 -> n58 []
+n52 -> n59 []
+n52 -> n52 []
+n52 -> n53 []
+n52 -> n54 []
+n60 [shape = "box", label = "Automata.RegularExpression.cvtBracket.anon\n", color = "Black"]
+n22 [shape = "box", label = "Automata.RegularExpression.cvtBound\n", color = "Black"]
+n22 -> n22 []
+n19 [shape = "box", label = "Sequence.fromList\n", color = "Black"]
+n61 [shape = "box", label = "Automata.Deterministic.char\n", color = "Black"]
+n61 -> n53 []
+n62 [shape = "box", label = "Automata.NonDeterministic.power\n", color = "Black"]
+n62 -> n63 []
+n62 -> n64 []
+n62 -> n13 []
+n65 [shape = "box", label = "Automata.NonDeterministic.mapAccept.mapEpsilon\n", color = "Black"]
+n65 -> n66 []
+n67 [shape = "box", label = "Automata.NonDeterministic.mapRenumber.anon\n", color = "Black"]
+n68 [shape = "box", label = "Automata.NonDeterministic.toDFA\n", color = "Black"]
+n68 -> n69 []
+n68 -> n70 []
+n68 -> n71 []
+n68 -> n72 []
+n63 [shape = "box", label = "Automata.NonDeterministic.mapRenumber\n", color = "Black"]
+n63 -> n67 []
+n63 -> n13 []
+n73 [shape = "box", label = "Automata.NonDeterministic.mapAccept.noAccept\n", color = "Black"]
+n73 -> n13 []
+n64 [shape = "box", label = "Automata.NonDeterministic.mapAccept\n", color = "Black"]
+n64 -> n73 []
+n64 -> n65 []
+n74 [shape = "box", label = "Automata.NonDeterministic.concat\n", color = "Black"]
+n74 -> n64 []
+n74 -> n63 []
+n74 -> n13 []
+n75 [shape = "box", label = "Automata.NonDeterministic.fromDFA\n", color = "Black"]
+n11 [shape = "box", label = "Automata.Deterministic.crossproduct\n", color = "Black"]
+n76 [shape = "box", label = "Automata.Deterministic.union\n", color = "Black"]
+n76 -> n11 []
+n76 -> n13 []
+n20 [shape = "box", label = "Automata.Expression.toDFA\n", color = "Black"]
+n20 -> n76 []
+n20 -> n75 []
+n20 -> n74 []
+n20 -> n68 []
+n20 -> n62 []
+n20 -> n61 []
+n20 -> n13 []
+n20 -> n19 []
+n20 -> n20 []
+n20 -> n17 []
+n20 -> n18 []
+n77 [shape = "box", label = "Automata.NonDeterministic.toDFA.buildTree\n", color = "Black"]
+n77 -> n78 []
+n77 -> n57 []
+n77 -> n58 []
+n77 -> n54 []
+n77 -> n79 []
+n77 -> n80 []
+n77 -> n81 []
+n82 [shape = "box", label = "BTree.insert\n", color = "Black"]
+n82 -> n83 []
+n82 -> n84 []
+n85 [shape = "box", label = "BTree.get\n", color = "Black"]
+n85 -> n86 []
+n72 [shape = "box", label = "Automata.NonDeterministic.toDFA.mapName\n0.1% (0.01s)\n", color = "Black"]
+n72 -> n85 []
+n72 -> n82 []
+n72 -> n66 []
+n72 -> n77 []
+n87 [shape = "box", label = "BTree.insert\n", color = "Black"]
+n87 -> n88 []
+n87 -> n89 []
+n90 [shape = "box", label = "BTree.get\n", color = "Black"]
+n91 [shape = "box", label = "Automata.NonDeterministic.dfs.pass\n", color = "Black"]
+n91 -> n90 []
+n91 -> n87 []
+n69 [shape = "box", label = "Automata.NonDeterministic.dfs\n", color = "Black"]
+n69 -> n91 []
+n92 [shape = "box", label = "Automata.NonDeterministic.toDFA.buildTree.getIter.anon\n", color = "Black"]
+n93 [shape = "box", label = "Automata.NonDeterministic.toDFA.buildTree.getIter\n", color = "Black"]
+n93 -> n92 []
+n93 -> n59 []
+n79 [shape = "box", label = "Automata.NonDeterministic.toDFA.buildTree.grow\n", color = "Black"]
+n79 -> n93 []
+n79 -> n27 []
+n79 -> n79 []
+n79 -> n80 []
+n79 -> n81 []
+n94 [shape = "box", label = "Automata.NonDeterministic.toDFA.buildTree.flatten\n", color = "Black"]
+n94 -> n94 []
+n83 [shape = "box", label = "BTree.balance\n", color = "Black"]
+n86 [shape = "box", label = "Automata.NonDeterministic.Names.<\n0.2% (0.02s)\n", color = "Black"]
+n84 [shape = "box", label = "BTree.insert.ins\n", color = "Black"]
+n84 -> n86 []
+n84 -> n83 []
+n84 -> n84 []
+n95 [shape = "box", label = "Automata.NonDeterministic.toDFA.anon\n", color = "Black"]
+n71 [shape = "box", label = "BTree.app\n", color = "Black"]
+n71 -> n95 []
+n71 -> n71 []
+n88 [shape = "box", label = "BTree.balance\n", color = "Black"]
+n89 [shape = "box", label = "BTree.insert.ins\n", color = "Black"]
+n89 -> n88 []
+n89 -> n89 []
+n96 [shape = "box", label = "Automata.Deterministic.crossproduct.ofPair\n0.1% (0.01s)\n", color = "Black"]
+n66 [shape = "box", label = "Automata.Deterministic.accepts\n0.1% (0.01s)\n", color = "Black"]
+n97 [shape = "box", label = "Automata.Deterministic.finddups.agree\n1.3% (0.11s)\n", color = "Black"]
+n97 -> n66 []
+n98 [shape = "box", label = "Automata.Deterministic.finddups.fold\n7.7% (0.63s)\n", color = "Black"]
+n98 -> n99 []
+n98 -> n59 []
+n98 -> n81 []
+n98 -> n100 []
+n101 [shape = "box", label = "Automata.Deterministic.finddups.tree.anon\n", color = "Black"]
+n102 [shape = "box", label = "Automata.Deterministic.finddups.tree\n2.1% (0.17s)\n", color = "Black"]
+n102 -> n101 []
+n103 [shape = "box", label = "Automata.Deterministic.finddups.toPair\n5.1% (0.42s)\n", color = "Black"]
+n103 -> n27 []
+n104 [shape = "box", label = "Automata.Deterministic.finddups.distinct\n0.4% (0.03s)\n", color = "Black"]
+n104 -> n103 []
+n104 -> n105 []
+n104 -> n56 []
+n104 -> n98 []
+n106 [shape = "box", label = "Automata.Deterministic.finddups.update\n1.2% (0.10s)\n", color = "Black"]
+n106 -> n104 []
+n107 [shape = "box", label = "Automata.Deterministic.finddups.whoAmI\n0.1% (0.01s)\n", color = "Black"]
+n107 -> n108 []
+n109 [shape = "box", label = "Automata.Deterministic.finddups.setState\n", color = "Black"]
+n109 -> n107 []
+n110 [shape = "box", label = "Automata.Deterministic.finddups.pass\n3.4% (0.28s)\n", color = "Black"]
+n110 -> n106 []
+n111 [shape = "box", label = "Automata.Deterministic.finddups\n", color = "Black"]
+n111 -> n110 []
+n111 -> n112 []
+n111 -> n109 []
+n111 -> n103 []
+n111 -> n97 []
+n108 [shape = "box", label = "Automata.Deterministic.finddups.ofPair\n0.6% (0.05s)\n", color = "Black"]
+n113 [shape = "box", label = "Automata.Deterministic.finddups.match\n0.1% (0.01s)\n", color = "Black"]
+n113 -> n108 []
+n81 [shape = "box", label = "ZTree.merge.wrap\n30.6% (2.50s)\n", color = "Black"]
+n81 -> n60 []
+n81 -> n96 []
+n81 -> n113 []
+n81 -> n99 []
+n81 -> n59 []
+n81 -> n80 []
+n81 -> n100 []
+n81 -> n81 []
+n114 [shape = "box", label = "Automata.Deterministic.unreachable.anon\n", color = "Black"]
+n78 [shape = "box", label = "ZTree.imap\n", color = "Black"]
+n78 -> n80 []
+n115 [shape = "box", label = "Automata.Deterministic.mapStates.map\n0.1% (0.01s)\n", color = "Black"]
+n115 -> n78 []
+n115 -> n57 []
+n115 -> n59 []
+n115 -> n58 []
+n115 -> n54 []
+n112 [shape = "box", label = "Automata.Deterministic.mapStates\n", color = "Black"]
+n112 -> n13 []
+n112 -> n115 []
+n18 [shape = "box", label = "Automata.Deterministic.unreachable\n", color = "Black"]
+n18 -> n116 []
+n18 -> n112 []
+n18 -> n114 []
+n18 -> n117 []
+n100 [shape = "box", label = "ZTree.uniq.wrap\n0.2% (0.02s)\n", color = "Black"]
+n100 -> n99 []
+n100 -> n59 []
+n100 -> n80 []
+n100 -> n100 []
+n100 -> n81 []
+n80 [shape = "box", label = "ZTree.imap.wrap\n0.2% (0.02s)\n", color = "Black"]
+n80 -> n17 []
+n80 -> n72 []
+n80 -> n99 []
+n80 -> n59 []
+n80 -> n80 []
+n80 -> n100 []
+n80 -> n81 []
+n118 [shape = "box", label = "Automata.NonDeterministic.dfs.anon\n0.1% (0.01s)\n", color = "Black"]
+n70 [shape = "box", label = "BTree.fold\n", color = "Black"]
+n70 -> n118 []
+n70 -> n70 []
+n99 [shape = "box", label = "ZTree.front.next\n1.1% (0.09s)\n", color = "Black"]
+n119 [shape = "box", label = "ZTree.fromFront.suck\n", color = "Black"]
+n119 -> n99 []
+n119 -> n59 []
+n119 -> n80 []
+n119 -> n100 []
+n119 -> n81 []
+n58 [shape = "box", label = "ZTree.fromFront\n0.7% (0.06s)\n", color = "Black"]
+n58 -> n119 []
+n54 [shape = "box", label = "ZTree.fromFront.grow\n", color = "Black"]
+n54 -> n27 []
+n54 -> n54 []
+n59 [shape = "box", label = "ZTree.front.goleft\n19.4% (1.58s)\n", color = "Black"]
+n120 [shape = "box", label = "Automata.Deterministic.char.anon\n", color = "Black"]
+n53 [shape = "box", label = "ZTree.map\n", color = "Black"]
+n53 -> n120 []
+n53 -> n53 []
+n121 [shape = "box", label = "Automata.Deterministic.unreachable.dfs.anon\n", color = "Black"]
+n116 [shape = "box", label = "Automata.Deterministic.unreachable.dfs\n", color = "Black"]
+n116 -> n121 []
+n117 [shape = "box", label = "ZTree.app\n", color = "Black"]
+n117 -> n117 []
+n117 -> n116 []
+n5 [shape = "box", label = "StreamIOExtra.flushOut\n", color = "Black"]
+n5 -> n7 []
+n5 -> n8 []
+n6 [shape = "box", label = "TextIO.print\n", color = "Black"]
+n6 -> n122 []
+n6 -> n123 []
+n6 -> n7 []
+n6 -> n8 []
+n7 [shape = "box", label = "StreamIOExtra.flushGen.loop\n", color = "Black"]
+n7 -> n122 []
+n7 -> n123 []
+n8 [shape = "box", label = "StreamIOExtra.flushBuf\n", color = "Black"]
+n124 [shape = "box", label = "Time.make.anon\n", color = "Black"]
+n17 [shape = "box", label = "General.o\n", color = "Black"]
+n17 -> n35 []
+n17 -> n69 []
+n17 -> n70 []
+n17 -> n94 []
+n17 -> n111 []
+n17 -> n18 []
+n17 -> n13 []
+n122 [shape = "box", label = "PosixError.SysCall.syscallErr.errUnblocked\n", color = "Black"]
+n123 [shape = "box", label = "PosixError.SysCall.simpleResult'\n", color = "Black"]
+n125 [shape = "box", label = "IntInf.dontInline.recur\n", color = "Black"]
+n125 -> n125 []
+n126 [shape = "box", label = "Sequence.unfoldi.loop\n", color = "Black"]
+n126 -> n127 []
+n126 -> n128 []
+n126 -> n129 []
+n126 -> n14 []
+n126 -> n15 []
+n126 -> n16 []
+n14 [shape = "box", label = "Array.ArraySlice.vector\n", color = "Black"]
+n15 [shape = "box", label = "Integer.fmt.loop\n", color = "Black"]
+n16 [shape = "box", label = "Integer.fmt\n", color = "Black"]
+n27 [shape = "box", label = "Integer.div\n4.3% (0.35s)\n", color = "Black"]
+n127 [shape = "box", label = "Sequence.Slice.sequence\n", color = "Black"]
+n128 [shape = "box", label = "Sequence.Slice.concat\n", color = "Black"]
+n129 [shape = "box", label = "Sequence.concat\n", color = "Black"]
+n4 [shape = "box", label = "Sequence.append\n", color = "Black"]
+n130 [shape = "box", label = "Automata.NonDeterministic.mapRenumber.stateRelabel\n", color = "Black"]
+n130 -> n53 []
+n131 [shape = "box", label = "Automata.Deterministic.complement.anon\n", color = "Black"]
+n132 [shape = "box", label = "Automata.Deterministic.mapStates.anon\n", color = "Black"]
+n133 [shape = "box", label = "Automata.Deterministic.intersect.anon\n", color = "Black"]
+n57 [shape = "box", label = "ZTree.uniq\n", color = "Black"]
+n57 -> n100 []
+n56 [shape = "box", label = "ZTree.merge\n1.6% (0.13s)\n", color = "Black"]
+n56 -> n81 []
+n105 [shape = "box", label = "Automata.Deterministic.mapPair\n3.4% (0.28s)\n", color = "Black"]
+n105 -> n102 []
+n105 -> n59 []
+n134 [shape = "box", label = "Automata.Deterministic.union.anon\n", color = "Black"]
+n135 [shape = "box", label = "Automata.Deterministic.crossproduct.cross\n0.2% (0.02s)\n", color = "Black"]
+n135 -> n134 []
+n135 -> n105 []
+n135 -> n56 []
+n135 -> n57 []
+n135 -> n133 []
+n135 -> n58 []
+n135 -> n54 []
+n136 [shape = "box", label = "Automata.Deterministic.crossproduct.getState\n", color = "Black"]
+n137 [shape = "box", label = "Automata.Deterministic.crossproduct.toPair\n", color = "Black"]
+n137 -> n27 []
+n138 [shape = "box", label = "Automata.NonDeterministic.mapAccept.noAccept.anon\n", color = "Black"]
+n13 [shape = "box", label = "Sequence.tabulate\n", color = "Black"]
+n13 -> n138 []
+n13 -> n137 []
+n13 -> n136 []
+n13 -> n135 []
+n13 -> n132 []
+n13 -> n131 []
+n13 -> n130 []
+n139 [shape = "box", label = "General.exnMessage.find\n", color = "Black"]
+n139 -> n139 []
+n139 -> n140 []
+n139 -> n127 []
+n139 -> n128 []
+n139 -> n129 []
+n140 [shape = "box", label = "General.exnMessage\n", color = "Black"]
+n141 [shape = "box", label = "<main>\n", color = "Black"]
+n141 -> n10 []
+n141 -> n139 []
+n141 -> n140 []
+n141 -> n127 []
+n141 -> n128 []
+n141 -> n129 []
+n141 -> n4 []
+n141 -> n126 []
+n141 -> n122 []
+n141 -> n123 []
+n141 -> n124 []
+n141 -> n17 []
+n141 -> n125 []
+n141 -> n7 []
+n141 -> n8 []
+n141 -> n5 []
+n141 -> n6 []
+n141 -> n41 []
+n142 [shape = "box", label = "<gc>\n15.1% (1.23s)\n", color = "Black"]
+n143 [shape = "box", label = "<unknown>\n", color = "Black"]
+}
\ No newline at end of file
Added: mltonlib/trunk/ca/terpstra/regexp/compare.mlb
===================================================================
--- mltonlib/trunk/ca/terpstra/regexp/compare.mlb 2006-12-19 02:52:52 UTC (rev 4982)
+++ mltonlib/trunk/ca/terpstra/regexp/compare.mlb 2006-12-19 02:56:05 UTC (rev 4983)
@@ -0,0 +1,6 @@
+local
+ $(SML_LIB)/basis/basis.mlb
+ automata.mlb
+in
+ compare.sml
+end
Added: mltonlib/trunk/ca/terpstra/regexp/compare.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/regexp/compare.sml 2006-12-19 02:52:52 UTC (rev 4982)
+++ mltonlib/trunk/ca/terpstra/regexp/compare.sml 2006-12-19 02:56:05 UTC (rev 4983)
@@ -0,0 +1,90 @@
+fun overlap (NONE, NONE, x, y) = true
+ | overlap (SOME l, NONE, x, y) = l < y
+ | overlap (NONE, SOME r, x, y) = x < r
+ | overlap (SOME l, SOME r, x, y) = x < r andalso l < y
+
+(* assumes overlap *)
+fun pick (NONE, NONE, x, y) = x
+ | pick (SOME l, NONE, x, y) = y - 1 (* l < y *)
+ | pick (NONE, SOME r, x, y) = x (* x < r *)
+ | pick (SOME l, SOME r, x, y) = if l < x then x else l
+
+fun edgeLength (l, r) =
+ let
+ val asciiweights = [
+ ( 65, 91, 1), (* uppercase chars are perfect *)
+ ( 97, 123, 1), (* lowercase chars are perfect *)
+ ( 48, 58, 2), (* digits are nice *)
+ ( 32, 33, 3), (* space is better than punctuation *)
+ ( 58, 65, 4), (* :;<=>?@ not pretty, but ok *)
+ ( 91, 97, 4), (* [\]^_` not pretty, but ok *)
+ (123, 127, 4), (* {|}~ not pretty, but ok *)
+ ( 33, 48, 4), (* !"#$%&'()*+-,-./ are not pretty, but acceptable *)
+ (127, 256, 12), (* anything bigger is not nicely printable *)
+ ( 1, 32, 25), (* control chars are bad too *)
+ ( 0, 1, 200)] (* try really hard to avoid nulls *)
+
+ val (li, ri) = (Option.map Char.ord l, Option.map Char.ord r)
+ fun match (x, y, _) = overlap (li, ri, x, y)
+ in
+ case valOf (List.find match asciiweights) of (x, y, w) =>
+ (w, Char.chr (pick (li, ri, x, y)))
+ end
+
+structure A = Automata(Alphabet)
+structure RE = A.RegularExpression
+structure E = A.Expression
+structure DFA = A.Deterministic
+
+fun examine (a, b) =
+ let
+ val convert = E.toDFA o RE.toExpression o RE.fromString
+ val find = Option.map String.implode o DFA.shortestMatch edgeLength
+ val join = find o DFA.optimize o DFA.intersect
+ val (pa, pb) = (convert a, convert b)
+ val (na, nb) = (DFA.complement pa, DFA.complement pb)
+ val (pas, nas, pbs, nbs) = (find pa, find na, find pb, find nb)
+ val (papbs, panbs, napbs, nanbs) =
+ (join (pa, pb), join (pa, nb), join (na, pb), join (na, nb))
+
+ fun length (SOME x) = 4 + String.size x
+ | length NONE = 3
+ fun max (x, y) = if x < y then y else x
+ fun biggest (x, y, z) = max (length x, max (length y, length z))
+ val col1 = biggest(NONE, pas, nas)
+ val col2 = biggest(pbs, papbs, napbs)
+ val col3 = max(biggest(nbs, panbs, nanbs), 8)
+
+ fun whitespace 0 = ""
+ | whitespace i = " " ^ whitespace (i-1)
+ fun dashes 0 = ""
+ | dashes i = "-" ^ dashes (i-1)
+ fun format (s, w) =
+ let val pad = w - String.size s in
+ whitespace (pad div 2) ^ s ^ whitespace ((pad+1) div 2) end
+ fun entry (SOME x, w) = format ("\"" ^ x ^ "\"", w)
+ | entry (NONE, w) = format ("-", w)
+
+ val setrelation = case (papbs, panbs, napbs, nanbs) of
+ (_, NONE, NONE, _) => "A is identical to B"
+ | (NONE, _, _, NONE) => "A is the complement of B"
+ | (_, NONE, _, _) => "A is a subset of B"
+ | (_, _, NONE, _) => "A is a superset of B"
+ | (NONE, _, _, _) => "A is disjoint from B"
+ | _ => "A overlaps B"
+ in
+ print ("Expression A (" ^ Int.toString (DFA.size pa) ^ " states) = \"" ^ a ^ "\"\n");
+ print ("Expression B (" ^ Int.toString (DFA.size pb) ^ " states) = \"" ^ b ^ "\"\n");
+ print "\n";
+ print (" |" ^ whitespace col1 ^ "|" ^ format("B", col2) ^ "|" ^ format("not(B)", col3) ^ "\n");
+ print ("--------" ^ dashes col1 ^ "-" ^ dashes col2 ^ "-" ^ dashes col3 ^ "\n");
+ print (" |" ^ whitespace col1 ^ "|" ^ entry(pbs, col2) ^ "|" ^ entry(nbs, col3) ^ "\n");
+ print ("A |" ^ entry(pas, col1) ^ "|" ^ entry(papbs, col2) ^ "|" ^ entry(panbs, col3) ^ "\n");
+ print ("not(A) |" ^ entry(nas, col1) ^ "|" ^ entry(napbs, col2) ^ "|" ^ entry(nanbs, col3) ^ "\n");
+ print "\n";
+ print ("Set relationship: " ^ setrelation ^ ".\n")
+ end
+
+val () = case CommandLine.arguments () of
+ (a :: b :: []) => examine (a, b)
+ | _ => print "Expect two regular expressions for arguments\n"
Added: mltonlib/trunk/ca/terpstra/regexp/todot.mlb
===================================================================
--- mltonlib/trunk/ca/terpstra/regexp/todot.mlb 2006-12-19 02:52:52 UTC (rev 4982)
+++ mltonlib/trunk/ca/terpstra/regexp/todot.mlb 2006-12-19 02:56:05 UTC (rev 4983)
@@ -0,0 +1,6 @@
+local
+ $(SML_LIB)/basis/basis.mlb
+ automata.mlb
+in
+ todot.sml
+end
Added: mltonlib/trunk/ca/terpstra/regexp/todot.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/regexp/todot.sml 2006-12-19 02:52:52 UTC (rev 4982)
+++ mltonlib/trunk/ca/terpstra/regexp/todot.sml 2006-12-19 02:56:05 UTC (rev 4983)
@@ -0,0 +1,10 @@
+structure T = Automata(Alphabet)
+structure DFA = T.Deterministic
+structure NFA = T.NonDeterministic
+structure E = T.Expression
+structure RE = T.RegularExpression
+open E
+
+val exp = (RE.toExpression o RE.fromString o hd o CommandLine.arguments) ()
+val s = toDFA exp
+val () = print (DFA.toDot ("dotfile", s))
Added: mltonlib/trunk/ca/terpstra/regexp/ztree.sml
===================================================================
--- mltonlib/trunk/ca/terpstra/regexp/ztree.sml 2006-12-19 02:52:52 UTC (rev 4982)
+++ mltonlib/trunk/ca/terpstra/regexp/ztree.sml 2006-12-19 02:56:05 UTC (rev 4983)
@@ -0,0 +1,171 @@
+signature ORDER =
+ sig
+ type t
+ val < : t * t -> bool
+ end
+
+signature ZTREE =
+ sig
+ type key
+ datatype 'val t =
+ Leaf of 'val |
+ Node of 'val t * key * 'val t
+
+ val uniform: 'val -> 'val t
+ val range: ('val * key * key * 'val) -> 'val t
+ val size: 'val t -> int
+
+ (* compare two ZTrees for structural equality (balance must match) *)
+ val equal: ('val * 'val -> bool) -> ('val t * 'val t) -> bool
+
+ val app: ('val -> unit) -> 'val t -> unit
+ val map: ('val -> 'new) -> 'val t -> 'new t
+ val fold: (key option * 'val * key option * 'a -> 'a) -> 'a -> 'val t -> 'a
+ val foldr: (key option * 'val * key option * 'a -> 'a) -> 'a -> 'val t -> 'a
+ val lookup: 'val t -> key -> 'val
+
+ datatype 'val iterator =
+ Iter of 'val * key option * (unit -> 'val iterator)
+ val front: 'val t -> 'val iterator
+ val back: 'val t -> 'val iterator
+ val fromFront: 'val iterator -> 'val t
+
+ val imap: ('val -> 'new) -> 'val iterator -> 'new iterator
+ val uniq: ('val * 'val -> bool) -> 'val iterator -> 'val iterator
+ val merge: ('v1 * 'v2 -> 'new) -> ('v1 iterator * 'v2 iterator) -> 'new iterator
+ end
+
+functor ZTree(Order : ORDER) : ZTREE
+ where type key = Order.t =
+ struct
+ open Order
+ type key = Order.t
+
+ datatype 'val t =
+ Leaf of 'val |
+ Node of 'val t * key * 'val t
+
+ fun uniform v = Leaf v
+ fun range (u, l, r, v) = Node (Node (Leaf u, l, Leaf v), r, Leaf u)
+
+ fun size (Leaf v) = 1
+ | size (Node (l, _, r)) = size l + size r
+
+ fun equal eq (Leaf v1, Leaf v2) = eq (v1, v2)
+ | equal eq (Node _, Leaf _) = false
+ | equal eq (Leaf _, Node _) = false
+ | equal eq (Node (l1, k1, r1), Node (l2, k2, r2)) =
+ not (k1 < k2) andalso not (k2 < k1) andalso
+ equal eq (l1, l2) andalso equal eq (r1, r2)
+
+ fun app f (Leaf v) = f v
+ | app f (Node (l, k, r)) = (app f l; app f r)
+
+ fun map f (Leaf v) = Leaf (f v)
+ | map f (Node (l, k, r)) = Node (map f l, k, map f r)
+
+ fun fold f a t =
+ let
+ fun deep (x, y, Leaf v, a) = f (x, v, y, a)
+ | deep (x, y, N...
[truncated message content] |
|
From: Wesley T. <we...@ml...> - 2006-12-18 18:52:58
|
my collection of SML libs, only half finished mostly ---------------------------------------------------------------------- A mltonlib/trunk/ca/terpstra/st/ A mltonlib/trunk/ca/terpstra/st/Makefile A mltonlib/trunk/ca/terpstra/st/README A mltonlib/trunk/ca/terpstra/st/data.sig A mltonlib/trunk/ca/terpstra/st/data.sml A mltonlib/trunk/ca/terpstra/st/edge.fun A mltonlib/trunk/ca/terpstra/st/epoll.h A mltonlib/trunk/ca/terpstra/st/epoll.sig A mltonlib/trunk/ca/terpstra/st/epoll.sml A mltonlib/trunk/ca/terpstra/st/ioevent.sig A mltonlib/trunk/ca/terpstra/st/ioevent.sml A mltonlib/trunk/ca/terpstra/st/kevent.h A mltonlib/trunk/ca/terpstra/st/kqueue.sml A mltonlib/trunk/ca/terpstra/st/level.fun A mltonlib/trunk/ca/terpstra/st/lpoll.sig A mltonlib/trunk/ca/terpstra/st/open.sml A mltonlib/trunk/ca/terpstra/st/scheduler.sig A mltonlib/trunk/ca/terpstra/st/socket.sml A mltonlib/trunk/ca/terpstra/st/st.mlb A mltonlib/trunk/ca/terpstra/st/state.sig A mltonlib/trunk/ca/terpstra/st/state.sml A mltonlib/trunk/ca/terpstra/st/test.mlb A mltonlib/trunk/ca/terpstra/st/test.sml A mltonlib/trunk/ca/terpstra/st/thread.sig A mltonlib/trunk/ca/terpstra/st/thread.sml A mltonlib/trunk/ca/terpstra/st/timeout.sig A mltonlib/trunk/ca/terpstra/st/timeout.sml ---------------------------------------------------------------------- Added: mltonlib/trunk/ca/terpstra/st/Makefile =================================================================== --- mltonlib/trunk/ca/terpstra/st/Makefile 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/Makefile 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,9 @@ +all: st + +epoll/epoll.mlb: epoll.h /usr/include/x86_64-linux/i386-linux/sys/epoll.h +kevent/kevent.mlb: kevent.h /usr/include/sys/event.h + +%.mlb: + mlnlffigen -allSU true -linkage static -dir $(@D) -mlbfile $(@F) $^ + +-include $(patsubst %.mlb,%.dep,$(wildcard *.mlb)) Added: mltonlib/trunk/ca/terpstra/st/README =================================================================== --- mltonlib/trunk/ca/terpstra/st/README 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/README 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,16 @@ +This is a simple work-alike of state-threads.sf.net for Standard ML. +It helps in building event driven state machines with non-concurrent threads. + +For an example, see test.sml + +To use on osx: + make kevent/kevent.mlb + mlton test.mlb + +To use on linux: + edit st.mlb to use epoll.mlb instead of kevent.mlb + make epoll/epoll.mlb + mlton test.mlb + +The test program downloads two webpages from google concurrently, while +answering TCP connections on port 12467 and printing a heart beat. Added: mltonlib/trunk/ca/terpstra/st/data.sig =================================================================== --- mltonlib/trunk/ca/terpstra/st/data.sig 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/data.sig 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,46 @@ +signature SPARSE_ARRAY = + sig + type 'a sparse_array + + val new: unit -> 'a sparse_array + + val sub: 'a sparse_array * int -> 'a option + val update: 'a sparse_array * int * 'a -> unit + val erase: 'a sparse_array * int -> unit + end + +signature DYNAMIC_ARRAY = + sig + type 'a dynamic_array + + val new: unit -> 'a dynamic_array + val size: 'a dynamic_array -> int + + val sub: 'a dynamic_array * int -> 'a + val update: 'a dynamic_array * int * 'a -> unit + val swap: 'a dynamic_array * int * int -> unit + + val push: 'a dynamic_array * 'a -> unit + val pop: 'a dynamic_array -> unit + end + +signature HEAP = + sig + type 'a heap + val new: ('a * 'a -> bool) -> 'a heap + val push: 'a heap * 'a -> unit + val pop: 'a heap -> unit + val peek: 'a heap -> 'a option + end + +signature QUEUE = + sig + type 'a queue + val new: unit -> 'a queue + + val empty: 'a queue -> bool + val enque: 'a queue * 'a -> unit + val deque: 'a queue -> 'a option + +(* val enqueList: 'a queue * 'a list -> unit *) + end Added: mltonlib/trunk/ca/terpstra/st/data.sml =================================================================== --- mltonlib/trunk/ca/terpstra/st/data.sml 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/data.sml 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,136 @@ +structure SparseArray :> SPARSE_ARRAY = + struct + type 'a sparse_array = 'a option array ref + + fun new () = ref (Array.array (8, NONE)) + + fun sub (ref array, i) = + if i >= (Array.length array) then NONE else + Array.sub (array, i) + + fun update (array, i, x) = ( + if i < Array.length (!array) then () else + let val a = Array.array (i*2 + 1, NONE) + in + Array.copy { src = !array, dst = a, di = 0 }; + array := a + end; + Array.update (!array, i, SOME x)) + + fun erase (ref array, i) = + if i >= (Array.length array) then () else + Array.update (array, i, NONE) + end + +structure DynamicArray :> DYNAMIC_ARRAY = + struct + type 'a dynamic_array = 'a option array ref * int ref + + fun new () = (ref (Array.array (8, NONE)), ref 0) + fun size (_, ref length) = length + + fun sub ((ref array, _), i) = valOf (Array.sub (array, i)) + fun update ((ref array, _), i, x) = Array.update (array, i, SOME x) + + fun swap ((ref array, _), i, j) = + let + val iv = Array.sub (array, i) + val jv = Array.sub (array, j) + in + Array.update (array, i, jv); + Array.update (array, j, iv) + end + + fun push ((array, length), x) = ( + if Array.length (!array) > !length then () else + let val a = Array.array (!length * 2, NONE) + in + Array.copy { src = !array, dst = a, di = 0 }; + array := a + end; + update ((array, length), !length, x); + length := !length + 1) + + fun pop (ref array, length) = ( + length := !length - 1; + Array.update (array, !length, NONE)) + end + +structure Heap :> HEAP = + struct + open DynamicArray + type 'a heap = 'a dynamic_array * ('a * 'a -> bool) + + fun left i = 2*i + 1 + fun right i = 2*i + 2 + fun parent i = (i - 1) div 2 + + fun new cmp = (DynamicArray.new (), cmp) + + fun push ((a, cmp), x) = + let + fun fixtail 0 = () | fixtail i = + let + val parent = parent i + in + if cmp (sub (a, parent), sub (a, i)) then () else + (swap (a, parent, i); fixtail parent) + end + in + DynamicArray.push (a, x); + fixtail (size a - 1) + end + + fun pop (a, cmp) = + let + val newsize = size a - 1 + + fun fixhead i = + let + val left = left i + val right = right i + in + if left >= newsize then () else + if right >= newsize then + if cmp (sub (a, i), sub (a, left)) then () else + swap (a, i, left) + else + if cmp (sub (a, left), sub (a, right)) then + if cmp (sub (a, i), sub (a, left)) then () else + (swap (a, i, left); fixhead left) + else + if cmp (sub (a, i), sub (a, right)) then () else + (swap (a, i, right); fixhead right) + end + in + update (a, 0, sub (a, newsize)); + DynamicArray.pop a; + fixhead 0 + end + + fun peek (a, cmp) = + if size a = 0 then NONE else SOME (sub (a, 0)) + end + +structure Queue :> QUEUE = + struct + datatype 'a queue = T of {front: 'a list ref, back: 'a list ref} + + fun new() = T{front = ref [], back = ref []} + + fun empty (T {front=ref [], back=ref []}) = true + | empty _ = false + + fun enque(T{back, ...}, x) = back := x :: !back + + fun deque(T{front, back}) = + case !front of + [] => (case !back of + [] => NONE + | l => let val l = rev l + in case l of + [] => raise Fail "deque" + | x :: l => (back := []; front := l; SOME x) + end) + | x :: l => (front := l; SOME x) + end Added: mltonlib/trunk/ca/terpstra/st/edge.fun =================================================================== --- mltonlib/trunk/ca/terpstra/st/edge.fun 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/edge.fun 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,58 @@ +functor Edge(Poll : EPOLL) :> SCHEDULER_EXTRA = + struct + open State + open Thread_Extra + open Timeout_Extra + open Poll + + val poll = create 1000 (* ready for 1000 file descriptors *) + + structure IoEvent : IOEVENT = + struct + open IoEvent + fun monitor fd status = ( + add (poll, fd); + IoEvent.monitor fd status) + fun unmonitor fd = ( + remove (poll, fd); + IoEvent.unmonitor fd) + end + open IoEvent + + fun sigPulse thread = thread before stop () + + fun loop block = + let + fun relativeTime time = + let + val delta = Time.- (time, Time.now ()) + in + if Time.< (delta, Time.zeroTime) + then Time.zeroTime + else delta + end + + val delay = + case block of + PENDING => SOME Time.zeroTime + | COMPLETE => Option.map relativeTime (getNext ()) + in + wait (poll, delay); + trigger (Time.now ()); + loop (run ()) + end + + fun main () = + let + open MLton + open Signal + val real = Itimer.signal Itimer.Real + val freq = Time.fromMilliseconds 50 + in + (* prevent high throughput connections from causing starvation *) + Mask.unblock (Mask.some [real]); + setHandler (real, Handler.handler sigPulse); + (* Itimer.set (Itimer.Real, { interval = freq, value = freq }); *) + loop (run ()) + end + end Added: mltonlib/trunk/ca/terpstra/st/epoll.h =================================================================== --- mltonlib/trunk/ca/terpstra/st/epoll.h 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/epoll.h 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,9 @@ +#include <sys/epoll.h> + +enum EPOLL_CTL { + CTL_ADD = EPOLL_CTL_ADD, + CTL_DEL = EPOLL_CTL_DEL, + CTL_MOD = EPOLL_CTL_MOD +}; + +int close(int); Added: mltonlib/trunk/ca/terpstra/st/epoll.sig =================================================================== --- mltonlib/trunk/ca/terpstra/st/epoll.sig 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/epoll.sig 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,15 @@ +signature EPOLL = + sig + type poll + type ioh = IoEvent.ioh + + val create: int -> poll + val close: poll -> unit + + (* Track changes to state of the io handle *) + val add: poll * ioh -> unit + val remove: poll * ioh -> unit + + (* will automatically change IoEvent's status *) + val wait: poll * Time.time option -> unit + end Added: mltonlib/trunk/ca/terpstra/st/epoll.sml =================================================================== --- mltonlib/trunk/ca/terpstra/st/epoll.sml 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/epoll.sml 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,71 @@ +(* Edge-triggered *) +structure EPoll :> EPOLL = + struct + type poll = MLRep.Int.Signed.int + type ioh = IoEvent.ioh + + fun create events = F_epoll_create.f (MLRep.Int.Signed.fromInt events) + fun close epoll = ignore (F_close.f epoll) + + fun ctl cmd (epoll, fd) = + let + open E_EPOLL_EVENTS + val makeUnsigned = MLRep.Int.Unsigned.fromInt o MLRep.Int.Signed.toInt + val flags = makeUnsigned (e_EPOLLIN + e_EPOLLOUT + e_EPOLLERR + + e_EPOLLHUP + e_EPOLLET) + val epoll_event = C.new S_epoll_event.typ + in + C.Set.uint (S_epoll_event.f_events epoll_event, flags); + C.Set.sint (U_epoll_data.f_fd (S_epoll_event.f_data epoll_event), + MLRep.Int.Signed.fromInt fd); + F_epoll_ctl.f (epoll, cmd, MLRep.Int.Signed.fromInt fd, + C.Ptr.|&| epoll_event); + C.discard epoll_event + end + + val add = ctl E_EPOLL_CTL.e_CTL_ADD + val remove = ctl E_EPOLL_CTL.e_CTL_DEL + + val nevents = 500 + val events = C.alloc S_epoll_event.typ (Word.fromInt nevents) + + fun wait (epoll, time) = + let + val roundup = Time.fromMicroseconds 999 + val delay = case time of + NONE => ~1 + | SOME x => LargeInt.toInt (Time.toMilliseconds (Time.+ (x, roundup))) + + val nevents = F_epoll_wait.f (epoll, events, nevents, delay) + + fun event ees = + let + open E_EPOLL_EVENTS + val makeUnsigned = MLRep.Int.Unsigned.fromInt o MLRep.Int.Signed.toInt + val EPOLLIN = makeUnsigned e_EPOLLIN + val EPOLLOUT = makeUnsigned e_EPOLLOUT + val EPOLLERR = makeUnsigned e_EPOLLERR + val EPOLLHUP = makeUnsigned e_EPOLLHUP + + val fdf = U_epoll_data.f_fd (S_epoll_event.f_data ees) + val fd = MLRep.Int.Signed.toInt (C.Get.sint fdf) + val flags = C.Get.uint (S_epoll_event.f_events ees) + + fun value bit = MLRep.Int.Unsigned.andb (flags, bit) = bit + val broken = value EPOLLERR orelse value EPOLLHUP + in + IoEvent.notifyHASINPUT fd (value EPOLLIN orelse broken); + IoEvent.notifyCANOUTPUT fd (value EPOLLOUT orelse broken) + end + + fun process i = + if i = nevents then () else + (event (C.Ptr.sub (events, i)); process (i + 1)) + in + process 0 + end + end + +structure Scheduler = Edge(EPoll) +structure IoEvent = Scheduler.IoEvent +structure Scheduler :> SCHEDULER = Scheduler Added: mltonlib/trunk/ca/terpstra/st/ioevent.sig =================================================================== --- mltonlib/trunk/ca/terpstra/st/ioevent.sig 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/ioevent.sig 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,20 @@ +signature IOEVENT = + sig + exception Unmonitored + + type status = { hasinput: bool, canoutput: bool} + type ioh + + val socket: ('af, 'sock_type) Socket.sock -> (ioh -> 'a) -> 'a + val sockdes: Socket.sock_desc -> (ioh -> 'a) -> 'a + val file: Posix.IO.file_desc -> (ioh -> 'a) -> 'a + + val HASINPUT: ioh -> (bool, bool) State.state + val CANOUTPUT: ioh -> (bool, bool) State.state + + val notifyHASINPUT: ioh -> bool State.signal + val notifyCANOUTPUT: ioh -> bool State.signal + + val monitor: ioh -> status -> unit + val unmonitor: ioh -> unit + end Added: mltonlib/trunk/ca/terpstra/st/ioevent.sml =================================================================== --- mltonlib/trunk/ca/terpstra/st/ioevent.sml 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/ioevent.sml 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,53 @@ +structure IoEvent : IOEVENT = + struct + open State + open SparseArray + + type ioh = int + exception Unmonitored + + type status = { + hasinput: bool, + canoutput: bool } + type filedes = { + fhasinput: (bool, bool) state * bool signal, + fcanoutput: (bool, bool) state * bool signal } + val filedes : filedes sparse_array = new () + + type 'a t = (unit -> 'a) * ('a -> unit) + val (geti, _) = _symbol "side_channel_hack" alloc: int t; + val (_, sets) = _symbol "side_channel_hack": ('a, 'b) Socket.sock t; + val (_, setd) = _symbol "side_channel_hack": Socket.sock_desc t; + val (_, setf) = _symbol "side_channel_hack": Posix.IO.file_desc t; + + fun socket sock f = f (sets sock; geti ()) + fun sockdes des f = f (setd des; geti ()) + fun file file f = f (setf file; geti ()) + + fun test select fd = case sub (filedes, fd) of + NONE => raise Unmonitored + | SOME x => case select x of (state, _) => state + + val HASINPUT = test #fhasinput + val CANOUTPUT = test #fcanoutput + + fun notify select fd = case sub (filedes, fd) of + NONE => raise Unmonitored + | SOME x => case select x of (_, signal) => signal + + val notifyHASINPUT = notify #fhasinput + val notifyCANOUTPUT = notify #fcanoutput + + fun monitor fd (status:status) = + let + val entry = { + fhasinput = state (#hasinput status), + fcanoutput = state (#canoutput status) } + in + update (filedes, fd, entry) + end + + fun unmonitor fd = case sub (filedes, fd) of + NONE => raise Unmonitored + | SOME _ => erase (filedes, fd) + end Added: mltonlib/trunk/ca/terpstra/st/kevent.h =================================================================== --- mltonlib/trunk/ca/terpstra/st/kevent.h 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/kevent.h 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,57 @@ +#include <sys/event.h> +#include <sys/time.h> + +enum filter { + read = EVFILT_READ, + write = EVFILT_WRITE, + aio = EVFILT_AIO, + vnode = EVFILT_VNODE, + proc = EVFILT_PROC, + signal = EVFILT_SIGNAL, + timer = EVFILT_TIMER, + machport = EVFILT_MACHPORT, + fs = EVFILT_FS +}; + +enum action { + add = EV_ADD, + delete = EV_DELETE, + enable = EV_ENABLE, + disable = EV_DISABLE, + oneshot = EV_ONESHOT, + clear = EV_CLEAR, + sysflags = EV_SYSFLAGS, + flag0 = EV_FLAG0, + flag1 = EV_FLAG1, + eof = EV_EOF, + error = EV_ERROR, + poll = EV_POLL, + ooband = EV_OOBAND +}; + +/* +enum note { + lowat = NOTE_LOWAT, + delete = NOTE_DELETE, + write = NOTE_WRITE, + extend = NOTE_EXTEND, + attrib = NOTE_ATTRIB, + link = NOTE_LINK, + rename = NOTE_RENAME, + revoke = NOTE_REVOKE, + exit = NOTE_EXIT, + fork = NOTE_FORK, + exec = NOTE_EXEC, + pctrlmask = NOTE_PCTRLMASK, + pdatamask = NOTE_PDATAMASK, + seconds = NOTE_SECONDS, + useconds = NOTE_USECONDS, + nseconds = NOTE_NSECONDS, + absolute = NOTE_ABSOLUTE, + track = NOTE_TRACK, + trackerr = NOTE_TRACKERR, + child = NOTE_CHILD +}; +*/ + +int close(int fd); Added: mltonlib/trunk/ca/terpstra/st/kqueue.sml =================================================================== --- mltonlib/trunk/ca/terpstra/st/kqueue.sml 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/kqueue.sml 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,102 @@ +structure KQueue :> EPOLL = + struct + type poll = MLRep.Int.Signed.int + type ioh = IoEvent.ioh + + fun create _ = F_kqueue.f () + fun close epoll = ignore (F_close.f epoll) + +(* + val () = print ("change: " ^ Int.toString fd ^ ": ") + val () = print (Int.toString filter ^ " ") + val () = print (Int.toString flags) + val () = print "\n" +*) + fun kevent (ke, fd, filter, flags) = + (C.Set.ulong (S_kevent.f_ident ke, + MLRep.Long.Unsigned.fromInt fd); + C.Set.sshort (S_kevent.f_filter ke, + MLRep.Short.Signed.fromInt + (MLRep.Int.Signed.toInt filter)); + C.Set.ushort (S_kevent.f_flags ke, + MLRep.Short.Unsigned.fromInt + (MLRep.Int.Signed.toInt flags))) + + fun control flags (epoll, fd) = + let + val changes = C.alloc S_kevent.typ (Word.fromInt 2) + val zero = C.new S_timespec.typ + in + kevent (C.Ptr.sub (changes, 0), fd, E_filter.e_read, flags); + kevent (C.Ptr.sub (changes, 1), fd, E_filter.e_write, flags); + C.Set.slong (S_timespec.f_tv_sec zero, 0); + C.Set.slong (S_timespec.f_tv_nsec zero, 0); + F_kevent.f (epoll, + C.Ptr.ro changes, 2, + C.Ptr.null (C.T.pointer S_kevent.typ), 0, + C.Ptr.ro (C.Ptr.|&| zero)); + C.discard zero; + C.free changes + end + + val add = control (E_action.e_add + E_action.e_clear) + val remove = control E_action.e_delete + + val nevents = 500 + val events = C.alloc S_kevent.typ (Word.fromInt nevents) + + fun event ke = + let + val fd = C.Get.ulong (S_kevent.f_ident ke) + val io = C.Get.sshort (S_kevent.f_filter ke) + + val fd = MLRep.Long.Unsigned.toInt fd + + val cvt = MLRep.Short.Signed.fromInt o MLRep.Int.Signed.toInt + val read = cvt E_filter.e_read + val write = cvt E_filter.e_write +(* + val () = print ("event: " ^ Int.toString fd ^ ":") + val () = if io = read then print " read" else () + val () = if io = write then print " write" else () + val () = print "\n" +*) + in + if io = read then IoEvent.notifyHASINPUT fd true else (); + if io = write then IoEvent.notifyCANOUTPUT fd true else () + end + + fun wait (epoll, time) = + let + fun timespec NONE = C.Ptr.null (C.T.pointer S_timespec.typ) + | timespec (SOME t) = + let + val ts = C.alloc S_timespec.typ (Word.fromInt 1) + val (seconds, nano) = + IntInf.quotRem (Time.toNanoseconds t, 1000000000) + in + C.Set.slong (S_timespec.f_tv_sec (C.Ptr.|*| ts), + MLRep.Long.Signed.fromLarge seconds); + C.Set.slong (S_timespec.f_tv_nsec (C.Ptr.|*| ts), + MLRep.Long.Signed.fromLarge nano); + ts + end + val ts = timespec time + + val changes = C.Ptr.ro (C.Ptr.null (C.T.pointer S_kevent.typ)) + val nevents = F_kevent.f (MLRep.Int.Signed.fromInt epoll, + changes, 0, + events, nevents, + C.Ptr.ro ts) + fun process i = + if i = nevents then () else + (event (C.Ptr.sub (events, i)); process (i + 1)) + in + process 0; + if C.Ptr.isNull ts then () else C.free ts + end + end + +structure Scheduler = Edge(KQueue) +structure IoEvent :> IOEVENT = Scheduler.IoEvent +structure Scheduler :> SCHEDULER = Scheduler Added: mltonlib/trunk/ca/terpstra/st/level.fun =================================================================== --- mltonlib/trunk/ca/terpstra/st/level.fun 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/level.fun 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,73 @@ +functor Level(Poll : LPOLL) :> SCHEDULER_EXTRA = + struct + open State + open Thread_Extra + open Timeout_Extra + open Poll + + val poll = create 1000 (* ready for 1000 file descriptors *) + + structure IoEvent : IOEVENT = + struct + open IoEvent + + fun monitor fd { hasinput, canoutput } = ( + if hasinput then () else watch (poll, fd, Poll.HASINPUT); + if canoutput then () else watch (poll, fd, Poll.CANOUTPUT); + IoEvent.monitor fd {hasinput = hasinput, canoutput = canoutput}) + + fun unmonitor fd = ( + unwatchall (poll, fd); + IoEvent.unmonitor fd) + + fun notifyHASINPUT fd true = ( + IoEvent.notifyHASINPUT fd true) + | notifyHASINPUT fd false = ( + Poll.watch (poll, fd, Poll.HASINPUT); + IoEvent.notifyHASINPUT fd false) + + fun notifyCANOUTPUT fd true = ( + IoEvent.notifyCANOUTPUT fd true) + | notifyCANOUTPUT fd false = ( + Poll.watch (poll, fd, Poll.CANOUTPUT); + IoEvent.notifyCANOUTPUT fd false) + end + open IoEvent + + fun sigPulse thread = thread before stop () + + fun loop block = + let + fun relativeTime time = + let + val delta = Time.- (time, Time.now ()) + in + if Time.< (delta, Time.zeroTime) + then Time.zeroTime + else delta + end + + val delay = + case block of + PENDING => SOME Time.zeroTime + | COMPLETE => Option.map relativeTime (getNext ()) + in + wait (poll, delay); + trigger (Time.now ()); + loop (run ()) + end + + fun main () = + let + open MLton + open Signal + val real = Itimer.signal Itimer.Real + val freq = Time.fromMilliseconds 50 + in + (* prevent high throughput connections from causing starvation *) + Mask.unblock (Mask.some [real]); + setHandler (real, Handler.handler sigPulse); + (* Itimer.set (Itimer.Real, { interval = freq, value = freq }); *) + loop (run ()) + end + end Added: mltonlib/trunk/ca/terpstra/st/lpoll.sig =================================================================== --- mltonlib/trunk/ca/terpstra/st/lpoll.sig 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/lpoll.sig 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,21 @@ +(* Signature for level-triggered poll *) +signature LPOLL = + sig + type poll + type ioh = IoEvent.ioh + datatype level = HASINPUT | CANOUTPUT + + val create: int -> poll + val close: poll -> unit + + (* add a watch to the list *) + val watch: poll * ioh * level -> unit + + (* called prior to closing the io handle *) + val unwatchall: poll * ioh -> unit + + (* automatically change IoEvent's status + * triggered watches are automatically removed from the poll (ie: oneshot) + *) + val wait: poll * Time.time option -> unit + end Added: mltonlib/trunk/ca/terpstra/st/open.sml =================================================================== --- mltonlib/trunk/ca/terpstra/st/open.sml 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/open.sml 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,5 @@ +open State +open Thread +open Timeout +open IoEvent +open Scheduler Added: mltonlib/trunk/ca/terpstra/st/scheduler.sig =================================================================== --- mltonlib/trunk/ca/terpstra/st/scheduler.sig 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/scheduler.sig 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,10 @@ +signature SCHEDULER = + sig + val main: unit -> unit + end + +signature SCHEDULER_EXTRA = + sig + include SCHEDULER + structure IoEvent: IOEVENT + end Added: mltonlib/trunk/ca/terpstra/st/socket.sml =================================================================== --- mltonlib/trunk/ca/terpstra/st/socket.sml 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/socket.sml 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,202 @@ +structure Socket : SOCKET = + struct + open Socket + open State + open IoEvent + open Timeout + open Thread + + fun wrapInNB f s x = + case f x of + NONE => NONE before socket (s x) notifyHASINPUT false + | SOME v => SOME v + + val recvVecNB = fn x => wrapInNB recvVecNB #1 x + val recvVecNB' = fn x => wrapInNB recvVecNB' #1 x + val recvArrNB = fn x => wrapInNB recvArrNB #1 x + val recvArrNB' = fn x => wrapInNB recvArrNB' #1 x + + val recvVecFromNB = fn x => wrapInNB recvVecFromNB #1 x + val recvVecFromNB' = fn x => wrapInNB recvVecFromNB' #1 x + val recvArrFromNB = fn x => wrapInNB recvArrFromNB #1 x + val recvArrFromNB' = fn x => wrapInNB recvArrFromNB' #1 x + + fun wrapIn f s x = ( + stopTill (socket (s x) HASINPUT); + case f x of + NONE => wrapIn f s x + | SOME x => x) + + fun recvVec x = wrapIn recvVecNB #1 x + fun recvVec' x = wrapIn recvVecNB' #1 x + fun recvArr x = wrapIn recvArrNB #1 x + fun recvArr' x = wrapIn recvArrNB' #1 x + + fun recvVecFrom x = wrapIn recvVecFromNB #1 x + fun recvVecFrom' x = wrapIn recvVecFromNB' #1 x + fun recvArrFrom x = wrapIn recvArrFromNB #1 x + fun recvArrFrom' x = wrapIn recvArrFromNB' #1 x + + fun wrapOutNB f s x = + case f x of + NONE => NONE before socket (s x) notifyCANOUTPUT false + | SOME v => SOME v + + val sendVecNB = fn x => wrapOutNB sendVecNB #1 x + val sendVecNB' = fn x => wrapOutNB sendVecNB' #1 x + val sendArrNB = fn x => wrapOutNB sendArrNB #1 x + val sendArrNB' = fn x => wrapOutNB sendArrNB' #1 x + + fun wrapOutNBbool f s x = + case f x of + false => false before socket (s x) notifyCANOUTPUT false + | true => true + + val sendVecToNB = fn x => wrapOutNBbool sendVecToNB #1 x + val sendVecToNB' = fn x => wrapOutNBbool sendVecToNB' #1 x + val sendArrToNB = fn x => wrapOutNBbool sendArrToNB #1 x + val sendArrToNB' = fn x => wrapOutNBbool sendArrToNB' #1 x + + fun wrapOut f s x = ( + stopTill (socket (s x) CANOUTPUT); + case f x of + NONE => wrapOut f s x + | SOME x => x) + + fun sendVec x = wrapOut sendVecNB #1 x + fun sendVec' x = wrapOut sendVecNB' #1 x + fun sendArr x = wrapOut sendArrNB #1 x + fun sendArr' x = wrapOut sendArrNB' #1 x + + fun wrapOutbool f s x = ( + stopTill (socket (s x) CANOUTPUT); + case f x of + false => wrapOutbool f s x + | true => ()) + + fun sendVecTo x = wrapOutbool sendVecToNB #1 x + fun sendVecTo' x = wrapOutbool sendVecToNB' #1 x + fun sendArrTo x = wrapOutbool sendArrToNB #1 x + fun sendArrTo' x = wrapOutbool sendArrToNB' #1 x + + val acceptNB = fn s => + case acceptNB s of + NONE => NONE before socket s notifyHASINPUT false + | SOME (s, a) => + (* It is safe to say no input, b/c edge triggered APIs always + * give at least one initial status report. It is also safe + * for level triggered, since this gets it added to the poll. + * Thus, no really fast sends are lost. + * + * This is the smart thing to do, because SYN+ACK takes a while + * to reach the client. So, there's no point wasting a recv() + * when it's almost surely not going to have data yet anyways. + *) + SOME (s, a) before socket s monitor { hasinput = false, + canoutput = true } + fun accept x = wrapIn acceptNB (fn s => s) x + + val close = fn s => (socket s unmonitor; close s) + + val listen = fn (s, i) => + (* due to a bug in BSD's kqueue API, we must re-monitor *) + (socket s unmonitor; + listen (s, i); + socket s monitor { hasinput = false, canoutput = true }) + + val connect = fn (s, a) => + case connectNB (s, a) of + true => () + | false => ( + stopTill (socket s CANOUTPUT); + (* Get the error status, if getERROR doesn't raise, we raise + * something generic since we only know that it failed. + *) + if Socket.Ctl.getERROR s + then raise OS.SysErr ("Connection failed", NONE) + else ()) + + fun select {rds, wrs, exs, timeout} = + let + datatype which = + RDS of sock_desc | WRS of sock_desc | TIMER + + val rds = List.map (fn rd => (sockdes rd HASINPUT, RDS rd)) rds + val wrs = List.map (fn wr => (sockdes wr CANOUTPUT, WRS wr)) wrs + val tmr = case timeout of SOME x => [(TIMEOUT x, TIMER)] | NONE => [] + val events = List.concat [rds, wrs, tmr] + + val ords = ref [] + val owrs = ref [] + + fun split (RDS rd) = ords := rd :: !ords + | split (WRS wr) = owrs := wr :: !owrs + | split TIME = () + in + List.app split (Thread.select events); + {rds = !ords, wrs = !owrs, exs = []} + end + end + +structure Wrap = + struct + local + open IoEvent + in + val monitor = fn s => + s before socket s monitor { hasinput = false, canoutput = false } + + fun monitorPair (s, t) = (monitor s, monitor t) + end + end + +structure GenericSock : GENERIC_SOCK = + struct + open GenericSock + open Wrap + + val socket = fn x => monitor (socket x) + val socket' = fn x => monitor (socket' x) + val socketPair = fn x => monitorPair (socketPair x) + val socketPair' = fn x => monitorPair (socketPair' x) + end + +structure INetSock : INET_SOCK = + struct + open INetSock + open Wrap + + structure UDP = + struct + open UDP + val socket = fn x => monitor (socket x) + val socket' = fn x => monitor (socket' x) + end + + structure TCP = + struct + open TCP + val socket = fn x => monitor (socket x) + val socket' = fn x => monitor (socket' x) + end + end + +structure UnixSock : UNIX_SOCK = + struct + open UnixSock + open Wrap + + structure Strm = + struct + open Strm + val socket = fn x => monitor (socket x) + val socketPair = fn x => monitorPair (socketPair x) + end + + structure DGrm = + struct + open DGrm + val socket = fn x => monitor (socket x) + val socketPair = fn x => monitorPair (socketPair x) + end + end Added: mltonlib/trunk/ca/terpstra/st/st.mlb =================================================================== --- mltonlib/trunk/ca/terpstra/st/st.mlb 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/st.mlb 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,56 @@ +local + $(SML_LIB)/basis/basis.mlb + $(SML_LIB)/basis/mlton.mlb + $(SML_LIB)/mlnlffi-lib/mlnlffi-lib.mlb + + ann + "allowFFI true" + in + data.sig + data.sml + + state.sig + state.sml + thread.sig + thread.sml + + timeout.sig + timeout.sml + ioevent.sig + ioevent.sml + + scheduler.sig + epoll.sig + edge.fun + lpoll.sig + level.fun + + kevent/kevent.mlb + kqueue.sml + +(* epoll/epoll.mlb + epoll.sml +*) + socket.sml + end +in + signature STATE + signature THREAD + signature TIMEOUT + signature IOEVENT + signature SCHEDULER + + structure State + structure Thread + structure Timeout + structure IoEvent + structure Scheduler + + (* override basis definitions with ours -- we have hooks *) + structure Socket + structure GenericSock + structure INetSock + structure UnixSock + + open.sml +end Added: mltonlib/trunk/ca/terpstra/st/state.sig =================================================================== --- mltonlib/trunk/ca/terpstra/st/state.sig 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/state.sig 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,47 @@ +(* Attempts to classify states as 'level-triggered' or 'edge-triggered' + * will fail, as these terms make sense only at the intersection of states + * and blocking primitives. Both styles (and others) can be realized using + * the watch and value methods. + * + * A given state may only be watched once (1 time in 1 thread). + * If a second watch is attempted, the RaceCondition exception is raised. + *) +signature STATE = + sig + type ('val, 'diff) state + type 'diff signal = 'diff -> unit + + (* create a new state *) + val state: ''val -> (''val, ''val) state * ''val signal + val delta: ('val * 'diff -> 'val option) -> 'val -> + ('val, 'diff) state * 'diff signal + + (* get the current value of a state *) + val value: ('val, 'diff) state -> 'val + + (* hook a callback invoked when the state changes *) + exception RaceCondition + exception UnWatched + val dwatch: ('val * 'diff -> unit) -> ('val, 'diff) state -> unit + val swatch: ('val -> unit) -> ('val, 'diff) state -> unit + val release: ('val, 'diff) state -> unit + + (* map this state into a new derived state *) + val smap: ('val1 -> 'val2) -> + ('val1, 'val1) state -> ('val2, 'val2) state + val dmap: ('val1 -> 'val2) * + ('val1 * 'diff1 * 'val2 -> ('val2 * 'diff2) option) -> + ('val1, 'diff1) state -> ('val2, 'diff2) state + + (* compose two states into their product *) + datatype ('diff1, 'diff2) alt = DIFF1 of 'diff1 | DIFF2 of 'diff2 + val scompose: ('val1, 'val1) state * ('val2, 'val2) state -> + ('val1 * 'val2, 'val1 * 'val2) state + val dcompose: ('val1, 'diff1) state * ('val2, 'diff2) state -> + ('val1 * 'val2, ('diff1, 'diff2) alt) state + + (* If you want multiple watchers on the same state *) + type ('val, 'diff) broadcast + val broadcast: ('val, 'diff) state -> ('val, 'diff) broadcast + val clone: ('val, 'diff) broadcast -> ('val, 'diff) state + end Added: mltonlib/trunk/ca/terpstra/st/state.sml =================================================================== --- mltonlib/trunk/ca/terpstra/st/state.sml 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/state.sml 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,133 @@ +structure State :> STATE = + struct + type ('val, 'diff) state = { + value: unit -> 'val, + release: unit -> unit, + watch: ('val * 'diff -> unit) -> unit + } + type 'diff signal = 'diff -> unit + exception RaceCondition + exception UnWatched + + fun delta update init = + let + val state = ref init + val block = ref NONE + + fun value () = !state + fun release () = + case !block of + NONE => raise UnWatched + | SOME _ => block := NONE + fun watch f = + case !block of + NONE => block := SOME f + | SOME _ => raise RaceCondition + fun signal diff = + case update (!state, diff) of + NONE => () + | SOME newval => + case !block of + NONE => state := newval + | SOME f => (state := newval; f (newval, diff)) + in + ({ value = value, release = release, watch = watch }, signal) + end + fun state init = delta (fn (s, d) => if s = d then NONE else SOME d) init + + fun value { value, release=_, watch=_ } = value () + fun release { value=_, release, watch=_ } = release () + fun dwatch f { value=_, release=_, watch } = watch f + fun swatch f = dwatch (fn (x, _) => f x) + + fun dmap (valmap, diffmap) state = + let + val valproxy = ref NONE + val block = ref NONE + + fun proxy (val1, diff1) = + case diffmap (val1, diff1, valOf (!valproxy)) of + NONE => () + | SOME (newval2, diff2) => + case !block of + NONE => valproxy := SOME newval2 + | SOME f => (valproxy := SOME newval2; f (newval2, diff2)) + + val watch = fn f => + case !block of + NONE => (dwatch proxy state; (* first b/c it might raise *) + block := SOME f; + valproxy := SOME (valmap (value state))) + | SOME _ => raise RaceCondition + val value = fn () => + case !valproxy of + NONE => valmap (value state) + | SOME x => x + val release = fn () => + case !block of + NONE => raise UnWatched + | SOME _ => (release state; block := NONE; valproxy := NONE) + in + { value = value, release = release, watch = watch } + end + fun smap valmap = + dmap (valmap, fn (v, _, _) => let val v2 = valmap v in SOME (v2, v2) end) + + datatype ('diff1, 'diff2) alt = DIFF1 of 'diff1 | DIFF2 of 'diff2 + fun dcompose (state1, state2) = + let + val block = ref NONE + fun proxy1 (val1, diff1) = + (valOf (!block)) ((val1, value state2), DIFF1 diff1) + fun proxy2 (val2, diff2) = + (valOf (!block)) ((value state1, val2), DIFF2 diff2) + + val watch = fn f => + case !block of + NONE => ( + dwatch proxy1 state1; + (dwatch proxy2 state2 handle ex => (release state1; raise ex)); + block := SOME f) + | SOME _ => raise RaceCondition + val value = fn () => + (value state1, value state2) + val release = fn () => + case !block of + NONE => raise UnWatched + | SOME _ => (release state1; release state2; block := NONE) + in + { value = value, release = release, watch = watch } + end + + fun scompose (state1, state2) = + let + val block = ref NONE + fun proxy1 (val1, diff1) = + let val val2 = value state2 in + (valOf (!block)) ((val1, val2), (val1, val2)) end + fun proxy2 (val2, diff2) = + let val val1 = value state1 in + (valOf (!block)) ((val1, val2), (val1, val2)) end + + val watch = fn f => + case !block of + NONE => ( + dwatch proxy1 state1; + (dwatch proxy2 state2 handle ex => (release state1; raise ex)); + block := SOME f) + | SOME _ => raise RaceCondition + val value = fn () => + (value state1, value state2) + val release = fn () => + case !block of + NONE => raise UnWatched + | SOME _ => (release state1; release state2; block := NONE) + in + { value = value, release = release, watch = watch } + end + + (* !!! fixme *) + type ('val, 'diff) broadcast = ('val, 'diff) state + fun broadcast state = state + fun clone broadcaster = broadcaster + end Added: mltonlib/trunk/ca/terpstra/st/test.mlb =================================================================== --- mltonlib/trunk/ca/terpstra/st/test.mlb 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/test.mlb 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,6 @@ +local + $(SML_LIB)/basis/basis.mlb + st.mlb +in + test.sml +end Added: mltonlib/trunk/ca/terpstra/st/test.sml =================================================================== --- mltonlib/trunk/ca/terpstra/st/test.sml 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/test.sml 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,59 @@ +type port = (INetSock.inet, Socket.passive Socket.stream) Socket.sock + +(* There must be a better (faster!) way to convert a string to unsigned char *) +fun msg s = Word8VectorSlice.full (Word8Vector.tabulate + (String.size s, Word8.fromInt o Char.ord o (fn i => String.sub (s, i)))) +fun str v = CharVector.tabulate (Word8Vector.length v, + Char.chr o Word8.toInt o (fn i => Word8Vector.sub (v, i))) + +val delay = Time.fromSeconds 5 +val port : port = INetSock.TCP.socket () +val () = Socket.Ctl.setREUSEADDR (port, true) +val () = Socket.bind (port, INetSock.any 12467) +val () = Socket.listen (port, 100) + +val google = valOf (NetHostDB.getByName "www.google.de") +val ghttp = INetSock.toAddr (NetHostDB.addr google, 80) + +fun http () = + let + val s = INetSock.TCP.socket () + val () = print "connecting...\n" + val () = Socket.connect (s, ghttp) + val () = print "sending...\n" + val _ = Socket.sendVec (s, msg "GET / HTTP/1.1\nHost: www.google.de\n\n") + val () = print "reading...\n" + val got = Socket.recvVec (s, 4096) + val () = print "done!\n" + in + print ("response: " ^ str got ^ "\n") + end + +fun worker s () = + let + val _ = Socket.sendVec (s, msg "hello and welcome!\n"); + val got = Word8VectorSlice.full (Socket.recvVec (s, 400)) + in + if Word8VectorSlice.length got = 0 then Socket.close s else + (Socket.sendVec (s, got); worker s ()) + end + +fun welcome () = + let + val (s, _) = Socket.accept port + in + spawn (worker s); + welcome () + end + +fun beat () = ( + stopTill (TIMEOUT delay); + print "hello world\n"; + beat ()) + +val () = spawn welcome +val () = spawn beat +val () = spawn http +val () = spawn http + +val () = main () Added: mltonlib/trunk/ca/terpstra/st/thread.sig =================================================================== --- mltonlib/trunk/ca/terpstra/st/thread.sig 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/thread.sig 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,18 @@ +signature THREAD = + sig + (* start a new thread, which will be run later *) + val spawn: (unit -> unit) -> unit + val yield: 'a -> 'a (* release control for a tick *) + + val stopTill: (bool, 'a) State.state -> unit + val select: ((bool, 'b) State.state * 'a) list -> 'a list + end + +signature THREAD_EXTRA = + sig + include THREAD + + datatype loop = COMPLETE | PENDING + val run: unit -> loop (* process queue till completed or stopped *) + val stop: unit -> unit (* stop processing queue and return soon *) + end Added: mltonlib/trunk/ca/terpstra/st/thread.sml =================================================================== --- mltonlib/trunk/ca/terpstra/st/thread.sml 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/thread.sml 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,65 @@ +structure Thread_Extra :> THREAD_EXTRA = + struct + open MLton.Thread + open State + type thread = Runnable.t + + val ready : thread Queue.queue = Queue.new () + val loop : thread option ref = ref NONE + val quit : bool ref = ref false + + fun next () = + if Queue.empty ready orelse !quit then valOf (!loop) else + valOf (Queue.deque ready) + + fun spawn main = + Queue.enque (ready, prepare (new + (fn () => (main (); switch (fn _ => next ()))), ())) + + fun yield result = switch (fn thread => ( + Queue.enque (ready, prepare (thread, result)); + next ())) + + datatype loop = COMPLETE | PENDING + fun run () = ( + quit := false; + switch (fn thread => (loop := SOME (prepare (thread, ())); next ())); + case Queue.empty ready of + true => COMPLETE | false => PENDING) + + fun stop () = quit := true + + (* the while loop deals with the case that a state may have only + * temporarily become true (before switch), but is not true any longer. + *) + fun stopTill state = + while not (value state) do switch (fn thread => + let + fun resume _ = ( + release state; + Queue.enque (ready, prepare (thread, ()))) + in + swatch resume state; + next () + end) + + fun select events = + let + fun map (state, res) = if value state then SOME res else NONE + fun block thread = + let + fun resume _ = ( + List.app (fn (state, _) => release state) events; + Queue.enque (ready, prepare (thread, ()))) + in + List.app (fn (state, _) => swatch resume state) events; + next () + end + in + case List.mapPartial map events of + x :: r => x :: r + | [] => (switch block; select events) + end + end + +structure Thread :> THREAD = Thread_Extra Added: mltonlib/trunk/ca/terpstra/st/timeout.sig =================================================================== --- mltonlib/trunk/ca/terpstra/st/timeout.sig 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/timeout.sig 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,21 @@ +signature TIMEOUT = + sig + (* TIMEOUT is measured since the last IO poll, not the instant called *) + val TIMEOUT: Time.time -> (bool, bool) State.state + + (* LATERTHAN is an absolute time value *) + val LATERTHAN: Time.time -> (bool, bool) State.state + + (* What is the cached time as of last tick (fast) *) + val lastTick: unit -> Time.time + end + +signature TIMEOUT_EXTRA = + sig + include TIMEOUT + + (* The earliest pending timer (if any) *) + val getNext: unit -> Time.time option + (* Toggle all states to true prior to the given *) + val trigger: Time.time -> unit + end Added: mltonlib/trunk/ca/terpstra/st/timeout.sml =================================================================== --- mltonlib/trunk/ca/terpstra/st/timeout.sml 2006-12-15 14:53:49 UTC (rev 4981) +++ mltonlib/trunk/ca/terpstra/st/timeout.sml 2006-12-19 02:52:52 UTC (rev 4982) @@ -0,0 +1,46 @@ +(* !!! fixme: timers persist in the heap even if unreferenced. + * once MLton bug is fixed, use MLton.Weak and MLton.Finalizable + *) +structure Timeout_Extra :> TIMEOUT_EXTRA = + struct + open State + open Time + open Heap + + type sleeper = time * bool signal + fun nextSleeper ((t1, _), (t2, _)) = t1 < t2 + val sleeper = new nextSleeper + val rLastTick = ref (Time.now ()) + + fun lastTick () = !rLastTick + + fun LATERTHAN time = + let + val (state, signal) = state false + in + push (sleeper, (time, signal)); + state + end + + fun TIMEOUT time = LATERTHAN (time + lastTick ()) + + fun getNext () = + case peek sleeper of + NONE => NONE + | SOME (t, _) => SOME t + + fun trigger time = + let + fun loop () = + case peek sleeper of + NONE => () + | SOME (t, s) => + if time < t then () else + (pop sleeper; s true; loop ()) + in + rLastTick := time; + loop () + end + end + +structure Timeout :> TIMEOUT = Timeout_Extra |
|
From: Wesley T. <we...@ml...> - 2006-12-15 06:53:51
|
a tree for me ---------------------------------------------------------------------- A mltonlib/trunk/ca/terpstra/ ---------------------------------------------------------------------- |
|
From: Wesley T. <we...@ml...> - 2006-12-15 06:53:11
|
a tree for mee ---------------------------------------------------------------------- A mltonlib/trunk/ca/ ---------------------------------------------------------------------- |
|
From: Vesa K. <ve...@ml...> - 2006-12-14 22:09:25
|
To allow top-level and infixes to be evaluated in any order. ---------------------------------------------------------------------- U mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/top-level.sml ---------------------------------------------------------------------- Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/top-level.sml =================================================================== --- mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/top-level.sml 2006-12-15 00:12:28 UTC (rev 4978) +++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/top-level.sml 2006-12-15 06:09:24 UTC (rev 4979) @@ -45,6 +45,6 @@ (** ==== UnPr ==== *) -val andAlso = UnPr.andAlso +val op andAlso = UnPr.andAlso val negate = UnPr.negate -val orElse = UnPr.orElse +val op orElse = UnPr.orElse |
|
From: Matthew F. <fl...@ml...> - 2006-12-14 16:12:35
|
Update comment ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h 2006-12-14 20:40:20 UTC (rev 4977) +++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h 2006-12-15 00:12:28 UTC (rev 4978) @@ -80,7 +80,7 @@ * native word size. MLton's aggressive representation strategies may * pack multiple primitive values into the same native word. * Likewise, a primitive value may span multiple native words (e.g., - * Word64.word). + * Word64.word on an x86). */ #define GC_NORMAL_HEADER_SIZE GC_HEADER_SIZE |
|
From: Matthew F. <fl...@ml...> - 2006-12-14 12:41:03
|
Delete unused files
----------------------------------------------------------------------
D mlton/branches/on-20050822-x86_64-branch/mlton/backend/small-int-inf.fun
D mlton/branches/on-20050822-x86_64-branch/mlton/backend/small-int-inf.sig
----------------------------------------------------------------------
Deleted: mlton/branches/on-20050822-x86_64-branch/mlton/backend/small-int-inf.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/small-int-inf.fun 2006-12-14 20:39:54 UTC (rev 4976)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/small-int-inf.fun 2006-12-14 20:40:20 UTC (rev 4977)
@@ -1,74 +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.
- *)
-
-functor SmallIntInf(S: SMALL_INT_INF_STRUCTS): SMALL_INT_INF =
-struct
-
-open S
-
-type t = Word.t
-
-fun hash x = x
-
-val equals = op =
-
-fun toCstring w = "0x" ^ Word.toString w
-
-val layout = Layout.str o toCstring
-
-fun toMLstring w = Int.toString(Word.toIntX(Word.~>>(w, 0w1)))
-
-fun fromString (str: string): t option =
- if IntInf.<= (minSmall, v) andalso IntInf.<= (v, maxSmall)
- then let val w = Word.fromInt (IntInf.toInt v)
- val res = Word.orb (0w1, Word.<< (w, 0w1))
- in SOME res
- end
- else NONE
-
-(* val fromString =
- * Trace.trace("SmallIntInf.fromString",
- * String.layout,
- * Option.layout layout) fromString
- *)
-
-(*
- * If you want to compile MLton using an ML implementation which does not
- * have IntInf, then use the following instead. Note, in this case Overflow
- * MUST be raised.
- *
- * fun fromString (str: string): t option =
- * let val size = String.size str
- * fun reader offset =
- * if offset = size
- * then NONE
- * else SOME (String.sub (str, offset), offset + 1)
- * val start = if String.sub (str, 0) = #"~"
- * then 1
- * else 0
- * val base = if String.sub (str, start) = #"0"
- * then case reader (start + 1) of
- * SOME (#"x", next) => StringCvt.HEX
- * | _ => StringCvt.DEC
- * else StringCvt.DEC
- * in (case Pervasive.Int.scan base reader 0 of
- * SOME (resv, _) =>
- * let val resw = Word.fromInt resv
- * val res = Word.orb (0w1, Word.<< (resw, 0w1))
- * in if Word.toLargeIntX (Word.xorb (resw, res)) < 0
- * then NONE
- * else SOME res
- * end
- * | _ => Error.bug "SmallIntInf.fromString")
- * handle Overflow => NONE
- * end
- *)
-
-fun toWord x = x
-
-end
Deleted: mlton/branches/on-20050822-x86_64-branch/mlton/backend/small-int-inf.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/small-int-inf.sig 2006-12-14 20:39:54 UTC (rev 4976)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/small-int-inf.sig 2006-12-14 20:40:20 UTC (rev 4977)
@@ -1,22 +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.
- *)
-
-signature SMALL_INT_INF_STRUCTS =
- sig
- end
-
-signature SMALL_INT_INF =
- sig
- include SMALL_INT_INF_STRUCTS
-
- type t
-
- val toCstring: t -> string
- val toMLstring: t -> string
- val toWord: t -> Word.t
- end
|
|
From: Matthew F. <fl...@ml...> - 2006-12-14 12:39:55
|
Rename variable in function prototype to match function definition ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/gc/object-size.h ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object-size.h =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object-size.h 2006-12-14 18:46:07 UTC (rev 4975) +++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object-size.h 2006-12-14 20:39:54 UTC (rev 4976) @@ -9,7 +9,7 @@ #if (defined (MLTON_GC_INTERNAL_FUNCS)) static inline size_t sizeofArrayNoHeader (GC_state s, GC_arrayLength numElements, - uint16_t numNonObjptrs, uint16_t numObjptrs); + uint16_t bytesNonObjptrs, uint16_t numObjptrs); static inline size_t sizeofStackNoHeader (GC_state s, GC_stack stack); static inline size_t sizeofObject (GC_state s, pointer p); |
|
From: Stephen W. <sw...@ml...> - 2006-12-14 10:46:17
|
Added Word.{numBits,toInt,toIntX}.
Added SysWord structure.
----------------------------------------------------------------------
U mltonlib/trunk/com/sweeks/basic/unstable/EXPORT
U mltonlib/trunk/com/sweeks/basic/unstable/export.sig
U mltonlib/trunk/com/sweeks/basic/unstable/export.sml
U mltonlib/trunk/com/sweeks/basic/unstable/word.fun
U mltonlib/trunk/com/sweeks/basic/unstable/word.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/sweeks/basic/unstable/EXPORT
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/EXPORT 2006-12-14 18:39:58 UTC (rev 4974)
+++ mltonlib/trunk/com/sweeks/basic/unstable/EXPORT 2006-12-14 18:46:07 UTC (rev 4975)
@@ -219,6 +219,8 @@
structure SysError: SYS_ERROR
where type Exn.t = SysError.Exn.t
where type t = SysError.t
+structure SysWord: WORD
+ where type t = Word64.t
structure Time: TIME
where type t = Time.t
structure Unit:
@@ -1126,6 +1128,7 @@
val div: (?.t * ?.t) -> ?.t
val mod: (?.t * ?.t) -> ?.t
val notb: ?.t -> ?.t
+ val numBits: Int.t
val ofLarge: Word64.t -> ?.t
val ofString: string -> ?.t Option.t
val ofStringRadix: (string * Radix.t) -> ?.t Option.t
@@ -1133,6 +1136,8 @@
val scanner: Radix.t -> ?.t Scanner.t
val subArr: (Word8.t ArraySlice.base * Int.t * ?.Endian.t) -> ?.t
val subVec: (Word8.t VectorSlice.base * Int.t * ?.Endian.t) -> ?.t
+ val toInt: ?.t -> Int.t
+ val toIntX: ?.t -> Int.t
val toLarge: ?.t -> Word64.t
val toLargeX: ?.t -> Word64.t
val toString: ?.t -> string
@@ -2294,11 +2299,14 @@
val div: (?.t * ?.t) -> ?.t
val mod: (?.t * ?.t) -> ?.t
val notb: ?.t -> ?.t
+ val numBits: Int.t
val ofLarge: Word64.t -> ?.t
val ofString: string -> ?.t Option.t
val ofStringRadix: (string * Radix.t) -> ?.t Option.t
val orb: (?.t * ?.t) -> ?.t
val scanner: Radix.t -> ?.t Scanner.t
+ val toInt: ?.t -> Int.t
+ val toIntX: ?.t -> Int.t
val toLarge: ?.t -> Word64.t
val toLargeX: ?.t -> Word64.t
val toString: ?.t -> string
@@ -2324,12 +2332,15 @@
val div: (?.t * ?.t) -> ?.t
val mod: (?.t * ?.t) -> ?.t
val notb: ?.t -> ?.t
+ val numBits: Int.t
val ofLarge: Word64.t -> ?.t
val ofString: string -> ?.t Option.t
val ofStringRadix: (string * Radix.t) -> ?.t Option.t
val orb: (?.t * ?.t) -> ?.t
val scanner: Radix.t -> ?.t Scanner.t
val toChar: ?.t -> Char.t
+ val toInt: ?.t -> Int.t
+ val toIntX: ?.t -> Int.t
val toLarge: ?.t -> Word64.t
val toLargeX: ?.t -> Word64.t
val toString: ?.t -> string
Modified: mltonlib/trunk/com/sweeks/basic/unstable/export.sig
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/export.sig 2006-12-14 18:39:58 UTC (rev 4974)
+++ mltonlib/trunk/com/sweeks/basic/unstable/export.sig 2006-12-14 18:46:07 UTC (rev 4975)
@@ -46,6 +46,7 @@
structure String: STRING
structure Substring: SUBSTRING
structure SysError: SYS_ERROR
+ structure SysWord: WORD
structure Time: TIME
structure Unit: UNIT
structure Vector: VECTOR
Modified: mltonlib/trunk/com/sweeks/basic/unstable/export.sml
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/export.sml 2006-12-14 18:39:58 UTC (rev 4974)
+++ mltonlib/trunk/com/sweeks/basic/unstable/export.sml 2006-12-14 18:46:07 UTC (rev 4975)
@@ -39,6 +39,7 @@
where type ('a, 'b) String.unfold = ('a, 'b) String.unfold
where type ('a, 'b) String.unfoldR = ('a, 'b) String.unfoldR
where type Substring.t = Substring.t
+ where type SysWord.t = SysWord.t
where type Time.t = Time.t
where type Unit.t = Unit.t
where type 'a Vector.t = 'a Vector.t
@@ -95,6 +96,7 @@
structure String = String
structure Substring = Substring
structure SysError = SysError
+ structure SysWord = SysWord
structure Time = Time
structure Unit = Unit
structure Vector = Vector
Modified: mltonlib/trunk/com/sweeks/basic/unstable/word.fun
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/word.fun 2006-12-14 18:39:58 UTC (rev 4974)
+++ mltonlib/trunk/com/sweeks/basic/unstable/word.fun 2006-12-14 18:46:07 UTC (rev 4975)
@@ -9,6 +9,8 @@
type t = word
+ val numBits = wordSize
+
val == = op =
val compare = Order.ofBasis o compare
Modified: mltonlib/trunk/com/sweeks/basic/unstable/word.sig
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/word.sig 2006-12-14 18:39:58 UTC (rev 4974)
+++ mltonlib/trunk/com/sweeks/basic/unstable/word.sig 2006-12-14 18:46:07 UTC (rev 4975)
@@ -60,6 +60,10 @@
* i mod 0 raises Div.
* i = j * (i div j) + i mod j.
*)
+ val numBits: Int.t
+ (**
+ * The number of bits in a value of this word type.
+ *)
val notb: t -> t
(**
* notb w returns the "bitwise not" of w.
@@ -79,7 +83,16 @@
* orb (w1, w2) returns the "bitwise or" of w1 and w2.
*)
val scanner: Radix.t -> t Scanner.t
+ val toInt: t -> Int.t
(**
+ * toInt w converts w to an integer, where w is in [0, 2^numBits - 1]
+ *)
+ val toIntX: t -> Int.t
+ (**
+ * toIntX w converts w to an integer, where w is in
+ * [-2^(numBits-1), 2^(numBits-1) - 1]
+ *)
+ (**
* scanner r returns a scanner for words where characters are interepreted
* according to radix r.
*)
|
|
From: Stephen W. <sw...@ml...> - 2006-12-14 10:39:59
|
Fixed comment-style for copyright notice. ---------------------------------------------------------------------- U mltonlib/trunk/com/sweeks/basic/unstable/Makefile ---------------------------------------------------------------------- Modified: mltonlib/trunk/com/sweeks/basic/unstable/Makefile =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/Makefile 2006-12-13 20:36:56 UTC (rev 4973) +++ mltonlib/trunk/com/sweeks/basic/unstable/Makefile 2006-12-14 18:39:58 UTC (rev 4974) @@ -1,8 +1,8 @@ -(* Copyright (C) 2006 Stephen Weeks. - * - * This code is released under the MLton license, a BSD-style license. - * See the LICENSE file or http://mlton.org/License for details. - *) +# Copyright (C) 2006 Stephen Weeks. +# +# This code is released under the MLton license, a BSD-style license. +# See the LICENSE file or http://mlton.org/License for details. + EXPORT: $(shell mlton -stop f lib.mlb) mlton -show-basis EXPORT -stop tc lib.mlb |
|
From: Stephen W. <sw...@ml...> - 2006-12-13 12:37:10
|
Added copyright notice. ---------------------------------------------------------------------- U mltonlib/trunk/com/sweeks/basic/unstable/Makefile U mltonlib/trunk/com/sweeks/basic/unstable/array-slice.sig U mltonlib/trunk/com/sweeks/basic/unstable/array-slice.sml U mltonlib/trunk/com/sweeks/basic/unstable/array.0.sml U mltonlib/trunk/com/sweeks/basic/unstable/array.1.sml U mltonlib/trunk/com/sweeks/basic/unstable/array.sig U mltonlib/trunk/com/sweeks/basic/unstable/basis.sml U mltonlib/trunk/com/sweeks/basic/unstable/bit-flags.fun U mltonlib/trunk/com/sweeks/basic/unstable/bit-flags.sig U mltonlib/trunk/com/sweeks/basic/unstable/bool.sig U mltonlib/trunk/com/sweeks/basic/unstable/bool.sml U mltonlib/trunk/com/sweeks/basic/unstable/char.sig U mltonlib/trunk/com/sweeks/basic/unstable/char.sml U mltonlib/trunk/com/sweeks/basic/unstable/date.sig U mltonlib/trunk/com/sweeks/basic/unstable/date.sml U mltonlib/trunk/com/sweeks/basic/unstable/dir.sig U mltonlib/trunk/com/sweeks/basic/unstable/dir.sml U mltonlib/trunk/com/sweeks/basic/unstable/endian.sig U mltonlib/trunk/com/sweeks/basic/unstable/endian.sml U mltonlib/trunk/com/sweeks/basic/unstable/enumerable.fun U mltonlib/trunk/com/sweeks/basic/unstable/enumerable.sig U mltonlib/trunk/com/sweeks/basic/unstable/enumerate-get.fun U mltonlib/trunk/com/sweeks/basic/unstable/enumerate.sig U mltonlib/trunk/com/sweeks/basic/unstable/exn.sig U mltonlib/trunk/com/sweeks/basic/unstable/exn.sml U mltonlib/trunk/com/sweeks/basic/unstable/export.sig U mltonlib/trunk/com/sweeks/basic/unstable/export.sml U mltonlib/trunk/com/sweeks/basic/unstable/fields-and-tokens.fun U mltonlib/trunk/com/sweeks/basic/unstable/file.sig U mltonlib/trunk/com/sweeks/basic/unstable/file.sml U mltonlib/trunk/com/sweeks/basic/unstable/generic-array.sig U mltonlib/trunk/com/sweeks/basic/unstable/generic-slice.sig U mltonlib/trunk/com/sweeks/basic/unstable/generic-vector.sig U mltonlib/trunk/com/sweeks/basic/unstable/get.fun U mltonlib/trunk/com/sweeks/basic/unstable/get.sig U mltonlib/trunk/com/sweeks/basic/unstable/in.sig U mltonlib/trunk/com/sweeks/basic/unstable/in.sml U mltonlib/trunk/com/sweeks/basic/unstable/int-inf.sig U mltonlib/trunk/com/sweeks/basic/unstable/int-inf.sml U mltonlib/trunk/com/sweeks/basic/unstable/int.fun U mltonlib/trunk/com/sweeks/basic/unstable/int.sig U mltonlib/trunk/com/sweeks/basic/unstable/int.sml U mltonlib/trunk/com/sweeks/basic/unstable/io-desc.sig U mltonlib/trunk/com/sweeks/basic/unstable/io-desc.sml U mltonlib/trunk/com/sweeks/basic/unstable/lazy.sig U mltonlib/trunk/com/sweeks/basic/unstable/lazy.sml U mltonlib/trunk/com/sweeks/basic/unstable/lib.mlb U mltonlib/trunk/com/sweeks/basic/unstable/list.0.sml U mltonlib/trunk/com/sweeks/basic/unstable/list.1.sml U mltonlib/trunk/com/sweeks/basic/unstable/list.sig U mltonlib/trunk/com/sweeks/basic/unstable/mono-array.sig U mltonlib/trunk/com/sweeks/basic/unstable/mono-slice.sig U mltonlib/trunk/com/sweeks/basic/unstable/mono-vector-slice.sig U mltonlib/trunk/com/sweeks/basic/unstable/mono-vector.sig U mltonlib/trunk/com/sweeks/basic/unstable/net.sig U mltonlib/trunk/com/sweeks/basic/unstable/net.sml U mltonlib/trunk/com/sweeks/basic/unstable/open-export.sml U mltonlib/trunk/com/sweeks/basic/unstable/option.0.sml U mltonlib/trunk/com/sweeks/basic/unstable/option.1.sml U mltonlib/trunk/com/sweeks/basic/unstable/option.sig U mltonlib/trunk/com/sweeks/basic/unstable/order.sig U mltonlib/trunk/com/sweeks/basic/unstable/order.sml U mltonlib/trunk/com/sweeks/basic/unstable/ordered.sig U mltonlib/trunk/com/sweeks/basic/unstable/out.sig U mltonlib/trunk/com/sweeks/basic/unstable/out.sml U mltonlib/trunk/com/sweeks/basic/unstable/packable-real.fun U mltonlib/trunk/com/sweeks/basic/unstable/packable-real.sig U mltonlib/trunk/com/sweeks/basic/unstable/packable-word.fun U mltonlib/trunk/com/sweeks/basic/unstable/packable-word.sig U mltonlib/trunk/com/sweeks/basic/unstable/path.sig U mltonlib/trunk/com/sweeks/basic/unstable/path.sml U mltonlib/trunk/com/sweeks/basic/unstable/poll.sig U mltonlib/trunk/com/sweeks/basic/unstable/poll.sml U mltonlib/trunk/com/sweeks/basic/unstable/posix.sig U mltonlib/trunk/com/sweeks/basic/unstable/posix.sml U mltonlib/trunk/com/sweeks/basic/unstable/primitive.sml U mltonlib/trunk/com/sweeks/basic/unstable/process.sig U mltonlib/trunk/com/sweeks/basic/unstable/process.sml U mltonlib/trunk/com/sweeks/basic/unstable/radix.sig U mltonlib/trunk/com/sweeks/basic/unstable/radix.sml U mltonlib/trunk/com/sweeks/basic/unstable/ram-sequence.fun U mltonlib/trunk/com/sweeks/basic/unstable/real-structs.sml U mltonlib/trunk/com/sweeks/basic/unstable/real.fun U mltonlib/trunk/com/sweeks/basic/unstable/real.sig U mltonlib/trunk/com/sweeks/basic/unstable/real.sml U mltonlib/trunk/com/sweeks/basic/unstable/recur.fun U mltonlib/trunk/com/sweeks/basic/unstable/ref.sig U mltonlib/trunk/com/sweeks/basic/unstable/ref.sml U mltonlib/trunk/com/sweeks/basic/unstable/scanner.0.sml U mltonlib/trunk/com/sweeks/basic/unstable/scanner.1.sml U mltonlib/trunk/com/sweeks/basic/unstable/scanner.sig U mltonlib/trunk/com/sweeks/basic/unstable/seq.0.sml U mltonlib/trunk/com/sweeks/basic/unstable/seq.1.sml U mltonlib/trunk/com/sweeks/basic/unstable/seq.2.sml U mltonlib/trunk/com/sweeks/basic/unstable/seq.sig U mltonlib/trunk/com/sweeks/basic/unstable/sequence.sig U mltonlib/trunk/com/sweeks/basic/unstable/slice.fun U mltonlib/trunk/com/sweeks/basic/unstable/slice.sig U mltonlib/trunk/com/sweeks/basic/unstable/sliceable.sig U mltonlib/trunk/com/sweeks/basic/unstable/static-sum.sig U mltonlib/trunk/com/sweeks/basic/unstable/static-sum.sml U mltonlib/trunk/com/sweeks/basic/unstable/string.0.sml U mltonlib/trunk/com/sweeks/basic/unstable/string.1.sml U mltonlib/trunk/com/sweeks/basic/unstable/string.sig U mltonlib/trunk/com/sweeks/basic/unstable/substring.sig U mltonlib/trunk/com/sweeks/basic/unstable/substring.sml U mltonlib/trunk/com/sweeks/basic/unstable/subtypes.sml U mltonlib/trunk/com/sweeks/basic/unstable/sys-error.sig U mltonlib/trunk/com/sweeks/basic/unstable/sys-error.sml U mltonlib/trunk/com/sweeks/basic/unstable/thunk.sig U mltonlib/trunk/com/sweeks/basic/unstable/thunk.sml U mltonlib/trunk/com/sweeks/basic/unstable/time.sig U mltonlib/trunk/com/sweeks/basic/unstable/time.sml U mltonlib/trunk/com/sweeks/basic/unstable/unit.sig U mltonlib/trunk/com/sweeks/basic/unstable/unit.sml U mltonlib/trunk/com/sweeks/basic/unstable/util.sig U mltonlib/trunk/com/sweeks/basic/unstable/util.sml U mltonlib/trunk/com/sweeks/basic/unstable/vector-slice.sig U mltonlib/trunk/com/sweeks/basic/unstable/vector-slice.sml U mltonlib/trunk/com/sweeks/basic/unstable/vector.sig U mltonlib/trunk/com/sweeks/basic/unstable/vector.sml U mltonlib/trunk/com/sweeks/basic/unstable/word.fun U mltonlib/trunk/com/sweeks/basic/unstable/word.sig U mltonlib/trunk/com/sweeks/basic/unstable/word.sml U mltonlib/trunk/com/sweeks/basic/unstable/word8.sig ---------------------------------------------------------------------- Modified: mltonlib/trunk/com/sweeks/basic/unstable/Makefile =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/Makefile 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/Makefile 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) EXPORT: $(shell mlton -stop f lib.mlb) mlton -show-basis EXPORT -stop tc lib.mlb Modified: mltonlib/trunk/com/sweeks/basic/unstable/array-slice.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/array-slice.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/array-slice.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature ARRAY_SLICE = sig include SLICE Modified: mltonlib/trunk/com/sweeks/basic/unstable/array-slice.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/array-slice.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/array-slice.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure ArraySlice: ARRAY_SLICE = struct structure Slice = struct Modified: mltonlib/trunk/com/sweeks/basic/unstable/array.0.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/array.0.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/array.0.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Array = struct type 'a t = 'a Array.t Modified: mltonlib/trunk/com/sweeks/basic/unstable/array.1.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/array.1.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/array.1.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Array: ARRAY = struct open Array Modified: mltonlib/trunk/com/sweeks/basic/unstable/array.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/array.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/array.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature ARRAY = sig type 'a t Modified: mltonlib/trunk/com/sweeks/basic/unstable/basis.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/basis.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/basis.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Basis = struct structure Array = struct open Array type 'a t = 'a array end structure ArraySlice = ArraySlice Modified: mltonlib/trunk/com/sweeks/basic/unstable/bit-flags.fun =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/bit-flags.fun 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/bit-flags.fun 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) functor BitFlags (S: BASIS_BIT_FLAGS): BIT_FLAGS = struct open S Modified: mltonlib/trunk/com/sweeks/basic/unstable/bit-flags.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/bit-flags.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/bit-flags.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature BIT_FLAGS = sig type t Modified: mltonlib/trunk/com/sweeks/basic/unstable/bool.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/bool.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/bool.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature BOOL = sig datatype t = datatype Bool.t Modified: mltonlib/trunk/com/sweeks/basic/unstable/bool.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/bool.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/bool.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Bool: BOOL = struct datatype t = datatype Bool.t Modified: mltonlib/trunk/com/sweeks/basic/unstable/char.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/char.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/char.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Word8 = struct open Word8 type t = word Modified: mltonlib/trunk/com/sweeks/basic/unstable/char.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/char.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/char.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Char: CHAR where type t = Char.t = struct type t = Char.t Modified: mltonlib/trunk/com/sweeks/basic/unstable/date.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/date.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/date.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature DATE = sig structure Month: sig Modified: mltonlib/trunk/com/sweeks/basic/unstable/date.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/date.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/date.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Date: DATE = struct open Date Modified: mltonlib/trunk/com/sweeks/basic/unstable/dir.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/dir.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/dir.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature DIR = sig structure Stream: sig Modified: mltonlib/trunk/com/sweeks/basic/unstable/dir.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/dir.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/dir.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Dir: DIR = struct structure Stream = struct Modified: mltonlib/trunk/com/sweeks/basic/unstable/endian.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/endian.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/endian.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature ENDIAN = sig datatype t = Big | Little Modified: mltonlib/trunk/com/sweeks/basic/unstable/endian.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/endian.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/endian.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Endian: ENDIAN = struct datatype t = Big | Little Modified: mltonlib/trunk/com/sweeks/basic/unstable/enumerable.fun =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/enumerable.fun 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/enumerable.fun 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) functor Enumerable (S: ENUMERATE): ENUMERABLE = struct open S Modified: mltonlib/trunk/com/sweeks/basic/unstable/enumerable.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/enumerable.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/enumerable.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature ENUMERABLE = sig type 'a elem Modified: mltonlib/trunk/com/sweeks/basic/unstable/enumerate-get.fun =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/enumerate-get.fun 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/enumerate-get.fun 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) functor EnumerateGet (S: GET): ENUMERATE = struct open S Modified: mltonlib/trunk/com/sweeks/basic/unstable/enumerate.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/enumerate.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/enumerate.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature ENUMERATE = sig type 'a const type 'a elem Modified: mltonlib/trunk/com/sweeks/basic/unstable/exn.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/exn.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/exn.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature EXN = sig type t Modified: mltonlib/trunk/com/sweeks/basic/unstable/exn.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/exn.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/exn.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Exn: EXN = struct type t = Exn.t Modified: mltonlib/trunk/com/sweeks/basic/unstable/export.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/export.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/export.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature EXPORT = sig structure Array: ARRAY Modified: mltonlib/trunk/com/sweeks/basic/unstable/export.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/export.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/export.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Export:> EXPORT where type 'a Array.t = 'a Array.t Modified: mltonlib/trunk/com/sweeks/basic/unstable/fields-and-tokens.fun =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/fields-and-tokens.fun 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/fields-and-tokens.fun 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) functor FieldsAndTokens (S: sig Modified: mltonlib/trunk/com/sweeks/basic/unstable/file.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/file.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/file.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature FILE = sig structure AccessMode: sig Modified: mltonlib/trunk/com/sweeks/basic/unstable/file.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/file.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/file.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure File: FILE = struct type t = String.t Modified: mltonlib/trunk/com/sweeks/basic/unstable/generic-array.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/generic-array.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/generic-array.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature GENERIC_ARRAY = sig include SEQUENCE Modified: mltonlib/trunk/com/sweeks/basic/unstable/generic-slice.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/generic-slice.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/generic-slice.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature GENERIC_SLICE = sig type 'a base Modified: mltonlib/trunk/com/sweeks/basic/unstable/generic-vector.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/generic-vector.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/generic-vector.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature GENERIC_VECTOR = sig include SEQUENCE Modified: mltonlib/trunk/com/sweeks/basic/unstable/get.fun =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/get.fun 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/get.fun 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) functor Get (S: sig Modified: mltonlib/trunk/com/sweeks/basic/unstable/get.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/get.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/get.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature GET = sig type 'a elem type 'a t Modified: mltonlib/trunk/com/sweeks/basic/unstable/in.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/in.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/in.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature IN = sig type t Modified: mltonlib/trunk/com/sweeks/basic/unstable/in.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/in.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/in.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure In: IN = struct type t = TextIO.instream Modified: mltonlib/trunk/com/sweeks/basic/unstable/int-inf.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/int-inf.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/int-inf.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature INT_INF = sig include INT end Modified: mltonlib/trunk/com/sweeks/basic/unstable/int-inf.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/int-inf.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/int-inf.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure IntInf: INT_INF = struct open IntInf Modified: mltonlib/trunk/com/sweeks/basic/unstable/int.fun =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/int.fun 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/int.fun 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) functor Int (Int: sig include BASIS_INT Modified: mltonlib/trunk/com/sweeks/basic/unstable/int.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/int.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/int.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature INT = sig include ORDERED Modified: mltonlib/trunk/com/sweeks/basic/unstable/int.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/int.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/int.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) local open Basis in Modified: mltonlib/trunk/com/sweeks/basic/unstable/io-desc.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/io-desc.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/io-desc.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature IO_DESC = sig structure Kind: sig Modified: mltonlib/trunk/com/sweeks/basic/unstable/io-desc.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/io-desc.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/io-desc.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure IoDesc: IO_DESC = struct open OS.IO Modified: mltonlib/trunk/com/sweeks/basic/unstable/lazy.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/lazy.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/lazy.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature LAZY = sig val memo: 'a thunk -> 'a thunk Modified: mltonlib/trunk/com/sweeks/basic/unstable/lazy.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/lazy.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/lazy.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Lazy: LAZY = struct fun memo th = let Modified: mltonlib/trunk/com/sweeks/basic/unstable/lib.mlb =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/lib.mlb 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/lib.mlb 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) $(SML_LIB)/basis/infixes.mlb $(SML_LIB)/basis/equal.mlb $(SML_LIB)/basis/overloads.mlb Modified: mltonlib/trunk/com/sweeks/basic/unstable/list.0.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/list.0.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/list.0.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure List = struct datatype t = datatype List.t Modified: mltonlib/trunk/com/sweeks/basic/unstable/list.1.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/list.1.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/list.1.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure List: LIST = struct structure S = struct Modified: mltonlib/trunk/com/sweeks/basic/unstable/list.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/list.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/list.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature LIST = sig datatype t = datatype List.t Modified: mltonlib/trunk/com/sweeks/basic/unstable/mono-array.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/mono-array.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/mono-array.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature MONO_ARRAY = sig type t Modified: mltonlib/trunk/com/sweeks/basic/unstable/mono-slice.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/mono-slice.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/mono-slice.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature MONO_SLICE = sig type t Modified: mltonlib/trunk/com/sweeks/basic/unstable/mono-vector-slice.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/mono-vector-slice.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/mono-vector-slice.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature MONO_VECTOR_SLICE = sig include MONO_SLICE Modified: mltonlib/trunk/com/sweeks/basic/unstable/mono-vector.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/mono-vector.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/mono-vector.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature MONO_VECTOR = sig type t Modified: mltonlib/trunk/com/sweeks/basic/unstable/net.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/net.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/net.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature NET = sig structure Family: sig Modified: mltonlib/trunk/com/sweeks/basic/unstable/net.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/net.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/net.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Net: NET = struct fun convertList list () = Modified: mltonlib/trunk/com/sweeks/basic/unstable/open-export.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/open-export.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/open-export.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) open Export datatype z = datatype Bool.t Modified: mltonlib/trunk/com/sweeks/basic/unstable/option.0.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/option.0.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/option.0.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Option = struct datatype 'a t = None | Some of 'a Modified: mltonlib/trunk/com/sweeks/basic/unstable/option.1.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/option.1.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/option.1.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Option = struct open Option Modified: mltonlib/trunk/com/sweeks/basic/unstable/option.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/option.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/option.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature OPTION = sig datatype 'a t = Modified: mltonlib/trunk/com/sweeks/basic/unstable/order.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/order.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/order.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature ORDER = sig datatype t = Equal | Greater | Less Modified: mltonlib/trunk/com/sweeks/basic/unstable/order.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/order.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/order.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Order = struct datatype t = Equal | Greater | Less Modified: mltonlib/trunk/com/sweeks/basic/unstable/ordered.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/ordered.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/ordered.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature ORDERED = sig type t Modified: mltonlib/trunk/com/sweeks/basic/unstable/out.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/out.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/out.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature OUT = sig type t Modified: mltonlib/trunk/com/sweeks/basic/unstable/out.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/out.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/out.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Out: OUT = struct type t = TextIO.outstream Modified: mltonlib/trunk/com/sweeks/basic/unstable/packable-real.fun =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/packable-real.fun 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/packable-real.fun 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) functor PackableReal (structure PackBig: BASIS_PACK_REAL structure PackLittle: BASIS_PACK_REAL Modified: mltonlib/trunk/com/sweeks/basic/unstable/packable-real.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/packable-real.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/packable-real.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature PACKABLE_REAL = sig include REAL Modified: mltonlib/trunk/com/sweeks/basic/unstable/packable-word.fun =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/packable-word.fun 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/packable-word.fun 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) functor PackableWord (structure PackBig: BASIS_PACK_WORD structure PackLittle: BASIS_PACK_WORD structure Word: BASIS_WORD): PACKABLE_WORD = struct Modified: mltonlib/trunk/com/sweeks/basic/unstable/packable-word.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/packable-word.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/packable-word.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature PACKABLE_WORD = sig include WORD Modified: mltonlib/trunk/com/sweeks/basic/unstable/path.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/path.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/path.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature PATH = sig type t = String.t Modified: mltonlib/trunk/com/sweeks/basic/unstable/path.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/path.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/path.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Path: PATH = struct structure Arc = struct Modified: mltonlib/trunk/com/sweeks/basic/unstable/poll.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/poll.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/poll.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature POLL = sig structure Desc: sig Modified: mltonlib/trunk/com/sweeks/basic/unstable/poll.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/poll.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/poll.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Poll: POLL = struct open OS.IO Modified: mltonlib/trunk/com/sweeks/basic/unstable/posix.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/posix.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/posix.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature LIKE_SYSWORD = sig type t Modified: mltonlib/trunk/com/sweeks/basic/unstable/posix.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/posix.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/posix.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Posix: POSIX = struct open Posix open FileSys IO Process ProcEnv SysDB TTY Modified: mltonlib/trunk/com/sweeks/basic/unstable/primitive.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/primitive.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/primitive.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Primitive = struct structure Array = struct Modified: mltonlib/trunk/com/sweeks/basic/unstable/process.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/process.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/process.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature PROCESS = sig structure Status: sig Modified: mltonlib/trunk/com/sweeks/basic/unstable/process.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/process.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/process.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Process: PROCESS = struct structure Status = struct Modified: mltonlib/trunk/com/sweeks/basic/unstable/radix.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/radix.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/radix.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature RADIX = sig type t Modified: mltonlib/trunk/com/sweeks/basic/unstable/radix.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/radix.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/radix.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Radix: sig include RADIX Modified: mltonlib/trunk/com/sweeks/basic/unstable/ram-sequence.fun =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/ram-sequence.fun 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/ram-sequence.fun 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) functor RamSequence (S: sig type 'a t Modified: mltonlib/trunk/com/sweeks/basic/unstable/real-structs.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/real-structs.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/real-structs.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure RealStructs = struct structure Class = struct Modified: mltonlib/trunk/com/sweeks/basic/unstable/real.fun =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/real.fun 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/real.fun 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) functor Real (structure Real: BASIS_REAL): REAL = struct open Real RealStructs Modified: mltonlib/trunk/com/sweeks/basic/unstable/real.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/real.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/real.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature REAL = sig structure Format: sig Modified: mltonlib/trunk/com/sweeks/basic/unstable/real.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/real.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/real.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure LargeReal = Real (structure Real = LargeReal) structure Real = PackableReal (structure PackBig = PackRealBig structure PackLittle = PackRealLittle Modified: mltonlib/trunk/com/sweeks/basic/unstable/recur.fun =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/recur.fun 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/recur.fun 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) functor Recur (S: sig Modified: mltonlib/trunk/com/sweeks/basic/unstable/ref.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/ref.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/ref.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature REF = sig datatype t = datatype Ref.t Modified: mltonlib/trunk/com/sweeks/basic/unstable/ref.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/ref.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/ref.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Ref: REF = struct datatype t = datatype Ref.t Modified: mltonlib/trunk/com/sweeks/basic/unstable/scanner.0.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/scanner.0.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/scanner.0.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Scanner = struct datatype 'a t = T of Char.t Seq.t -> ('a * Char.t Seq.t) Option.t Modified: mltonlib/trunk/com/sweeks/basic/unstable/scanner.1.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/scanner.1.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/scanner.1.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Scanner = struct open Scanner Modified: mltonlib/trunk/com/sweeks/basic/unstable/scanner.sig =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/scanner.sig 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/scanner.sig 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) signature SCANNER = sig type 'a t Modified: mltonlib/trunk/com/sweeks/basic/unstable/seq.0.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/seq.0.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/seq.0.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Seq = struct local Modified: mltonlib/trunk/com/sweeks/basic/unstable/seq.1.sml =================================================================== --- mltonlib/trunk/com/sweeks/basic/unstable/seq.1.sml 2006-12-13 01:56:27 UTC (rev 4972) +++ mltonlib/trunk/com/sweeks/basic/unstable/seq.1.sml 2006-12-13 20:36:56 UTC (rev 4973) @@ -1,3 +1,8 @@ +(* Copyright (C) 2006 Stephen Weeks. + * + * This code is released under the MLton license, a BSD-style license. + * See the LICENSE file or http://mlton.org/License for details. + *) structure Seq = struct open Seq Modified: mltonlib/trunk/com/sweeks/basic/unst... [truncated message content] |
|
From: Stephen W. <sw...@ml...> - 2006-12-12 17:56:29
|
Avoided spurious "* unit" for Seq.unfold.
----------------------------------------------------------------------
U mltonlib/trunk/com/sweeks/basic/unstable/EXPORT
U mltonlib/trunk/com/sweeks/basic/unstable/enumerable.fun
U mltonlib/trunk/com/sweeks/basic/unstable/export.sml
U mltonlib/trunk/com/sweeks/basic/unstable/in.sml
U mltonlib/trunk/com/sweeks/basic/unstable/int.fun
U mltonlib/trunk/com/sweeks/basic/unstable/list.0.sml
U mltonlib/trunk/com/sweeks/basic/unstable/list.1.sml
U mltonlib/trunk/com/sweeks/basic/unstable/ram-sequence.fun
U mltonlib/trunk/com/sweeks/basic/unstable/seq.1.sml
U mltonlib/trunk/com/sweeks/basic/unstable/seq.2.sml
U mltonlib/trunk/com/sweeks/basic/unstable/sequence.sig
U mltonlib/trunk/com/sweeks/basic/unstable/string.0.sml
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/sweeks/basic/unstable/EXPORT
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/EXPORT 2006-12-13 01:50:35 UTC (rev 4971)
+++ mltonlib/trunk/com/sweeks/basic/unstable/EXPORT 2006-12-13 01:56:27 UTC (rev 4972)
@@ -26,8 +26,8 @@
structure Array: ARRAY
where type 'a elem = 'a
where type 'a t = 'a ArraySlice.base
- where type 'a unfold = 'a
- where type 'a unfoldR = 'a
+ where type ('a, 'b) unfold = 'a * 'b
+ where type ('a, 'b) unfoldR = 'a * 'b
structure ArraySlice: ARRAY_SLICE
where type 'a base = 'a ArraySlice.base
where type 'a elem = 'a
@@ -78,8 +78,8 @@
structure Lazy: LAZY
structure List: LIST
where type 'a elem = 'a
- where type 'a unfold = 'a
- where type 'a unfoldR = 'a
+ where type ('a, 'b) unfold = 'a * 'b
+ where type ('a, 'b) unfoldR = 'a * 'b
structure Net: NET
where type Family.inet = Net.Family.inet
where type 'a Family.t = 'a Net.Family.t
@@ -207,12 +207,12 @@
structure Seq: SEQ
where type 'a elem = 'a
where type 'a t = 'a Seq.t
- where type 'a unfold = unit
- where type 'a unfoldR = 'a
+ where type ('a, 'b) unfold = 'a
+ where type ('a, 'b) unfoldR = 'a * 'b
structure String: STRING
where type t = string
- where type 'a unfold = 'a
- where type 'a unfoldR = 'a
+ where type ('a, 'b) unfold = 'a * 'b
+ where type ('a, 'b) unfoldR = 'a * 'b
structure Substring: SUBSTRING
where type 'a base = 'a Substring.base
where type t = Char.t VectorSlice.t
@@ -228,8 +228,8 @@
structure Vector: VECTOR
where type 'a elem = 'a
where type 'a t = 'a VectorSlice.base
- where type 'a unfold = 'a
- where type 'a unfoldR = 'a
+ where type ('a, 'b) unfold = 'a * 'b
+ where type ('a, 'b) unfoldR = 'a * 'b
structure VectorSlice: VECTOR_SLICE
where type 'a base = 'a VectorSlice.base
where type 'a elem = 'a
@@ -249,8 +249,8 @@
type 'a elem = 'a ?.elem
type 'a t = 'a ?.t
type 'a t0 = 'a ?.t
- type 'a unfold = 'a ?.unfold
- type 'a unfoldR = 'a ?.unfoldR
+ type ('a, 'b) unfold = ('a, 'b) ?.unfold
+ type ('a, 'b) unfoldR = ('a, 'b) ?.unfoldR
val all: ('a ?.t * ('a ?.elem -> Bool.t)) -> Bool.t
val append: ('a ?.t * 'a ?.t) -> 'a ?.t
val concat: 'a ?.t Seq.t -> 'a ?.t
@@ -294,13 +294,13 @@
val toSeqR: 'a ?.t -> 'a ?.elem Seq.t
val tokens: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t Seq.t
val unfold: ('a * ('a -> ('b ?.elem * 'a) Option.t))
- -> ('b ?.t * 'a ?.unfold)
+ -> ('b ?.t, 'a) ?.unfold
val unfoldN: (Int.t * 'a * ((Int.t * 'a) -> ('b ?.elem * 'a) Option.t))
- -> ('b ?.t * 'a ?.unfold)
+ -> ('b ?.t, 'a) ?.unfold
val unfoldNR: (Int.t * 'a * ((Int.t * 'a) -> ('b ?.elem * 'a) Option.t))
- -> ('b ?.t * 'a ?.unfoldR)
+ -> ('b ?.t, 'a) ?.unfoldR
val unfoldR: ('a * ('a -> ('b ?.elem * 'a) Option.t))
- -> ('b ?.t * 'a ?.unfoldR)
+ -> ('b ?.t, 'a) ?.unfoldR
val update: ('a ?.t * Int.t * 'a) -> unit
val updates: ('a ?.t * Int.t * 'a Seq.t) -> unit
structure Unsafe:
@@ -594,8 +594,8 @@
type 'a elem = 'a ?.elem
datatype 'a t = nil | :: of 'a * 'a List.t
eqtype 'a t0 = 'a List.t
- type 'a unfold = 'a ?.unfold
- type 'a unfoldR = 'a ?.unfoldR
+ type ('a, 'b) unfold = ('a, 'b) ?.unfold
+ type ('a, 'b) unfoldR = ('a, 'b) ?.unfoldR
val all: ('a List.t * ('a ?.elem -> Bool.t)) -> Bool.t
val append: ('a List.t * 'a List.t) -> 'a List.t
val concat: 'a List.t Seq.t -> 'a List.t
@@ -639,13 +639,13 @@
val toSeqR: 'a List.t -> 'a ?.elem Seq.t
val tokens: ('a List.t * ('a ?.elem -> Bool.t)) -> 'a List.t Seq.t
val unfold: ('a * ('a -> ('b ?.elem * 'a) Option.t))
- -> ('b List.t * 'a ?.unfold)
+ -> ('b List.t, 'a) ?.unfold
val unfoldN: (Int.t * 'a * ((Int.t * 'a) -> ('b ?.elem * 'a) Option.t))
- -> ('b List.t * 'a ?.unfold)
+ -> ('b List.t, 'a) ?.unfold
val unfoldNR: (Int.t * 'a * ((Int.t * 'a) -> ('b ?.elem * 'a) Option.t))
- -> ('b List.t * 'a ?.unfoldR)
+ -> ('b List.t, 'a) ?.unfoldR
val unfoldR: ('a * ('a -> ('b ?.elem * 'a) Option.t))
- -> ('b List.t * 'a ?.unfoldR)
+ -> ('b List.t, 'a) ?.unfoldR
end
signature NET =
sig
@@ -1972,8 +1972,8 @@
type 'a elem = 'a ?.elem
type 'a t = 'a ?.t
type 'a t0 = 'a ?.t
- type 'a unfold = 'a ?.unfold
- type 'a unfoldR = 'a ?.unfoldR
+ type ('a, 'b) unfold = ('a, 'b) ?.unfold
+ type ('a, 'b) unfoldR = ('a, 'b) ?.unfoldR
val all: ('a ?.t * ('a ?.elem -> Bool.t)) -> Bool.t
val append: ('a ?.t * 'a ?.t) -> 'a ?.t
val concat: 'a ?.t Seq.t -> 'a ?.t
@@ -2018,21 +2018,21 @@
val toSeqR: 'a ?.t -> 'a ?.elem Seq.t
val tokens: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t Seq.t
val unfold: ('a * ('a -> ('b ?.elem * 'a) Option.t))
- -> ('b ?.t * 'a ?.unfold)
+ -> ('b ?.t, 'a) ?.unfold
val unfoldN: (Int.t * 'a * ((Int.t * 'a) -> ('b ?.elem * 'a) Option.t))
- -> ('b ?.t * 'a ?.unfold)
+ -> ('b ?.t, 'a) ?.unfold
val unfoldNR: (Int.t * 'a * ((Int.t * 'a) -> ('b ?.elem * 'a) Option.t))
- -> ('b ?.t * 'a ?.unfoldR)
+ -> ('b ?.t, 'a) ?.unfoldR
val unfoldR: ('a * ('a -> ('b ?.elem * 'a) Option.t))
- -> ('b ?.t * 'a ?.unfoldR)
+ -> ('b ?.t, 'a) ?.unfoldR
end
signature STRING =
sig
eqtype 'a elem = Char.t
type t = ?.t
type 'a t0 = ?.t
- type 'a unfold = 'a ?.unfold
- type 'a unfoldR = 'a ?.unfoldR
+ type ('a, 'b) unfold = ('a, 'b) ?.unfold
+ type ('a, 'b) unfoldR = ('a, 'b) ?.unfoldR
val all: (?.t * (Char.t -> Bool.t)) -> Bool.t
val append: (?.t * ?.t) -> ?.t
val concat: ?.t Seq.t -> ?.t
@@ -2080,12 +2080,12 @@
val toUpper: ?.t -> ?.t
val toWord8Vector: ?.t -> Word8.t VectorSlice.base
val tokens: (?.t * (Char.t -> Bool.t)) -> ?.t Seq.t
- val unfold: ('a * ('a -> (Char.t * 'a) Option.t)) -> (?.t * 'a ?.unfold)
+ val unfold: ('a * ('a -> (Char.t * 'a) Option.t)) -> (?.t, 'a) ?.unfold
val unfoldN: (Int.t * 'a * ((Int.t * 'a) -> (Char.t * 'a) Option.t))
- -> (?.t * 'a ?.unfold)
+ -> (?.t, 'a) ?.unfold
val unfoldNR: (Int.t * 'a * ((Int.t * 'a) -> (Char.t * 'a) Option.t))
- -> (?.t * 'a ?.unfoldR)
- val unfoldR: ('a * ('a -> (Char.t * 'a) Option.t)) -> (?.t * 'a ?.unfoldR)
+ -> (?.t, 'a) ?.unfoldR
+ val unfoldR: ('a * ('a -> (Char.t * 'a) Option.t)) -> (?.t, 'a) ?.unfoldR
structure Unsafe:
sig
val sub: (?.t * Int.t) -> Char.t
@@ -2177,8 +2177,8 @@
type 'a elem = 'a ?.elem
type 'a t = 'a ?.t
type 'a t0 = 'a ?.t
- type 'a unfold = 'a ?.unfold
- type 'a unfoldR = 'a ?.unfoldR
+ type ('a, 'b) unfold = ('a, 'b) ?.unfold
+ type ('a, 'b) unfoldR = ('a, 'b) ?.unfoldR
val all: ('a ?.t * ('a ?.elem -> Bool.t)) -> Bool.t
val append: ('a ?.t * 'a ?.t) -> 'a ?.t
val concat: 'a ?.t Seq.t -> 'a ?.t
@@ -2225,13 +2225,13 @@
val toSeqR: 'a ?.t -> 'a ?.elem Seq.t
val tokens: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t Seq.t
val unfold: ('a * ('a -> ('b ?.elem * 'a) Option.t))
- -> ('b ?.t * 'a ?.unfold)
+ -> ('b ?.t, 'a) ?.unfold
val unfoldN: (Int.t * 'a * ((Int.t * 'a) -> ('b ?.elem * 'a) Option.t))
- -> ('b ?.t * 'a ?.unfold)
+ -> ('b ?.t, 'a) ?.unfold
val unfoldNR: (Int.t * 'a * ((Int.t * 'a) -> ('b ?.elem * 'a) Option.t))
- -> ('b ?.t * 'a ?.unfoldR)
+ -> ('b ?.t, 'a) ?.unfoldR
val unfoldR: ('a * ('a -> ('b ?.elem * 'a) Option.t))
- -> ('b ?.t * 'a ?.unfoldR)
+ -> ('b ?.t, 'a) ?.unfoldR
structure Unsafe:
sig
val sub: ('a ?.t * Int.t) -> 'a ?.elem
Modified: mltonlib/trunk/com/sweeks/basic/unstable/enumerable.fun
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/enumerable.fun 2006-12-13 01:50:35 UTC (rev 4971)
+++ mltonlib/trunk/com/sweeks/basic/unstable/enumerable.fun 2006-12-13 01:56:27 UTC (rev 4972)
@@ -22,7 +22,7 @@
fun toSeq e = let
val (c, s) = start e
in
- #1 (Seq.unfold (s, fn s => next (c, s)))
+ Seq.unfold (s, fn s => next (c, s))
end
end
Modified: mltonlib/trunk/com/sweeks/basic/unstable/export.sml
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/export.sml 2006-12-13 01:50:35 UTC (rev 4971)
+++ mltonlib/trunk/com/sweeks/basic/unstable/export.sml 2006-12-13 01:56:27 UTC (rev 4972)
@@ -2,8 +2,8 @@
EXPORT
where type 'a Array.t = 'a Array.t
where type 'a Array.elem = 'a Array.elem
- where type 'a Array.unfold = 'a Array.unfold
- where type 'a Array.unfoldR = 'a Array.unfoldR
+ where type ('a, 'b) Array.unfold = ('a, 'b) Array.unfold
+ where type ('a, 'b) Array.unfoldR = ('a, 'b) Array.unfoldR
where type 'a ArraySlice.elem = 'a ArraySlice.elem
where type Char.t = Char.t
where type In.t = In.t
@@ -17,8 +17,8 @@
where type LargeReal.t = LargeReal.t
where type LargeWord.t = LargeWord.t
where type 'a List.elem = 'a List.elem
- where type 'a List.unfold = 'a List.unfold
- where type 'a List.unfoldR = 'a List.unfoldR
+ where type ('a, 'b) List.unfold = ('a, 'b) List.unfold
+ where type ('a, 'b) List.unfoldR = ('a, 'b) List.unfoldR
where type 'a Option.t = 'a Option.t
where type Out.t = Out.t
where type Radix.t = Radix.t
@@ -28,18 +28,18 @@
where type 'a Scanner.t = 'a Scanner.t
where type 'a Seq.t = 'a Seq.t
where type 'a Seq.elem = 'a Seq.elem
- where type 'a Seq.unfold = 'a Seq.unfold
- where type 'a Seq.unfoldR = 'a Seq.unfoldR
+ where type ('a, 'b) Seq.unfold = ('a, 'b) Seq.unfold
+ where type ('a, 'b) Seq.unfoldR = ('a, 'b) Seq.unfoldR
where type String.t = String.t
- where type 'a String.unfold = 'a String.unfold
- where type 'a String.unfoldR = 'a String.unfoldR
+ where type ('a, 'b) String.unfold = ('a, 'b) String.unfold
+ where type ('a, 'b) String.unfoldR = ('a, 'b) String.unfoldR
where type Substring.t = Substring.t
where type Time.t = Time.t
where type Unit.t = Unit.t
where type 'a Vector.t = 'a Vector.t
where type 'a Vector.elem = 'a Vector.elem
- where type 'a Vector.unfold = 'a Vector.unfold
- where type 'a Vector.unfoldR = 'a Vector.unfoldR
+ where type ('a, 'b) Vector.unfold = ('a, 'b) Vector.unfold
+ where type ('a, 'b) Vector.unfoldR = ('a, 'b) Vector.unfoldR
where type 'a VectorSlice.t = 'a VectorSlice.t
where type 'a VectorSlice.elem = 'a VectorSlice.elem
where type Word.t = Word.t
Modified: mltonlib/trunk/com/sweeks/basic/unstable/in.sml
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/in.sml 2006-12-13 01:50:35 UTC (rev 4971)
+++ mltonlib/trunk/com/sweeks/basic/unstable/in.sml 2006-12-13 01:56:27 UTC (rev 4972)
@@ -13,6 +13,6 @@
end
fun lines ins =
- #1 (Seq.unfold ((), fn () => Option.map (getLine ins, fn s => (s, ()))))
+ Seq.unfold ((), fn () => Option.map (getLine ins, fn s => (s, ())))
end
Modified: mltonlib/trunk/com/sweeks/basic/unstable/int.fun
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/int.fun 2006-12-13 01:50:35 UTC (rev 4971)
+++ mltonlib/trunk/com/sweeks/basic/unstable/int.fun 2006-12-13 01:56:27 UTC (rev 4972)
@@ -32,21 +32,21 @@
val toWord = Basis.Word.fromLargeInt o Int.toLarge
fun fromToBy (start, stop, by) =
- #1 (Seq.unfold
- (start,
- if by > zero then
- (fn i => if i >= stop then None else Some (i, i + by))
- else if by < zero then
- (fn i => let
- val i = i + by
- in
- if i < stop then
- None
- else
- Some (i, i)
- end)
- else
- die "Int.fromToBy 0"))
+ Seq.unfold
+ (start,
+ if by > zero then
+ (fn i => if i >= stop then None else Some (i, i + by))
+ else if by < zero then
+ (fn i => let
+ val i = i + by
+ in
+ if i < stop then
+ None
+ else
+ Some (i, i)
+ end)
+ else
+ die "Int.fromToBy 0")
fun fromTo (start, stop) = fromToBy (start, stop, one)
Modified: mltonlib/trunk/com/sweeks/basic/unstable/list.0.sml
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/list.0.sml 2006-12-13 01:50:35 UTC (rev 4971)
+++ mltonlib/trunk/com/sweeks/basic/unstable/list.0.sml 2006-12-13 01:56:27 UTC (rev 4972)
@@ -13,6 +13,6 @@
fun reverse l = fold (l, [], op ::)
- fun toSeq l = #1 (Seq.unfold (l, fn [] => None | x :: l => Some (x, l)))
+ fun toSeq l = Seq.unfold (l, fn [] => None | x :: l => Some (x, l))
end
Modified: mltonlib/trunk/com/sweeks/basic/unstable/list.1.sml
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/list.1.sml 2006-12-13 01:50:35 UTC (rev 4971)
+++ mltonlib/trunk/com/sweeks/basic/unstable/list.1.sml 2006-12-13 01:56:27 UTC (rev 4972)
@@ -39,9 +39,9 @@
fun single x = [x]
- type 'a unfold = 'a
+ type ('a, 'b) unfold = 'a * 'b
- type 'a unfoldR = 'a
+ type ('a, 'b) unfoldR = 'a * 'b
fun unfoldNR (n, b, f) =
Util.recur
Modified: mltonlib/trunk/com/sweeks/basic/unstable/ram-sequence.fun
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/ram-sequence.fun 2006-12-13 01:50:35 UTC (rev 4971)
+++ mltonlib/trunk/com/sweeks/basic/unstable/ram-sequence.fun 2006-12-13 01:56:27 UTC (rev 4972)
@@ -61,9 +61,10 @@
fun ofSeq s = ofSeqN (s, Seq.size s)
- type 'a unfold = 'a
- type 'a unfoldR = 'a
+ type ('a, 'b) unfold = 'a * 'b
+ type ('a, 'b) unfoldR = 'a * 'b
+
local
fun make fold (n, b, f) = let
val a = Array.Unsafe.make n
Modified: mltonlib/trunk/com/sweeks/basic/unstable/seq.1.sml
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/seq.1.sml 2006-12-13 01:50:35 UTC (rev 4971)
+++ mltonlib/trunk/com/sweeks/basic/unstable/seq.1.sml 2006-12-13 01:56:27 UTC (rev 4972)
@@ -3,13 +3,12 @@
open Seq
fun unfold (b, f) =
- (Util.recur
- (b, fn (b, loop) =>
- delay (fn () =>
- case f b of
- None => empty ()
- | Some (a, b) => cons (a, loop b))),
- ())
+ Util.recur
+ (b, fn (b, loop) =>
+ delay (fn () =>
+ case f b of
+ None => empty ()
+ | Some (a, b) => cons (a, loop b)))
fun unfoldN (n, b, f) =
unfold
Modified: mltonlib/trunk/com/sweeks/basic/unstable/seq.2.sml
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/seq.2.sml 2006-12-13 01:50:35 UTC (rev 4971)
+++ mltonlib/trunk/com/sweeks/basic/unstable/seq.2.sml 2006-12-13 01:56:27 UTC (rev 4972)
@@ -22,9 +22,9 @@
fun single x = cons (x, empty ())
- type 'a unfold = Unit.t
+ type ('a, 'b) unfold = 'a
- type 'a unfoldR = 'a
+ type ('a, 'b) unfoldR = 'a * 'b
fun unfoldR (b, f) =
Util.recur ((b, empty ()), fn ((b, ac), loop) =>
@@ -45,7 +45,7 @@
| Some (a, b) => loop (i, b, cons (a, ac))
end)
- fun ofList l = #1 (unfold (l, fn [] => None | x :: l => Some (x, l)))
+ fun ofList l = unfold (l, fn [] => None | x :: l => Some (x, l))
fun ofListR l =
Util.recur
@@ -59,20 +59,20 @@
val toSeqR = reverse
fun tabulate (n, f) =
- #1 (unfold (0, fn i => if i = n then None else Some (f i, i + 1)))
+ unfold (0, fn i => if i = n then None else Some (f i, i + 1))
fun map (s, f) =
- #1 (unfold (s, fn s => Option.map (get s, fn (x, s) => (f x, s))))
+ unfold (s, fn s => Option.map (get s, fn (x, s) => (f x, s)))
fun drop (s, f) =
- #1 (unfold
- (s, fn s =>
- Util.recur
- (s, fn (s, loop) =>
- case get s of
- None => None
- | Some (x, s) => if f x then loop s else Some (x, s))))
-
+ unfold
+ (s, fn s =>
+ Util.recur
+ (s, fn (s, loop) =>
+ case get s of
+ None => None
+ | Some (x, s) => if f x then loop s else Some (x, s)))
+
fun keep (s, f) = drop (s, not o f)
fun append (s, s') =
@@ -100,23 +100,23 @@
fun join (vs, sep) = concat (separate (vs, sep))
fun keepPrefix (s, f) =
- #1 (unfold (s, fn s =>
- case get s of
- None => None
- | Some (x, s) => if f x then Some (x, s) else None))
+ unfold (s, fn s =>
+ case get s of
+ None => None
+ | Some (x, s) => if f x then Some (x, s) else None)
fun keepPrefixN (s, n) =
if n < 0 then
die "takeN"
else
- #1 (unfold ((s, n), fn (s, n) =>
- if n = 0 then
- None
- else
- case get s of
- None => die "takeN"
- | Some (x, s) => Some (x, (s, n - 1))))
-
+ unfold ((s, n), fn (s, n) =>
+ if n = 0 then
+ None
+ else
+ case get s of
+ None => die "takeN"
+ | Some (x, s) => Some (x, (s, n - 1)))
+
fun keepSuffix (s, f) = reverse (keepPrefix (reverse s, f))
fun keepSuffixN (s, n) = dropPrefixN (s, size s - n)
Modified: mltonlib/trunk/com/sweeks/basic/unstable/sequence.sig
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/sequence.sig 2006-12-13 01:50:35 UTC (rev 4971)
+++ mltonlib/trunk/com/sweeks/basic/unstable/sequence.sig 2006-12-13 01:56:27 UTC (rev 4972)
@@ -2,8 +2,8 @@
include SLICEABLE
- type 'a unfold
- type 'a unfoldR
+ type ('a, 'b) unfold
+ type ('a, 'b) unfoldR
(**
* Used for the return state of a call to unfold{,R}.
* Lazy constructions define this as Unit.t.
@@ -75,23 +75,24 @@
* tabulate (n, f) returns the sequence [f 0, f 1, ..., f (n-1)].
* It may compute the elements in any order.
*)
- val unfold: 'b * ('b -> ('a elem * 'b) Option.t) -> 'a t0 * 'b unfold
+ val unfold: 'b * ('b -> ('a elem * 'b) Option.t) -> ('a t0, 'b) unfold
(**
* unfold (b0, f) = [a0, a1, ...] where f bi = Some (ai, bi+1)
*)
val unfoldN:
- Int.t * 'b * (Int.t * 'b -> ('a elem * 'b) Option.t) -> 'a t0 * 'b unfold
+ Int.t * 'b * (Int.t * 'b -> ('a elem * 'b) Option.t) -> ('a t0, 'b) unfold
(**
* unfoldN (n, b0, f) = [a0, a1, ..., an-1]
* where f (i, bi) = Some (ai, bi+1)
*)
val unfoldNR:
- Int.t * 'b * (Int.t * 'b -> ('a elem * 'b) Option.t) -> 'a t0 * 'b unfoldR
+ Int.t * 'b * (Int.t * 'b -> ('a elem * 'b) Option.t)
+ -> ('a t0, 'b) unfoldR
(**
* unfoldNR (n, b0, f) = [an-1, ..., a1, a0]
* where f (n - 1 - i, bi) = Some (ai, bi+1)
*)
- val unfoldR: 'b * ('b -> ('a elem * 'b) Option.t) -> 'a t0 * 'b unfoldR
+ val unfoldR: 'b * ('b -> ('a elem * 'b) Option.t) -> ('a t0, 'b) unfoldR
(**
* unfoldR (b0, f) = [an-1, ..., a1, a0] where f bi = Some (ai, bi+1) and
* f bn = None.
Modified: mltonlib/trunk/com/sweeks/basic/unstable/string.0.sml
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/string.0.sml 2006-12-13 01:50:35 UTC (rev 4971)
+++ mltonlib/trunk/com/sweeks/basic/unstable/string.0.sml 2006-12-13 01:56:27 UTC (rev 4972)
@@ -3,10 +3,10 @@
open String
fun toSeq s =
- #1 (Seq.unfold (0, fn i =>
- if i = size s then
- None
- else
- Some (String.sub (s, i), i + 1)))
+ Seq.unfold (0, fn i =>
+ if i = size s then
+ None
+ else
+ Some (String.sub (s, i), i + 1))
end
|
|
From: Stephen W. <sw...@ml...> - 2006-12-12 17:50:37
|
Made scanner type abstract.
----------------------------------------------------------------------
U mltonlib/trunk/com/sweeks/basic/unstable/EXPORT
U mltonlib/trunk/com/sweeks/basic/unstable/date.sig
U mltonlib/trunk/com/sweeks/basic/unstable/export.sml
U mltonlib/trunk/com/sweeks/basic/unstable/scanner.0.sml
U mltonlib/trunk/com/sweeks/basic/unstable/scanner.1.sml
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/sweeks/basic/unstable/EXPORT
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/EXPORT 2006-12-11 04:56:50 UTC (rev 4970)
+++ mltonlib/trunk/com/sweeks/basic/unstable/EXPORT 2006-12-13 01:50:35 UTC (rev 4971)
@@ -408,7 +408,7 @@
val ofTimeLocal: Time.t -> ?.t
val ofTimeUniv: Time.t -> ?.t
val offset: ?.t -> Time.t Option.t
- val scanner: Char.t Seq.t -> (?.t * Char.t Seq.t) Option.t
+ val scanner: ?.t Scanner.t
val second: ?.t -> Int.t
val toString: ?.t -> string
val toTime: ?.t -> Time.t
@@ -533,7 +533,7 @@
val ofStringRadix: (string * Radix.t) -> ?.t Option.t
val quot: (?.t * ?.t) -> ?.t
val rem: (?.t * ?.t) -> ?.t
- val scanner: Radix.t -> (Char.t Seq.t -> (?.t * Char.t Seq.t) Option.t)
+ val scanner: Radix.t -> ?.t Scanner.t
val toString: ?.t -> string
val toStringRadix: (?.t * Radix.t) -> string
val toWord: ?.t -> Word.t
@@ -562,7 +562,7 @@
val ofStringRadix: (string * Radix.t) -> ?.t Option.t
val quot: (?.t * ?.t) -> ?.t
val rem: (?.t * ?.t) -> ?.t
- val scanner: Radix.t -> (Char.t Seq.t -> (?.t * Char.t Seq.t) Option.t)
+ val scanner: Radix.t -> ?.t Scanner.t
val toString: ?.t -> string
val toStringRadix: (?.t * Radix.t) -> string
val toWord: ?.t -> Word.t
@@ -679,8 +679,7 @@
type t = ?.Host.Address.t
val == : (?.Host.Address.t * ?.Host.Address.t) -> Bool.t
val ofString: string -> ?.Host.Address.t Option.t
- val scanner: Char.t Seq.t
- -> (?.Host.Address.t * Char.t Seq.t) Option.t
+ val scanner: ?.Host.Address.t Scanner.t
val toString: ?.Host.Address.t -> string
end
end
@@ -1039,7 +1038,7 @@
val rem: (?.t * ?.t) -> ?.t
val round: ?.t -> Int.t
val sameSign: (?.t * ?.t) -> Bool.t
- val scanner: Char.t Seq.t -> (?.t * Char.t Seq.t) Option.t
+ val scanner: ?.t Scanner.t
val sign: ?.t -> Int.t
val signBit: ?.t -> Bool.t
val sin: ?.t -> ?.t
@@ -1080,12 +1079,10 @@
digits: Int.t List.t,
exp: Int.t,
sign: Bool.t} Option.t
- val scanner: Char.t Seq.t
- -> ({class: ?.Class.t,
- digits: Int.t List.t,
- exp: Int.t,
- sign: Bool.t}
- * Char.t Seq.t) Option.t
+ val scanner: {class: ?.Class.t,
+ digits: Int.t List.t,
+ exp: Int.t,
+ sign: Bool.t} Scanner.t
val toString: {class: ?.Class.t,
digits: Int.t List.t,
exp: Int.t,
@@ -1133,7 +1130,7 @@
val ofString: string -> ?.t Option.t
val ofStringRadix: (string * Radix.t) -> ?.t Option.t
val orb: (?.t * ?.t) -> ?.t
- val scanner: Radix.t -> (Char.t Seq.t -> (?.t * Char.t Seq.t) Option.t)
+ val scanner: Radix.t -> ?.t Scanner.t
val subArr: (Word8.t ArraySlice.base * Int.t * ?.Endian.t) -> ?.t
val subVec: (Word8.t VectorSlice.base * Int.t * ?.Endian.t) -> ?.t
val toLarge: ?.t -> Word64.t
@@ -1891,7 +1888,7 @@
val rem: (?.t * ?.t) -> ?.t
val round: ?.t -> Int.t
val sameSign: (?.t * ?.t) -> Bool.t
- val scanner: Char.t Seq.t -> (?.t * Char.t Seq.t) Option.t
+ val scanner: ?.t Scanner.t
val sign: ?.t -> Int.t
val signBit: ?.t -> Bool.t
val sin: ?.t -> ?.t
@@ -1928,12 +1925,10 @@
digits: Int.t List.t,
exp: Int.t,
sign: Bool.t} Option.t
- val scanner: Char.t Seq.t
- -> ({class: ?.Class.t,
- digits: Int.t List.t,
- exp: Int.t,
- sign: Bool.t}
- * Char.t Seq.t) Option.t
+ val scanner: {class: ?.Class.t,
+ digits: Int.t List.t,
+ exp: Int.t,
+ sign: Bool.t} Scanner.t
val toString: {class: ?.Class.t,
digits: Int.t List.t,
exp: Int.t,
@@ -2168,7 +2163,7 @@
val ofNanoseconds: IntInf.t -> ?.t
val ofSeconds: IntInf.t -> ?.t
val ofString: string -> ?.t Option.t
- val scanner: Char.t Seq.t -> (?.t * Char.t Seq.t) Option.t
+ val scanner: ?.t Scanner.t
val toMicroseconds: ?.t -> IntInf.t
val toMilliseconds: ?.t -> IntInf.t
val toNanoseconds: ?.t -> IntInf.t
@@ -2303,7 +2298,7 @@
val ofString: string -> ?.t Option.t
val ofStringRadix: (string * Radix.t) -> ?.t Option.t
val orb: (?.t * ?.t) -> ?.t
- val scanner: Radix.t -> (Char.t Seq.t -> (?.t * Char.t Seq.t) Option.t)
+ val scanner: Radix.t -> ?.t Scanner.t
val toLarge: ?.t -> Word64.t
val toLargeX: ?.t -> Word64.t
val toString: ?.t -> string
@@ -2333,7 +2328,7 @@
val ofString: string -> ?.t Option.t
val ofStringRadix: (string * Radix.t) -> ?.t Option.t
val orb: (?.t * ?.t) -> ?.t
- val scanner: Radix.t -> (Char.t Seq.t -> (?.t * Char.t Seq.t) Option.t)
+ val scanner: Radix.t -> ?.t Scanner.t
val toChar: ?.t -> Char.t
val toLarge: ?.t -> Word64.t
val toLargeX: ?.t -> Word64.t
Modified: mltonlib/trunk/com/sweeks/basic/unstable/date.sig
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/date.sig 2006-12-11 04:56:50 UTC (rev 4970)
+++ mltonlib/trunk/com/sweeks/basic/unstable/date.sig 2006-12-13 01:50:35 UTC (rev 4971)
@@ -53,7 +53,7 @@
*)
val ofTimeLocal: Time.t -> t
val ofTimeUniv: Time.t -> t
- val scanner: Char.t Seq.t -> (t * Char.t Seq.t) Option.t
+ val scanner: t Scanner.t
val second: t -> Int.t
val toString: t -> String.t
val toTime: t -> Time.t
Modified: mltonlib/trunk/com/sweeks/basic/unstable/export.sml
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/export.sml 2006-12-11 04:56:50 UTC (rev 4970)
+++ mltonlib/trunk/com/sweeks/basic/unstable/export.sml 2006-12-13 01:50:35 UTC (rev 4971)
@@ -25,6 +25,7 @@
where type Real.t = Real.t
where type Real32.t = Real32.t
where type Real64.t = Real64.t
+ where type 'a Scanner.t = 'a Scanner.t
where type 'a Seq.t = 'a Seq.t
where type 'a Seq.elem = 'a Seq.elem
where type 'a Seq.unfold = 'a Seq.unfold
Modified: mltonlib/trunk/com/sweeks/basic/unstable/scanner.0.sml
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/scanner.0.sml 2006-12-11 04:56:50 UTC (rev 4970)
+++ mltonlib/trunk/com/sweeks/basic/unstable/scanner.0.sml 2006-12-13 01:50:35 UTC (rev 4971)
@@ -1,9 +1,9 @@
structure Scanner = struct
- type 'a t = Char.t Seq.t -> ('a * Char.t Seq.t) Option.t
+ datatype 'a t = T of Char.t Seq.t -> ('a * Char.t Seq.t) Option.t
- val make = id
+ val make = T
- fun scan (s, cs) = s cs
+ fun scan (T s, cs) = s cs
end
Modified: mltonlib/trunk/com/sweeks/basic/unstable/scanner.1.sml
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/scanner.1.sml 2006-12-11 04:56:50 UTC (rev 4970)
+++ mltonlib/trunk/com/sweeks/basic/unstable/scanner.1.sml 2006-12-13 01:50:35 UTC (rev 4971)
@@ -2,7 +2,8 @@
open Scanner
- fun map (s, f) cs = Option.map (s cs, fn (x, cs) => (f x, cs))
+ fun map (s, f) =
+ make (fn cs => Option.map (scan (s, cs), fn (x, cs) => (f x, cs)))
fun scanString (s, str) =
case scan (s, String.toSeq str) of
@@ -13,7 +14,8 @@
else
None
- fun ofBasis b s = Option.ofBasis (b (Option.toBasis o Seq.get) s)
+ fun ofBasis b =
+ make (fn s => Option.ofBasis (b (Option.toBasis o Seq.get) s))
end
|
|
From: Stephen W. <sw...@ml...> - 2006-12-10 20:56:59
|
Eliminated top-level type abbreviations.
----------------------------------------------------------------------
U mltonlib/trunk/com/sweeks/basic/unstable/EXPORT
U mltonlib/trunk/com/sweeks/basic/unstable/array.0.sml
U mltonlib/trunk/com/sweeks/basic/unstable/basis.sml
U mltonlib/trunk/com/sweeks/basic/unstable/bit-flags.sig
U mltonlib/trunk/com/sweeks/basic/unstable/bool.sig
U mltonlib/trunk/com/sweeks/basic/unstable/bool.sml
U mltonlib/trunk/com/sweeks/basic/unstable/char.sig
U mltonlib/trunk/com/sweeks/basic/unstable/char.sml
U mltonlib/trunk/com/sweeks/basic/unstable/date.sig
U mltonlib/trunk/com/sweeks/basic/unstable/dir.sig
U mltonlib/trunk/com/sweeks/basic/unstable/dir.sml
U mltonlib/trunk/com/sweeks/basic/unstable/enumerable.sig
U mltonlib/trunk/com/sweeks/basic/unstable/enumerate-get.fun
U mltonlib/trunk/com/sweeks/basic/unstable/enumerate.sig
U mltonlib/trunk/com/sweeks/basic/unstable/exn.sig
U mltonlib/trunk/com/sweeks/basic/unstable/exn.sml
U mltonlib/trunk/com/sweeks/basic/unstable/export.sig
U mltonlib/trunk/com/sweeks/basic/unstable/export.sml
U mltonlib/trunk/com/sweeks/basic/unstable/fields-and-tokens.fun
U mltonlib/trunk/com/sweeks/basic/unstable/file.sig
U mltonlib/trunk/com/sweeks/basic/unstable/file.sml
U mltonlib/trunk/com/sweeks/basic/unstable/generic-array.sig
U mltonlib/trunk/com/sweeks/basic/unstable/generic-slice.sig
U mltonlib/trunk/com/sweeks/basic/unstable/generic-vector.sig
U mltonlib/trunk/com/sweeks/basic/unstable/get.fun
U mltonlib/trunk/com/sweeks/basic/unstable/get.sig
U mltonlib/trunk/com/sweeks/basic/unstable/in.sig
U mltonlib/trunk/com/sweeks/basic/unstable/int.sig
U mltonlib/trunk/com/sweeks/basic/unstable/io-desc.sig
U mltonlib/trunk/com/sweeks/basic/unstable/lib.mlb
U mltonlib/trunk/com/sweeks/basic/unstable/list.0.sml
U mltonlib/trunk/com/sweeks/basic/unstable/list.1.sml
U mltonlib/trunk/com/sweeks/basic/unstable/list.sig
U mltonlib/trunk/com/sweeks/basic/unstable/net.sig
U mltonlib/trunk/com/sweeks/basic/unstable/net.sml
U mltonlib/trunk/com/sweeks/basic/unstable/open-export.sml
U mltonlib/trunk/com/sweeks/basic/unstable/option.0.sml
U mltonlib/trunk/com/sweeks/basic/unstable/option.sig
U mltonlib/trunk/com/sweeks/basic/unstable/order.sml
U mltonlib/trunk/com/sweeks/basic/unstable/ordered.sig
U mltonlib/trunk/com/sweeks/basic/unstable/out.sig
U mltonlib/trunk/com/sweeks/basic/unstable/packable-real.sig
U mltonlib/trunk/com/sweeks/basic/unstable/packable-word.sig
U mltonlib/trunk/com/sweeks/basic/unstable/path.sig
U mltonlib/trunk/com/sweeks/basic/unstable/path.sml
U mltonlib/trunk/com/sweeks/basic/unstable/poll.sig
U mltonlib/trunk/com/sweeks/basic/unstable/posix.sig
U mltonlib/trunk/com/sweeks/basic/unstable/process.sig
U mltonlib/trunk/com/sweeks/basic/unstable/radix.sig
U mltonlib/trunk/com/sweeks/basic/unstable/ram-sequence.fun
U mltonlib/trunk/com/sweeks/basic/unstable/real-structs.sml
U mltonlib/trunk/com/sweeks/basic/unstable/real.sig
U mltonlib/trunk/com/sweeks/basic/unstable/ref.sig
U mltonlib/trunk/com/sweeks/basic/unstable/ref.sml
U mltonlib/trunk/com/sweeks/basic/unstable/scanner.0.sml
U mltonlib/trunk/com/sweeks/basic/unstable/scanner.sig
U mltonlib/trunk/com/sweeks/basic/unstable/seq.0.sml
U mltonlib/trunk/com/sweeks/basic/unstable/seq.2.sml
U mltonlib/trunk/com/sweeks/basic/unstable/seq.sig
U mltonlib/trunk/com/sweeks/basic/unstable/sequence.sig
U mltonlib/trunk/com/sweeks/basic/unstable/slice.fun
U mltonlib/trunk/com/sweeks/basic/unstable/sliceable.sig
U mltonlib/trunk/com/sweeks/basic/unstable/static-sum.sig
U mltonlib/trunk/com/sweeks/basic/unstable/static-sum.sml
U mltonlib/trunk/com/sweeks/basic/unstable/string.1.sml
U mltonlib/trunk/com/sweeks/basic/unstable/string.sig
U mltonlib/trunk/com/sweeks/basic/unstable/substring.sig
U mltonlib/trunk/com/sweeks/basic/unstable/substring.sml
U mltonlib/trunk/com/sweeks/basic/unstable/sys-error.sig
U mltonlib/trunk/com/sweeks/basic/unstable/sys-error.sml
U mltonlib/trunk/com/sweeks/basic/unstable/thunk.sig
U mltonlib/trunk/com/sweeks/basic/unstable/thunk.sml
U mltonlib/trunk/com/sweeks/basic/unstable/time.sig
A mltonlib/trunk/com/sweeks/basic/unstable/unit.sig
A mltonlib/trunk/com/sweeks/basic/unstable/unit.sml
U mltonlib/trunk/com/sweeks/basic/unstable/util.sig
U mltonlib/trunk/com/sweeks/basic/unstable/vector.sml
U mltonlib/trunk/com/sweeks/basic/unstable/word.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/sweeks/basic/unstable/EXPORT
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/EXPORT 2006-12-11 03:36:48 UTC (rev 4969)
+++ mltonlib/trunk/com/sweeks/basic/unstable/EXPORT 2006-12-11 04:56:50 UTC (rev 4970)
@@ -1,40 +1,27 @@
-type 'a array = 'a array
-datatype bool = false | true
-eqtype char = char
-type exn = exn
-eqtype int = int
-datatype 'a list = nil | :: of 'a * 'a list
-datatype 'a option = None | Some of 'a
-datatype order = Equal | Greater | Less
-type 'a seq = 'a seq
-eqtype string = string
-type 'a thunk = unit -> 'a
-eqtype unit = unit
-eqtype 'a vector = 'a vector
-eqtype word = word
+eqtype z = unit
val * : ('a * 'a) -> 'a
val + : ('a * 'a) -> 'a
val - : ('a * 'a) -> 'a
val / : ('a * 'a) -> 'a
-val < : ('a * 'a) -> bool
-val <= : ('a * 'a) -> bool
-val <> : ('a * 'a) -> bool
-val = : ('a * 'a) -> bool
-val > : ('a * 'a) -> bool
-val >= : ('a * 'a) -> bool
-val @ : ('a list * 'a list) -> 'a list
+val < : ('a * 'a) -> Bool.t
+val <= : ('a * 'a) -> Bool.t
+val <> : ('a * 'a) -> Bool.t
+val = : ('a * 'a) -> Bool.t
+val > : ('a * 'a) -> Bool.t
+val >= : ('a * 'a) -> Bool.t
+val @ : ('a List.t * 'a List.t) -> 'a List.t
val abs: 'a -> 'a
-val concat: string seq -> string
+val concat: string Seq.t -> string
val die: string -> 'a
val div: ('a * 'a) -> 'a
val finally: ((unit -> 'a) * (unit -> unit)) -> 'a
val ignore: 'a -> unit
val lazy: (unit -> 'a) -> (unit -> 'a)
val mod: ('a * 'a) -> 'a
-val not: bool -> bool
+val not: Bool.t -> Bool.t
val o: (('a -> 'b) * ('c -> 'a)) -> ('c -> 'b)
val print: string -> unit
-val valOf: 'a option -> 'a
+val valOf: 'a Option.t -> 'a
val ~ : 'a -> 'a
structure Array: ARRAY
where type 'a elem = 'a
@@ -47,7 +34,7 @@
where type 'a t = 'a ArraySlice.t
structure Bool: BOOL
structure Char: CHAR
- where type t = char
+ where type t = Char.t
structure CommandLine: COMMAND_LINE
structure Date: DATE
where type Month.t = Date.Month.t
@@ -58,34 +45,34 @@
structure Endian: ENDIAN
where type t = Endian.t
structure Exn: EXN
- where type t = exn
+ where type t = Exn.t
structure File: FILE
where type AccessMode.t = File.AccessMode.t
where type Id.t = File.Id.t
structure In: IN
where type t = In.t
structure Int: INT
- where type t = int
+ where type t = Int.t
structure Int16: INT
where type t = Int16.t
structure Int32: INT
- where type t = int
+ where type t = Int.t
structure Int64: INT
where type t = Int64.t
structure Int8: INT
where type t = Int8.t
structure IntInf: INT_INF
- where type t = LargeInt.t
+ where type t = IntInf.t
structure IoDesc: IO_DESC
where type Kind.t = IoDesc.Kind.t
where type t = IoDesc.t
structure LargeInt: INT
- where type t = LargeInt.t
+ where type t = IntInf.t
structure LargeReal: REAL
where type Class.t = LargeReal.Class.t
where type Format.t = LargeReal.Format.t
where type RoundingMode.t = LargeReal.RoundingMode.t
- where type t = Real64.t
+ where type t = Real.t
structure LargeWord: WORD
where type t = Word64.t
structure Lazy: LAZY
@@ -105,9 +92,9 @@
where type 'a Socket.Address.t = 'a Net.Socket.Address.t
where type ('a, 'b, 'c) Socket.Block.t = ('a, 'b, 'c) Net.Socket.Block.t
where type Socket.Desc.t = Net.Socket.Desc.t
- where type Socket.Option.ro = Net.Socket.Option.ro
- where type Socket.Option.rw = Net.Socket.Option.rw
- where type ('a, 'b, 'c, 'd) Socket.Option.t = ('a, 'b, 'c, 'd) Net.Socket.Option.t
+ where type Socket.Opt.ro = Net.Socket.Opt.ro
+ where type Socket.Opt.rw = Net.Socket.Opt.rw
+ where type ('a, 'b, 'c, 'd) Socket.Opt.t = ('a, 'b, 'c, 'd) Net.Socket.Opt.t
where type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i) Socket.Receive.Block.t = ('a,
'b,
'c,
@@ -148,7 +135,7 @@
where type Socket.Type.unknown = Net.Socket.Type.unknown
where type ('a, 'b) Socket.sock = ('a, 'b) Net.Socket.sock
structure Option: OPTION
- where type 'a t = 'a option
+ where type 'a t = 'a Option.t
structure Order: ORDER
where type t = Order.t
structure Out: OUT
@@ -203,7 +190,7 @@
where type Class.t = Real.Class.t
where type Format.t = Real.Format.t
where type RoundingMode.t = Real.RoundingMode.t
- where type t = Real64.t
+ where type t = Real.t
structure Real32: PACKABLE_REAL
where type Class.t = Real32.Class.t
where type Format.t = Real32.Format.t
@@ -213,13 +200,13 @@
where type Class.t = Real64.Class.t
where type Format.t = Real64.Format.t
where type RoundingMode.t = Real64.RoundingMode.t
- where type t = Real64.t
+ where type t = Real.t
structure Ref: REF
structure Scanner: SCANNER
where type 'a t = 'a Scanner.t
structure Seq: SEQ
where type 'a elem = 'a
- where type 'a t = 'a seq
+ where type 'a t = 'a Seq.t
where type 'a unfold = unit
where type 'a unfoldR = 'a
structure String: STRING
@@ -228,27 +215,31 @@
where type 'a unfoldR = 'a
structure Substring: SUBSTRING
where type 'a base = 'a Substring.base
- where type t = char VectorSlice.t
+ where type t = Char.t VectorSlice.t
structure SysError: SYS_ERROR
where type Exn.t = SysError.Exn.t
where type t = SysError.t
structure Time: TIME
where type t = Time.t
+structure Unit:
+ sig
+ eqtype t = unit
+ end
structure Vector: VECTOR
where type 'a elem = 'a
- where type 'a t = 'a vector
+ where type 'a t = 'a VectorSlice.base
where type 'a unfold = 'a
where type 'a unfoldR = 'a
structure VectorSlice: VECTOR_SLICE
- where type 'a base = 'a vector
+ where type 'a base = 'a VectorSlice.base
where type 'a elem = 'a
where type 'a t = 'a VectorSlice.t
structure Word: WORD
- where type t = word
+ where type t = Word.t
structure Word16: WORD
where type t = Word16.t
structure Word32: PACKABLE_WORD
- where type t = word
+ where type t = Word.t
structure Word64: WORD
where type t = Word64.t
structure Word8: WORD8
@@ -260,33 +251,33 @@
type 'a t0 = 'a ?.t
type 'a unfold = 'a ?.unfold
type 'a unfoldR = 'a ?.unfoldR
- val all: ('a ?.t * ('a ?.elem -> bool)) -> bool
+ val all: ('a ?.t * ('a ?.elem -> Bool.t)) -> Bool.t
val append: ('a ?.t * 'a ?.t) -> 'a ?.t
- val concat: 'a ?.t seq -> 'a ?.t
+ val concat: 'a ?.t Seq.t -> 'a ?.t
val cons: ('a ?.elem * 'a ?.t) -> 'a ?.t
- val drop: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val dropPrefix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val dropPrefixN: ('a ?.t * int) -> 'a ?.t
- val dropSuffix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val dropSuffixN: ('a ?.t * int) -> 'a ?.t
+ val drop: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t
+ val dropPrefix: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t
+ val dropPrefixN: ('a ?.t * Int.t) -> 'a ?.t
+ val dropSuffix: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t
+ val dropSuffixN: ('a ?.t * Int.t) -> 'a ?.t
val empty: unit -> 'a ?.t
- val exists: ('a ?.t * ('a ?.elem -> bool)) -> bool
- val fields: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t seq
- val find: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.elem option
+ val exists: ('a ?.t * ('a ?.elem -> Bool.t)) -> Bool.t
+ val fields: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t Seq.t
+ val find: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.elem Option.t
val fold: ('a ?.t * 'b * (('a ?.elem * 'b) -> 'b)) -> 'b
val for: ('a ?.t * ('a ?.elem -> unit)) -> unit
- val isEmpty: 'a ?.t -> bool
- val join: ('a ?.t seq * 'a ?.t) -> 'a ?.t
- val keep: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val keepPrefix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val keepPrefixN: ('a ?.t * int) -> 'a ?.t
- val keepSuffix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val keepSuffixN: ('a ?.t * int) -> 'a ?.t
+ val isEmpty: 'a ?.t -> Bool.t
+ val join: ('a ?.t Seq.t * 'a ?.t) -> 'a ?.t
+ val keep: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t
+ val keepPrefix: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t
+ val keepPrefixN: ('a ?.t * Int.t) -> 'a ?.t
+ val keepSuffix: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t
+ val keepSuffixN: ('a ?.t * Int.t) -> 'a ?.t
val last: 'a ?.t -> 'a ?.elem
- val make: (int * 'a) -> 'a ?.t
+ val make: (Int.t * 'a) -> 'a ?.t
val map: ('a ?.t * ('a ?.elem -> 'b ?.elem)) -> 'b ?.t
- val ofSeq: 'a ?.elem seq -> 'a ?.t
- val ofSeqN: ('a ?.elem seq * int) -> 'a ?.t
+ val ofSeq: 'a ?.elem Seq.t -> 'a ?.t
+ val ofSeqN: ('a ?.elem Seq.t * Int.t) -> 'a ?.t
val recur: ('a ?.t
* 'b
* ('b -> 'c)
@@ -295,28 +286,28 @@
val reverse: 'a ?.t -> 'a ?.t
val separate: ('a ?.t * 'a ?.elem) -> 'a ?.t
val single: 'a ?.elem -> 'a ?.t
- val size: 'a ?.t -> int
- val splitPrefix: ('a ?.t * ('a ?.elem -> bool)) -> ('a ?.t * 'a ?.t)
- val sub: ('a ?.t * int) -> 'a ?.elem
- val tabulate: (int * (int -> 'a ?.elem)) -> 'a ?.t
- val toSeq: 'a ?.t -> 'a ?.elem seq
- val toSeqR: 'a ?.t -> 'a ?.elem seq
- val tokens: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t seq
- val unfold: ('a * ('a -> ('b ?.elem * 'a) option))
+ val size: 'a ?.t -> Int.t
+ val splitPrefix: ('a ?.t * ('a ?.elem -> Bool.t)) -> ('a ?.t * 'a ?.t)
+ val sub: ('a ?.t * Int.t) -> 'a ?.elem
+ val tabulate: (Int.t * (Int.t -> 'a ?.elem)) -> 'a ?.t
+ val toSeq: 'a ?.t -> 'a ?.elem Seq.t
+ val toSeqR: 'a ?.t -> 'a ?.elem Seq.t
+ val tokens: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t Seq.t
+ val unfold: ('a * ('a -> ('b ?.elem * 'a) Option.t))
-> ('b ?.t * 'a ?.unfold)
- val unfoldN: (int * 'a * ((int * 'a) -> ('b ?.elem * 'a) option))
+ val unfoldN: (Int.t * 'a * ((Int.t * 'a) -> ('b ?.elem * 'a) Option.t))
-> ('b ?.t * 'a ?.unfold)
- val unfoldNR: (int * 'a * ((int * 'a) -> ('b ?.elem * 'a) option))
+ val unfoldNR: (Int.t * 'a * ((Int.t * 'a) -> ('b ?.elem * 'a) Option.t))
-> ('b ?.t * 'a ?.unfoldR)
- val unfoldR: ('a * ('a -> ('b ?.elem * 'a) option))
+ val unfoldR: ('a * ('a -> ('b ?.elem * 'a) Option.t))
-> ('b ?.t * 'a ?.unfoldR)
- val update: ('a ?.t * int * 'a) -> unit
- val updates: ('a ?.t * int * 'a seq) -> unit
+ val update: ('a ?.t * Int.t * 'a) -> unit
+ val updates: ('a ?.t * Int.t * 'a Seq.t) -> unit
structure Unsafe:
sig
- val make: int -> 'a ?.t
- val sub: ('a ?.t * int) -> 'a
- val update: ('a ?.t * int * 'a) -> unit
+ val make: Int.t -> 'a ?.t
+ val sub: ('a ?.t * Int.t) -> 'a
+ val update: ('a ?.t * Int.t * 'a) -> unit
end
end
signature ARRAY_SLICE =
@@ -325,24 +316,24 @@
type 'a elem = 'a ?.elem
type 'a t = 'a ?.t
type 'a t0 = 'a ?.t
- val all: ('a ?.t * ('a ?.elem -> bool)) -> bool
- val base: 'a ?.t -> ('a ?.base * {start: int})
- val dropPrefix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val dropPrefixN: ('a ?.t * int) -> 'a ?.t
- val dropSuffix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val dropSuffixN: ('a ?.t * int) -> 'a ?.t
- val exists: ('a ?.t * ('a ?.elem -> bool)) -> bool
- val fields: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t seq
- val find: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.elem option
+ val all: ('a ?.t * ('a ?.elem -> Bool.t)) -> Bool.t
+ val base: 'a ?.t -> ('a ?.base * {start: Int.t})
+ val dropPrefix: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t
+ val dropPrefixN: ('a ?.t * Int.t) -> 'a ?.t
+ val dropSuffix: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t
+ val dropSuffixN: ('a ?.t * Int.t) -> 'a ?.t
+ val exists: ('a ?.t * ('a ?.elem -> Bool.t)) -> Bool.t
+ val fields: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t Seq.t
+ val find: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.elem Option.t
val fold: ('a ?.t * 'b * (('a ?.elem * 'b) -> 'b)) -> 'b
val for: ('a ?.t * ('a ?.elem -> unit)) -> unit
val full: 'a ?.base -> 'a ?.t
- val get: 'a ?.t -> ('a ?.elem * 'a ?.t) option
- val isEmpty: 'a ?.t -> bool
- val keepPrefix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val keepPrefixN: ('a ?.t * int) -> 'a ?.t
- val keepSuffix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val keepSuffixN: ('a ?.t * int) -> 'a ?.t
+ val get: 'a ?.t -> ('a ?.elem * 'a ?.t) Option.t
+ val isEmpty: 'a ?.t -> Bool.t
+ val keepPrefix: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t
+ val keepPrefixN: ('a ?.t * Int.t) -> 'a ?.t
+ val keepSuffix: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t
+ val keepSuffixN: ('a ?.t * Int.t) -> 'a ?.t
val last: 'a ?.t -> 'a ?.elem
val map: ('a ?.t * ('a ?.elem -> 'b ?.elem)) -> 'b ?.base
val recur: ('a ?.t
@@ -350,80 +341,80 @@
* ('b -> 'c)
* (('a ?.elem * 'b * ('b -> 'c)) -> 'c))
-> 'c
- val size: 'a ?.t -> int
- val slice: ('a ?.t * {size: int, start: int}) -> 'a ?.t
- val splitPrefix: ('a ?.t * ('a ?.elem -> bool)) -> ('a ?.t * 'a ?.t)
- val sub: ('a ?.t * int) -> 'a ?.elem
- val toSeq: 'a ?.t -> 'a ?.elem seq
- val toSeqR: 'a ?.t -> 'a ?.elem seq
- val tokens: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t seq
+ val size: 'a ?.t -> Int.t
+ val slice: ('a ?.t * {size: Int.t, start: Int.t}) -> 'a ?.t
+ val splitPrefix: ('a ?.t * ('a ?.elem -> Bool.t)) -> ('a ?.t * 'a ?.t)
+ val sub: ('a ?.t * Int.t) -> 'a ?.elem
+ val toSeq: 'a ?.t -> 'a ?.elem Seq.t
+ val toSeqR: 'a ?.t -> 'a ?.elem Seq.t
+ val tokens: ('a ?.t * ('a ?.elem -> Bool.t)) -> 'a ?.t Seq.t
end
signature BOOL =
sig
- datatype t = false | true
- val not: bool -> bool
+ eqtype t = Bool.t
+ val not: Bool.t -> Bool.t
end
signature CHAR =
sig
type t = ?.t
- val < : (?.t * ?.t) -> bool
- val <= : (?.t * ?.t) -> bool
- val == : (?.t * ?.t) -> bool
- val > : (?.t * ?.t) -> bool
- val >= : (?.t * ?.t) -> bool
- val compare: (?.t * ?.t) -> order
- val isAlpha: ?.t -> bool
- val isAlphaNum: ?.t -> bool
- val isAscii: ?.t -> bool
- val isCntrl: ?.t -> bool
- val isDigit: ?.t -> bool
- val isGraph: ?.t -> bool
- val isHexDigit: ?.t -> bool
- val isLower: ?.t -> bool
- val isPrint: ?.t -> bool
- val isPunct: ?.t -> bool
- val isSpace: ?.t -> bool
- val isUpper: ?.t -> bool
- val ofInt: int -> ?.t
- val toInt: ?.t -> int
+ val < : (?.t * ?.t) -> Bool.t
+ val <= : (?.t * ?.t) -> Bool.t
+ val == : (?.t * ?.t) -> Bool.t
+ val > : (?.t * ?.t) -> Bool.t
+ val >= : (?.t * ?.t) -> Bool.t
+ val compare: (?.t * ?.t) -> ?.Order.t
+ val isAlpha: ?.t -> Bool.t
+ val isAlphaNum: ?.t -> Bool.t
+ val isAscii: ?.t -> Bool.t
+ val isCntrl: ?.t -> Bool.t
+ val isDigit: ?.t -> Bool.t
+ val isGraph: ?.t -> Bool.t
+ val isHexDigit: ?.t -> Bool.t
+ val isLower: ?.t -> Bool.t
+ val isPrint: ?.t -> Bool.t
+ val isPunct: ?.t -> Bool.t
+ val isSpace: ?.t -> Bool.t
+ val isUpper: ?.t -> Bool.t
+ val ofInt: Int.t -> ?.t
+ val toInt: ?.t -> Int.t
val toLower: ?.t -> ?.t
val toUpper: ?.t -> ?.t
val toWord8: ?.t -> Word8.t
end
signature COMMAND_LINE =
sig
- val arguments: unit -> string list
+ val arguments: unit -> string List.t
val name: unit -> string
end
signature DATE =
sig
type t = ?.t
val format: (?.t * string) -> string
- val hour: ?.t -> int
- val isDst: ?.t -> bool option
+ val hour: ?.t -> Int.t
+ val isDst: ?.t -> Bool.t Option.t
val localOffset: unit -> Time.t
- val make: {hour: int,
- minute: int,
+ val make: {hour: Int.t,
+ minute: Int.t,
month: ?.Month.t,
- monthDay: int,
- offset: Time.t option,
- second: int,
- year: int}
+ monthDay: Int.t,
+ offset: Time.t Option.t,
+ second: Int.t,
+ year: Int.t}
-> ?.t
- val minute: ?.t -> int
+ val minute: ?.t -> Int.t
val month: ?.t -> ?.Month.t
- val monthDay: ?.t -> int
- val ofString: string -> ?.t option
+ val monthDay: ?.t -> Int.t
+ val ofString: string -> ?.t Option.t
val ofTimeLocal: Time.t -> ?.t
val ofTimeUniv: Time.t -> ?.t
- val offset: ?.t -> Time.t option
- val scanner: char seq -> (?.t * char seq) option
- val second: ?.t -> int
+ val offset: ?.t -> Time.t Option.t
+ val scanner: Char.t Seq.t -> (?.t * Char.t Seq.t) Option.t
+ val second: ?.t -> Int.t
val toString: ?.t -> string
val toTime: ?.t -> Time.t
val weekDay: ?.t -> ?.WeekDay.t
- val year: ?.t -> int
- val yearDay: ?.t -> int
+ val year: ?.t -> Int.t
+ val yearDay: ?.t -> Int.t
structure Month:
sig
type t = ?.Month.t
@@ -464,7 +455,7 @@
sig
type t = ?.Stream.t
val close: ?.Stream.t -> unit
- val read: ?.Stream.t -> string option
+ val read: ?.Stream.t -> string Option.t
val rewind: ?.Stream.t -> unit
end
end
@@ -481,7 +472,7 @@
signature FILE =
sig
eqtype t = string
- val canAccess: (string * ?.AccessMode.t list) -> bool
+ val canAccess: (string * ?.AccessMode.t List.t) -> Bool.t
val id: string -> ?.Id.t
val modTime: string -> Time.t
val openIn: string -> In.t
@@ -503,19 +494,19 @@
structure Id:
sig
type t = ?.Id.t
- val == : (?.Id.t * ?.Id.t) -> bool
- val compare: (?.Id.t * ?.Id.t) -> order
- val hash: ?.Id.t -> word
+ val == : (?.Id.t * ?.Id.t) -> Bool.t
+ val compare: (?.Id.t * ?.Id.t) -> ?.Order.t
+ val hash: ?.Id.t -> Word.t
end
end
signature IN =
sig
type t = ?.t
val close: ?.t -> unit
- val get1: ?.t -> char option
+ val get1: ?.t -> Char.t Option.t
val getAll: ?.t -> string
- val getLine: ?.t -> string option
- val lines: ?.t -> string seq
+ val getLine: ?.t -> string Option.t
+ val lines: ?.t -> string Seq.t
val standard: ?.t
end
signature INT =
@@ -524,28 +515,28 @@
val * : (?.t * ?.t) -> ?.t
val + : (?.t * ?.t) -> ?.t
val - : (?.t * ?.t) -> ?.t
- val < : (?.t * ?.t) -> bool
- val <= : (?.t * ?.t) -> bool
- val == : (?.t * ?.t) -> bool
- val > : (?.t * ?.t) -> bool
- val >= : (?.t * ?.t) -> bool
- val compare: (?.t * ?.t) -> order
+ val < : (?.t * ?.t) -> Bool.t
+ val <= : (?.t * ?.t) -> Bool.t
+ val == : (?.t * ?.t) -> Bool.t
+ val > : (?.t * ?.t) -> Bool.t
+ val >= : (?.t * ?.t) -> Bool.t
+ val compare: (?.t * ?.t) -> ?.Order.t
val div: (?.t * ?.t) -> ?.t
val fold: (?.t * ?.t * 'a * ((?.t * 'a) -> 'a)) -> 'a
val foldDown: (?.t * ?.t * 'a * ((?.t * 'a) -> 'a)) -> 'a
val for: (?.t * ?.t * (?.t -> unit)) -> unit
- val fromTo: (?.t * ?.t) -> ?.t seq
- val fromToBy: (?.t * ?.t * ?.t) -> ?.t seq
- val geu: (?.t * ?.t) -> bool
+ val fromTo: (?.t * ?.t) -> ?.t Seq.t
+ val fromToBy: (?.t * ?.t * ?.t) -> ?.t Seq.t
+ val geu: (?.t * ?.t) -> Bool.t
val mod: (?.t * ?.t) -> ?.t
- val ofString: string -> ?.t option
- val ofStringRadix: (string * Radix.t) -> ?.t option
+ val ofString: string -> ?.t Option.t
+ val ofStringRadix: (string * Radix.t) -> ?.t Option.t
val quot: (?.t * ?.t) -> ?.t
val rem: (?.t * ?.t) -> ?.t
- val scanner: Radix.t -> (char seq -> (?.t * char seq) option)
+ val scanner: Radix.t -> (Char.t Seq.t -> (?.t * Char.t Seq.t) Option.t)
val toString: ?.t -> string
val toStringRadix: (?.t * Radix.t) -> string
- val toWord: ?.t -> word
+ val toWord: ?.t -> Word.t
end
signature INT_INF =
sig
@@ -553,38 +544,38 @@
val * : (?.t * ?.t) -> ?.t
val + : (?.t * ?.t) -> ?.t
val - : (?.t * ?.t) -> ?.t
- val < : (?.t * ?.t) -> bool
- val <= : (?.t * ?.t) -> bool
- val == : (?.t * ?.t) -> bool
- val > : (?.t * ?.t) -> bool
- val >= : (?.t * ?.t) -> bool
- val compare: (?.t * ?.t) -> order
+ val < : (?.t * ?.t) -> Bool.t
+ val <= : (?.t * ?.t) -> Bool.t
+ val == : (?.t * ?.t) -> Bool.t
+ val > : (?.t * ?.t) -> Bool.t
+ val >= : (?.t * ?.t) -> Bool.t
+ val compare: (?.t * ?.t) -> ?.Order.t
val div: (?.t * ?.t) -> ?.t
val fold: (?.t * ?.t * 'a * ((?.t * 'a) -> 'a)) -> 'a
val foldDown: (?.t * ?.t * 'a * ((?.t * 'a) -> 'a)) -> 'a
val for: (?.t * ?.t * (?.t -> unit)) -> unit
- val fromTo: (?.t * ?.t) -> ?.t seq
- val fromToBy: (?.t * ?.t * ?.t) -> ?.t seq
- val geu: (?.t * ?.t) -> bool
+ val fromTo: (?.t * ?.t) -> ?.t Seq.t
+ val fromToBy: (?.t * ?.t * ?.t) -> ?.t Seq.t
+ val geu: (?.t * ?.t) -> Bool.t
val mod: (?.t * ?.t) -> ?.t
- val ofString: string -> ?.t option
- val ofStringRadix: (string * Radix.t) -> ?.t option
+ val ofString: string -> ?.t Option.t
+ val ofStringRadix: (string * Radix.t) -> ?.t Option.t
val quot: (?.t * ?.t) -> ?.t
val rem: (?.t * ?.t) -> ?.t
- val scanner: Radix.t -> (char seq -> (?.t * char seq) option)
+ val scanner: Radix.t -> (Char.t Seq.t -> (?.t * Char.t Seq.t) Option.t)
val toString: ?.t -> string
val toStringRadix: (?.t * Radix.t) -> string
- val toWord: ?.t -> word
+ val toWord: ?.t -> Word.t
end
signature IO_DESC =
sig
type t = ?.t
- val compare: (?.t * ?.t) -> order
- val hash: ?.t -> word
+ val compare: (?.t * ?.t) -> ?.Order.t
+ val hash: ?.t -> Word.t
structure Kind:
sig
type t = ?.Kind.t
- val == : (?.Kind.t * ?.Kind.t) -> bool
+ val == : (?.Kind.t * ?.Kind.t) -> Bool.t
val device: ?.Kind.t
val dir: ?.Kind.t
val file: ?.Kind.t
@@ -601,59 +592,60 @@
signature LIST =
sig
type 'a elem = 'a ?.elem
- datatype 'a t = nil | :: of 'a * 'a list
- eqtype 'a t0 = 'a list
+ datatype 'a t = nil | :: of 'a * 'a List.t
+ eqtype 'a t0 = 'a List.t
type 'a unfold = 'a ?.unfold
type 'a unfoldR = 'a ?.unfoldR
- val all: ('a list * ('a ?.elem -> bool)) -> bool
- val append: ('a list * 'a list) -> 'a list
- val concat: 'a list seq -> 'a list
- val cons: ('a ?.elem * 'a list) -> 'a list
- val drop: ('a list * ('a ?.elem -> bool)) -> 'a list
- val dropPrefix: ('a list * ('a ?.elem -> bool)) -> 'a list
- val dropPrefixN: ('a list * int) -> 'a list
- val dropSuffix: ('a list * ('a ?.elem -> bool)) -> 'a list
- val dropSuffixN: ('a list * int) -> 'a list
- val empty: unit -> 'a list
- val exists: ('a list * ('a ?.elem -> bool)) -> bool
- val fields: ('a list * ('a ?.elem -> bool)) -> 'a list seq
- val find: ('a list * ('a ?.elem -> bool)) -> 'a ?.elem option
- val fold: ('a list * 'b * (('a ?.elem * 'b) -> 'b)) -> 'b
- val for: ('a list * ('a ?.elem -> unit)) -> unit
- val isEmpty: 'a list -> bool
- val join: ('a list seq * 'a list) -> 'a list
- val keep: ('a list * ('a ?.elem -> bool)) -> 'a list
- val keepPrefix: ('a list * ('a ?.elem -> bool)) -> 'a list
- val keepPrefixN: ('a list * int) -> 'a list
- val keepSuffix: ('a list * ('a ?.elem -> bool)) -> 'a list
- val keepSuffixN: ('a list * int) -> 'a list
- val last: 'a list -> 'a ?.elem
- val map: ('a list * ('a ?.elem -> 'b ?.elem)) -> 'b list
- val ofSeq: 'a ?.elem seq -> 'a list
- val ofSeqN: ('a ?.elem seq * int) -> 'a list
- val recur: ('a list
+ val all: ('a List.t * ('a ?.elem -> Bool.t)) -> Bool.t
+ val append: ('a List.t * 'a List.t) -> 'a List.t
+ val concat: 'a List.t Seq.t -> 'a List.t
+ val cons: ('a ?.elem * 'a List.t) -> 'a List.t
+ val drop: ('a List.t * ('a ?.elem -> Bool.t)) -> 'a List.t
+ val dropPrefix: ('a List.t * ('a ?.elem -> Bool.t)) -> 'a List.t
+ val dropPrefixN: ('a List.t * Int.t) -> 'a List.t
+ val dropSuffix: ('a List.t * ('a ?.elem -> Bool.t)) -> 'a List.t
+ val dropSuffixN: ('a List.t * Int.t) -> 'a List.t
+ val empty: unit -> 'a List.t
+ val exists: ('a List.t * ('a ?.elem -> Bool.t)) -> Bool.t
+ val fields: ('a List.t * ('a ?.elem -> Bool.t)) -> 'a List.t Seq.t
+ val find: ('a List.t * ('a ?.elem -> Bool.t)) -> 'a ?.elem Option.t
+ val fold: ('a List.t * 'b * (('a ?.elem * 'b) -> 'b)) -> 'b
+ val for: ('a List.t * ('a ?.elem -> unit)) -> unit
+ val isEmpty: 'a List.t -> Bool.t
+ val join: ('a List.t Seq.t * 'a List.t) -> 'a List.t
+ val keep: ('a List.t * ('a ?.elem -> Bool.t)) -> 'a List.t
+ val keepPrefix: ('a List.t * ('a ?.elem -> Bool.t)) -> 'a List.t
+ val keepPrefixN: ('a List.t * Int.t) -> 'a List.t
+ val keepSuffix: ('a List.t * ('a ?.elem -> Bool.t)) -> 'a List.t
+ val keepSuffixN: ('a List.t * Int.t) -> 'a List.t
+ val last: 'a List.t -> 'a ?.elem
+ val map: ('a List.t * ('a ?.elem -> 'b ?.elem)) -> 'b List.t
+ val ofSeq: 'a ?.elem Seq.t -> 'a List.t
+ val ofSeqN: ('a ?.elem Seq.t * Int.t) -> 'a List.t
+ val recur: ('a List.t
* 'b
* ('b -> 'c)
* (('a ?.elem * 'b * ('b -> 'c)) -> 'c))
-> 'c
- val reverse: 'a list -> 'a list
- val separate: ('a list * 'a ?.elem) -> 'a list
- val single: 'a ?.elem -> 'a list
- val size: 'a list -> int
- val splitPrefix: ('a list * ('a ?.elem -> bool)) -> ('a list * 'a list)
- val sub: ('a list * int) -> 'a ?.elem
- val tabulate: (int * (int -> 'a ?.elem)) -> 'a list
- val toSeq: 'a list -> 'a ?.elem seq
- val toSeqR: 'a list -> 'a ?.elem seq
- val tokens: ('a list * ('a ?.elem -> bool)) -> 'a list seq
- val unfold: ('a * ('a -> ('b ?.elem * 'a) option))
- -> ('b list * 'a ?.unfold)
- val unfoldN: (int * 'a * ((int * 'a) -> ('b ?.elem * 'a) option))
- -> ('b list * 'a ?.unfold)
- val unfoldNR: (int * 'a * ((int * 'a) -> ('b ?.elem * 'a) option))
- -> ('b list * 'a ?.unfoldR)
- val unfoldR: ('a * ('a -> ('b ?.elem * 'a) option))
- -> ('b list * 'a ?.unfoldR)
+ val reverse: 'a List.t -> 'a List.t
+ val separate: ('a List.t * 'a ?.elem) -> 'a List.t
+ val single: 'a ?.elem -> 'a List.t
+ val size: 'a List.t -> Int.t
+ val splitPrefix: ('a List.t * ('a ?.elem -> Bool.t))
+ -> ('a List.t * 'a List.t)
+ val sub: ('a List.t * Int.t) -> 'a ?.elem
+ val tabulate: (Int.t * (Int.t -> 'a ?.elem)) -> 'a List.t
+ val toSeq: 'a List.t -> 'a ?.elem Seq.t
+ val toSeqR: 'a List.t -> 'a ?.elem Seq.t
+ val tokens: ('a List.t * ('a ?.elem -> Bool.t)) -> 'a List.t Seq.t
+ val unfold: ('a * ('a -> ('b ?.elem * 'a) Option.t))
+ -> ('b List.t * 'a ?.unfold)
+ val unfoldN: (Int.t * 'a * ((Int.t * 'a) -> ('b ?.elem * 'a) Option.t))
+ -> ('b List.t * 'a ?.unfold)
+ val unfoldNR: (Int.t * 'a * ((Int.t * 'a) -> ('b ?.elem * 'a) Option.t))
+ -> ('b List.t * 'a ?.unfoldR)
+ val unfoldR: ('a * ('a -> ('b ?.elem * 'a) Option.t))
+ -> ('b List.t * 'a ?.unfoldR)
end
signature NET =
sig
@@ -664,11 +656,11 @@
type 'a t = 'a ?.Family.t
type unix = ?.Family.unix
type unknown = ?.Family.unknown
- val == : ('a ?.Family.t * 'a ?.Family.t) -> bool
+ val == : ('a ?.Family.t * 'a ?.Family.t) -> Bool.t
val all: unit
- -> (?.Family.unknown ?.Family.t * {name: string}) vector
+ -> (?.Family.unknown ?.Family.t * {name: string}) VectorSlice.base
val inet: ?.Family.inet ?.Family.t
- val ofString: string -> ?.Family.unknown ?.Family.t option
+ val ofString: string -> ?.Family.unknown ?.Family.t Option.t
val toString: 'a ?.Family.t -> string
val unix: ?.Family.unix ?.Family.t
end
@@ -676,38 +668,39 @@
sig
type t = ?.Host.t
val address: ?.Host.t -> ?.Host.Address.t
- val addresses: ?.Host.t -> ?.Host.Address.t vector
- val aliases: ?.Host.t -> string vector
+ val addresses: ?.Host.t -> ?.Host.Address.t VectorSlice.base
+ val aliases: ?.Host.t -> string VectorSlice.base
val family: ?.Host.t -> ?.Family.unknown ?.Family.t
- val getByAddress: ?.Host.Address.t -> ?.Host.t option
- val getByName: string -> ?.Host.t option
+ val getByAddress: ?.Host.Address.t -> ?.Host.t Option.t
+ val getByName: string -> ?.Host.t Option.t
val name: ?.Host.t -> string
structure Address:
sig
type t = ?.Host.Address.t
- val == : (?.Host.Address.t * ?.Host.Address.t) -> bool
- val ofString: string -> ?.Host.Address.t option
- val scanner: char seq -> (?.Host.Address.t * char seq) option
+ val == : (?.Host.Address.t * ?.Host.Address.t) -> Bool.t
+ val ofString: string -> ?.Host.Address.t Option.t
+ val scanner: Char.t Seq.t
+ -> (?.Host.Address.t * Char.t Seq.t) Option.t
val toString: ?.Host.Address.t -> string
end
end
structure Protocol:
sig
type t = ?.Protocol.t
- val aliases: ?.Protocol.t -> string vector
- val getByName: string -> ?.Protocol.t option
- val getByNumber: int -> ?.Protocol.t option
+ val aliases: ?.Protocol.t -> string VectorSlice.base
+ val getByName: string -> ?.Protocol.t Option.t
+ val getByNumber: Int.t -> ?.Protocol.t Option.t
val name: ?.Protocol.t -> string
- val number: ?.Protocol.t -> int
+ val number: ?.Protocol.t -> Int.t
end
structure Service:
sig
type t = ?.Service.t
- val aliases: ?.Service.t -> string vector
- val getByName: (string * string option) -> ?.Service.t option
- val getByPort: (int * string option) -> ?.Service.t option
+ val aliases: ?.Service.t -> string VectorSlice.base
+ val getByName: (string * string Option.t) -> ?.Service.t Option.t
+ val getByPort: (Int.t * string Option.t) -> ?.Service.t Option.t
val name: ?.Service.t -> string
- val port: ?.Service.t -> int
+ val port: ?.Service.t -> Int.t
val protocol: ?.Service.t -> string
end
structure Socket:
@@ -718,44 +711,44 @@
* ((('a, ?.Socket.Type.active ?.Socket.Type.stream) ?.Socket.sock
* 'a ?.Socket.Address.t),
(('a, ?.Socket.Type.active ?.Socket.Type.stream) ?.Socket.sock
- * 'a ?.Socket.Address.t) option,
+ * 'a ?.Socket.Address.t) Option.t,
'b) ?.Socket.Block.t)
-> 'b
val bind: (('a, 'b) ?.Socket.sock * 'a ?.Socket.Address.t) -> unit
val close: ('a, 'b) ?.Socket.sock -> unit
val connect: (('a, 'b) ?.Socket.sock
* 'a ?.Socket.Address.t
- * (unit, unit option, 'c) ?.Socket.Block.t)
+ * (unit, unit Option.t, 'c) ?.Socket.Block.t)
-> 'c
val desc: ('a, 'b) ?.Socket.sock -> ?.Socket.Desc.t
- val getOption: (('a, 'b) ?.Socket.sock
- * ('c, 'a, 'b, 'd) ?.Socket.Option.t)
- -> 'c
- val ioDesc: ('a, 'b) ?.Socket.sock -> int
+ val getOpt: (('a, 'b) ?.Socket.sock
+ * ('c, 'a, 'b, 'd) ?.Socket.Opt.t)
+ -> 'c
+ val ioDesc: ('a, 'b) ?.Socket.sock -> Int.t
val listen: (('a, ?.Socket.Type.passive ?.Socket.Type.stream) ?.Socket.sock
- * int)
+ * Int.t)
-> unit
val make: ('a ?.Family.t
* 'b ?.Socket.Type.t
- * {protocol: int} option)
+ * {protocol: Int.t} Option.t)
-> ('a, 'b) ?.Socket.sock
val makePair: ('a ?.Family.t
* 'b ?.Socket.Type.t
- * {protocol: int} option)
+ * {protocol: Int.t} Option.t)
-> (('a, 'b) ?.Socket.sock * ('a, 'b) ?.Socket.sock)
val myAddress: ('a, 'b) ?.Socket.sock -> 'a ?.Socket.Address.t
val peerAddress: ('a, 'b) ?.Socket.sock -> 'a ?.Socket.Address.t
- val select: {exs: ?.Socket.Desc.t list,
- rds: ?.Socket.Desc.t list,
- timeout: Time.t option,
- wrs: ?.Socket.Desc.t list}
- -> {exs: ?.Socket.Desc.t list,
- rds: ?.Socket.Desc.t list,
- wrs: ?.Socket.Desc.t list}
- val setOption: (('a, 'b) ?.Socket.sock
- * ('c, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
- * 'c)
- -> unit
+ val select: {exs: ?.Socket.Desc.t List.t,
+ rds: ?.Socket.Desc.t List.t,
+ timeout: Time.t Option.t,
+ wrs: ?.Socket.Desc.t List.t}
+ -> {exs: ?.Socket.Desc.t List.t,
+ rds: ?.Socket.Desc.t List.t,
+ wrs: ?.Socket.Desc.t List.t}
+ val setOpt: (('a, 'b) ?.Socket.sock
+ * ('c, 'a, 'b, ?.Socket.Opt.rw) ?.Socket.Opt.t
+ * 'c)
+ -> unit
val shutdown: (('a, 'b ?.Socket.Type.stream) ?.Socket.sock
* ?.Socket.ShutdownMode.t)
-> unit
@@ -763,71 +756,72 @@
sig
type 'a t = 'a ?.Socket.Address.t
val == : ('a ?.Socket.Address.t * 'a ?.Socket.Address.t)
- -> bool
+ -> Bool.t
val family: 'a ?.Socket.Address.t -> 'a ?.Family.t
- val inet: {port: int} -> ?.Family.inet ?.Socket.Address.t
- val ofHost: (?.Host.Address.t * {port: int})
+ val inet: {port: Int.t} -> ?.Family.inet ?.Socket.Address.t
+ val ofHost: (?.Host.Address.t * {port: Int.t})
-> ?.Family.inet ?.Socket.Address.t
val ofUnix: string -> ?.Family.unix ?.Socket.Address.t
val toHost: ?.Family.inet ?.Socket.Address.t
- -> (?.Host.Address.t * {port: int})
+ -> (?.Host.Address.t * {port: Int.t})
val toUnix: ?.Family.unix ?.Socket.Address.t -> string
end
structure Block:
sig
type ('a, 'b, 'c) t = ('a, 'b, 'c) ?.Socket.Block.t
- type ('a, 'b) u = ('a, 'a option, 'b) ?.Socket.Block.t
+ type ('a, 'b) u = ('a, 'a Option.t, 'b) ?.Socket.Block.t
val may: ('a, 'b, 'a) ?.Socket.Block.t
val non: ('a, 'b, 'b) ?.Socket.Block.t
end
structure Desc:
sig
type t = ?.Socket.Desc.t
- val == : (?.Socket.Desc.t * ?.Socket.Desc.t) -> bool
+ val == : (?.Socket.Desc.t * ?.Socket.Desc.t) -> Bool.t
end
- structure Option:
+ structure Opt:
sig
- type ro = ?.Socket.Option.ro
- type rw = ?.Socket.Option.rw
- type ('a, 'b, 'c, 'd) t = ('a, 'b, 'c, 'd) ?.Socket.Option.t
- val atmark: (bool,
+ type ro = ?.Socket.Opt.ro
+ type rw = ?.Socket.Opt.rw
+ type ('a, 'b, 'c, 'd) t = ('a, 'b, 'c, 'd) ?.Socket.Opt.t
+ val atmark: (Bool.t,
'a,
?.Socket.Type.active ?.Socket.Type.stream,
- ?.Socket.Option.ro) ?.Socket.Option.t
- val broadcast: (bool, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
- val debug: (bool, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
- val dontRoute: (bool, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
- val error: (bool, 'a, 'b, ?.Socket.Option.ro) ?.Socket.Option.t
- val keepAlive: (bool, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
- val linger: (Time.t option, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
- val nRead: (int, 'a, 'b, ?.Socket.Option.ro) ?.Socket.Option.t
- val noDelay: (bool,
+ ?.Socket.Opt.ro) ?.Socket.Opt.t
+ val broadcast: (Bool.t, 'a, 'b, ?.Socket.Opt.rw) ?.Socket.Opt.t
+ val debug: (Bool.t, 'a, 'b, ?.Socket.Opt.rw) ?.Socket.Opt.t
+ val dontRoute: (Bool.t, 'a, 'b, ?.Socket.Opt.rw) ?.Socket.Opt.t
+ val error: (Bool.t, 'a, 'b, ?.Socket.Opt.ro) ?.Socket.Opt.t
+ val keepAlive: (Bool.t, 'a, 'b, ?.Socket.Opt.rw) ?.Socket.Opt.t
+ val linger: (Time.t Option.t, 'a, 'b, ?.Socket.Opt.rw) ?.Socket.Opt.t
+ val nRead: (Int.t, 'a, 'b, ?.Socket.Opt.ro) ?.Socket.Opt.t
+ val noDelay: (Bool.t,
?.Family.inet,
'a ?.Socket.Type.stream,
- ?.Socket.Option.rw) ?.Socket.Option.t
- val oobInline: (bool, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
- val rcvBuf: (int, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
- val reuseAddr: (bool, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
- val sndBuf: (int, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
+ ?.Socket.Opt.rw) ?.Socket.Opt.t
+ val oobInline: (Bool.t, 'a, 'b, ?.Socket.Opt.rw) ?.Socket.Opt.t
+ val rcvBuf: (Int.t, 'a, 'b, ?.Socket.Opt.rw) ?.Socket.Opt.t
+ val reuseAddr: (Bool.t, 'a, 'b, ?.Socket.Opt.rw) ?.Socket.Opt.t
+ val sndBuf: (Int.t, 'a, 'b, ?.Socket.Opt.rw) ?.Socket.Opt.t
val ty: (?.Socket.Type.unknown ?.Socket.Type.t,
'a,
'b,
- ?.Socket.Option.ro) ?.Socket.Option.t
+ ?.Socket.Opt.ro) ?.Socket.Opt.t
end
structure Receive:
sig
val receive: (('a, 'b, 'c, 'd) ?.Socket.Receive.From.t
* ('a, 'e, 'f, 'g, 'h, 'b, 'c) ?.Socket.Receive.To.t
* ('a,
- (int * 'a ?.Socket.Address.t),
- int,
- (Word8.t vector * 'a ?.Socket.Address.t),
- Word8.t vector,
+ (Int.t * 'a ?.Socket.Address.t),
+ Int.t,
+ (Word8.t VectorSlice.base
+ * 'a ?.Socket.Address.t),
+ Word8.t VectorSlice.base,
'e,
'f,
'g,
'h) ?.Socket.Receive.Block.t
- * ?.Socket.Receive.Flag.t list)
+ * ?.Socket.Receive.Flag.t List.t)
-> 'd
structure Block:
sig
@@ -846,10 +840,10 @@
'c,
'd,
'e,
- 'b option,
- 'c option,
- 'd option,
- 'e option) ?.Socket.Receive.Block.t
+ 'b Option.t,
+ 'c Option.t,
+ 'd Option.t,
+ 'e Option.t) ?.Socket.Receive.Block.t
end
structure Flag:
sig
@@ -877,7 +871,7 @@
'g) ?.Socket.Receive.To.t
val array: Word8.t ?.Sequence.Slice.t
-> ('a, 'b, 'c, 'd, 'e, 'b, 'c) ?.Socket.Receive.To.t
- val vector: {numBytes: int}
+ val vector: {numBytes: Int.t}
-> ('a, 'b, 'c, 'd, 'e, 'd, 'e) ?.Socket.Receive.To.t
end
end
@@ -885,8 +879,8 @@
sig
val send: (?.Socket.Send.From.t
* ('a, 'b, 'c, 'd) ?.Socket.Send.To.t
- * ('a, unit, int, bool, int option, 'b, 'c) ?.Socket.Send.Block.t
- * ?.Socket.Send.Flag.t list)
+ * ('a, unit, Int.t, Bool.t, Int.t Option.t, 'b, 'c) ?.Socket.Send.Block.t
+ * ?.Socket.Send.Flag.t List.t)
-> 'd
structure Block:
sig
@@ -942,13 +936,13 @@
type 'a stream = 'a ?.Socket.Type.stream
type 'a t = 'a ?.Socket.Type.t
type unknown = ?.Socket.Type.unknown
- val == : ('a ?.Socket.Type.t * 'a ?.Socket.Type.t) -> bool
+ val == : ('a ?.Socket.Type.t * 'a ?.Socket.Type.t) -> Bool.t
val all: unit
-> (?.Socket.Type.unknown ?.Socket.Type.t
- * {name: string}) vector
+ * {name: string}) VectorSlice.base
val dgram: ?.Socket.Type.dgram ?.Socket.Type.t
val ofString: string
- -> ?.Socket.Type.unknown ?.Socket.Type.t option
+ -> ?.Socket.Type.unknown ?.Socket.Type.t Option.t
val stream: 'a ?.Socket.Type.stream ?.Socket.Type.t
val toString: 'a ?.Socket.Type.t -> string
end
@@ -957,10 +951,10 @@
signature OPTION =
sig
datatype 'a t = None | Some of 'a
- val isNone: 'a ?.t -> bool
- val isSome: 'a ?.t -> bool
+ val isNone: 'a ?.t -> Bool.t
+ val isSome: 'a ?.t -> Bool.t
val map: ('a ?.t * ('a -> 'b)) -> 'b ?.t
- val toSeq: 'a ?.t -> 'a seq
+ val toSeq: 'a ?.t -> 'a Seq.t
val valOf: 'a ?.t -> 'a
end
signature ORDER =
@@ -975,43 +969,43 @@
val flush: ?.t -> unit
val newline: ?.t -> unit
val put: (?.t * string) -> unit
- val put1: (?.t * char) -> unit
- val puts: (?.t * string seq) -> unit
+ val put1: (?.t * Char.t) -> unit
+ val puts: (?.t * string Seq.t) -> unit
val standard: ?.t
end
signature PACKABLE_REAL =
sig
type t = ?.t
- val != : (?.t * ?.t) -> bool
+ val != : (?.t * ?.t) -> Bool.t
val * : (?.t * ?.t) -> ?.t
val + : (?.t * ?.t) -> ?.t
val - : (?.t * ?.t) -> ?.t
val / : (?.t * ?.t) -> ?.t
- val < : (?.t * ?.t) -> bool
- val <= : (?.t * ?.t) -> bool
- val == : (?.t * ?.t) -> bool
- val > : (?.t * ?.t) -> bool
- val >= : (?.t * ?.t) -> bool
- val ?= : (?.t * ?.t) -> bool
+ val < : (?.t * ?.t) -> Bool.t
+ val <= : (?.t * ?.t) -> Bool.t
+ val == : (?.t * ?.t) -> Bool.t
+ val > : (?.t * ?.t) -> Bool.t
+ val >= : (?.t * ?.t) -> Bool.t
+ val ?= : (?.t * ?.t) -> Bool.t
val abs: ?.t -> ?.t
val acos: ?.t -> ?.t
val asin: ?.t -> ?.t
val atan: ?.t -> ?.t
val atan2: (?.t * ?.t) -> ?.t
- val ceil: ?.t -> int
+ val ceil: ?.t -> Int.t
val checkFloat: ?.t -> ?.t
val class: ?.t -> ?.Class.t
- val compare: (?.t * ?.t) -> order
+ val compare: (?.t * ?.t) -> ?.Order.t
val copySign: (?.t * ?.t) -> ?.t
val cos: ?.t -> ?.t
val cosh: ?.t -> ?.t
val e: ?.t
val exp: ?.t -> ?.t
- val floor: ?.t -> int
+ val floor: ?.t -> Int.t
val format: (?.t * ?.Format.t) -> string
- val isFinite: ?.t -> bool
- val isNan: ?.t -> bool
- val isNormal: ?.t -> bool
+ val isFinite: ?.t -> Bool.t
+ val isNan: ?.t -> Bool.t
+ val isNormal: ?.t -> Bool.t
val ln: ?.t -> ?.t
val log10: ?.t -> ?.t
val max: (?.t * ?.t) -> ?.t
@@ -1021,52 +1015,55 @@
val minPos: ?.t
val negInf: ?.t
val nextAfter: (?.t * ?.t) -> ?.t
- val ofBytes: (Word8.t vector * ?.Endian.t) -> ?.t
- val ofDecimal: {class: ?.Class.t, digits: int list, exp: int, sign: bool}
- -> ?.t option
- val ofInt: int -> ?.t
- val ofLarge: (Real64.t * ?.RoundingMode.t) -> ?.t
- val ofLargeInt: LargeInt.t -> ?.t
- val ofManExp: {exp: int, man: ?.t} -> ?.t
- val ofString: string -> ?.t option
+ val ofBytes: (Word8.t VectorSlice.base * ?.Endian.t) -> ?.t
+ val ofDecimal: {class: ?.Class.t,
+ digits: Int.t List.t,
+ exp: Int.t,
+ sign: Bool.t}
+ -> ?.t Option.t
+ val ofInt: Int.t -> ?.t
+ val ofLarge: (Real.t * ?.RoundingMode.t) -> ?.t
+ val ofLargeInt: IntInf.t -> ?.t
+ val ofManExp: {exp: Int.t, man: ?.t} -> ?.t
+ val ofString: string -> ?.t Option.t
val pi: ?.t
val posInf: ?.t
val pow: (?.t * ?.t) -> ?.t
- val precision: int
- val radix: int
+ val precision: Int.t
+ val radix: Int.t
val realCeil: ?.t -> ?.t
val realFloor: ?.t -> ?.t
val realMod: ?.t -> ?.t
val realRound: ?.t -> ?.t
val realTrunc: ?.t -> ?.t
val rem: (?.t * ?.t) -> ?.t
- val round: ?.t -> int
- val sameSign: (?.t * ?.t) -> bool
- val scanner: char seq -> (?.t * char seq) option
- val sign: ?.t -> int
- val signBit: ?.t -> bool
+ val round: ?.t -> Int.t
+ val sameSign: (?.t * ?.t) -> Bool.t
+ val scanner: Char.t Seq.t -> (?.t * Char.t Seq.t) Option.t
+ val sign: ?.t -> Int.t
+ val signBit: ?.t -> Bool.t
val sin: ?.t -> ?.t
val sinh: ?.t -> ?.t
val split: ?.t -> {frac: ?.t, whole: ?.t}
val sqrt: ?.t -> ?.t
- val subArr: (Word8.t ArraySlice.base * int * ?.Endian.t) -> ?.t
- val subVec: (Word8.t vector * int * ?.Endian.t) -> ?.t
+ val subArr: (Word8.t ArraySlice.base * Int.t * ?.Endian.t) -> ?.t
+ val subVec: (Word8.t VectorSlice.base * Int.t * ?.Endian.t) -> ?.t
val tan: ?.t -> ?.t
val tanh: ?.t -> ?.t
- val toBytes: (?.t * ?.Endian.t) -> Word8.t vector
+ val toBytes: (?.t * ?.Endian.t) -> Word8.t VectorSlice.base
val toDecimal: ?.t
-> {class: ?.Class.t,
- digits: int list,
- exp: int,
- sign: bool}
- val toInt: (?.t * ?.RoundingMode.t) -> int
- val toLarge: ?.t -> Real64.t
- val toLargeInt: (?.t * ?.RoundingMode.t) -> LargeInt.t
- val toManExp: ?.t -> {exp: int, man: ?.t}
+ digits: Int.t List.t,
+ exp: Int.t,
+ sign: Bool.t}
+ val toInt: (?.t * ?.RoundingMode.t) -> Int.t
+ val toLarge: ?.t -> Real.t
+ val toLargeInt: (?.t * ?.RoundingMode.t) -> IntInf.t
+ val toManExp: ?.t -> {exp: Int.t, man: ?.t}
val toString: ?.t -> string
- val trunc: ?.t -> int
- val unordered: (?.t * ?.t) -> bool
- val update: (Word8.t ArraySlice.base * int * ?.t * ?.Endian.t) -> unit
+ val trunc: ?.t -> Int.t
+ val unordered: (?.t * ?.t) -> Bool.t
+ val update: (Word8.t ArraySlice.base * Int.t * ?.t * ?.Endian.t) -> unit
val ~ : ?.t -> ?.t
structure Class:
sig
@@ -1074,31 +1071,34 @@
end
structure Decimal:
sig
- eqtype t = {class: ?.Class.t, digits: int list, exp: int, sign: bool}
+ eqtype t = {class: ?.Class.t,
+ digits: Int.t List.t,
+ exp: Int.t,
+ sign: Bool.t}
val ofString: string
-> {class: ?.Class.t,
- digits: int list,
- exp: int,
- sign: bool} option
- val scanner: char seq
+ digits: Int.t List.t,
+ exp: Int.t,
+ sign: Bool.t} Option.t
+ val scanner: Char.t Seq.t
-> ({class: ?.Class.t,
- digits: int list,
- exp: int,
- sign: bool}
- * char seq) option
+ digits: Int.t List.t,
+ exp: Int.t,
+ sign: Bool.t}
+ * Char.t Seq.t) Option.t
val toString: {class: ?.Class.t,
- digits: int list,
- exp: int,
- sign: bool}
+ digits: Int.t List.t,
+ exp: Int.t,
+ sign: Bool.t}
-> string
end
structure Format:
sig
type t = ?.Format.t
val exact: ?.Format.t
- val fix: int -> ?.Format.t
- val gen: int -> ?.Format.t
- val sci: int -> ?.Format.t
+ val fix: Int.t -> ?.Format.t
+ val gen: Int.t -> ?.Format.t
+ val sci: Int.t -> ?.Format.t
end
structure RoundingMode:
sig
@@ -1117,32 +1117,32 @@
val * : (?.t * ?.t) -> ?.t
val + : (?.t * ?.t) -> ?.t
val - : (?.t * ?.t) -> ?.t
- val < : (?.t * ?.t) -> bool
- val << : (?.t * word) -> ?.t
- val <= : (?.t * ?.t) -> bool
- val == : (?.t * ?.t) -> bool
- val > : (?.t * ?.t) -> bool
- val >= : (?.t * ?.t) -> bool
- val >> : (?.t * word) -> ?.t
+ val < : (?.t * ?.t) -> Bool.t
+ val << : (?.t * Word.t) -> ?.t
+ val <= : (?.t * ?.t) -> Bool.t
+ val == : (?.t * ?.t) -> Bool.t
+ val > : (?.t * ?.t) -> Bool.t
+ val >= : (?.t * ?.t) -> Bool.t
+ val >> : (?.t * Word.t) -> ?.t
val andb: (?.t * ?.t) -> ?.t
- val compare: (?.t * ?.t) -> order
+ val compare: (?.t * ?.t) -> ?.Order.t
val div: (?.t * ?.t) -> ?.t
val mod: (?.t * ?.t) -> ?.t
val notb: ?.t -> ?.t
val ofLarge: Word64.t -> ?.t
- val ofString: string -> ?.t option
- val ofStringRadix: (string * Radix.t) -> ?.t option
+ val ofString: string -> ?.t Option.t
+ val ofStringRadix: (string * Radix.t) -> ?.t Option.t
val orb: (?.t * ?.t) -> ?.t
- val scanner: Radix.t -> (char seq -> (?.t * char seq) option)
- val subArr: (Word8.t ArraySlice.base * int * ?.Endian.t) -> ?.t
- val subVec: (Word8.t vector * int * ?.Endian.t) -> ?.t
+ val scanner: Radix.t -> (Char.t Seq.t -> (?.t * Char.t Seq.t) Option.t)
+ val subArr: (Word8.t ArraySlice.base * Int.t * ?.Endian.t) -> ?.t
+ val subVec: (Word8.t VectorSlice.base * Int.t * ?.Endian.t) -> ?.t
val toLarge: ?.t -> Word64.t
val toLargeX: ?.t -> Word64.t
val toString: ?.t -> string
val toStringRadix: (?.t * Radix.t) -> string
- val update: (Word8.t ArraySlice.base * int * ?.t * ?.Endian.t) -> unit
+ val update: (Word8.t ArraySlice.base * Int.t * ?.t * ?.Endian.t) -> unit
val xorb: (?.t * ?.t) -> ?.t
- val ~>> : (?.t * word) -> ?.t
+ val ~>> : (?.t * Word.t) -> ?.t
end
signature PATH =
sig
@@ -1150,18 +1150,18 @@
val append: (string * string) -> string
val base: string -> string
val dir: string -> string
- val ext: string -> string option
+ val ext: string -> string Option.t
val file: string -> string
val full: string -> string
val getParent: string -> string
val getVolume: string -> string
- val isAbsolute: string -> bool
- val isCanonical: string -> bool
- val isDir: string -> bool
- val isLink: string -> bool
- val isRelative: string -> bool
- val isRoot: string -> bool
- val joinBaseExt: {base: string, ext: string option} -> string
+ val isAbsolute: string -> Bool.t
+ val isCanonical: string -> Bool.t
+ val isDir: string -> Bool.t
+ val isLink: string -> Bool.t
+ val isRelative: string -> Bool.t
+ val isRoot: string -> Bool.t
+ val joinBaseExt: {base: string, ext: string Option.t} -> string
val joinDirFile: {dir: string, file: string} -> string
val mkAbsolute: (string * {relativeTo: string}) -> string
val mkCanonical: string -> string
@@ -1170,7 +1170,7 @@
val ofUnix: string -> string
val readLink: string -> string
val real: string -> string
- val splitBaseExt: string -> {base: string, ext: string option}
+ val splitBaseExt: string -> {base: string, ext: string Option.t}
val splitDirFile: string -> {dir: string, file: string}
val toPieces: string -> ?.Pieces.t
val toUnix: string -> string
@@ -1182,17 +1182,19 @@
end
structure Pieces:
sig
- datatype t = T of {arcs: string list, isAbs: bool, volume: string}
+ datatype t = T of {arcs: string List.t,
+ isAbs: Bool.t,
+ volume: string}
end
structure Volume:
sig
eqtype t = string
- val isValid: (string * {isAbs: bool}) -> bool
+ val isValid: (string * {isAbs: Bool.t}) -> Bool.t
end
end
signature POLL =
sig
- val poll: (?.Desc.t list * Time.t option) -> ?.Info.t list
+ val poll: (?.Desc.t List.t * Time.t Option.t) -> ?.Info.t List.t
structure Desc:
sig
type t = ?.Desc.t
@@ -1200,21 +1202,21 @@
val addIn: ?.Desc.t -> ?.Desc.t
val addOut: ?.Desc.t -> ?.Desc.t
val addPri: ?.Desc.t -> ?.Desc.t
- val ofIO: int -> ?.Desc.t option
- val toIO: ?.Desc.t -> int
+ val ofIO: Int.t -> ?.Desc.t Option.t
+ val toIO: ?.Desc.t -> Int.t
end
structure Info:
sig
type t = ?.Info.t
- val isIn: ?.Info.t -> bool
- val isOut: ?.Info.t -> bool
- val isPri: ?.Info.t -> bool
+ val isIn: ?.Info.t -> Bool.t
+ val isOut: ?.Info.t -> Bool.t
+ val isPri: ?.Info.t -> Bool.t
val toDesc: ?.Info.t -> ?.Desc.t
end
end
signature POSIX =
sig
- val access: (string * ?.AccessMode.t list) -> bool
+ val access: (string * ?.AccessMode.t List.t) -> Bool.t
val alarm: Time.t -> Time.t
val cfgetispeed: ?.Termios.t -> ?.Termios.Speed.t
val cfgetospeed: ?.Termios.t -> ?.Termios.Speed.t
@@ -1231,27 +1233,27 @@
val ctermid: unit -> string
val dup: ?.FileDesc.t -> ?.FileDesc.t
val dup2: {new: ?.FileDesc.t, old: ?.FileDesc.t} -> unit
- val environ: unit -> string list
- val exec: (string * string list) -> 'a
- val exece: (string * string list * string list) -> 'a
- val execp: (string * string list) -> 'a
+ val environ: unit -> string List.t
+ val exec: (string * string List.t) -> 'a
+ val exece: (string * string List.t * string List.t) -> 'a
+ val execp: (string * string List.t) -> 'a
val exit: Word8.t -> 'a
val fchmod: (?.FileDesc.t * ?.Mode.t) -> unit
val fchown: (?.FileDesc.t * ?.Uid.t * ?.Gid.t) -> unit
val fcntl: (?.FileDesc.t * ('a, 'b) ?.Fcntl.t * 'a) -> 'b
- val fork: unit -> ?.Pid.t option
- val fpathconf: (?.FileDesc.t * string) -> Word64.t option
+ val fork: unit -> ?.Pid.t Option.t
+ val fpathconf: (?.FileDesc.t * string) -> Word64.t Option.t
val fstat: ?.FileDesc.t -> ?.Stat.t
val fsync: ?.FileDesc.t -> unit
val ftruncate: (?.FileDesc.t * Int64.t) -> unit
val getcwd: unit -> string
val getegid: unit -> ?.Gid.t
- val getenv: string -> string option
+ val getenv: string -> string Option.t
val geteuid: unit -> ?.Uid.t
val getgid: unit -> ?.Gid.t
val getgrgid: ?.Gid.t -> ?.Group.t
val getgrnam: string -> ?.Group.t
- val getgroups: unit -> ?.Gid.t list
+ val getgroups: unit -> ?.Gid.t List.t
val getlogin: unit -> string
val getpgrp: unit -> ?.Pid.t
val getpid: unit -> ?.Pid.t
@@ -1259,7 +1261,7 @@
val getpwnam: string -> ?.Passwd.t
val getpwuid: ?.Uid.t -> ?.Passwd.t
val getuid: unit -> ?.Uid.t
- val isatty: ?.FileDesc.t -> bool
+ val isatty: ?.FileDesc.t -> Bool.t
val kill: (?.KillArg.t * ?.Signal.t) -> unit
val link: {new: string, old: string} -> unit
val lseek: (?.FileDesc.t * Int64.t * ?.Whence.t) -> Int64.t
@@ -1268,18 +1270,18 @@
val mkfifo: (string * ?.Mode.t) -> unit
val opendir: string -> ?.DirStream.t
val openf: (string * ?.OpenMode.t * ?.OpenFlags.t) -> ?.FileDesc.t
- val pathconf: (string * string) -> Word64.t option
+ val pathconf: (string * string) -> Word64.t Option.t
val pause: unit -> unit
val pipe: unit -> {infd: ?.FileDesc.t, outfd: ?.FileDesc.t}
- val readArr: (?.FileDesc.t * Word8.t ?.Sequence.Slice.t) -> int
- val readVec: (?.FileDesc.t * int) -> Word8.t vector
- val readdir: ?.DirStream.t -> string option
+ val readArr: (?.FileDesc.t * Word8.t ?.Sequence.Slice.t) -> Int.t
+ val readVec: (?.FileDesc.t * Int.t) -> Word8.t VectorSlice.base
+ val readdir: ?.DirStream.t -> string Option.t
val readlink: string -> string
val rename: {new: string, old: string} -> unit
val rewinddir: ?.DirStream.t -> unit
val rmdir: string -> unit
val setgid: ?.Gid.t -> unit
- val setpgid: {pgid: ?.Pid.t option, pid: ?.Pid.t option} -> unit
+ val setpgid: {pgid: ?.Pid.t Option.t, pid: ?.Pid.t Option.t} -> unit
val setsid: unit -> ?.Pid.t
val setuid: ?.Uid.t -> unit
val sleep: Time.t -> Time.t
@@ -1291,7 +1293,7 @@
val tcflush: (?.FileDesc.t * ?.QueueSel.t) -> unit
val tcgetattr: ?.FileDesc.t -> ?.Termios.t
val tcgetpgrp: ?.FileDesc.t -> ?.Pid.t
- val tcsendbreak: (?.FileDesc.t * int) -> unit
+ val tcsendbreak: (?.FileDesc.t * Int.t) -> unit
val tcsetattr: (?.FileDesc.t * ?.SetAction.t * ?.Termios.t) -> unit
val tcsetpgrp: (?.FileDesc.t * ?.Pid.t) -> unit
val time: unit -> Time.t
@@ -1303,16 +1305,16 @@
utime: Time.t}
val ttyname: ?.FileDesc.t -> string
val umask: ?.Mode.t -> ?.Mode.t
- val uname: unit -> (string * string) list
+ val uname: unit -> (string * string) List.t
val unlink: string -> unit
- val utime: (string * {actime: Time.t, modtime: Time.t} option) -> unit
+ val utime: (string * {actime: Time.t, modtime: Time.t} Option.t) -> unit
val wait: unit -> (?.Pid.t * ?.ExitStatus.t)
- val waitpid: (?.WaitPidArg.t * ?.WaitPidFlags.t list)
+ val waitpid: (?.WaitPidArg.t * ?.WaitPidFlags.t List.t)
-> (?.Pid.t * ?.ExitStatus.t)
- val waitpidNohang: (?.WaitPidArg.t * ?.WaitPidFlags.t list)
- -> (?.Pid.t * ?.ExitStatus.t) option
- val writeArr: (?.FileDesc.t * Word8.t ?.Sequence.Slice.t) -> int
- val writeVec: (?.FileDesc.t * Word8.t VectorSlice.t) -> int
+ val waitpidNohang: (?.WaitPidArg.t * ?.WaitPidFlags.t List.t)
+ -> (?.Pid.t * ?.ExitStatus.t) Option.t
+ val writeArr: (?.FileDesc.t * Word8.t ?.Sequence.Slice.t) -> Int.t
+ val writeVec: (?.FileDesc.t * Word8.t VectorSlice.t) -> Int.t
structure AccessMode:
sig
type t = ?.AccessMode.t
@@ -1370,7 +1372,7 @@
val notsup: ?.Error.t
val notty: ?.Error.t
val nxio: ?.Err...
[truncated message content] |
|
From: Stephen W. <sw...@ml...> - 2006-12-10 19:36:49
|
Added String.{of,to}Word8Vector.
----------------------------------------------------------------------
U mltonlib/trunk/com/sweeks/basic/unstable/EXPORT
U mltonlib/trunk/com/sweeks/basic/unstable/string.1.sml
U mltonlib/trunk/com/sweeks/basic/unstable/string.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/sweeks/basic/unstable/EXPORT
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/EXPORT 2006-12-11 03:18:01 UTC (rev 4968)
+++ mltonlib/trunk/com/sweeks/basic/unstable/EXPORT 2006-12-11 03:36:48 UTC (rev 4969)
@@ -2060,6 +2060,7 @@
val map: (?.t * (char -> char)) -> ?.t
val ofSeq: char seq -> ?.t
val ofSeqN: (char seq * int) -> ?.t
+ val ofWord8Vector: Word8.t vector -> ?.t
val recur: (?.t * 'a * ('a -> 'b) * ((char * 'a * ('a -> 'b)) -> 'b))
-> 'b
val reverse: ?.t -> ?.t
@@ -2073,6 +2074,7 @@
val toSeq: ?.t -> char seq
val toSeqR: ?.t -> char seq
val toUpper: ?.t -> ?.t
+ val toWord8Vector: ?.t -> Word8.t vector
val tokens: (?.t * (char -> bool)) -> ?.t seq
val unfold: ('a * ('a -> (char * 'a) option)) -> (?.t * 'a ?.unfold)
val unfoldN: (int * 'a * ((int * 'a) -> (char * 'a) option))
Modified: mltonlib/trunk/com/sweeks/basic/unstable/string.1.sml
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/string.1.sml 2006-12-11 03:18:01 UTC (rev 4968)
+++ mltonlib/trunk/com/sweeks/basic/unstable/string.1.sml 2006-12-11 03:36:48 UTC (rev 4969)
@@ -13,6 +13,8 @@
fun hasPrefix (s, s') = String.isPrefix s' s
+ val ofWord8Vector = Byte.bytesToString
+ val toWord8Vector = Byte.stringToBytes
end
local
Modified: mltonlib/trunk/com/sweeks/basic/unstable/string.sig
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/string.sig 2006-12-11 03:18:01 UTC (rev 4968)
+++ mltonlib/trunk/com/sweeks/basic/unstable/string.sig 2006-12-11 03:36:48 UTC (rev 4969)
@@ -3,7 +3,9 @@
include MONO_VECTOR where type 'a elem = char
val hasPrefix: t * t -> bool
+ val ofWord8Vector: Word8.t vector -> t
val toLower: t -> t
val toUpper: t -> t
+ val toWord8Vector: t -> Word8.t vector
end
|
|
From: Stephen W. <sw...@ml...> - 2006-12-10 19:18:03
|
Exposed some types.
Added Char.toWord8 and Word8.toChar (and WORD8 signature).
----------------------------------------------------------------------
U mltonlib/trunk/com/sweeks/basic/unstable/EXPORT
U mltonlib/trunk/com/sweeks/basic/unstable/basis.sml
U mltonlib/trunk/com/sweeks/basic/unstable/char.sig
U mltonlib/trunk/com/sweeks/basic/unstable/char.sml
U mltonlib/trunk/com/sweeks/basic/unstable/export.sig
U mltonlib/trunk/com/sweeks/basic/unstable/export.sml
U mltonlib/trunk/com/sweeks/basic/unstable/lib.mlb
U mltonlib/trunk/com/sweeks/basic/unstable/word.sml
A mltonlib/trunk/com/sweeks/basic/unstable/word8.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/sweeks/basic/unstable/EXPORT
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/EXPORT 2006-12-10 19:30:19 UTC (rev 4967)
+++ mltonlib/trunk/com/sweeks/basic/unstable/EXPORT 2006-12-11 03:18:01 UTC (rev 4968)
@@ -2,7 +2,7 @@
datatype bool = false | true
eqtype char = char
type exn = exn
-type int = int
+eqtype int = int
datatype 'a list = nil | :: of 'a * 'a list
datatype 'a option = None | Some of 'a
datatype order = Equal | Greater | Less
@@ -10,8 +10,8 @@
eqtype string = string
type 'a thunk = unit -> 'a
eqtype unit = unit
-type 'a vector = 'a vector
-type word = word
+eqtype 'a vector = 'a vector
+eqtype word = word
val * : ('a * 'a) -> 'a
val + : ('a * 'a) -> 'a
val - : ('a * 'a) -> 'a
@@ -37,13 +37,13 @@
val valOf: 'a option -> 'a
val ~ : 'a -> 'a
structure Array: ARRAY
- where type 'a elem = 'a Array.elem
+ where type 'a elem = 'a
where type 'a t = 'a ArraySlice.base
- where type 'a unfold = 'a Array.unfold
- where type 'a unfoldR = 'a Array.unfoldR
+ where type 'a unfold = 'a
+ where type 'a unfoldR = 'a
structure ArraySlice: ARRAY_SLICE
where type 'a base = 'a ArraySlice.base
- where type 'a elem = 'a ArraySlice.elem
+ where type 'a elem = 'a
where type 'a t = 'a ArraySlice.t
structure Bool: BOOL
structure Char: CHAR
@@ -69,13 +69,13 @@
structure Int16: INT
where type t = Int16.t
structure Int32: INT
- where type t = Int32.t
+ where type t = int
structure Int64: INT
where type t = Int64.t
structure Int8: INT
where type t = Int8.t
structure IntInf: INT_INF
- where type t = IntInf.t
+ where type t = LargeInt.t
structure IoDesc: IO_DESC
where type Kind.t = IoDesc.Kind.t
where type t = IoDesc.t
@@ -85,14 +85,14 @@
where type Class.t = LargeReal.Class.t
where type Format.t = LargeReal.Format.t
where type RoundingMode.t = LargeReal.RoundingMode.t
- where type t = LargeReal.t
+ where type t = Real64.t
structure LargeWord: WORD
- where type t = LargeWord.t
+ where type t = Word64.t
structure Lazy: LAZY
structure List: LIST
- where type 'a elem = 'a List.elem
- where type 'a unfold = 'a List.unfold
- where type 'a unfoldR = 'a List.unfoldR
+ where type 'a elem = 'a
+ where type 'a unfold = 'a
+ where type 'a unfoldR = 'a
structure Net: NET
where type Family.inet = Net.Family.inet
where type 'a Family.t = 'a Net.Family.t
@@ -203,7 +203,7 @@
where type Class.t = Real.Class.t
where type Format.t = Real.Format.t
where type RoundingMode.t = Real.RoundingMode.t
- where type t = Real.t
+ where type t = Real64.t
structure Real32: PACKABLE_REAL
where type Class.t = Real32.Class.t
where type Format.t = Real32.Format.t
@@ -218,40 +218,40 @@
structure Scanner: SCANNER
where type 'a t = 'a Scanner.t
structure Seq: SEQ
- where type 'a elem = 'a Seq.elem
+ where type 'a elem = 'a
where type 'a t = 'a seq
- where type 'a unfold = 'a Seq.unfold
- where type 'a unfoldR = 'a Seq.unfoldR
+ where type 'a unfold = unit
+ where type 'a unfoldR = 'a
structure String: STRING
where type t = string
- where type 'a unfold = 'a String.unfold
- where type 'a unfoldR = 'a String.unfoldR
+ where type 'a unfold = 'a
+ where type 'a unfoldR = 'a
structure Substring: SUBSTRING
where type 'a base = 'a Substring.base
- where type t = Substring.t
+ where type t = char VectorSlice.t
structure SysError: SYS_ERROR
where type Exn.t = SysError.Exn.t
where type t = SysError.t
structure Time: TIME
where type t = Time.t
structure Vector: VECTOR
- where type 'a elem = 'a Vector.elem
+ where type 'a elem = 'a
where type 'a t = 'a vector
- where type 'a unfold = 'a Vector.unfold
- where type 'a unfoldR = 'a Vector.unfoldR
+ where type 'a unfold = 'a
+ where type 'a unfoldR = 'a
structure VectorSlice: VECTOR_SLICE
where type 'a base = 'a vector
- where type 'a elem = 'a VectorSlice.elem
+ where type 'a elem = 'a
where type 'a t = 'a VectorSlice.t
structure Word: WORD
where type t = word
structure Word16: WORD
where type t = Word16.t
structure Word32: PACKABLE_WORD
- where type t = Word32.t
+ where type t = word
structure Word64: WORD
where type t = Word64.t
-structure Word8: WORD
+structure Word8: WORD8
where type t = Word8.t
signature ARRAY =
sig
@@ -266,9 +266,9 @@
val cons: ('a ?.elem * 'a ?.t) -> 'a ?.t
val drop: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
val dropPrefix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val dropPrefixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val dropPrefixN: ('a ?.t * int) -> 'a ?.t
val dropSuffix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val dropSuffixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val dropSuffixN: ('a ?.t * int) -> 'a ?.t
val empty: unit -> 'a ?.t
val exists: ('a ?.t * ('a ?.elem -> bool)) -> bool
val fields: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t seq
@@ -279,14 +279,14 @@
val join: ('a ?.t seq * 'a ?.t) -> 'a ?.t
val keep: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
val keepPrefix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val keepPrefixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val keepPrefixN: ('a ?.t * int) -> 'a ?.t
val keepSuffix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val keepSuffixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val keepSuffixN: ('a ?.t * int) -> 'a ?.t
val last: 'a ?.t -> 'a ?.elem
- val make: (Int32.t * 'a) -> 'a ?.t
+ val make: (int * 'a) -> 'a ?.t
val map: ('a ?.t * ('a ?.elem -> 'b ?.elem)) -> 'b ?.t
val ofSeq: 'a ?.elem seq -> 'a ?.t
- val ofSeqN: ('a ?.elem seq * Int32.t) -> 'a ?.t
+ val ofSeqN: ('a ?.elem seq * int) -> 'a ?.t
val recur: ('a ?.t
* 'b
* ('b -> 'c)
@@ -295,28 +295,28 @@
val reverse: 'a ?.t -> 'a ?.t
val separate: ('a ?.t * 'a ?.elem) -> 'a ?.t
val single: 'a ?.elem -> 'a ?.t
- val size: 'a ?.t -> Int32.t
+ val size: 'a ?.t -> int
val splitPrefix: ('a ?.t * ('a ?.elem -> bool)) -> ('a ?.t * 'a ?.t)
- val sub: ('a ?.t * Int32.t) -> 'a ?.elem
- val tabulate: (Int32.t * (Int32.t -> 'a ?.elem)) -> 'a ?.t
+ val sub: ('a ?.t * int) -> 'a ?.elem
+ val tabulate: (int * (int -> 'a ?.elem)) -> 'a ?.t
val toSeq: 'a ?.t -> 'a ?.elem seq
val toSeqR: 'a ?.t -> 'a ?.elem seq
val tokens: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t seq
val unfold: ('a * ('a -> ('b ?.elem * 'a) option))
-> ('b ?.t * 'a ?.unfold)
- val unfoldN: (Int32.t * 'a * ((Int32.t * 'a) -> ('b ?.elem * 'a) option))
+ val unfoldN: (int * 'a * ((int * 'a) -> ('b ?.elem * 'a) option))
-> ('b ?.t * 'a ?.unfold)
- val unfoldNR: (Int32.t * 'a * ((Int32.t * 'a) -> ('b ?.elem * 'a) option))
+ val unfoldNR: (int * 'a * ((int * 'a) -> ('b ?.elem * 'a) option))
-> ('b ?.t * 'a ?.unfoldR)
val unfoldR: ('a * ('a -> ('b ?.elem * 'a) option))
-> ('b ?.t * 'a ?.unfoldR)
- val update: ('a ?.t * Int32.t * 'a) -> unit
- val updates: ('a ?.t * Int32.t * 'a seq) -> unit
+ val update: ('a ?.t * int * 'a) -> unit
+ val updates: ('a ?.t * int * 'a seq) -> unit
structure Unsafe:
sig
- val make: Int32.t -> 'a ?.t
- val sub: ('a ?.t * Int32.t) -> 'a
- val update: ('a ?.t * Int32.t * 'a) -> unit
+ val make: int -> 'a ?.t
+ val sub: ('a ?.t * int) -> 'a
+ val update: ('a ?.t * int * 'a) -> unit
end
end
signature ARRAY_SLICE =
@@ -326,11 +326,11 @@
type 'a t = 'a ?.t
type 'a t0 = 'a ?.t
val all: ('a ?.t * ('a ?.elem -> bool)) -> bool
- val base: 'a ?.t -> ('a ?.base * {start: Int32.t})
+ val base: 'a ?.t -> ('a ?.base * {start: int})
val dropPrefix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val dropPrefixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val dropPrefixN: ('a ?.t * int) -> 'a ?.t
val dropSuffix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val dropSuffixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val dropSuffixN: ('a ?.t * int) -> 'a ?.t
val exists: ('a ?.t * ('a ?.elem -> bool)) -> bool
val fields: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t seq
val find: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.elem option
@@ -340,9 +340,9 @@
val get: 'a ?.t -> ('a ?.elem * 'a ?.t) option
val isEmpty: 'a ?.t -> bool
val keepPrefix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val keepPrefixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val keepPrefixN: ('a ?.t * int) -> 'a ?.t
val keepSuffix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val keepSuffixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val keepSuffixN: ('a ?.t * int) -> 'a ?.t
val last: 'a ?.t -> 'a ?.elem
val map: ('a ?.t * ('a ?.elem -> 'b ?.elem)) -> 'b ?.base
val recur: ('a ?.t
@@ -350,10 +350,10 @@
* ('b -> 'c)
* (('a ?.elem * 'b * ('b -> 'c)) -> 'c))
-> 'c
- val size: 'a ?.t -> Int32.t
- val slice: ('a ?.t * {size: Int32.t, start: Int32.t}) -> 'a ?.t
+ val size: 'a ?.t -> int
+ val slice: ('a ?.t * {size: int, start: int}) -> 'a ?.t
val splitPrefix: ('a ?.t * ('a ?.elem -> bool)) -> ('a ?.t * 'a ?.t)
- val sub: ('a ?.t * Int32.t) -> 'a ?.elem
+ val sub: ('a ?.t * int) -> 'a ?.elem
val toSeq: 'a ?.t -> 'a ?.elem seq
val toSeqR: 'a ?.t -> 'a ?.elem seq
val tokens: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t seq
@@ -384,10 +384,11 @@
val isPunct: ?.t -> bool
val isSpace: ?.t -> bool
val isUpper: ?.t -> bool
- val ofInt: Int32.t -> ?.t
- val toInt: ?.t -> Int32.t
+ val ofInt: int -> ?.t
+ val toInt: ?.t -> int
val toLower: ?.t -> ?.t
val toUpper: ?.t -> ?.t
+ val toWord8: ?.t -> Word8.t
end
signature COMMAND_LINE =
sig
@@ -398,31 +399,31 @@
sig
type t = ?.t
val format: (?.t * string) -> string
- val hour: ?.t -> Int32.t
+ val hour: ?.t -> int
val isDst: ?.t -> bool option
val localOffset: unit -> Time.t
- val make: {hour: Int32.t,
- minute: Int32.t,
+ val make: {hour: int,
+ minute: int,
month: ?.Month.t,
- monthDay: Int32.t,
+ monthDay: int,
offset: Time.t option,
- second: Int32.t,
- year: Int32.t}
+ second: int,
+ year: int}
-> ?.t
- val minute: ?.t -> Int32.t
+ val minute: ?.t -> int
val month: ?.t -> ?.Month.t
- val monthDay: ?.t -> Int32.t
+ val monthDay: ?.t -> int
val ofString: string -> ?.t option
val ofTimeLocal: Time.t -> ?.t
val ofTimeUniv: Time.t -> ?.t
val offset: ?.t -> Time.t option
val scanner: char seq -> (?.t * char seq) option
- val second: ?.t -> Int32.t
+ val second: ?.t -> int
val toString: ?.t -> string
val toTime: ?.t -> Time.t
val weekDay: ?.t -> ?.WeekDay.t
- val year: ?.t -> Int32.t
- val yearDay: ?.t -> Int32.t
+ val year: ?.t -> int
+ val yearDay: ?.t -> int
structure Month:
sig
type t = ?.Month.t
@@ -504,7 +505,7 @@
type t = ?.Id.t
val == : (?.Id.t * ?.Id.t) -> bool
val compare: (?.Id.t * ?.Id.t) -> order
- val hash: ?.Id.t -> Word32.t
+ val hash: ?.Id.t -> word
end
end
signature IN =
@@ -544,7 +545,7 @@
val scanner: Radix.t -> (char seq -> (?.t * char seq) option)
val toString: ?.t -> string
val toStringRadix: (?.t * Radix.t) -> string
- val toWord: ?.t -> Word32.t
+ val toWord: ?.t -> word
end
signature INT_INF =
sig
@@ -573,13 +574,13 @@
val scanner: Radix.t -> (char seq -> (?.t * char seq) option)
val toString: ?.t -> string
val toStringRadix: (?.t * Radix.t) -> string
- val toWord: ?.t -> Word32.t
+ val toWord: ?.t -> word
end
signature IO_DESC =
sig
type t = ?.t
val compare: (?.t * ?.t) -> order
- val hash: ?.t -> Word32.t
+ val hash: ?.t -> word
structure Kind:
sig
type t = ?.Kind.t
@@ -610,9 +611,9 @@
val cons: ('a ?.elem * 'a list) -> 'a list
val drop: ('a list * ('a ?.elem -> bool)) -> 'a list
val dropPrefix: ('a list * ('a ?.elem -> bool)) -> 'a list
- val dropPrefixN: ('a list * Int32.t) -> 'a list
+ val dropPrefixN: ('a list * int) -> 'a list
val dropSuffix: ('a list * ('a ?.elem -> bool)) -> 'a list
- val dropSuffixN: ('a list * Int32.t) -> 'a list
+ val dropSuffixN: ('a list * int) -> 'a list
val empty: unit -> 'a list
val exists: ('a list * ('a ?.elem -> bool)) -> bool
val fields: ('a list * ('a ?.elem -> bool)) -> 'a list seq
@@ -623,13 +624,13 @@
val join: ('a list seq * 'a list) -> 'a list
val keep: ('a list * ('a ?.elem -> bool)) -> 'a list
val keepPrefix: ('a list * ('a ?.elem -> bool)) -> 'a list
- val keepPrefixN: ('a list * Int32.t) -> 'a list
+ val keepPrefixN: ('a list * int) -> 'a list
val keepSuffix: ('a list * ('a ?.elem -> bool)) -> 'a list
- val keepSuffixN: ('a list * Int32.t) -> 'a list
+ val keepSuffixN: ('a list * int) -> 'a list
val last: 'a list -> 'a ?.elem
val map: ('a list * ('a ?.elem -> 'b ?.elem)) -> 'b list
val ofSeq: 'a ?.elem seq -> 'a list
- val ofSeqN: ('a ?.elem seq * Int32.t) -> 'a list
+ val ofSeqN: ('a ?.elem seq * int) -> 'a list
val recur: ('a list
* 'b
* ('b -> 'c)
@@ -638,18 +639,18 @@
val reverse: 'a list -> 'a list
val separate: ('a list * 'a ?.elem) -> 'a list
val single: 'a ?.elem -> 'a list
- val size: 'a list -> Int32.t
+ val size: 'a list -> int
val splitPrefix: ('a list * ('a ?.elem -> bool)) -> ('a list * 'a list)
- val sub: ('a list * Int32.t) -> 'a ?.elem
- val tabulate: (Int32.t * (Int32.t -> 'a ?.elem)) -> 'a list
+ val sub: ('a list * int) -> 'a ?.elem
+ val tabulate: (int * (int -> 'a ?.elem)) -> 'a list
val toSeq: 'a list -> 'a ?.elem seq
val toSeqR: 'a list -> 'a ?.elem seq
val tokens: ('a list * ('a ?.elem -> bool)) -> 'a list seq
val unfold: ('a * ('a -> ('b ?.elem * 'a) option))
-> ('b list * 'a ?.unfold)
- val unfoldN: (Int32.t * 'a * ((Int32.t * 'a) -> ('b ?.elem * 'a) option))
+ val unfoldN: (int * 'a * ((int * 'a) -> ('b ?.elem * 'a) option))
-> ('b list * 'a ?.unfold)
- val unfoldNR: (Int32.t * 'a * ((Int32.t * 'a) -> ('b ?.elem * 'a) option))
+ val unfoldNR: (int * 'a * ((int * 'a) -> ('b ?.elem * 'a) option))
-> ('b list * 'a ?.unfoldR)
val unfoldR: ('a * ('a -> ('b ?.elem * 'a) option))
-> ('b list * 'a ?.unfoldR)
@@ -665,7 +666,7 @@
type unknown = ?.Family.unknown
val == : ('a ?.Family.t * 'a ?.Family.t) -> bool
val all: unit
- -> (?.Family.unknown ?.Family.t * {name: string}) ?.vector
+ -> (?.Family.unknown ?.Family.t * {name: string}) vector
val inet: ?.Family.inet ?.Family.t
val ofString: string -> ?.Family.unknown ?.Family.t option
val toString: 'a ?.Family.t -> string
@@ -675,8 +676,8 @@
sig
type t = ?.Host.t
val address: ?.Host.t -> ?.Host.Address.t
- val addresses: ?.Host.t -> ?.Host.Address.t ?.vector
- val aliases: ?.Host.t -> string ?.vector
+ val addresses: ?.Host.t -> ?.Host.Address.t vector
+ val aliases: ?.Host.t -> string vector
val family: ?.Host.t -> ?.Family.unknown ?.Family.t
val getByAddress: ?.Host.Address.t -> ?.Host.t option
val getByName: string -> ?.Host.t option
@@ -693,20 +694,20 @@
structure Protocol:
sig
type t = ?.Protocol.t
- val aliases: ?.Protocol.t -> string ?.vector
+ val aliases: ?.Protocol.t -> string vector
val getByName: string -> ?.Protocol.t option
- val getByNumber: Int32.t -> ?.Protocol.t option
+ val getByNumber: int -> ?.Protocol.t option
val name: ?.Protocol.t -> string
- val number: ?.Protocol.t -> Int32.t
+ val number: ?.Protocol.t -> int
end
structure Service:
sig
type t = ?.Service.t
- val aliases: ?.Service.t -> string ?.vector
+ val aliases: ?.Service.t -> string vector
val getByName: (string * string option) -> ?.Service.t option
- val getByPort: (Int32.t * string option) -> ?.Service.t option
+ val getByPort: (int * string option) -> ?.Service.t option
val name: ?.Service.t -> string
- val port: ?.Service.t -> Int32.t
+ val port: ?.Service.t -> int
val protocol: ?.Service.t -> string
end
structure Socket:
@@ -730,17 +731,17 @@
val getOption: (('a, 'b) ?.Socket.sock
* ('c, 'a, 'b, 'd) ?.Socket.Option.t)
-> 'c
- val ioDesc: ('a, 'b) ?.Socket.sock -> Int32.t
+ val ioDesc: ('a, 'b) ?.Socket.sock -> int
val listen: (('a, ?.Socket.Type.passive ?.Socket.Type.stream) ?.Socket.sock
- * Int32.t)
+ * int)
-> unit
val make: ('a ?.Family.t
* 'b ?.Socket.Type.t
- * {protocol: Int32.t} option)
+ * {protocol: int} option)
-> ('a, 'b) ?.Socket.sock
val makePair: ('a ?.Family.t
* 'b ?.Socket.Type.t
- * {protocol: Int32.t} option)
+ * {protocol: int} option)
-> (('a, 'b) ?.Socket.sock * ('a, 'b) ?.Socket.sock)
val myAddress: ('a, 'b) ?.Socket.sock -> 'a ?.Socket.Address.t
val peerAddress: ('a, 'b) ?.Socket.sock -> 'a ?.Socket.Address.t
@@ -764,12 +765,12 @@
val == : ('a ?.Socket.Address.t * 'a ?.Socket.Address.t)
-> bool
val family: 'a ?.Socket.Address.t -> 'a ?.Family.t
- val inet: {port: Int32.t} -> ?.Family.inet ?.Socket.Address.t
- val ofHost: (?.Host.Address.t * {port: Int32.t})
+ val inet: {port: int} -> ?.Family.inet ?.Socket.Address.t
+ val ofHost: (?.Host.Address.t * {port: int})
-> ?.Family.inet ?.Socket.Address.t
val ofUnix: string -> ?.Family.unix ?.Socket.Address.t
val toHost: ?.Family.inet ?.Socket.Address.t
- -> (?.Host.Address.t * {port: Int32.t})
+ -> (?.Host.Address.t * {port: int})
val toUnix: ?.Family.unix ?.Socket.Address.t -> string
end
structure Block:
@@ -799,15 +800,15 @@
val error: (bool, 'a, 'b, ?.Socket.Option.ro) ?.Socket.Option.t
val keepAlive: (bool, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
val linger: (Time.t option, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
- val nRead: (Int32.t, 'a, 'b, ?.Socket.Option.ro) ?.Socket.Option.t
+ val nRead: (int, 'a, 'b, ?.Socket.Option.ro) ?.Socket.Option.t
val noDelay: (bool,
?.Family.inet,
'a ?.Socket.Type.stream,
?.Socket.Option.rw) ?.Socket.Option.t
val oobInline: (bool, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
- val rcvBuf: (Int32.t, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
+ val rcvBuf: (int, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
val reuseAddr: (bool, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
- val sndBuf: (Int32.t, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
+ val sndBuf: (int, 'a, 'b, ?.Socket.Option.rw) ?.Socket.Option.t
val ty: (?.Socket.Type.unknown ?.Socket.Type.t,
'a,
'b,
@@ -818,10 +819,10 @@
val receive: (('a, 'b, 'c, 'd) ?.Socket.Receive.From.t
* ('a, 'e, 'f, 'g, 'h, 'b, 'c) ?.Socket.Receive.To.t
* ('a,
- (Int32.t * 'a ?.Socket.Address.t),
- Int32.t,
- (Word8.t ?.vector * 'a ?.Socket.Address.t),
- Word8.t ?.vector,
+ (int * 'a ?.Socket.Address.t),
+ int,
+ (Word8.t vector * 'a ?.Socket.Address.t),
+ Word8.t vector,
'e,
'f,
'g,
@@ -876,7 +877,7 @@
'g) ?.Socket.Receive.To.t
val array: Word8.t ?.Sequence.Slice.t
-> ('a, 'b, 'c, 'd, 'e, 'b, 'c) ?.Socket.Receive.To.t
- val vector: {numBytes: Int32.t}
+ val vector: {numBytes: int}
-> ('a, 'b, 'c, 'd, 'e, 'd, 'e) ?.Socket.Receive.To.t
end
end
@@ -884,7 +885,7 @@
sig
val send: (?.Socket.Send.From.t
* ('a, 'b, 'c, 'd) ?.Socket.Send.To.t
- * ('a, unit, Int32.t, bool, Int32.t option, 'b, 'c) ?.Socket.Send.Block.t
+ * ('a, unit, int, bool, int option, 'b, 'c) ?.Socket.Send.Block.t
* ?.Socket.Send.Flag.t list)
-> 'd
structure Block:
@@ -910,7 +911,7 @@
type t = ?.Socket.Send.From.t
val array: Word8.t ?.Sequence.Slice.t
-> ?.Socket.Send.From.t
- val vector: Word8.t ?.Sequence.Slice.t
+ val vector: Word8.t VectorSlice.t
-> ?.Socket.Send.From.t
end
structure To:
@@ -944,7 +945,7 @@
val == : ('a ?.Socket.Type.t * 'a ?.Socket.Type.t) -> bool
val all: unit
-> (?.Socket.Type.unknown ?.Socket.Type.t
- * {name: string}) ?.vector
+ * {name: string}) vector
val dgram: ?.Socket.Type.dgram ?.Socket.Type.t
val ofString: string
-> ?.Socket.Type.unknown ?.Socket.Type.t option
@@ -997,7 +998,7 @@
val asin: ?.t -> ?.t
val atan: ?.t -> ?.t
val atan2: (?.t * ?.t) -> ?.t
- val ceil: ?.t -> Int32.t
+ val ceil: ?.t -> int
val checkFloat: ?.t -> ?.t
val class: ?.t -> ?.Class.t
val compare: (?.t * ?.t) -> order
@@ -1006,7 +1007,7 @@
val cosh: ?.t -> ?.t
val e: ?.t
val exp: ?.t -> ?.t
- val floor: ?.t -> Int32.t
+ val floor: ?.t -> int
val format: (?.t * ?.Format.t) -> string
val isFinite: ?.t -> bool
val isNan: ?.t -> bool
@@ -1020,55 +1021,52 @@
val minPos: ?.t
val negInf: ?.t
val nextAfter: (?.t * ?.t) -> ?.t
- val ofBytes: (Word8.t ?.vector * ?.Endian.t) -> ?.t
- val ofDecimal: {class: ?.Class.t,
- digits: Int32.t list,
- exp: Int32.t,
- sign: bool}
+ val ofBytes: (Word8.t vector * ?.Endian.t) -> ?.t
+ val ofDecimal: {class: ?.Class.t, digits: int list, exp: int, sign: bool}
-> ?.t option
- val ofInt: Int32.t -> ?.t
+ val ofInt: int -> ?.t
val ofLarge: (Real64.t * ?.RoundingMode.t) -> ?.t
- val ofLargeInt: IntInf.t -> ?.t
- val ofManExp: {exp: Int32.t, man: ?.t} -> ?.t
+ val ofLargeInt: LargeInt.t -> ?.t
+ val ofManExp: {exp: int, man: ?.t} -> ?.t
val ofString: string -> ?.t option
val pi: ?.t
val posInf: ?.t
val pow: (?.t * ?.t) -> ?.t
- val precision: Int32.t
- val radix: Int32.t
+ val precision: int
+ val radix: int
val realCeil: ?.t -> ?.t
val realFloor: ?.t -> ?.t
val realMod: ?.t -> ?.t
val realRound: ?.t -> ?.t
val realTrunc: ?.t -> ?.t
val rem: (?.t * ?.t) -> ?.t
- val round: ?.t -> Int32.t
+ val round: ?.t -> int
val sameSign: (?.t * ?.t) -> bool
val scanner: char seq -> (?.t * char seq) option
- val sign: ?.t -> Int32.t
+ val sign: ?.t -> int
val signBit: ?.t -> bool
val sin: ?.t -> ?.t
val sinh: ?.t -> ?.t
val split: ?.t -> {frac: ?.t, whole: ?.t}
val sqrt: ?.t -> ?.t
- val subArr: (Word8.t ?.array * Int32.t * ?.Endian.t) -> ?.t
- val subVec: (Word8.t ?.vector * Int32.t * ?.Endian.t) -> ?.t
+ val subArr: (Word8.t ArraySlice.base * int * ?.Endian.t) -> ?.t
+ val subVec: (Word8.t vector * int * ?.Endian.t) -> ?.t
val tan: ?.t -> ?.t
val tanh: ?.t -> ?.t
- val toBytes: (?.t * ?.Endian.t) -> Word8.t ?.vector
+ val toBytes: (?.t * ?.Endian.t) -> Word8.t vector
val toDecimal: ?.t
-> {class: ?.Class.t,
- digits: Int32.t list,
- exp: Int32.t,
+ digits: int list,
+ exp: int,
sign: bool}
- val toInt: (?.t * ?.RoundingMode.t) -> Int32.t
+ val toInt: (?.t * ?.RoundingMode.t) -> int
val toLarge: ?.t -> Real64.t
- val toLargeInt: (?.t * ?.RoundingMode.t) -> IntInf.t
- val toManExp: ?.t -> {exp: Int32.t, man: ?.t}
+ val toLargeInt: (?.t * ?.RoundingMode.t) -> LargeInt.t
+ val toManExp: ?.t -> {exp: int, man: ?.t}
val toString: ?.t -> string
- val trunc: ?.t -> Int32.t
+ val trunc: ?.t -> int
val unordered: (?.t * ?.t) -> bool
- val update: (Word8.t ?.array * Int32.t * ?.t * ?.Endian.t) -> unit
+ val update: (Word8.t ArraySlice.base * int * ?.t * ?.Endian.t) -> unit
val ~ : ?.t -> ?.t
structure Class:
sig
@@ -1076,24 +1074,21 @@
end
structure Decimal:
sig
- eqtype t = {class: ?.Class.t,
- digits: Int32.t list,
- exp: Int32.t,
- sign: bool}
+ eqtype t = {class: ?.Class.t, digits: int list, exp: int, sign: bool}
val ofString: string
-> {class: ?.Class.t,
- digits: Int32.t list,
- exp: Int32.t,
+ digits: int list,
+ exp: int,
sign: bool} option
val scanner: char seq
-> ({class: ?.Class.t,
- digits: Int32.t list,
- exp: Int32.t,
+ digits: int list,
+ exp: int,
sign: bool}
* char seq) option
val toString: {class: ?.Class.t,
- digits: Int32.t list,
- exp: Int32.t,
+ digits: int list,
+ exp: int,
sign: bool}
-> string
end
@@ -1101,9 +1096,9 @@
sig
type t = ?.Format.t
val exact: ?.Format.t
- val fix: Int32.t -> ?.Format.t
- val gen: Int32.t -> ?.Format.t
- val sci: Int32.t -> ?.Format.t
+ val fix: int -> ?.Format.t
+ val gen: int -> ?.Format.t
+ val sci: int -> ?.Format.t
end
structure RoundingMode:
sig
@@ -1123,12 +1118,12 @@
val + : (?.t * ?.t) -> ?.t
val - : (?.t * ?.t) -> ?.t
val < : (?.t * ?.t) -> bool
- val << : (?.t * Word32.t) -> ?.t
+ val << : (?.t * word) -> ?.t
val <= : (?.t * ?.t) -> bool
val == : (?.t * ?.t) -> bool
val > : (?.t * ?.t) -> bool
val >= : (?.t * ?.t) -> bool
- val >> : (?.t * Word32.t) -> ?.t
+ val >> : (?.t * word) -> ?.t
val andb: (?.t * ?.t) -> ?.t
val compare: (?.t * ?.t) -> order
val div: (?.t * ?.t) -> ?.t
@@ -1139,15 +1134,15 @@
val ofStringRadix: (string * Radix.t) -> ?.t option
val orb: (?.t * ?.t) -> ?.t
val scanner: Radix.t -> (char seq -> (?.t * char seq) option)
- val subArr: (Word8.t ?.array * Int32.t * ?.Endian.t) -> ?.t
- val subVec: (Word8.t ?.vector * Int32.t * ?.Endian.t) -> ?.t
+ val subArr: (Word8.t ArraySlice.base * int * ?.Endian.t) -> ?.t
+ val subVec: (Word8.t vector * int * ?.Endian.t) -> ?.t
val toLarge: ?.t -> Word64.t
val toLargeX: ?.t -> Word64.t
val toString: ?.t -> string
val toStringRadix: (?.t * Radix.t) -> string
- val update: (Word8.t ?.array * Int32.t * ?.t * ?.Endian.t) -> unit
+ val update: (Word8.t ArraySlice.base * int * ?.t * ?.Endian.t) -> unit
val xorb: (?.t * ?.t) -> ?.t
- val ~>> : (?.t * Word32.t) -> ?.t
+ val ~>> : (?.t * word) -> ?.t
end
signature PATH =
sig
@@ -1205,8 +1200,8 @@
val addIn: ?.Desc.t -> ?.Desc.t
val addOut: ?.Desc.t -> ?.Desc.t
val addPri: ?.Desc.t -> ?.Desc.t
- val ofIO: Int32.t -> ?.Desc.t option
- val toIO: ?.Desc.t -> Int32.t
+ val ofIO: int -> ?.Desc.t option
+ val toIO: ?.Desc.t -> int
end
structure Info:
sig
@@ -1276,8 +1271,8 @@
val pathconf: (string * string) -> Word64.t option
val pause: unit -> unit
val pipe: unit -> {infd: ?.FileDesc.t, outfd: ?.FileDesc.t}
- val readArr: (?.FileDesc.t * Word8.t ?.Sequence.Slice.t) -> Int32.t
- val readVec: (?.FileDesc.t * Int32.t) -> Word8.t ?.vector
+ val readArr: (?.FileDesc.t * Word8.t ?.Sequence.Slice.t) -> int
+ val readVec: (?.FileDesc.t * int) -> Word8.t vector
val readdir: ?.DirStream.t -> string option
val readlink: string -> string
val rename: {new: string, old: string} -> unit
@@ -1296,7 +1291,7 @@
val tcflush: (?.FileDesc.t * ?.QueueSel.t) -> unit
val tcgetattr: ?.FileDesc.t -> ?.Termios.t
val tcgetpgrp: ?.FileDesc.t -> ?.Pid.t
- val tcsendbreak: (?.FileDesc.t * Int32.t) -> unit
+ val tcsendbreak: (?.FileDesc.t * int) -> unit
val tcsetattr: (?.FileDesc.t * ?.SetAction.t * ?.Termios.t) -> unit
val tcsetpgrp: (?.FileDesc.t * ?.Pid.t) -> unit
val time: unit -> Time.t
@@ -1316,8 +1311,8 @@
-> (?.Pid.t * ?.ExitStatus.t)
val waitpidNohang: (?.WaitPidArg.t * ?.WaitPidFlags.t list)
-> (?.Pid.t * ?.ExitStatus.t) option
- val writeArr: (?.FileDesc.t * Word8.t ?.Sequence.Slice.t) -> Int32.t
- val writeVec: (?.FileDesc.t * Word8.t ?.Sequence.Slice.t) -> Int32.t
+ val writeArr: (?.FileDesc.t * Word8.t ?.Sequence.Slice.t) -> int
+ val writeVec: (?.FileDesc.t * Word8.t VectorSlice.t) -> int
structure AccessMode:
sig
type t = ?.AccessMode.t
@@ -1393,7 +1388,7 @@
| ExitStatus of Word8.t
| Signaled of ?.Signal.t
| Stopped of ?.Signal.t
- val ofStatus: Int32.t -> ?.ExitStatus.t
+ val ofStatus: int -> ?.ExitStatus.t
end
structure Fcntl:
sig
@@ -1410,12 +1405,12 @@
structure FileDesc:
sig
type t = ?.FileDesc.t
- val ofIODesc: Int32.t -> ?.FileDesc.t option
+ val ofIODesc: int -> ?.FileDesc.t option
val ofWord: Word64.t -> ?.FileDesc.t
val stderr: ?.FileDesc.t
val stdin: ?.FileDesc.t
val stdout: ?.FileDesc.t
- val toIODesc: ?.FileDesc.t -> Int32.t
+ val toIODesc: ?.FileDesc.t -> int
val toWord: ?.FileDesc.t -> Word64.t
end
structure FileDescFlags:
@@ -1627,7 +1622,7 @@
val isSock: ?.Stat.t -> bool
val mode: ?.Stat.t -> ?.Mode.t
val mtime: ?.Stat.t -> Time.t
- val nlink: ?.Stat.t -> Int32.t
+ val nlink: ?.Stat.t -> int
val size: ?.Stat.t -> Int64.t
val uid: ?.Stat.t -> ?.Uid.t
end
@@ -1667,21 +1662,21 @@
structure CC:
sig
type t = ?.Termios.CC.t
- val eof: Int32.t
- val eol: Int32.t
- val erase: Int32.t
- val intr: Int32.t
- val kill: Int32.t
- val make: (Int32.t * char) list -> ?.Termios.CC.t
- val min: Int32.t
- val nccs: Int32.t
- val quit: Int32.t
- val start: Int32.t
- val stop: Int32.t
- val sub: (?.Termios.CC.t * Int32.t) -> char
- val susp: Int32.t
- val time: Int32.t
- val update: (?.Termios.CC.t * (Int32.t * char) list)
+ val eof: int
+ val eol: int
+ val erase: int
+ val intr: int
+ val kill: int
+ val make: (int * char) list -> ?.Termios.CC.t
+ val min: int
+ val nccs: int
+ val quit: int
+ val start: int
+ val stop: int
+ val sub: (?.Termios.CC.t * int) -> char
+ val susp: int
+ val time: int
+ val update: (?.Termios.CC.t * (int * char) list)
-> ?.Termios.CC.t
end
structure I:
@@ -1847,7 +1842,7 @@
val asin: ?.t -> ?.t
val atan: ?.t -> ?.t
val atan2: (?.t * ?.t) -> ?.t
- val ceil: ?.t -> Int32.t
+ val ceil: ?.t -> int
val checkFloat: ?.t -> ?.t
val class: ?.t -> ?.Class.t
val compare: (?.t * ?.t) -> order
@@ -1856,7 +1851,7 @@
val cosh: ?.t -> ?.t
val e: ?.t
val exp: ?.t -> ?.t
- val floor: ?.t -> Int32.t
+ val floor: ?.t -> int
val format: (?.t * ?.Format.t) -> string
val isFinite: ?.t -> bool
val isNan: ?.t -> bool
@@ -1870,31 +1865,28 @@
val minPos: ?.t
val negInf: ?.t
val nextAfter: (?.t * ?.t) -> ?.t
- val ofDecimal: {class: ?.Class.t,
- digits: Int32.t list,
- exp: Int32.t,
- sign: bool}
+ val ofDecimal: {class: ?.Class.t, digits: int list, exp: int, sign: bool}
-> ?.t option
- val ofInt: Int32.t -> ?.t
+ val ofInt: int -> ?.t
val ofLarge: (Real64.t * ?.RoundingMode.t) -> ?.t
- val ofLargeInt: IntInf.t -> ?.t
- val ofManExp: {exp: Int32.t, man: ?.t} -> ?.t
+ val ofLargeInt: LargeInt.t -> ?.t
+ val ofManExp: {exp: int, man: ?.t} -> ?.t
val ofString: string -> ?.t option
val pi: ?.t
val posInf: ?.t
val pow: (?.t * ?.t) -> ?.t
- val precision: Int32.t
- val radix: Int32.t
+ val precision: int
+ val radix: int
val realCeil: ?.t -> ?.t
val realFloor: ?.t -> ?.t
val realMod: ?.t -> ?.t
val realRound: ?.t -> ?.t
val realTrunc: ?.t -> ?.t
val rem: (?.t * ?.t) -> ?.t
- val round: ?.t -> Int32.t
+ val round: ?.t -> int
val sameSign: (?.t * ?.t) -> bool
val scanner: char seq -> (?.t * char seq) option
- val sign: ?.t -> Int32.t
+ val sign: ?.t -> int
val signBit: ?.t -> bool
val sin: ?.t -> ?.t
val sinh: ?.t -> ?.t
@@ -1904,15 +1896,15 @@
val tanh: ?.t -> ?.t
val toDecimal: ?.t
-> {class: ?.Class.t,
- digits: Int32.t list,
- exp: Int32.t,
+ digits: int list,
+ exp: int,
sign: bool}
- val toInt: (?.t * ?.RoundingMode.t) -> Int32.t
+ val toInt: (?.t * ?.RoundingMode.t) -> int
val toLarge: ?.t -> Real64.t
- val toLargeInt: (?.t * ?.RoundingMode.t) -> IntInf.t
- val toManExp: ?.t -> {exp: Int32.t, man: ?.t}
+ val toLargeInt: (?.t * ?.RoundingMode.t) -> LargeInt.t
+ val toManExp: ?.t -> {exp: int, man: ?.t}
val toString: ?.t -> string
- val trunc: ?.t -> Int32.t
+ val trunc: ?.t -> int
val unordered: (?.t * ?.t) -> bool
val ~ : ?.t -> ?.t
structure Class:
@@ -1921,24 +1913,21 @@
end
structure Decimal:
sig
- eqtype t = {class: ?.Class.t,
- digits: Int32.t list,
- exp: Int32.t,
- sign: bool}
+ eqtype t = {class: ?.Class.t, digits: int list, exp: int, sign: bool}
val ofString: string
-> {class: ?.Class.t,
- digits: Int32.t list,
- exp: Int32.t,
+ digits: int list,
+ exp: int,
sign: bool} option
val scanner: char seq
-> ({class: ?.Class.t,
- digits: Int32.t list,
- exp: Int32.t,
+ digits: int list,
+ exp: int,
sign: bool}
* char seq) option
val toString: {class: ?.Class.t,
- digits: Int32.t list,
- exp: Int32.t,
+ digits: int list,
+ exp: int,
sign: bool}
-> string
end
@@ -1946,9 +1935,9 @@
sig
type t = ?.Format.t
val exact: ?.Format.t
- val fix: Int32.t -> ?.Format.t
- val gen: Int32.t -> ?.Format.t
- val sci: Int32.t -> ?.Format.t
+ val fix: int -> ?.Format.t
+ val gen: int -> ?.Format.t
+ val sci: int -> ?.Format.t
end
structure RoundingMode:
sig
@@ -1988,9 +1977,9 @@
val delay: (unit -> 'a ?.t) -> 'a ?.t
val drop: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
val dropPrefix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val dropPrefixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val dropPrefixN: ('a ?.t * int) -> 'a ?.t
val dropSuffix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val dropSuffixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val dropSuffixN: ('a ?.t * int) -> 'a ?.t
val empty: unit -> 'a ?.t
val exists: ('a ?.t * ('a ?.elem -> bool)) -> bool
val fields: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t seq
@@ -2002,13 +1991,13 @@
val join: ('a ?.t seq * 'a ?.t) -> 'a ?.t
val keep: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
val keepPrefix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val keepPrefixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val keepPrefixN: ('a ?.t * int) -> 'a ?.t
val keepSuffix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val keepSuffixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val keepSuffixN: ('a ?.t * int) -> 'a ?.t
val last: 'a ?.t -> 'a ?.elem
val map: ('a ?.t * ('a ?.elem -> 'b ?.elem)) -> 'b ?.t
val ofSeq: 'a ?.elem seq -> 'a ?.t
- val ofSeqN: ('a ?.elem seq * Int32.t) -> 'a ?.t
+ val ofSeqN: ('a ?.elem seq * int) -> 'a ?.t
val recur: ('a ?.t
* 'b
* ('b -> 'c)
@@ -2017,18 +2006,18 @@
val reverse: 'a ?.t -> 'a ?.t
val separate: ('a ?.t * 'a ?.elem) -> 'a ?.t
val single: 'a ?.elem -> 'a ?.t
- val size: 'a ?.t -> Int32.t
+ val size: 'a ?.t -> int
val splitPrefix: ('a ?.t * ('a ?.elem -> bool)) -> ('a ?.t * 'a ?.t)
- val sub: ('a ?.t * Int32.t) -> 'a ?.elem
- val tabulate: (Int32.t * (Int32.t -> 'a ?.elem)) -> 'a ?.t
+ val sub: ('a ?.t * int) -> 'a ?.elem
+ val tabulate: (int * (int -> 'a ?.elem)) -> 'a ?.t
val toSeq: 'a ?.t -> 'a ?.elem seq
val toSeqR: 'a ?.t -> 'a ?.elem seq
val tokens: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t seq
val unfold: ('a * ('a -> ('b ?.elem * 'a) option))
-> ('b ?.t * 'a ?.unfold)
- val unfoldN: (Int32.t * 'a * ((Int32.t * 'a) -> ('b ?.elem * 'a) option))
+ val unfoldN: (int * 'a * ((int * 'a) -> ('b ?.elem * 'a) option))
-> ('b ?.t * 'a ?.unfold)
- val unfoldNR: (Int32.t * 'a * ((Int32.t * 'a) -> ('b ?.elem * 'a) option))
+ val unfoldNR: (int * 'a * ((int * 'a) -> ('b ?.elem * 'a) option))
-> ('b ?.t * 'a ?.unfoldR)
val unfoldR: ('a * ('a -> ('b ?.elem * 'a) option))
-> ('b ?.t * 'a ?.unfoldR)
@@ -2046,9 +2035,9 @@
val cons: (char * ?.t) -> ?.t
val drop: (?.t * (char -> bool)) -> ?.t
val dropPrefix: (?.t * (char -> bool)) -> ?.t
- val dropPrefixN: (?.t * Int32.t) -> ?.t
+ val dropPrefixN: (?.t * int) -> ?.t
val dropSuffix: (?.t * (char -> bool)) -> ?.t
- val dropSuffixN: (?.t * Int32.t) -> ?.t
+ val dropSuffixN: (?.t * int) -> ?.t
val empty: unit -> ?.t
val exists: (?.t * (char -> bool)) -> bool
val fields: (?.t * (char -> bool)) -> ?.t seq
@@ -2060,40 +2049,40 @@
val join: (?.t seq * ?.t) -> ?.t
val keep: (?.t * (char -> bool)) -> ?.t
val keepPrefix: (?.t * (char -> bool)) -> ?.t
- val keepPrefixN: (?.t * Int32.t) -> ?.t
+ val keepPrefixN: (?.t * int) -> ?.t
val keepSuffix: (?.t * (char -> bool)) -> ?.t
- val keepSuffixN: (?.t * Int32.t) -> ?.t
+ val keepSuffixN: (?.t * int) -> ?.t
val last: ?.t -> char
- val make: Int32.t
+ val make: int
-> {done: unit -> ?.t,
- sub: Int32.t -> char,
- update: (Int32.t * char) -> unit}
+ sub: int -> char,
+ update: (int * char) -> unit}
val map: (?.t * (char -> char)) -> ?.t
val ofSeq: char seq -> ?.t
- val ofSeqN: (char seq * Int32.t) -> ?.t
+ val ofSeqN: (char seq * int) -> ?.t
val recur: (?.t * 'a * ('a -> 'b) * ((char * 'a * ('a -> 'b)) -> 'b))
-> 'b
val reverse: ?.t -> ?.t
val separate: (?.t * char) -> ?.t
val single: char -> ?.t
- val size: ?.t -> Int32.t
+ val size: ?.t -> int
val splitPrefix: (?.t * (char -> bool)) -> (?.t * ?.t)
- val sub: (?.t * Int32.t) -> char
- val tabulate: (Int32.t * (Int32.t -> char)) -> ?.t
+ val sub: (?.t * int) -> char
+ val tabulate: (int * (int -> char)) -> ?.t
val toLower: ?.t -> ?.t
val toSeq: ?.t -> char seq
val toSeqR: ?.t -> char seq
val toUpper: ?.t -> ?.t
val tokens: (?.t * (char -> bool)) -> ?.t seq
val unfold: ('a * ('a -> (char * 'a) option)) -> (?.t * 'a ?.unfold)
- val unfoldN: (Int32.t * 'a * ((Int32.t * 'a) -> (char * 'a) option))
+ val unfoldN: (int * 'a * ((int * 'a) -> (char * 'a) option))
-> (?.t * 'a ?.unfold)
- val unfoldNR: (Int32.t * 'a * ((Int32.t * 'a) -> (char * 'a) option))
+ val unfoldNR: (int * 'a * ((int * 'a) -> (char * 'a) option))
-> (?.t * 'a ?.unfoldR)
val unfoldR: ('a * ('a -> (char * 'a) option)) -> (?.t * 'a ?.unfoldR)
structure Unsafe:
sig
- val sub: (?.t * Int32.t) -> char
+ val sub: (?.t * int) -> char
end
end
signature SUBSTRING =
@@ -2103,11 +2092,11 @@
type t = ?.t
type 'a t0 = ?.t
val all: (?.t * (char -> bool)) -> bool
- val base: ?.t -> ('a ?.base * {start: Int32.t})
+ val base: ?.t -> ('a ?.base * {start: int})
val dropPrefix: (?.t * (char -> bool)) -> ?.t
- val dropPrefixN: (?.t * Int32.t) -> ?.t
+ val dropPrefixN: (?.t * int) -> ?.t
val dropSuffix: (?.t * (char -> bool)) -> ?.t
- val dropSuffixN: (?.t * Int32.t) -> ?.t
+ val dropSuffixN: (?.t * int) -> ?.t
val exists: (?.t * (char -> bool)) -> bool
val fields: (?.t * (char -> bool)) -> ?.t seq
val find: (?.t * (char -> bool)) -> char option
@@ -2117,17 +2106,17 @@
val get: ?.t -> (char * ?.t) option
val isEmpty: ?.t -> bool
val keepPrefix: (?.t * (char -> bool)) -> ?.t
- val keepPrefixN: (?.t * Int32.t) -> ?.t
+ val keepPrefixN: (?.t * int) -> ?.t
val keepSuffix: (?.t * (char -> bool)) -> ?.t
- val keepSuffixN: (?.t * Int32.t) -> ?.t
+ val keepSuffixN: (?.t * int) -> ?.t
val last: ?.t -> char
val map: (?.t * (char -> char)) -> 'a ?.base
val recur: (?.t * 'a * ('a -> 'b) * ((char * 'a * ('a -> 'b)) -> 'b))
-> 'b
- val size: ?.t -> Int32.t
- val slice: (?.t * {size: Int32.t, start: Int32.t}) -> ?.t
+ val size: ?.t -> int
+ val slice: (?.t * {size: int, start: int}) -> ?.t
val splitPrefix: (?.t * (char -> bool)) -> (?.t * ?.t)
- val sub: (?.t * Int32.t) -> char
+ val sub: (?.t * int) -> char
val toSeq: ?.t -> char seq
val toSeqR: ?.t -> char seq
val tokens: (?.t * (char -> bool)) -> ?.t seq
@@ -2160,20 +2149,20 @@
val >= : (?.t * ?.t) -> bool
exception Time
val compare: (?.t * ?.t) -> order
- val format: (?.t * {fractionalDigits: Int32.t}) -> string
+ val format: (?.t * {fractionalDigits: int}) -> string
val fromReal: Real64.t -> ?.t
val now: unit -> ?.t
- val ofMicroseconds: IntInf.t -> ?.t
- val ofMilliseconds: IntInf.t -> ?.t
- val ofNanoseconds: IntInf.t -> ?.t
- val ofSeconds: IntInf.t -> ?.t
+ val ofMicroseconds: LargeInt.t -> ?.t
+ val ofMilliseconds: LargeInt.t -> ?.t
+ val ofNanoseconds: LargeInt.t -> ?.t
+ val ofSeconds: LargeInt.t -> ?.t
val ofString: string -> ?.t option
val scanner: char seq -> (?.t * char seq) option
- val toMicroseconds: ?.t -> IntInf.t
- val toMilliseconds: ?.t -> IntInf.t
- val toNanoseconds: ?.t -> IntInf.t
+ val toMicroseconds: ?.t -> LargeInt.t
+ val toMilliseconds: ?.t -> LargeInt.t
+ val toNanoseconds: ?.t -> LargeInt.t
val toReal: ?.t -> Real64.t
- val toSeconds: ?.t -> IntInf.t
+ val toSeconds: ?.t -> LargeInt.t
val toString: ?.t -> string
val zero: ?.t
end
@@ -2190,9 +2179,9 @@
val cons: ('a ?.elem * 'a ?.t) -> 'a ?.t
val drop: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
val dropPrefix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val dropPrefixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val dropPrefixN: ('a ?.t * int) -> 'a ?.t
val dropSuffix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val dropSuffixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val dropSuffixN: ('a ?.t * int) -> 'a ?.t
val empty: unit -> 'a ?.t
val exists: ('a ?.t * ('a ?.elem -> bool)) -> bool
val fields: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t seq
@@ -2203,17 +2192,17 @@
val join: ('a ?.t seq * 'a ?.t) -> 'a ?.t
val keep: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
val keepPrefix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val keepPrefixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val keepPrefixN: ('a ?.t * int) -> 'a ?.t
val keepSuffix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val keepSuffixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val keepSuffixN: ('a ?.t * int) -> 'a ?.t
val last: 'a ?.t -> 'a ?.elem
- val make: Int32.t
+ val make: int
-> {done: unit -> 'a ?.t,
- sub: Int32.t -> 'a ?.elem,
- update: (Int32.t * 'a ?.elem) -> unit}
+ sub: int -> 'a ?.elem,
+ update: (int * 'a ?.elem) -> unit}
val map: ('a ?.t * ('a ?.elem -> 'b ?.elem)) -> 'b ?.t
val ofSeq: 'a ?.elem seq -> 'a ?.t
- val ofSeqN: ('a ?.elem seq * Int32.t) -> 'a ?.t
+ val ofSeqN: ('a ?.elem seq * int) -> 'a ?.t
val recur: ('a ?.t
* 'b
* ('b -> 'c)
@@ -2222,24 +2211,24 @@
val reverse: 'a ?.t -> 'a ?.t
val separate: ('a ?.t * 'a ?.elem) -> 'a ?.t
val single: 'a ?.elem -> 'a ?.t
- val size: 'a ?.t -> Int32.t
+ val size: 'a ?.t -> int
val splitPrefix: ('a ?.t * ('a ?.elem -> bool)) -> ('a ?.t * 'a ?.t)
- val sub: ('a ?.t * Int32.t) -> 'a ?.elem
- val tabulate: (Int32.t * (Int32.t -> 'a ?.elem)) -> 'a ?.t
+ val sub: ('a ?.t * int) -> 'a ?.elem
+ val tabulate: (int * (int -> 'a ?.elem)) -> 'a ?.t
val toSeq: 'a ?.t -> 'a ?.elem seq
val toSeqR: 'a ?.t -> 'a ?.elem seq
val tokens: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t seq
val unfold: ('a * ('a -> ('b ?.elem * 'a) option))
-> ('b ?.t * 'a ?.unfold)
- val unfoldN: (Int32.t * 'a * ((Int32.t * 'a) -> ('b ?.elem * 'a) option))
+ val unfoldN: (int * 'a * ((int * 'a) -> ('b ?.elem * 'a) option))
-> ('b ?.t * 'a ?.unfold)
- val unfoldNR: (Int32.t * 'a * ((Int32.t * 'a) -> ('b ?.elem * 'a) option))
+ val unfoldNR: (int * 'a * ((int * 'a) -> ('b ?.elem * 'a) option))
-> ('b ?.t * 'a ?.unfoldR)
val unfoldR: ('a * ('a -> ('b ?.elem * 'a) option))
-> ('b ?.t * 'a ?.unfoldR)
structure Unsafe:
sig
- val sub: ('a ?.t * Int32.t) -> 'a ?.elem
+ val sub: ('a ?.t * int) -> 'a ?.elem
end
end
signature VECTOR_SLICE =
@@ -2249,11 +2238,11 @@
type 'a t = 'a ?.t
type 'a t0 = 'a ?.t
val all: ('a ?.t * ('a ?.elem -> bool)) -> bool
- val base: 'a ?.t -> ('a ?.base * {start: Int32.t})
+ val base: 'a ?.t -> ('a ?.base * {start: int})
val dropPrefix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val dropPrefixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val dropPrefixN: ('a ?.t * int) -> 'a ?.t
val dropSuffix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val dropSuffixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val dropSuffixN: ('a ?.t * int) -> 'a ?.t
val exists: ('a ?.t * ('a ?.elem -> bool)) -> bool
val fields: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t seq
val find: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.elem option
@@ -2263,9 +2252,9 @@
val get: 'a ?.t -> ('a ?.elem * 'a ?.t) option
val isEmpty: 'a ?.t -> bool
val keepPrefix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val keepPrefixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val keepPrefixN: ('a ?.t * int) -> 'a ?.t
val keepSuffix: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t
- val keepSuffixN: ('a ?.t * Int32.t) -> 'a ?.t
+ val keepSuffixN: ('a ?.t * int) -> 'a ?.t
val last: 'a ?.t -> 'a ?.elem
val map: ('a ?.t * ('a ?.elem -> 'b ?.elem)) -> 'b ?.base
val recur: ('a ?.t
@@ -2273,10 +2262,10 @@
* ('b -> 'c)
* (('a ?.elem * 'b * ('b -> 'c)) -> 'c))
-> 'c
- val size: 'a ?.t -> Int32.t
- val slice: ('a ?.t * {size: Int32.t, start: Int32.t}) -> 'a ?.t
+ val size: 'a ?.t -> int
+ val slice: ('a ?.t * {size: int, start: int}) -> 'a ?.t
val splitPrefix: ('a ?.t * ('a ?.elem -> bool)) -> ('a ?.t * 'a ?.t)
- val sub: ('a ?.t * Int32.t) -> 'a ?.elem
+ val sub: ('a ?.t * int) -> 'a ?.elem
val toSeq: 'a ?.t -> 'a ?.elem seq
val toSeqR: 'a ?.t -> 'a ?.elem seq
val tokens: ('a ?.t * ('a ?.elem -> bool)) -> 'a ?.t seq
@@ -2288,12 +2277,12 @@
val + : (?.t * ?.t) -> ?.t
val - : (?.t * ?.t) -> ?.t
val < : (?.t * ?.t) -> bool
- val << : (?.t * Word32.t) -> ?.t
+ val << : (?.t * word) -> ?.t
val <= : (?.t * ?.t) -> bool
val == : (?.t * ?.t) -> bool
val > : (?.t * ?.t) -> bool
val >= : (?.t * ?.t) -> bool
- val >> : (?.t * Word32.t) -> ?.t
+ val >> : (?.t * word) -> ?.t
val andb: (?.t * ?.t) -> ?.t
val compare: (?.t * ?.t) -> order
val div: (?.t * ?.t) -> ?.t
@@ -2309,5 +2298,36 @@
val toString: ?.t -> string
val toStringRadix: (?.t * Radix.t) -> string
val xorb: (?.t * ?.t) -> ?.t
- val ~>> : (?.t * Word32.t) -> ?.t
+ val ~>> : (?.t * word) -> ?.t
end
+signature WORD8 =
+ sig
+ type t = ?.t
+ val * : (?.t * ?.t) -> ?.t
+ val + : (?.t * ?.t) -> ?.t
+ val - : (?.t * ?.t) -> ?.t
+ val < : (?.t * ?.t) -> bool
+ val << : (?.t * word) -> ?.t
+ val <= : (?.t * ?.t) -> bool
+ val == : (?.t * ?.t) -> bool
+ val > : (?.t * ?.t) -> bool
+ val >= : (?.t * ?.t) -> bool
+ val >> : (?.t * word) -> ?.t
+ val andb: (?.t * ?.t) -> ?.t
+ val compare: (?.t * ?.t) -> order
+ val div: (?.t * ?.t) -> ?.t
+ val mod: (?.t * ?.t) -> ?.t
+ val notb: ?.t -> ?.t
+ val ofLarge: Word64.t -> ?.t
+ val ofString: string -> ?.t option
+ val ofStringRadix: (string * Radix.t) -> ?.t option
+ val orb: (?.t * ?.t) -> ?.t
+ val scanner: Radix.t -> (char seq -> (?.t * char seq) option)
+ val toChar: ?.t -> char
+ val toLarge: ?.t -> Word64.t
+ val toLargeX: ?.t -> Word64.t
+ val toString: ?.t -> string
+ val toStringRadix: (?.t * Radix.t) -> string
+ val xorb: (?.t * ?.t) -> ?.t
+ val ~>> : (?.t * word) -> ?.t
+ end
Modified: mltonlib/trunk/com/sweeks/basic/unstable/basis.sml
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/basis.sml 2006-12-10 19:30:19 UTC (rev 4967)
+++ mltonlib/trunk/com/sweeks/basic/unstable/basis.sml 2006-12-11 03:18:01 UTC (rev 4968)
@@ -2,6 +2,7 @@
structure Array = Array
structure ArraySlice = ArraySlice
structure Bool = Bool
+ structure Byte = Byte
structure Char = Char
structure CommandLine = CommandLine
structure Date = Date
Modified: mltonlib/trunk/com/sweeks/basic/unstable/char.sig
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/char.sig 2006-12-10 19:30:19 UTC (rev 4967)
+++ mltonlib/trunk/com/sweeks/basic/unstable/char.sig 2006-12-11 03:18:01 UTC (rev 4968)
@@ -1,3 +1,8 @@
+structure Word8 = struct
+ open Word8
+ type t = word
+end
+
signature CHAR = sig
include ORDERED
@@ -69,5 +74,9 @@
* toUpper c returns the uppercase letter corresponding to c, if c is a
* letter, otherwise returns c.
*)
+ val toWord8: t -> Word8.t
+ (**
+ * returns an 8-bit word holding the code for the character c.
+ *)
end
Modified: mltonlib/trunk/com/sweeks/basic/unstable/char.sml
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/char.sml 2006-12-10 19:30:19 UTC (rev 4967)
+++ mltonlib/trunk/com/sweeks/basic/unstable/char.sml 2006-12-11 03:18:01 UTC (rev 4968)
@@ -30,5 +30,7 @@
val == = op =
val compare = Order.ofBasis o Char.compare
+
+ val toWord8 = Byte.charToByte
end
Modified: mltonlib/trunk/com/sweeks/basic/unstable/export.sig
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/export.sig 2006-12-10 19:30:19 UTC (rev 4967)
+++ mltonlib/trunk/com/sweeks/basic/unstable/export.sig 2006-12-11 03:18:01 UTC (rev 4968)
@@ -45,7 +45,7 @@
structure Vector: VECTOR
structure VectorSlice: VECTOR_SLICE
structure Word: WORD
- structure Word8: WORD
+ structure Word8: WORD8
structure Word16: WORD
structure Word32: PACKABLE_WORD
structure Word64: WORD
Modified: mltonlib/trunk/com/sweeks/basic/unstable/export.sml
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/export.sml 2006-12-10 19:30:19 UTC (rev 4967)
+++ mltonlib/trunk/com/sweeks/basic/unstable/export.sml 2006-12-11 03:18:01 UTC (rev 4968)
@@ -1,20 +1,46 @@
structure Export:>
EXPORT
+ where type 'a Array.t = 'a Array.t
+ where type 'a Array.elem = 'a Array.elem
+ where type 'a Array.unfold = 'a Array.unfold
+ where type 'a Array.unfoldR = 'a Array.unfoldR
+ where type 'a ArraySlice.elem = 'a ArraySlice.elem
where type Char.t = Char.t
where type In.t = In.t
+ where type Int.t = Int.t
where type Int8.t = Int8.t
where type Int16.t = Int16.t
where type Int32.t = Int32.t
where type Int64.t = Int64.t
where type IntInf.t = IntInf.t
+ where type LargeInt.t = LargeInt.t
+ where type LargeReal.t = LargeReal.t
+ where type LargeWord.t = LargeWord.t
+ where type 'a List.elem = 'a List.elem
+ where type 'a List.unfold = 'a List.unfold
+ where type 'a List.unfoldR = 'a List.unfoldR
where type 'a Option.t = 'a Option.t
where type Out.t = Out.t
where type Radix.t = Radix.t
+ where type Real.t = Real.t
where type Real32.t = Real32.t
where type Real64.t = Real64.t
where type 'a Seq.t = 'a Seq.t
+ where type 'a Seq.elem = 'a Seq.elem
+ where type 'a Seq.unfold = 'a Seq.unfold
+ where type 'a Seq.unfoldR = 'a Seq.unfoldR
where type String.t = String.t
+ where type 'a String.unfold = 'a String.unfold
+ where type 'a String.unfoldR = 'a String.unfoldR
+ where type Substring.t = Substring.t
where type Time.t = Time.t
+ where type 'a Vector.t = 'a Vector.t
+ where type 'a Vector.elem = 'a Vector.elem
+ where type 'a Vector.unfold = 'a Vector.unfold
+ where type 'a Vector.unfoldR = 'a Vector.unfoldR
+ where type 'a VectorSlice.t = 'a VectorSlice.t
+ where type 'a VectorSlice.elem = 'a VectorSlice.elem
+ where type Word.t = Word.t
where type Word8.t = Word8.t
where type Word16.t = Word16.t
where type Word32.t = Word32.t
Modified: mltonlib/trunk/com/sweeks/basic/unstable/lib.mlb
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/lib.mlb 2006-12-10 19:30:19 UTC (rev 4967)
+++ mltonlib/trunk/com/sweeks/basic/unstable/lib.mlb 2006-12-11 03:18:01 UTC (rev 4968)
@@ -108,6 +108,7 @@
endian.sig
endian.sml
word.sig
+ word8.sig
word.fun
packable-word.sig
packable-word.fun
@@ -195,6 +196,7 @@
signature VECTOR
signature VECTOR_SLICE
signature WORD
+ signature WORD8
end
end
Modified: mltonlib/trunk/com/sweeks/basic/unstable/word.sml
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/word.sml 2006-12-10 19:30:19 UTC (rev 4967)
+++ mltonlib/trunk/com/sweeks/basic/unstable/word.sml 2006-12-11 03:18:01 UTC (rev 4968)
@@ -11,3 +11,10 @@
structure Word = Word32)
structure Word64 = Word (structure Word = Word64)
end
+
+
+structure Word8 = struct
+ open Word8
+
+ val toChar = Byte.byteToChar
+end
Added: mltonlib/trunk/com/sweeks/basic/unstable/word8.sig
===================================================================
--- mltonlib/trunk/com/sweeks/basic/unstable/word8.sig 2006-12-10 19:30:19 UTC (rev 4967)
+++ mltonlib/trunk/com/sweeks/basic/unstable/word8.sig 2006-12-11 03:18:01 UTC (rev 4968)
@@ -0,0 +1,5 @@
+signature WORD8 = sig
+ include WORD
+
+ val toChar: t -> Char.t
+end
|
|
From: Vesa K. <ve...@ml...> - 2006-12-10 11:30:32
|
More reliable/portable (hopefully) implementation of esml-split-string.
----------------------------------------------------------------------
U mlton/trunk/ide/emacs/esml-util.el
----------------------------------------------------------------------
Modified: mlton/trunk/ide/emacs/esml-util.el
===================================================================
--- mlton/trunk/ide/emacs/esml-util.el 2006-12-10 19:17:51 UTC (rev 4966)
+++ mlton/trunk/ide/emacs/esml-util.el 2006-12-10 19:30:19 UTC (rev 4967)
@@ -32,11 +32,8 @@
(forward-char (length str))
(insert str)))
-;; workaround for incompatibility between GNU Emacs and XEmacs
(defun esml-split-string (string separator)
- (if (string-match "XEmacs" emacs-version)
- (split-string string separator t)
- (remove* "" (split-string string separator))))
+ (remove* "" (split-string string separator) :test 'equal))
;; workaround for incompatibility between GNU Emacs and XEmacs
(defun esml-replace-regexp-in-string (str regexp rep)
|
|
From: Vesa K. <ve...@ml...> - 2006-12-10 11:17:58
|
Reorganized public files. ---------------------------------------------------------------------- D mltonlib/trunk/com/ssh/extended-basis/unstable/public/integer.sig ---------------------------------------------------------------------- Deleted: mltonlib/trunk/com/ssh/extended-basis/unstable/public/integer.sig =================================================================== --- mltonlib/trunk/com/ssh/extended-basis/unstable/public/integer.sig 2006-12-10 19:17:36 UTC (rev 4965) +++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/integer.sig 2006-12-10 19:17:51 UTC (rev 4966) @@ -1,64 +0,0 @@ -(* Copyright (C) 2006 SSH Communications Security, Helsinki, Finland - * - * This code is released under the MLton license, a BSD-style license. - * See the LICENSE file or http://mlton.org/License for details. - *) - -(** Extended {INTEGER} signature. *) -signature INTEGER = sig - include INTEGER - - type t = int - (** Convenience alias. *) - - (** == Bounds == *) - - val bounds : t Sq.t Option.t - (** - * Pair of the minimal and maximal integers, respectively, - * representable by {int}. If {minInt = NONE} and {maxInt = NONE}, - * this is also {NONE}. Otherwise this is {SOME (valOf minInt, valOf - * maxInt)}. - *) - - (** == Embeddings == *) - - val embString : (t, String.t) Emb.t - (** - * An embedding of integers into strings. It is always equivalent to - * {(toString, fromString)}. - *) - - (** == Isomorphisms == *) - - val isoInt : (t, Int.t) Iso.t - (** - * An isomorphism between integers of type {int} and the default - * integer type. It is always equivalent to {(toInt, fromInt)}. Note - * that one of the injection and projection parts may be partial. - *) - - val isoLarge : (t, LargeInt.t) Iso.t - (** - * An isomorphism between integers of type {int} and integers of type - * {LargeInt.int}. It is always equivalent to {(toLarge, fromLarge)}. - * Note that the projection part may be partial. - *) - - (** == Predicates == *) - - val isEven : t UnPr.t - (** - * Returns true if the given integer is of the form {2*n} for some - * integer {n}. - *) - - val isOdd : t UnPr.t - (** - * Returns true if the given integer is of the form {2*n+1} for some - * integer {n}. - *) - - val isZero : t UnPr.t - (** Returns true if the given integer is {0}. *) -end |
|
From: Vesa K. <ve...@ml...> - 2006-12-10 11:17:39
|
Reorganized public files. ---------------------------------------------------------------------- D mltonlib/trunk/com/ssh/extended-basis/unstable/public/effect.sig ---------------------------------------------------------------------- Deleted: mltonlib/trunk/com/ssh/extended-basis/unstable/public/effect.sig =================================================================== --- mltonlib/trunk/com/ssh/extended-basis/unstable/public/effect.sig 2006-12-10 19:17:13 UTC (rev 4964) +++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/effect.sig 2006-12-10 19:17:36 UTC (rev 4965) @@ -1,32 +0,0 @@ -(* Copyright (C) 2006 SSH Communications Security, Helsinki, Finland - * - * This code is released under the MLton license, a BSD-style license. - * See the LICENSE file or http://mlton.org/License for details. - *) - -(** Utilities for dealing with side-effecting procedures. *) -signature EFFECT = sig - type 'a t = 'a -> unit - (** Type of side-effecting procedures. *) - - val ignore : 'a t - (** No-operation ({ignore = fn _ => ()}). *) - - val nop : unit t - (** No-operation ({nop = fn () => ()}). *) - - val obs : 'a t -> 'a UnOp.t - (** - * Side-effecting I-combinator ({obs ef x = (ef x ; x)}). Using {obs} - * and {o} you can "attach" side-effects to a function. The name {obs} - * is short for {observe} and comes from the idea that the data is - * observed by the effect. - *) - - val past : unit t -> 'a UnOp.t - (** - * Side-effecting I-combinator ({past ef x = (ef () ; x)}). Using - * {past} and {o} you can "attach" side-effects to a function. The - * name {past} comes from the idea that the data flows past the effect. - *) -end |
|
From: Vesa K. <ve...@ml...> - 2006-12-10 11:17:23
|
Reorganized public files. ---------------------------------------------------------------------- D mltonlib/trunk/com/ssh/extended-basis/unstable/public/iso.sig ---------------------------------------------------------------------- Deleted: mltonlib/trunk/com/ssh/extended-basis/unstable/public/iso.sig =================================================================== --- mltonlib/trunk/com/ssh/extended-basis/unstable/public/iso.sig 2006-12-10 19:17:04 UTC (rev 4963) +++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/iso.sig 2006-12-10 19:17:13 UTC (rev 4964) @@ -1,51 +0,0 @@ -(* Copyright (C) 2006 SSH Communications Security, Helsinki, Finland - * - * This code is released under the MLton license, a BSD-style license. - * See the LICENSE file or http://mlton.org/License for details. - *) - -(** Signature for the {Iso} structure for isomorphisms. *) -signature ISO = sig - type ('a, 'b) t = ('a -> 'b) * ('b -> 'a) - (** Witness to an isomorphism between {'a} and {'b}. *) - - val id : ('a, 'a) t - (** The trivial isomorphism. This is always equivalent to {(id, id)}. *) - - (** == Basic == *) - - val to : ('a, 'b) t -> 'a -> 'b - (** Extracts the injection part of the given isomorphism. *) - - val from : ('a, 'b) t -> 'b -> 'a - (** Extracts the projection part of the given isomorphism. *) - - val swap : ('a, 'b) t -> ('b, 'a) t - (** Switch the direction of the isomorphism. *) - - (** == Combinators for Building Isomorphisms == *) - - val map : ('c, 'a) t * ('b, 'd) t -> ('a, 'b) t -> ('c, 'd) t - (** Changes the domain and range of an isomorphism. *) - - val <--> : ('a, 'b) t * ('c, 'a) t -> ('c, 'b) t - (** Isomorphism composition. *) - - val --> : ('c, 'a) t * ('b, 'd) t -> (('a, 'b) Fn.t, ('c, 'd) Fn.t) t - (** - * Creates an isomorphism between functions given isomorphisms between - * domains and ranges. - *) - - val +` : ('a, 'c) t * ('b, 'd) t -> (('a, 'b) Sum.t, ('c, 'd) Sum.t) t - (** - * Creates an isomorphism between sums given isomorphisms between - * elements. - *) - - val *` : ('a, 'c) t * ('b, 'd) t -> (('a, 'b) Product.t, ('c, 'd) Product.t) t - (** - * Creates an isomorphism between products given isomorphisms between - * elements. - *) -end |
