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 <me...@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 <jere...@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 <jere...@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 <jere...@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 <jere...@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 <jere...@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 <jere...@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@_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@_loc< $lid:id$ >> when is_special_id id -> expand_expr context _loc id + | e -> e + + method patt p = match super#patt p with + | <:patt@_loc< $lid:id$ >> when is_special_id id -> expand_patt context _loc id + | p -> p + + method match_case = function + | <:match_case@_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@_loc< $id$ = $e$ >> -> + <:binding< $id$ = $map_expr e$ >> + | <:binding@_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 <jere...@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 <jere...@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 <jere...@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 <jere...@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 _______________________________________________ Pkg-ocaml-maint-commits mailing list Pkg-ocaml-maint-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-ocaml-maint-commits