[Pkg-ocaml-maint-commits] [ocaml-estring] 01/01: Imported Upstream version 20130822
Mehdi Dogguy
mehdi at moszumanska.debian.org
Mon Nov 25 21:43:14 UTC 2013
This is an automated email from the git hooks/post-receive script.
mehdi pushed a commit to branch master
in repository ocaml-estring.
commit bff568ff2fe55e3ece4f7ed43fda4b23b996a682
Author: Mehdi Dogguy <mehdi at debian.org>
Date: Mon Nov 25 22:43:05 2013 +0100
Imported Upstream version 20130822
---
.gitignore | 6 +
CHANGES.md | 15 ++
LICENSE | 24 +++
Makefile | 59 +++++++
README.md | 55 +++++++
_oasis | 68 ++++++++
_tags | 5 +
configure | 5 +
dist | 38 +++++
myocamlbuild.ml | 36 +++++
pa_estring.ml | 407 +++++++++++++++++++++++++++++++++++++++++++++++
pa_estring.mli | 132 +++++++++++++++
sample/pa_string_list.ml | 20 +++
sample/sample.ml | 24 +++
setup.ml | 14 ++
style.css | 171 ++++++++++++++++++++
16 files changed, 1079 insertions(+)
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..95fe78f
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,6 @@
+_build/
+/estring-*.tar.gz
+/setup.data
+/setup.log
+/setup.exe
+/setup-dev.exe
diff --git a/CHANGES.md b/CHANGES.md
new file mode 100644
index 0000000..e158034
--- /dev/null
+++ b/CHANGES.md
@@ -0,0 +1,15 @@
+1.3 (2012-09-23)
+----------------
+
+* fix `META` generation
+
+1.2 (2012-07-30)
+----------------
+
+* update oasis files
+
+1.1 (2011-03-05)
+----------------
+
+* fix a bug in expansion of class expressions
+* use oasis
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..415e202
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,24 @@
+Copyright (c) 2008, Jeremie Dimino <jeremie at dimino.org>
+All rights reserved.
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Jeremie Dimino nor the names of its
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE REGENTS AND CONTRIBUTORS BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..3ffbdc7
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,59 @@
+# Makefile
+# --------
+# Copyright : (c) 2012, Jeremie Dimino <jeremie at dimino.org>
+# Licence : BSD3
+#
+# Generic Makefile for oasis project
+
+# Set to setup.exe for the release
+SETUP := setup-dev.exe
+
+# Default rule
+default: build
+
+# Setup for the development version
+setup-dev.exe: _oasis setup.ml
+ sed '/^#/D' setup.ml > setup_dev.ml
+ ocamlfind ocamlopt -o $@ -linkpkg -package ocamlbuild,oasis.dynrun setup_dev.ml || \
+ ocamlfind ocamlc -o $@ -linkpkg -package ocamlbuild,oasis.dynrun setup_dev.ml || true
+ rm -f setup_dev.*
+
+# Setup for the release
+setup.exe: setup.ml
+ ocamlopt.opt -o $@ $< || ocamlopt -o $@ $< || ocamlc -o $@ $<
+ rm -f setup.cmx setup.cmi setup.o setup.obj setup.cmo
+
+build: $(SETUP) setup.data
+ ./$(SETUP) -build $(BUILDFLAGS)
+
+doc: $(SETUP) setup.data build
+ ./$(SETUP) -doc $(DOCFLAGS)
+
+test: $(SETUP) setup.data build
+ ./$(SETUP) -test $(TESTFLAGS)
+
+all: $(SETUP)
+ ./$(SETUP) -all $(ALLFLAGS)
+
+install: $(SETUP) setup.data
+ ./$(SETUP) -install $(INSTALLFLAGS)
+
+uninstall: $(SETUP) setup.data
+ ./$(SETUP) -uninstall $(UNINSTALLFLAGS)
+
+reinstall: $(SETUP) setup.data
+ ./$(SETUP) -reinstall $(REINSTALLFLAGS)
+
+clean: $(SETUP)
+ ./$(SETUP) -clean $(CLEANFLAGS)
+
+distclean: $(SETUP)
+ ./$(SETUP) -distclean $(DISTCLEANFLAGS)
+
+configure: $(SETUP)
+ ./$(SETUP) -configure $(CONFIGUREFLAGS)
+
+setup.data: $(SETUP)
+ ./$(SETUP) -configure $(CONFIGUREFLAGS)
+
+.PHONY: default build doc test all install uninstall reinstall clean distclean configure
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..108a2de
--- /dev/null
+++ b/README.md
@@ -0,0 +1,55 @@
+estring - extension for string literals
+=======================================
+
+Estring is a syntax extension which aims to make the use of custom
+string types more convenient.
+
+The idea is to replace this kind of code:
+
+ (My_string.of_string "string literals")
+
+by:
+
+ m"string literals"
+
+Dependencies
+------------
+
+* [OCaml](http://caml.inria.fr/ocaml/) (>= 3.11)
+* [findlib](http://projects.camlcity.org/projects/findlib.html)
+
+For building the development version, you also need to install
+[oasis](http://oasis.forge.ocamlcore.org/) (>= 0.3.0).
+
+Installation
+------------
+
+To build and install estring:
+
+ $ ./configure
+ $ make
+ $ make install
+
+### Documentation _(optional)_
+
+To build the documentation:
+
+ $ make doc
+
+It will then be installed by `make install`.
+
+### Tests _(optionnal)_
+
+To build and execute tests:
+
+ $ ./configure --enable-tests
+ $ make test
+
+Usage
+-----
+
+Files in the "sample" directory show how to define string convertors.
+
+For the distribution of your project, you can either add a dependency
+to the estring package or embed it in your sources. Several instances
+of estring can work together so this will not break anything.
diff --git a/_oasis b/_oasis
new file mode 100644
index 0000000..79c6e62
--- /dev/null
+++ b/_oasis
@@ -0,0 +1,68 @@
+# +-------------------------------------------------------------------+
+# | Package parameters |
+# +-------------------------------------------------------------------+
+
+OASISFormat: 0.3
+Name: estring
+Version: 1.3
+LicenseFile: LICENSE
+License: BSD3
+Authors: Jeremie Dimino
+Maintainers: Jeremie Dimino <jeremie at dimino.org>
+Homepage: http://estring.forge.ocamlcore.org/
+BuildTools: ocamlbuild
+Plugins: DevFiles (0.3), META (0.3)
+XDevFilesEnableMakefile: false
+Synopsis: Extension for string literals
+Description:
+ Estring allows to transform string literals in programs by
+ prefixing them with a specifier. For example ``u"foo"'' can be
+ automatically replaced by ``Unicode.of_string "foo"''.
+
+# +-------------------------------------------------------------------+
+# | The library |
+# +-------------------------------------------------------------------+
+
+Library estring
+ FindlibName: estring
+ BuildDepends: camlp4, camlp4.quotations.o
+ XMETADescription: Extension for string literals
+ XMETARequires: camlp4
+ XMETAType: syntax
+ Path: ./
+ Install: true
+ Modules: Pa_estring
+
+# +-------------------------------------------------------------------+
+# | Examples |
+# +-------------------------------------------------------------------+
+
+Executable sample
+ Path: sample
+ Install: false
+ CompiledObject: best
+ MainIs: sample.ml
+ BuildDepends: estring
+
+# +-------------------------------------------------------------------+
+# | Doc |
+# +-------------------------------------------------------------------+
+
+Document "estring-api"
+ Title: API reference for Estring
+ Type: ocamlbuild (0.3)
+ Install: true
+ InstallDir: $htmldir/api
+ DataFiles: style.css
+ BuildTools: ocamldoc
+ XOCamlbuildPath: ./
+ XOCamlbuildLibraries: estring
+
+# +-------------------------------------------------------------------+
+# | Misc |
+# +-------------------------------------------------------------------+
+
+SourceRepository head
+ Type: git
+ Location: https://github.com/diml/estring.git
+ Browser: https://github.com/diml/estring
diff --git a/_tags b/_tags
new file mode 100644
index 0000000..a429e0f
--- /dev/null
+++ b/_tags
@@ -0,0 +1,5 @@
+<**/*.ml>: syntax_camlp4o
+<sample/sample.ml>: pa_estring, pa_string_list
+
+# OASIS_START
+# OASIS_STOP
diff --git a/configure b/configure
new file mode 100755
index 0000000..3234be2
--- /dev/null
+++ b/configure
@@ -0,0 +1,5 @@
+#!/bin/sh
+
+# OASIS_START
+make configure CONFIGUREFLAGS="$*"
+# OASIS_STOP
diff --git a/dist b/dist
new file mode 100755
index 0000000..ae5efa6
--- /dev/null
+++ b/dist
@@ -0,0 +1,38 @@
+#!/bin/bash
+#
+# dist
+# ----
+# Copyright : (c) 2012, Jeremie Dimino <jeremie at dimino.org>
+# Licence : BSD3
+#
+# Script to build the release
+
+set -e
+
+# Extract project parameters from _oasis
+NAME=`oasis query Name 2> /dev/null`
+VERSION=`oasis query Version 2> /dev/null`
+PREFIX=$NAME-$VERSION
+ARCHIVE=$(pwd)/$PREFIX.tar.gz
+
+# Temporary directory
+DIR=$(mktemp -t -d dist.XXXXXXXXXX)
+trap "rm -rf $DIR" EXIT
+
+# Copy files into the temporary directory
+git archive --format=tar --prefix $NAME-$VERSION/ HEAD | tar xf - -C $DIR
+
+cd $DIR/$PREFIX
+
+# Generate files
+oasis setup
+
+# Set release mode in the Makefile
+sed -i 's/^SETUP := setup-dev.exe.*/SETUP := setup.exe/' Makefile
+
+# Remove this script
+rm -f dist
+
+# Create the archive
+cd ..
+tar czf $ARCHIVE $PREFIX
diff --git a/myocamlbuild.ml b/myocamlbuild.ml
new file mode 100644
index 0000000..784a0c0
--- /dev/null
+++ b/myocamlbuild.ml
@@ -0,0 +1,36 @@
+(*
+ * myocamlbuild.ml
+ * ---------------
+ * Copyright : (c) 2011, Jeremie Dimino <jeremie at dimino.org>
+ * Licence : BSD3
+ *
+ * This file is a part of estring.
+ *)
+
+(* OASIS_START *)
+(* OASIS_STOP *)
+
+open Ocamlbuild_plugin
+
+let () =
+ dispatch
+ (fun hook ->
+ dispatch_default hook;
+ match hook with
+ | Before_options ->
+ Options.make_links := false
+
+ | After_rules ->
+ flag ["ocaml"; "compile"; "pa_estring"] & S[A"-ppopt"; A "estring.cma"];
+ flag ["ocaml"; "ocamldep"; "pa_estring"] & S[A"-ppopt"; A "estring.cma"];
+ flag ["ocaml"; "doc"; "pa_estring"] & S[A"-ppopt"; A "estring.cma"];
+ dep ["ocaml"; "ocamldep"; "pa_estring"] ["estring.cma"];
+
+ flag ["ocaml"; "compile"; "pa_string_list"] & S[A"-ppopt"; A "sample/pa_string_list.cmo"];
+ flag ["ocaml"; "ocamldep"; "pa_string_list"] & S[A"-ppopt"; A "sample/pa_string_list.cmo"];
+ flag ["ocaml"; "doc"; "pa_string_list"] & S[A"-ppopt"; A "sample/pa_string_list.cmo"];
+ dep ["ocaml"; "ocamldep"; "pa_string_list"] ["sample/pa_string_list.cmo"]
+
+
+ | _ ->
+ ())
diff --git a/pa_estring.ml b/pa_estring.ml
new file mode 100644
index 0000000..61b65c3
--- /dev/null
+++ b/pa_estring.ml
@@ -0,0 +1,407 @@
+(*
+ * pa_estring.ml
+ * -------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie at dimino.org>
+ * Licence : BSD3
+ *
+ * This file is a part of estring.
+ *)
+
+open Printf
+open Camlp4.Sig
+open Camlp4.PreCast
+
+type specifier = string
+
+type context = {
+ mutable next_id : int;
+ mutable shared_exprs : (Loc.t * string * Ast.expr) list;
+}
+
+let lookup tbl key =
+ try
+ Some(Hashtbl.find tbl key)
+ with
+ Not_found -> None
+
+(* +---------------------+
+ | Lists with location |
+ +---------------------+ *)
+
+type 'a llist =
+ | Nil of Loc.t
+ | Cons of Loc.t * 'a * 'a llist
+
+let loc_of_llist = function
+ | Nil loc -> loc
+ | Cons(loc, x, l) -> loc
+
+let rec llength_rec acc = function
+ | Nil _ -> acc
+ | Cons(_, _, ll) -> llength_rec (acc + 1) ll
+
+let llength ll = llength_rec 0 ll
+
+let rec lfoldr f g = function
+ | Nil loc -> g loc
+ | Cons(loc, x, l) -> f loc x (lfoldr f g l)
+
+let rec list_of_llist = function
+ | Nil _ -> []
+ | Cons(_, x, l) -> x :: list_of_llist l
+
+let rec llist_of_list loc = function
+ | [] -> Nil loc
+ | x :: l -> Cons(loc, x, llist_of_list (Loc.move `start 1 loc) l)
+
+let rec ldrop n l =
+ if n <= 0 then
+ l
+ else match l with
+ | Cons(_, _, l) -> ldrop (n - 1) l
+ | l -> l
+
+let rec ltake n l =
+ if n <= 0 then
+ Nil (loc_of_llist l)
+ else match l with
+ | Cons(loc, x, l) -> Cons(loc, x, ltake (n - 1) l)
+ | l -> l
+
+let rec lappend ll1 ll2 = match ll1 with
+ | Nil _ -> ll1
+ | Cons(loc, x, ll) -> Cons(loc, x, lappend ll ll2)
+
+let llist_expr f ll = lfoldr (fun _loc x acc -> <:expr< $f _loc x$ :: $acc$ >>) (fun _loc -> <:expr< [] >>) ll
+let llist_patt f ll = lfoldr (fun _loc x acc -> <:patt< $f _loc x$ :: $acc$ >>) (fun _loc -> <:patt< [] >>) ll
+
+(* +--------------------+
+ | Strings unescaping |
+ +--------------------+ *)
+
+(* String appears in the camlp4 ast as they apears in the source
+ code. So if we want to process a string then we need to first
+ unescape it. Camlp4 provide such a function
+ (Camlp4.Struct.Token.Eval.string) but the problem is that we do not
+ know exactly the location of unescaped characters:
+
+ For instance: "\tx\tA" will be unescaped in " x A", and the
+ position of "A" in the resulting string will be changed.
+
+ So here is an implementation of an unescaping function which also
+ compute the location of each unescaped characters. *)
+
+module Unescape =
+struct
+ let add n loc = Loc.move `start n loc
+ let inc loc = add 1 loc
+ let addl n loc = Loc.move_line n loc
+ let incl loc = addl 1 loc
+ let resetl loc = addl 0 loc
+
+ let dec x = Char.code x - Char.code '0'
+ let hex = function
+ | '0'..'9' as x -> Char.code x - Char.code '0'
+ | 'a'..'f' as x -> Char.code x - Char.code 'a' + 10
+ | 'A'..'F' as x -> Char.code x - Char.code 'A' + 10
+ | x -> assert false
+
+ let rec skip_indent cont loc = function
+ | (' ' | '\t') :: l -> skip_indent cont (inc loc) l
+ | l -> cont loc l
+
+ let skip_opt_linefeed cont loc = function
+ | '\n' :: l -> cont (incl loc) l
+ | l -> cont loc l
+
+ let rec string loc = function
+ | [] -> Nil loc
+ | '\\' :: l ->
+ let loc = inc loc in
+ begin match l with
+ | '\n' :: l -> skip_indent string (incl loc) l
+ | '\r' :: l -> skip_opt_linefeed (skip_indent string) (resetl loc) l
+ | 'n' :: l -> Cons(loc, '\n', string (inc loc) l)
+ | 'r' :: l -> Cons(loc, '\r', string (inc loc) l)
+ | 't' :: l -> Cons(loc, '\t', string (inc loc) l)
+ | 'b' :: l -> Cons(loc, '\b', string (inc loc) l)
+ | '\\' :: l -> Cons(loc, '\\', string (inc loc) l)
+ | '"' :: l -> Cons(loc, '"', string (inc loc) l)
+ | '\'' :: l -> Cons(loc, '\'', string (inc loc) l)
+ | ' ' :: l -> Cons(loc, ' ', string (inc loc) l)
+ | ('0'..'9' as c1) :: ('0'..'9' as c2) :: ('0'..'9' as c3) :: l ->
+ Cons(loc,
+ char_of_int (100 * (dec c1) + 10 * (dec c2) + (dec c3)),
+ string (add 3 loc) l)
+ | 'x'
+ :: ('0'..'9' | 'a'..'f' | 'A'..'F' as c1)
+ :: ('0'..'9' | 'a'..'f' | 'A'..'F' as c2) :: l ->
+ Cons(loc,
+ char_of_int (16 * (hex c1) + (hex c2)),
+ string (add 3 loc) l)
+ | _ -> Loc.raise loc (Stream.Error "illegal backslash")
+ end
+ | '\r' :: l -> Cons(loc, '\r', string (resetl loc) l)
+ | '\n' :: l -> Cons(loc, '\n', string (incl loc) l)
+ | ch :: l -> Cons(loc, ch, string (inc loc) l)
+end
+
+let unescape loc str =
+ let l = ref [] in
+ for i = String.length str - 1 downto 0 do
+ l := str.[i] :: !l
+ done;
+ Unescape.string loc !l
+
+(* +------------------------+
+ | Specifier registration |
+ +------------------------+ *)
+
+module String_set = Set.Make(String)
+
+let specifiers = ref String_set.empty
+let add_specifier spec =
+ specifiers := String_set.add spec !specifiers
+
+let expr_specifiers = Hashtbl.create 42
+let patt_specifiers = Hashtbl.create 42
+let when_specifiers = Hashtbl.create 42
+
+let register_expr_specifier specifier f =
+ add_specifier specifier;
+ Hashtbl.add expr_specifiers specifier f
+
+let register_patt_specifier specifier f =
+ add_specifier specifier;
+ Hashtbl.add patt_specifiers specifier f
+
+let register_when_specifier specifier f =
+ add_specifier specifier;
+ Hashtbl.add when_specifiers specifier f
+
+(* +------------------------------+
+ | String specifier recognition |
+ +------------------------------+ *)
+
+(* Strings with a specifier are recognized using a token filter. This
+ is to avoid recognizing things like [u "string"], [X.u"string"].
+
+ Strings with a specifier are replaced by an identifier of the form
+ "__estring_string_NNN_XXX". *)
+
+let strings = Hashtbl.create 42
+ (* Mapping identifier of the form "__estring_XXX" -> specifier + string literal *)
+
+let estring_prefix = sprintf "__estring_string_%d_" (Oo.id (object end))
+ (* Prefix for identifiers referring to strings with specifier. The
+ [Oo.id (object end)] is a trick to generate a fresh id so several
+ estring instances can works together. *)
+
+let gen_string_id =
+ let nb = ref 0 in
+ fun () ->
+ let x = !nb in
+ nb := x + 1;
+ estring_prefix ^ string_of_int x
+
+let wrap_stream stm =
+ (* The previous token *)
+ let previous = ref EOI in
+
+ let func pos =
+ try
+ let prev = !previous
+ and tok, loc = Stream.next stm in
+
+ previous := tok;
+
+ match tok with
+ | (LIDENT id | UIDENT id) when prev <> KEYWORD "." && String_set.mem id !specifiers ->
+ begin match Stream.peek stm with
+ | Some(STRING(s, orig), loc) ->
+ Stream.junk stm;
+ let string_id = gen_string_id () in
+ Hashtbl.add strings string_id (id, orig);
+ Some(LIDENT string_id, loc)
+ | _ ->
+ Some(tok, loc)
+ end
+
+ | _ ->
+ Some(tok, loc)
+ with
+ Stream.Failure -> None
+ in
+ Stream.from func
+
+(* +--------------------+
+ | Strings conversion |
+ +--------------------+ *)
+
+let register_shared_expr context expr =
+ let id = "__estring_shared_" ^ string_of_int context.next_id in
+ context.next_id <- context.next_id + 1;
+ let _loc = Ast.loc_of_expr expr in
+ context.shared_exprs <- (_loc, id, expr) :: context.shared_exprs;
+ <:ident< $lid:id$ >>
+
+let is_special_id id =
+ let rec aux1 i =
+ if i = String.length estring_prefix then
+ aux2 i
+ else
+ i < String.length id && id.[i] = estring_prefix.[i] && aux1 (i + 1)
+ and aux2 i =
+ (i < String.length id) && match id.[i] with
+ | '0' .. '9' -> aux3 (i + 1)
+ | _ -> false
+ and aux3 i =
+ if i = String.length id then
+ true
+ else match id.[i] with
+ | '0' .. '9' -> aux3 (i + 1)
+ | _ -> false
+ in
+ aux1 0
+
+let expand_expr context _loc id =
+ match lookup strings id with
+ | Some(specifier, string) -> begin
+ match lookup expr_specifiers specifier with
+ | Some f ->
+ f context _loc string
+ | None ->
+ Loc.raise _loc (Failure "pa_estring: this specifier can not be used here")
+ end
+
+ | None ->
+ <:expr< $lid:id$ >>
+
+let expand_patt context _loc id =
+ match lookup strings id with
+ | Some(specifier, string) -> begin
+ match lookup patt_specifiers specifier with
+ | Some f ->
+ f context _loc string
+ | None ->
+ Loc.raise _loc (Failure "pa_estring: this specifier can not be used here")
+ end
+
+ | None ->
+ <:patt< $lid:id$ >>
+
+(* Replace extended strings with identifiers and collect conditions *)
+let map_match context (num, conds) = object
+ inherit Ast.map as super
+
+ method patt p = match super#patt p with
+ | <:patt at _loc< $lid:id$ >> as p when is_special_id id -> begin
+ match lookup strings id with
+ | Some(specifier, string) -> begin
+ match lookup when_specifiers specifier with
+ | Some f ->
+ let id = <:ident< $lid:"__estring_var_" ^ string_of_int !num$ >> in
+ incr num;
+ conds := f context _loc id string :: !conds;
+ <:patt< $id:id$ >>
+
+ | None ->
+ expand_patt context _loc id
+ end
+
+ | None ->
+ p
+ end
+
+ | p -> p
+end
+
+let map context = object(self)
+ inherit Ast.map as super
+
+ method expr e = match super#expr e with
+ | <:expr at _loc< $lid:id$ >> when is_special_id id -> expand_expr context _loc id
+ | e -> e
+
+ method patt p = match super#patt p with
+ | <:patt at _loc< $lid:id$ >> when is_special_id id -> expand_patt context _loc id
+ | p -> p
+
+ method match_case = function
+ | <:match_case at _loc< $p$ when $c$ -> $e$ >> ->
+ let conds = ref [] in
+ let p = (map_match context (ref 0, conds))#patt p
+ and c = self#expr c and e = self#expr e in
+ let gen_mc first_cond conds =
+ <:match_case< $p$ when $List.fold_left (fun acc cond -> <:expr< $cond$ && $acc$ >>) first_cond conds$ -> $e$ >>
+ in
+ begin match c, !conds with
+ | <:expr< >>, [] ->
+ <:match_case< $p$ when $c$ -> $e$ >>
+
+ | <:expr< >>, c :: l ->
+ gen_mc c l
+
+ | e, l ->
+ gen_mc e l
+ end
+
+ | mc ->
+ super#match_case mc
+end
+
+let map_expr e =
+ let context = { next_id = 0; shared_exprs = [] } in
+ let e = (map context)#expr e in
+ List.fold_left
+ (fun acc (_loc, id, expr) -> <:expr< let $lid:id$ = $expr$ in $acc$ >>)
+ e context.shared_exprs
+
+let rec map_class_expr = function
+ | Ast.CeAnd(loc, e1, e2) ->
+ Ast.CeAnd(loc, map_class_expr e1, map_class_expr e2)
+ | Ast.CeEq(loc, name, e) ->
+ let context = { next_id = 0; shared_exprs = [] } in
+ let e = (map context)#class_expr e in
+ let e =
+ List.fold_left
+ (fun acc (_loc, id, expr) -> <:class_expr< let $lid:id$ = $expr$ in $acc$ >>)
+ e context.shared_exprs
+ in
+ Ast.CeEq(loc, name, e)
+ | ce ->
+ ce
+
+let rec map_binding = function
+ | <:binding at _loc< $id$ = $e$ >> ->
+ <:binding< $id$ = $map_expr e$ >>
+ | <:binding at _loc< $a$ and $b$ >> ->
+ <:binding< $map_binding a$ and $map_binding b$ >>
+ | x ->
+ x
+
+let map_def = function
+ | Ast.StVal(loc, is_rec, binding) ->
+ Ast.StVal(loc, is_rec, map_binding binding)
+ | Ast.StExp(loc, expr) ->
+ Ast.StExp(loc, map_expr expr)
+ | Ast.StCls(loc, ce) ->
+ Ast.StCls(loc, map_class_expr ce)
+ | x ->
+ x
+
+(* +--------------+
+ | Registration |
+ +--------------+ *)
+
+let _ =
+ (* Register the token filter for specifiers *)
+ Gram.Token.Filter.define_filter (Gram.get_filter ()) (fun filter stm -> filter (wrap_stream stm));
+
+ let map = (Ast.map_str_item map_def)#str_item in
+
+ (* Register the mapper for implementations *)
+ AstFilters.register_str_item_filter map;
+
+ (* Register the mapper for the toplevel *)
+ AstFilters.register_topphrase_filter map
diff --git a/pa_estring.mli b/pa_estring.mli
new file mode 100644
index 0000000..d0336b6
--- /dev/null
+++ b/pa_estring.mli
@@ -0,0 +1,132 @@
+(*
+ * pa_estring.mli
+ * --------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie at dimino.org>
+ * Licence : BSD3
+ *
+ * This file is a part of estring.
+ *)
+
+(** The pa_estring syntax extension *)
+
+open Camlp4.PreCast
+
+type specifier = string
+ (** Type of a string specifier (the letters just before the
+ string) *)
+
+(** {6 Specifier registration} *)
+
+type context
+ (** Context of an expression *)
+
+val register_expr_specifier : specifier -> (context -> Loc.t -> string -> Ast.expr) -> unit
+ (** [register_expr_specifier spec f] registers [f] as a mapping
+ function for string with the specifier [spec] in expressions. *)
+
+val register_patt_specifier : specifier -> (context -> Loc.t -> string -> Ast.patt) -> unit
+ (** [register_patt_specifier spec f] same thing but for strings in
+ patterns *)
+
+val register_when_specifier : specifier -> (context -> Loc.t -> Ast.ident -> string -> Ast.expr) -> unit
+ (** [register_when_specifier spec f] same thing, but for strings in
+ match case, which will be compared using a when clause. [f]
+ takes as argument the identifier used in the pattern and the
+ string. *)
+
+(** Note: strings are passed unescaped to the expansion functions *)
+
+(** {6 Shared expression} *)
+
+val register_shared_expr : context -> Ast.expr -> Ast.ident
+ (** [register_shared_expr context expr] registers [expr] as a shared
+ constant and return the identifier to which it is bound. The
+ binding will be placed in the current definition.
+
+ for example with the following specifier:
+
+ {[
+ register_expr_specifier "u"
+ (fun context _loc str ->
+ let id = register_shared_expr context <:expr< UTF8.of_string $str:str$ >> in
+ <:expr< $id:id$ >>)
+ ]}
+
+ The following definition:
+
+ {[
+ let f x y z = u"foo"
+ ]}
+
+ will be expanded to:
+
+ {[
+ let f =
+ let __estring_shared_0 = UTF8.of_string "foo" in
+ fun x y z -> __estring_shared_0
+ ]}
+ *)
+
+(** {6 Lists with location} *)
+
+(** We may want to know the location of each characters in a
+ string. In order to do this we deal with strings as list of
+ characters with location. The type [(char * Loc.t) list] is not
+ suitable since we do not know the location of the end of the
+ list. The right choise is: *)
+
+type 'a llist =
+ | Nil of Loc.t
+ | Cons of Loc.t * 'a * 'a llist
+
+val loc_of_llist : 'a llist -> Loc.t
+ (** Returns the location of the first element of a llist *)
+
+val llength : 'a llist -> int
+ (** Returns the length of a llist *)
+
+val lfoldr : (Loc.t -> 'a -> 'acc -> 'acc) -> (Loc.t -> 'acc) -> 'a llist -> 'acc
+ (** [lfoldr f g l] fold_right-like function for llist.
+
+ For example:
+
+ {[
+ lfoldr f g (Cons(loc1, 1, Cons(loc2, 2, Nil loc3)))
+ ]}
+
+ is the same as:
+
+ {[
+ f loc1 1 (f loc2 2 (g loc3))
+ ]}
+ *)
+
+val list_of_llist : 'a llist -> 'a list
+ (** Returns the list of elements contained in a llist *)
+
+val llist_of_list : Loc.t -> 'a list -> 'a llist
+ (** [llist_of_list loc l] Create a llist with all elements from [l].
+ The nth element will be at loc + n. *)
+
+val ldrop : int -> 'a llist -> 'a llist
+ (** [ldrop count ll] returns [ll] without its firsts [count]
+ elements. *)
+
+val ltake : int -> 'a llist -> 'a llist
+ (** [ltake count ll] returns the firsts [count] elements of [ll]. *)
+
+val lappend : 'a llist -> 'a llist -> 'a llist
+ (** [lappend ll1 ll2] appends [ll2] to [ll1] *)
+
+val llist_expr : (Loc.t -> 'a -> Ast.expr) -> 'a llist -> Ast.expr
+ (** [llist_expr f ll] returns the expression representing a list
+ with element obtained by applying [f] on element of [ll] *)
+
+val llist_patt : (Loc.t -> 'a -> Ast.patt) -> 'a llist -> Ast.patt
+ (** [llist_patt f ll] same as {!llist_expr} but for patterns *)
+
+(** {6 String unescaping} *)
+
+val unescape : Loc.t -> string -> char llist
+ (** [unescape loc str] returns the unescaped version of [str] where
+ each unescaped character position has been computed *)
diff --git a/sample/pa_string_list.ml b/sample/pa_string_list.ml
new file mode 100644
index 0000000..97dd096
--- /dev/null
+++ b/sample/pa_string_list.ml
@@ -0,0 +1,20 @@
+(*
+ * pa_string_list.ml
+ * -----------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie at dimino.org>
+ * Licence : BSD3
+ *
+ * This file is a part of estring.
+ *)
+
+(* Sample syntax extension for replacing strings by list of
+ characters *)
+
+open Camlp4.PreCast
+open Pa_estring
+
+let _ =
+ register_expr_specifier "l"
+ (fun ctx loc str -> llist_expr (fun _loc ch -> <:expr< $chr:Char.escaped ch$ >>) (unescape loc str));
+ register_patt_specifier "l"
+ (fun ctx loc str -> llist_patt (fun _loc ch -> <:patt< $chr:Char.escaped ch$ >>) (unescape loc str))
diff --git a/sample/sample.ml b/sample/sample.ml
new file mode 100644
index 0000000..bb751c4
--- /dev/null
+++ b/sample/sample.ml
@@ -0,0 +1,24 @@
+(*
+ * sample.ml
+ * ---------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie at dimino.org>
+ * Licence : BSD3
+ *
+ * This file is a part of estring.
+ *)
+
+open Printf
+
+(* [x] is a list of characters defined in a convenient way: *)
+let x = l"Hello, world!"
+
+(* Simple function on list of characters: *)
+let replace patt repl l =
+ List.map (fun ch -> if ch = patt then repl else ch) l
+
+let y = replace 'o' 'i' x
+
+let output_char_list oc l = List.iter (output_char oc) l
+
+let _ =
+ printf "x = %a\ny = %a\n" output_char_list x output_char_list y
diff --git a/setup.ml b/setup.ml
new file mode 100644
index 0000000..9356f63
--- /dev/null
+++ b/setup.ml
@@ -0,0 +1,14 @@
+(*
+ * setup.ml
+ * --------
+ * Copyright : (c) 2012, Jeremie Dimino <jeremie at dimino.org>
+ * Licence : BSD3
+ *)
+
+(* OASIS_START *)
+#use "topfind";;
+#require "oasis.dynrun";;
+open OASISDynRun;;
+(* OASIS_STOP *)
+
+let () = setup ();;
diff --git a/style.css b/style.css
new file mode 100644
index 0000000..6ae1569
--- /dev/null
+++ b/style.css
@@ -0,0 +1,171 @@
+/* A style for ocamldoc. Daniel C. Buenzli, Jérémie Dimino */
+
+body {
+ padding: 0em;
+ border: 0em;
+ margin: 2em 10% 2em 10%;
+ font-weight: normal;
+ line-height: 130%;
+ text-align: justify;
+ background: white;
+ color : black;
+ min-width: 40ex;
+}
+
+pre, p, div, span, img, table, td, ol, ul, li {
+ padding: 0em;
+ border: 0em;
+ margin: 0em
+}
+
+h1, h2, h3, h4, h5, h6, div.h7, div.h8, div.h9 {
+ fontsize: 100%;
+ margin-bottom: 1em
+ padding: 1ex 0em 0em 0em;
+ border: 0em;
+ margin: 1em 0em 0em 0em;
+ font-weight : bold;
+ text-align: center;
+}
+
+h1 {
+ font-size : 140%
+}
+
+h2, h3, h4, h5, h6, div.h7, div.h8, div.h9 {
+ font-size : 100%;
+ border-top-style : none;
+ margin: 1ex 0em 0em 0em;
+ border: 1px solid #000000;
+ margin-top: 5px;
+ margin-bottom: 2px;
+ text-align: center;
+ padding: 2px;
+}
+
+h2 {
+ font-size : 120%;
+ background-color: #90BDFF ;
+}
+h3 {
+ background-color: #90DDFF;
+}
+h4 {
+ background-color: #90EDFF;
+}
+h5 {
+ background-color: #90FDFF;
+}
+h6 {
+ background-color: #C0FFFF;
+}
+div.h7 {
+ background-color: #E0FFFF;
+}
+div.h8 {
+ background-color: #F0FFFF;
+}
+div.h9 {
+ background-color: #FFFFFF;
+}
+
+.navbar {
+ padding-bottom : 1em;
+ margin-bottom: 1em;
+ border-bottom: 1px solid #000000;
+ border-bottom-style: dotted;
+}
+
+p {
+ padding: 1em 0ex 0em 0em
+}
+
+a, a:link, a:visited, a:active, a:hover {
+ color : #009;
+ text-decoration: none
+}
+a:hover {
+ color : #009;
+ text-decoration : none;
+ background-color: #5FFF88
+}
+
+hr {
+ border-style: none;
+}
+table {
+ font-size : 100% /* Why ? */
+}
+ul li {
+ padding: 1em 0em 0em 0em;
+ margin:0em 0em 0em 2.5ex
+}
+ol li {
+ padding: 1em 0em 0em 0em;
+ margin:0em 0em 0em 2em
+}
+
+pre {
+ margin: 3ex 0em 1ex 0em;
+ background-color: #edf0f9;
+}
+.keyword {
+ font-weight: bold;
+ color: #a020f0;
+}
+.keywordsign {
+ font-weight: bold;
+ color: #a020f0;
+}
+.typefieldcomment {
+ color : #b22222;
+}
+.keywordsign {
+ color: #a020f0;
+
+}
+.code {
+ font-size: 100%;
+ color: #5f5f5f;
+}
+.info {
+ margin: 0em 0em 0em 2em
+}
+.comment {
+ color : #b22222;
+}
+.constructor {
+ color : #072
+}
+.type {
+ color : #228b22;
+}
+.string {
+ color : #bc8f8f;
+}
+.warning {
+ color : Red;
+ font-weight : bold
+}
+
+div.sig_block {
+ margin-left: 2em
+}
+.typetable {
+ color : #b8860b;
+ border-style : hidden
+}
+.indextable {
+ border-style : hidden
+}
+.paramstable {
+ border-style : hidden;
+ padding: 5pt 5pt
+}
+
+.superscript {
+ font-size : 80%
+}
+.subscript {
+ font-size : 80%
+}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/ocaml-estring.git
More information about the Pkg-ocaml-maint-commits
mailing list