Skip to content

Commit 7cc4e1b

Browse files
committed
first commit
1 parent df72a0b commit 7cc4e1b

File tree

14 files changed

+321
-1
lines changed

14 files changed

+321
-1
lines changed

.travis.yml

+22
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
language: c
2+
3+
dist: xenial
4+
5+
os:
6+
- linux
7+
- osx
8+
9+
before_install:
10+
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew update ; fi
11+
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then rm -f /usr/local/include/c++ ; fi
12+
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew install mlkit ; fi
13+
- if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then sudo apt-get -qq update ; fi
14+
- if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then sudo apt-get install -y mlton make ; fi
15+
16+
install:
17+
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then make clean all ; fi
18+
- if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then MLCOMP='mlton -output run' make clean all ; fi
19+
20+
script:
21+
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then make test ; fi
22+
- if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then MLCOMP=mlton make test ; fi

LICENSE

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
MIT License
22

3-
Copyright (c) 2020 DIKU
3+
Copyright (c) 199x-2020 Fritz Henglein, Henning Niss
44

55
Permission is hereby granted, free of charge, to any person obtaining a copy
66
of this software and associated documentation files (the "Software"), to deal

Makefile

+13
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
2+
.PHONY: all
3+
all:
4+
$(MAKE) -C lib/github.com/diku-dk/sml-uref all
5+
6+
.PHONY: test
7+
test:
8+
$(MAKE) -C lib/github.com/diku-dk/sml-uref test
9+
10+
.PHONY: clean
11+
clean:
12+
$(MAKE) -C lib/github.com/diku-dk/sml-uref clean
13+
rm -rf MLB *~ .*~

README.md

