Commit 40302a02 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2002-10-31 17:35:39 by cvscast] Empty log message

Original author: cvscast
Date: 2002-10-31 17:36:04+00:00
parent 154fac89
......@@ -8,7 +8,8 @@ PARSER = parser/lexer.cmo parser/location.cmo parser/ast.cmo parser/parser.cmo
TYPING = typing/typed.cmo typing/typer.cmo
TYPES = types/recursive.cmo types/sortedList.cmo \
TYPES = types/recursive.cmo types/recursive_share.cmo types/recursive_noshare.cmo \
types/sortedList.cmo \
types/sortedMap.cmo types/boolean.cmo \
types/intervals.cmo types/chars.cmo types/atoms.cmo \
types/types.cmo \
......
......@@ -12,18 +12,20 @@ typing/typed.cmo: parser/location.cmi types/patterns.cmi types/sortedMap.cmi \
types/types.cmi
typing/typed.cmx: parser/location.cmx types/patterns.cmx types/sortedMap.cmx \
types/types.cmx
typing/typer.cmo: parser/ast.cmo types/intervals.cmi parser/location.cmi \
types/patterns.cmi types/sequence.cmi types/sortedList.cmi \
typing/typed.cmo types/types.cmi typing/typer.cmi
typing/typer.cmx: parser/ast.cmx types/intervals.cmx parser/location.cmx \
types/patterns.cmx types/sequence.cmx types/sortedList.cmx \
typing/typed.cmx types/types.cmx typing/typer.cmi
typing/typer.cmo: parser/ast.cmo types/builtin.cmo types/intervals.cmi \
parser/location.cmi types/patterns.cmi types/sequence.cmi \
types/sortedList.cmi typing/typed.cmo types/types.cmi typing/typer.cmi
typing/typer.cmx: parser/ast.cmx types/builtin.cmx types/intervals.cmx \
parser/location.cmx types/patterns.cmx types/sequence.cmx \
types/sortedList.cmx typing/typed.cmx types/types.cmx typing/typer.cmi
types/atoms.cmo: types/sortedList.cmi types/atoms.cmi
types/atoms.cmx: types/sortedList.cmx types/atoms.cmi
types/boolean.cmo: types/recursive.cmi types/sortedList.cmi types/boolean.cmi
types/boolean.cmo: types/recursive.cmo types/sortedList.cmi types/boolean.cmi
types/boolean.cmx: types/recursive.cmx types/sortedList.cmx types/boolean.cmi
types/builtin.cmo: types/atoms.cmi types/chars.cmi types/types.cmi
types/builtin.cmx: types/atoms.cmx types/chars.cmx types/types.cmx
types/builtin.cmo: types/atoms.cmi types/chars.cmi types/sequence.cmi \
types/types.cmi
types/builtin.cmx: types/atoms.cmx types/chars.cmx types/sequence.cmx \
types/types.cmx
types/chars.cmo: types/chars.cmi
types/chars.cmx: types/chars.cmi
types/intervals.cmo: types/intervals.cmi
......@@ -32,26 +34,28 @@ types/patterns.cmo: types/sortedList.cmi types/sortedMap.cmi types/types.cmi \
types/patterns.cmi
types/patterns.cmx: types/sortedList.cmx types/sortedMap.cmx types/types.cmx \
types/patterns.cmi
types/recursive.cmo: types/recursive.cmi
types/recursive.cmx: types/recursive.cmi
types/recursive_noshare.cmo: types/recursive.cmo
types/recursive_noshare.cmx: types/recursive.cmx
types/recursive_share.cmo: types/recursive.cmo
types/recursive_share.cmx: types/recursive.cmx
types/sequence.cmo: types/atoms.cmi types/types.cmi types/sequence.cmi
types/sequence.cmx: types/atoms.cmx types/types.cmx types/sequence.cmi
types/sortedList.cmo: types/sortedList.cmi
types/sortedList.cmx: types/sortedList.cmi
types/sortedMap.cmo: types/sortedMap.cmi
types/sortedMap.cmx: types/sortedMap.cmi
types/strings.cmo: types/boolean.cmi types/intervals.cmi types/recursive.cmi \
types/strings.cmo: types/boolean.cmi types/intervals.cmi types/recursive.cmo \
types/strings.cmi
types/strings.cmx: types/boolean.cmx types/intervals.cmx types/recursive.cmx \
types/strings.cmi
types/type_bool.cmo: types/boolean.cmi types/recursive.cmi
types/type_bool.cmo: types/boolean.cmi types/recursive.cmo
types/type_bool.cmx: types/boolean.cmx types/recursive.cmx
types/types.cmo: types/atoms.cmi types/boolean.cmi types/chars.cmi \
types/intervals.cmi types/recursive.cmi types/sortedList.cmi \
types/sortedMap.cmi types/types.cmi
types/intervals.cmi types/recursive.cmo types/recursive_share.cmo \
types/sortedList.cmi types/sortedMap.cmi types/types.cmi
types/types.cmx: types/atoms.cmx types/boolean.cmx types/chars.cmx \
types/intervals.cmx types/recursive.cmx types/sortedList.cmx \
types/sortedMap.cmx types/types.cmi
types/intervals.cmx types/recursive.cmx types/recursive_share.cmx \
types/sortedList.cmx types/sortedMap.cmx types/types.cmi
runtime/value.cmo: types/chars.cmi types/patterns.cmi types/sequence.cmi \
types/sortedMap.cmi typing/typed.cmo types/types.cmi runtime/value.cmi
runtime/value.cmx: types/chars.cmx types/patterns.cmx types/sequence.cmx \
......
......@@ -24,7 +24,7 @@ let prog () =
| Stdpp.Exc_located (loc, e) -> raise (Location (loc, e))
let print_norm ppf d =
Types.Print.print_descr ppf (Types.normalize d)
Types.Print.print_descr ppf ((*Types.normalize*) d)
let rec print_exn ppf = function
| Location (loc, exn) ->
......
<?xml version="1.0" standalone="yes"?>
<bib>
<book>
<title>Persistent Object Systems</title>
<year>1994</year>
<author>M. Atkinson</author>
<author>V. Benzaken</author>
<author>D. Maier</author>
</book>
<book>
<title>OOP: a unified foundation</title>
<year>1997</year>
<author>G. Castagna</author>
</book>
</bib>
......@@ -59,3 +59,9 @@ type Flat = [ (Title Year Author+)* ];;
let fun flatten_bib (l : [Book*]) : Flat =
transform l with <book>x -> x;;
type Chair_auth = <author>['Pierce'|'Wadler'];;
type Chair = <book>[_* Chair_auth _*];;
let fun chair_books (Bib -> [(Chair & Book)*])
<bib>[(b::Chair | _)*] -> b;;
(* A fast replacement of Recursive without sharing at all *)
exception NotEqual
exception Incomplete
......@@ -9,51 +7,41 @@ sig
val map: ('a -> 'b) -> ('a t -> 'b t)
val equal: ('a -> 'a -> unit) -> ('a t -> 'a t -> unit)
(* equal checks that two terms are equal and raises NotEqual otherwise;
the first argument must be called to check equality of subterms *)
val iter: ('a -> unit) -> ('a t -> unit)
(* a valid definition is often:
let iter f a = ignore (map f a) *)
val hash: ('a -> int) -> ('a t -> int)
(* [hash] should behave correctly w.r.t [map], that is:
hash h (map f a) == hash (h \circ f) a
A valid definition is often:
let hash h a = Hashtbl.hash (map h a)
*)
val deep: int
(* specify the deepness of hashing; use a value large enough to
discriminate between most non-equivalent graphs;
deep = 3 or 4 may often be adequate. *)
end
module type Make = functor (X : S) ->
sig
type node
type descr = node X.t
module Make(X : S) =
struct
type state = Undefined | Defined
type node = {
id : int;
mutable descr : descr;
}
and descr = node X.t
let id n = n.id
let counter = ref 0
let make () =
incr counter;
{
id = !counter;
descr = Obj.magic 0;
}
let equal x y = x.id = y.id
let internalize n = n
let internalize_descr d = d
val make: unit -> node
val define: node -> descr -> unit
let descr n = n.descr
val internalize: node -> node
val internalize_descr: descr -> descr
let define n d = n.descr <- d
val id: node -> int
val descr: node -> descr
let hash_descr d = X.hash (fun n -> n.id) d
let equal_descr d1 d2 =
(d1 == d2) ||
try
X.equal
(fun n1 n2 -> if n1.id <> n2.id then raise NotEqual)
d1 d2;
true
with NotEqual -> false
val hash_descr: descr -> int
val equal_descr: descr -> descr -> bool
end
(* $Id: recursive.mli,v 1.3 2002/10/17 15:38:34 cvscast Exp $ *)
exception NotEqual
exception Incomplete
module type S =
sig
type 'a t
val map: ('a -> 'b) -> ('a t -> 'b t)
val equal: ('a -> 'a -> unit) -> ('a t -> 'a t -> unit)
(* equal checks that two terms are equal and raises NotEqual otherwise;
the first argument must be called to check equality of subterms *)
val iter: ('a -> unit) -> ('a t -> unit)
(* a valid definition is often:
let iter f a = ignore (map f a) *)
val hash: ('a -> int) -> ('a t -> int)
(* [hash] should behave correctly w.r.t [map], that is:
hash h (map f a) == hash (h \circ f) a
A valid definition is often:
let hash h a = Hashtbl.hash (map h a)
*)
val deep: int
(* specify the deepness of hashing; use a value large enough to
discriminate between most non-equivalent graphs;
deep = 3 or 4 may often be adequate. *)
end
module Make(X : S) :
sig
type node
type descr = node X.t
val make: unit -> node
val define: node -> descr -> unit
val internalize: node -> node
val internalize_descr: descr -> descr
val id: node -> int
val descr: node -> descr
val hash_descr: descr -> int
val equal_descr: descr -> descr -> bool
end
(* A fast replacement of Recursive without sharing at all *)
exception NotEqual
exception Incomplete
module type S =
sig
type 'a t
val map: ('a -> 'b) -> ('a t -> 'b t)
val equal: ('a -> 'a -> unit) -> ('a t -> 'a t -> unit)
val iter: ('a -> unit) -> ('a t -> unit)
val hash: ('a -> int) -> ('a t -> int)
val deep: int
end
open Recursive
module Make(X : S) =
struct
......
(* $Id: recursive_share.ml,v 1.1 2002/10/30 02:05:42 cvscast Exp $ *)
exception NotEqual
exception Incomplete
module type S =
sig
type 'a t
val map: ('a -> 'b) -> ('a t -> 'b t)
val equal: ('a -> 'a -> unit) -> ('a t -> 'a t -> unit)
val iter: ('a -> unit) -> ('a t -> unit)
val hash: ('a -> int) -> ('a t -> int)
val deep: int
end
(* $Id: recursive_share.ml,v 1.2 2002/10/31 17:35:39 cvscast Exp $ *)
open Recursive
module Make(X : S) =
struct
......
......@@ -112,7 +112,7 @@ module I = struct
end
module Algebra = Recursive.Make(I)
module Algebra = Recursive_noshare.Make(I)
include I
include Algebra
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment