diff options
Diffstat (limited to 'ocaml-binary-annot/camlp4/unmaintained/lib')
7 files changed, 348 insertions, 0 deletions
diff --git a/ocaml-binary-annot/camlp4/unmaintained/lib/.cvsignore b/ocaml-binary-annot/camlp4/unmaintained/lib/.cvsignore new file mode 100644 index 0000000000..c77a681dd6 --- /dev/null +++ b/ocaml-binary-annot/camlp4/unmaintained/lib/.cvsignore @@ -0,0 +1,3 @@ +*.cm[oiax] +*.cmxa +*.lib diff --git a/ocaml-binary-annot/camlp4/unmaintained/lib/.depend b/ocaml-binary-annot/camlp4/unmaintained/lib/.depend new file mode 100644 index 0000000000..a779396987 --- /dev/null +++ b/ocaml-binary-annot/camlp4/unmaintained/lib/.depend @@ -0,0 +1,14 @@ +debug.cmo: debug.cmi +debug.cmx: debug.cmi +extfun.cmo: extfun.cmi +extfun.cmx: extfun.cmi +fstream.cmo: fstream.cmi +fstream.cmx: fstream.cmi +grammar.cmo: token.cmi plexer.cmi loc.cmi +grammar.cmx: token.cmx plexer.cmi loc.cmx +loc.cmo: loc.cmi +loc.cmx: loc.cmi +token.cmo: loc.cmi token.cmi +token.cmx: loc.cmx token.cmi +plexer.cmi: token.cmi loc.cmi +token.cmi: loc.cmi diff --git a/ocaml-binary-annot/camlp4/unmaintained/lib/Makefile b/ocaml-binary-annot/camlp4/unmaintained/lib/Makefile new file mode 100644 index 0000000000..3d5be9b45a --- /dev/null +++ b/ocaml-binary-annot/camlp4/unmaintained/lib/Makefile @@ -0,0 +1,52 @@ + + +include ../config/Makefile.cnf + +INCLUDES=-I $(OTOP)/parsing -I $(OTOP)/utils +LIBRARIES=gramlib.cma +OBJS=$(OTOP)/utils/misc.cmo $(OTOP)/parsing/linenum.cmo \ + $(OTOP)/utils/warnings.cmo $(OTOP)/parsing/location.cmo \ + $(OTOP)/utils/config.cmo debug.cmo loc.cmo \ + token.cmo lexer_token.cmo lexer_error.cmo \ + plexer.cmo grammar.cmo extfun.cmo \ + fstream.cmo +CLEANFILES=plexer.ml + +include ../config/Makefile.base + +debug.cmo: debug.cmi +debug.cmo: debug.ml + $(OCAMLC) -pp '$(CAMLP4BOOT)' -rectypes $(OCAMLCFLAGS) $< -c -o $@ + +plexer.cmo: plexer.ml plexer.cmi + $(OCAMLC) $(OCAMLCFLAGS) $< -c -o $@ + +plexer.cmx: plexer.ml plexer.cmi + $(OCAMLOPT) $(OCAMLCFLAGS) $< -c -o $@ + +$(LIBRARIES): $(OBJS) + $(OCAMLC) -linkall $(OBJS) -a -o $(LIBRARIES) + +$(LIBRARIESX): $(OBJSX) + $(OCAMLOPT) -linkall $(OBJSX) -a -o $(LIBRARIESX) + +$(LIBRARIESP): $(OBJSP) + $(OCAMLOPT) -linkall $(OBJSP) -a -o $(LIBRARIESP) + +install-local: + -$(MKDIR) "$(LIBDIR)/camlp4" + cp $(LIBRARIES) *.mli "$(LIBDIR)/camlp4/." + cp *.cmi "$(LIBDIR)/camlp4/." + test -f $(LIBRARIESX) && $(MAKE) installopt LIBDIR="$(LIBDIR)" || true + +installopt: + for f in $(LIBRARIESX) $(LIBRARIESP) *.cmx ; do \ + test -f $$f && cp $$f "$(LIBDIR)/camlp4/." || true ; \ + done + # Special treatment for this one: some versions of make don't like $(A) in $(TARGET:.cma=.$(A)) + target="`echo $(LIBRARIES) | sed -e 's/\.cma$$/.$(A)/'`" ; \ + if test -f $$target ; then \ + cp $$target "$(LIBDIR)/camlp4/." && ( cd "$(LIBDIR)/camlp4/." && $(RANLIB) $$target ) \ + fi + +include .depend diff --git a/ocaml-binary-annot/camlp4/unmaintained/lib/extfun.ml b/ocaml-binary-annot/camlp4/unmaintained/lib/extfun.ml new file mode 100644 index 0000000000..4f4cbbd93a --- /dev/null +++ b/ocaml-binary-annot/camlp4/unmaintained/lib/extfun.ml @@ -0,0 +1,107 @@ +(* camlp4r *) + +(* Copyright 2001 INRIA *) + +(* Extensible Functions *) + +type t 'a 'b = list (matching 'a 'b) +and matching 'a 'b = { patt : patt; has_when : bool; expr : expr 'a 'b } +and patt = + [ Eapp of list patt + | Eacc of list patt + | Econ of string + | Estr of string + | Eint of string + | Etup of list patt + | Evar of unit ] +and expr 'a 'b = 'a -> option 'b +; + +exception Failure; + +value empty = []; + +(*** Apply ***) + +value rec apply_matchings a = + fun + [ [m :: ml] -> + match m.expr a with + [ None -> apply_matchings a ml + | x -> x ] + | [] -> None ] +; + +value apply ef a = + match apply_matchings a ef with + [ Some x -> x + | None -> raise Failure ] +; + +(*** Trace ***) + +value rec list_iter_sep f s = + fun + [ [] -> () + | [x] -> f x + | [x :: l] -> do { f x; s (); list_iter_sep f s l } ] +; + +value rec print_patt = + fun + [ Eapp pl -> list_iter_sep print_patt2 (fun () -> print_string " ") pl + | p -> print_patt2 p ] +and print_patt2 = + fun + [ Eacc pl -> list_iter_sep print_patt1 (fun () -> print_string ".") pl + | p -> print_patt1 p ] +and print_patt1 = + fun + [ Econ s -> print_string s + | Estr s -> do { print_string "\""; print_string s; print_string "\"" } + | Eint s -> print_string s + | Evar () -> print_string "_" + | Etup pl -> + do { + print_string "("; + list_iter_sep print_patt (fun () -> print_string ", ") pl; + print_string ")" + } + | Eapp _ | Eacc _ as p -> + do { print_string "("; print_patt p; print_string ")" } ] +; + +value print ef = + List.iter + (fun m -> + do { + print_patt m.patt; + if m.has_when then print_string " when ..." else (); + print_newline () + }) + ef +; + +(*** Extension ***) + +value insert_matching matchings (patt, has_when, expr) = + let m1 = {patt = patt; has_when = has_when; expr = expr} in + let rec loop = + fun + [ [m :: ml] as gml -> + if m1.has_when && not m.has_when then [m1 :: gml] else + if not m1.has_when && m.has_when then [m :: loop ml] else + (* either both or none have a when clause *) + if compare m1.patt m.patt = 0 then + if not m1.has_when then [m1 :: ml] else [m1 :: gml] + else [m :: loop ml] + | [] -> [m1] ] + in + loop matchings +; + +(* available extension function *) + +value extend ef matchings_def = + List.fold_left insert_matching ef matchings_def +; diff --git a/ocaml-binary-annot/camlp4/unmaintained/lib/extfun.mli b/ocaml-binary-annot/camlp4/unmaintained/lib/extfun.mli new file mode 100644 index 0000000000..6d71fc11f0 --- /dev/null +++ b/ocaml-binary-annot/camlp4/unmaintained/lib/extfun.mli @@ -0,0 +1,35 @@ +(* camlp4r *) + + +(** Extensible functions. + + This module implements pattern matching extensible functions. + To extend, use syntax [pa_extfun.cmo]: + + [extfun e with [ pattern_matching ]] *) + +type t 'a 'b = 'x; + (** The type of the extensible functions of type ['a -> 'b] *) +value empty : t 'a 'b; + (** Empty extensible function *) +value apply : t 'a 'b -> 'a -> 'b; + (** Apply an extensible function *) +exception Failure; + (** Match failure while applying an extensible function *) +value print : t 'a 'b -> unit; + (** Print patterns in the order they are recorded *) + +(**/**) + +type patt = + [ Eapp of list patt + | Eacc of list patt + | Econ of string + | Estr of string + | Eint of string + | Etup of list patt + | Evar of unit ] +and expr 'a 'b = 'a -> option 'b +; + +value extend : t 'a 'b -> list (patt * bool * expr 'a 'b) -> t 'a 'b; diff --git a/ocaml-binary-annot/camlp4/unmaintained/lib/fstream.ml b/ocaml-binary-annot/camlp4/unmaintained/lib/fstream.ml new file mode 100644 index 0000000000..8c3171a877 --- /dev/null +++ b/ocaml-binary-annot/camlp4/unmaintained/lib/fstream.ml @@ -0,0 +1,77 @@ +(* camlp4r *) + +(* Copyright 2001 INRIA *) + +type t 'a = { count : int; data : Lazy.t (data 'a) } +and data 'a = + [ Nil + | Cons of 'a and t 'a + | App of t 'a and t 'a ] +; + +value from f = + loop 0 where rec loop i = + {count = 0; + data = + lazy + (match f i with + [ Some x -> Cons x (loop (i + 1)) + | None -> Nil ])} +; + +value rec next s = + let count = s.count + 1 in + match Lazy.force s.data with + [ Nil -> None + | Cons a s -> Some (a, {count = count; data = s.data}) + | App s1 s2 -> + match next s1 with + [ Some (a, s1) -> Some (a, {count = count; data = lazy (App s1 s2)}) + | None -> + match next s2 with + [ Some (a, s2) -> Some (a, {count = count; data = s2.data}) + | None -> None ] ] ] +; + +value empty s = + match next s with + [ Some _ -> None + | None -> Some ((), s) ] +; + +value nil = {count = 0; data = lazy Nil}; +value cons a s = Cons a s; +value app s1 s2 = App s1 s2; +value flazy f = {count = 0; data = Lazy.lazy_from_fun f}; + +value of_list l = + List.fold_right (fun x s -> flazy (fun () -> cons x s)) l nil +; + +value of_string s = + from (fun c -> if c < String.length s then Some s.[c] else None) +; + +value of_channel ic = + from (fun _ -> try Some (input_char ic) with [ End_of_file -> None ]) +; + +value iter f = + do_rec where rec do_rec strm = + match next strm with + [ Some (a, strm) -> + let _ = f a in + do_rec strm + | None -> () ] +; + +value count s = s.count; + +value count_unfrozen s = + loop 0 s where rec loop cnt s = + if Lazy.lazy_is_val s.data then + match Lazy.force s.data with + [ Cons _ s -> loop (cnt + 1) s + | _ -> cnt ] + else cnt +; diff --git a/ocaml-binary-annot/camlp4/unmaintained/lib/fstream.mli b/ocaml-binary-annot/camlp4/unmaintained/lib/fstream.mli new file mode 100644 index 0000000000..723389ac03 --- /dev/null +++ b/ocaml-binary-annot/camlp4/unmaintained/lib/fstream.mli @@ -0,0 +1,60 @@ +(* camlp4r *) + + +(* Module [Fstream]: functional streams *) + +(* This module implement functional streams. + To be used with syntax [pa_fstream.cmo]. The syntax is: +- stream: [fstream [: ... :]] +- parser: [parser [ [: ... :] -> ... | ... ]] + + Functional parsers are of type: [Fstream.t 'a -> option ('a * Fstream.t 'a)] + + They have limited backtrack, i.e if a rule fails, the next rule is tested + with the initial stream; limited because when in case of a rule with two + consecutive symbols [a] and [b], if [b] fails, the rule fails: there is + no try with the next rule of [a]. +*) + +type t 'a = 'x; + (* The type of 'a functional streams *) +value from : (int -> option 'a) -> t 'a; + (* [Fstream.from f] returns a stream built from the function [f]. + To create a new stream element, the function [f] is called with + the current stream count. The user function [f] must return either + [Some <value>] for a value or [None] to specify the end of the + stream. *) + +value of_list : list 'a -> t 'a; + (* Return the stream holding the elements of the list in the same + order. *) +value of_string : string -> t char; + (* Return the stream of the characters of the string parameter. *) +value of_channel : in_channel -> t char; + (* Return the stream of the characters read from the input channel. *) + +value iter : ('a -> unit) -> t 'a -> unit; + (* [Fstream.iter f s] scans the whole stream s, applying function [f] + in turn to each stream element encountered. *) + +value next : t 'a -> option ('a * t 'a); + (* Return [Some (a, s)] where [a] is the first element of the stream + and [s] the remaining stream, or [None] if the stream is empty. *) +value empty : t 'a -> option (unit * t 'a); + (* Return [Some ((), s)] if the stream is empty where [s] is itself, + else [None] *) +value count : t 'a -> int; + (* Return the current count of the stream elements, i.e. the number + of the stream elements discarded. *) +value count_unfrozen : t 'a -> int; + (* Return the number of unfrozen elements in the beginning of the + stream; useful to determine the position of a parsing error (longuest + path). *) + +(*--*) + +value nil : t 'a; +type data 'a = 'x; +value cons : 'a -> t 'a -> data 'a; +value app : t 'a -> t 'a -> data 'a; +value flazy : (unit -> data 'a) -> t 'a; |