+47
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
# sml-uref [![Build Status](https://travis-ci.org/diku-dk/sml-uref.svg?branch=master)](https://travis-ci.org/diku-dk/sml-uref)
2+
3+
Standard ML package for unifiable references.
4+
5+
## Overview of MLB files
6+
7+
- `lib/github.com/diku-dk/sml-uref/uref.mlb`:
8+
9+
- **signature** [`UREF`](lib/github.com/diku-dk/sml-uref/UREF.sig)
10+
- **structure** `URef`
11+
12+
## Use of the package
13+
14+
This library is set up to work well with the SML package manager
15+
[smlpkg](https://github.com/diku-dk/smlpkg). To use the package, in
16+
the root of your project directory, execute the command:
17+
18+
```
19+
$ smlpkg add github.com/diku-dk/sml-uref
20+
```
21+
22+
This command will add a _requirement_ (a line) to the `sml.pkg` file in your
23+
project directory (and create the file, if there is no file `sml.pkg`
24+
already).
25+
26+
To download the library into the directory
27+
`lib/github.com/diku-dk/sml-uref`, execute the command:
28+
29+
```
30+
$ smlpkg sync
31+
```
32+
33+
You can now reference the `mlb`-file using relative paths from within
34+
your project's `mlb`-files.
35+
36+
Notice that you can choose either to treat the downloaded package as
37+
part of your own project sources (vendoring) or you can add the
38+
`sml.pkg` file to your project sources and make the `smlpkg sync`
39+
command part of your build process.
40+
41+
## Author
42+
43+
The `URef` structure is written by Fritz Henglein. The present version
44+
uses union-by-rank and path-compression for the `find` operation. On
45+
some systems, such as SML/NJ, better results may be obtained by
46+
implementing `find` using path-halving, which can be implemented in a
47+
tail-recursive fashion.
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
*~
2+
MLB
3+
run
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
MLCOMP ?= mlkit
2+
3+
.PHONY: all
4+
all:
5+
$(MLCOMP) uref.mlb
6+
7+
.PHONY: test
8+
test:
9+
$(MAKE) -C test test
10+
11+
.PHONY: clean
12+
clean:
13+
$(MAKE) -C test clean
14+
rm -rf MLB *~ run
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
*.res
2+
*.exe
3+
*~
4+
*.out
5+
MLB
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
MLCOMP ?= mlkit
2+
3+
.PHONY: test
4+
test: test_uref.res
5+
cat $^
6+
7+
%.res: %.out
8+
@(diff -aq $< $<.ok > /dev/null 2>&1; \
9+
if [ $$? -eq 0 ]; then \
10+
echo "OK: $*" > $@ \
11+
; else \
12+
if [ -e $<.ok ]; then \
13+
echo "ERR: $* - file $< differs from $<.ok"; \
14+
echo "ERR: $* - file $< differs from $<.ok" > $@ \
15+
; else \
16+
echo "ERR: $* - file $<.ok does not exist"; \
17+
echo "ERR: $* - file $<.ok does not exist" > $@ \
18+
; fi \
19+
; exit 1 \
20+
;fi)
21+
22+
%.out: %.exe
23+
./$< > $@
24+
25+
%.exe: %.mlb
26+
$(MLCOMP) -output $@ $<
27+
28+
.PHONY: clean
29+
clean:
30+
rm -rf MLB *.out *~ *.exe *.res run
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
local $(SML_LIB)/basis/basis.mlb
2+
../uref.mlb
3+
in test_uref.sml
4+
end
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
fun pr s = print ("URef." ^ s ^ "\n")
2+
3+
fun test s b =
4+
if b then pr (s ^ ": OK")
5+
else pr (s ^ ": ERR")
6+
7+
fun itest s expected n =
8+
if n=expected then pr (s ^ ": OK")
9+
else pr(s ^ ": ERR - expected " ^ Int.toString expected ^ " but got " ^ Int.toString n)
10+
11+
open URef infix ::=
12+
13+
val () = print "Testing URef\n"
14+
15+
val a = uref 8
16+
17+
val b = uref 9
18+
19+
val c = uref 10
20+
21+
val () = test "eq.not" (not(eq(a,b)))
22+
23+
val () = test "eq.1" (eq(a,a))
24+
25+
val () = unify (fn (x,y) => x+y) (b,c)
26+
27+
val () = test "eq.1" (eq(b,c))
28+
29+
val () = test "find.1" (!!b = !!c)
30+
31+
val () = itest "find.1" (!!b) 19
32+
33+
val () = itest "update.1" (b ::= 18; !!c) 18
34+
35+
val () = test "compare" (compare Int.compare (a,b) = LESS)
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
local $(SML_LIB)/basis/basis.mlb
2+
in uref.sig
3+
uref.sml
4+
end
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,81 @@
1+
(** Unifiable references.
2+
*
3+
* Unifiable references provide a Union/Find data type with a ref-like
4+
* interface. A Union/Find structure consists of a type constructor
5+
* 'a uref with operations for creating an element of type 'a uref (uRef),
6+
* getting the contents of an element (!!), checking for equality of
7+
* two elements (equal), and for unifying two elements (unify).
8+
*)
9+
10+
signature UREF = sig
11+
type 'a uref
12+
13+
val uref : 'a -> 'a uref
14+
val !! : 'a uref -> 'a
15+
val ::= : 'a uref * 'a -> unit
16+
17+
val unify : ('a * 'a -> 'a) -> 'a uref * 'a uref -> unit
18+
19+
val eq : 'a uref * 'a uref -> bool
20+
val compare : ('a * 'a -> order) -> 'a uref * 'a uref -> order
21+
end
22+
23+
(**
24+
25+
[type 'a uref] is the type of uref-elements with contents of type 'a.
26+
27+
[uref x] creates a new element with contents x.
28+
29+
[!!e] returns the contents of e.
30+
31+
[e ::= x] updates the contents of e to be x.
32+
33+
[unify f (e, e')] makes e and e' equal; if v and v' are the contents
34+
of e and e', respectively, before unioning them, then the contents of
35+
the unioned element is f(v,v').
36+
37+
[eq (e, e')] returns true if and only if e and e' are either made by
38+
the same call to uref or if they have been unioned (see below).
39+
40+
[compare cmp (e, e')] returns EQUAL if eq (e, e') returns true;
41+
otherwise return cmp (!!e, !!e').
42+
43+
Discussion:
44+
45+
The uref type constructor is analogous to the ref type constructor as
46+
expressed in the following table:
47+
48+
-------------------------------------------------------------------
49+
type 'a ref 'a uref
50+
-------------------------------------------------------------------
51+
introduction ref uref
52+
elimination ! !!
53+
equality = eq
54+
updating := ::=
55+
unioning unify
56+
-------------------------------------------------------------------
57+
58+
The main difference between 'a ref and 'a uref is in the unify
59+
operation. Without unify, 'a ref and 'a uref can be used
60+
interchangebly. An assignment to a reference changes only the
61+
contents of the reference, but not the reference itself. In
62+
particular, any two pointers that were different (in the sense of the
63+
equality predicate = returning false) before an assignment will still
64+
be so. Their contents may or may not be equal after the assignment,
65+
though. In contrast, applying the unify operation to two uref
66+
elements makes the two elements themselves equal (in the sense of the
67+
predicate equal returning true). As a consequence their contents will
68+
also be identical; the actual content is determined by a binary
69+
function parameter to unify.
70+
71+
AUTHOR:
72+
73+
This software was originally authored by Fritz
74+
Henglein. Simplifications have been made by Henning Niss (eliminating
75+
redundant matches) and Martin Elsman (removed some exposed
76+
functionality such as link and union.
77+
78+
Copyright (c) 199x-2020 Fritz Henglein, Henning Niss, University of
79+
Copenhagen.
80+
81+
*)
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
2+
structure URef :> UREF =
3+
struct
4+
5+
infix ::=
6+
7+
fun impossible () = raise Fail "URef: impossible"
8+
9+
datatype 'a urefC = ECR of 'a * int
10+
| PTR of 'a uref
11+
withtype 'a uref = 'a urefC ref
12+
13+
fun find (p as ref (ECR _)) = p
14+
| find (p as ref (PTR p')) = let val p'' = find p'
15+
in p := PTR p''; p''
16+
end
17+
18+
fun uref x = ref (ECR(x, 0))
19+
20+
fun !! p =
21+
case !(find p) of
22+
ECR(x,_) => x
23+
| _ => impossible()
24+
25+
fun update (p, x) =
26+
case find p of
27+
p' as ref(ECR(_, r)) => p' := ECR(x, r)
28+
| _ => impossible()
29+
30+
val op ::= = update
31+
32+
fun unify f (p, q) =
33+
case (find p, find q) of
34+
(p' as ref(ECR(pc, pr)), q' as ref(ECR(qc, qr))) =>
35+
let val newC = f (pc, qc)
36+
in if p' = q' then p' := ECR(newC, pr)
37+
else if pr = qr
38+
then (q' := ECR(newC, qr+1);
39+
p' := PTR q')
40+
else if pr < qr
41+
then (q' := ECR(newC, qr);
42+
p' := PTR q')
43+
else (p' := ECR(newC, pr); (* pr > qr *)
44+
q':= PTR p')
45+
end
46+
| _ => impossible()
47+
48+
fun eq (p, p') = (find p = find p')
49+
50+
fun compare cmp (p, p') =
51+
case (find p, find p') of
52+
(p as ref (ECR(x,_)),p' as ref (ECR(x',_))) =>
53+
if p = p' then EQUAL else cmp (x,x')
54+
| _ => impossible()
55+
56+
end
57+
58+
(* Copyright 199x-2020 Fritz Henglein, Henning Niss *)

sml.pkg

+4
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
package github.com/diku-dk/sml-uref
2+
3+
require {
4+
}

0 commit comments

Comments
 (0)