Commit 1dbc7d2c authored by gerd's avatar gerd

Sylvain's patch


git-svn-id: https://godirepo.camlcity.org/svn/lib-xstrp4/trunk@34 56444827-45db-0310-81c6-95464f7ca4c4
parent 758595a0
......@@ -29,7 +29,7 @@ sample: sample.ml
sample.ml \
-o sample
view.sample:
view.sample: all
camlp4 $(ROPTIONS) pa_o.cmo ./xstrp4.cma pr_o.cmo sample.ml
......
......@@ -28,6 +28,9 @@ is O'Caml bug #4357 (http://caml.inria.fr/mantis/view.php?id=4357).
CHANGES:
Changed in version 1.8:
Removal of the support for O'Caml 3.09 and earlier.
Integrating Sylvain's record access patch.
Changed in version 1.7:
Porting to O'Caml 3.10. Still works for older O'Caml versions.
......
......@@ -89,4 +89,19 @@ print_string interpolate "\$s \${f,%f} is not \${i,%d}\n";;
>>
(**********************************************************************)
(* Access to record fields *)
(**********************************************************************)
(* It is also possible to access record fields. Just use the standard
* OCaml notation rcrd.field.
*)
type rcrd =
{
s: string;
f: float;
i: int;
}
let rcrd = {s = "The number"; f = 3.14; i = 42} in
print_string interpolate "$rcrd.s ${rcrd.f,%f} is not ${rcrd.i,%d}\n";;
......@@ -13,6 +13,12 @@ let camlp4loc (loc1,loc2) =
(Loc.of_lexing_position loc2)
class camlp4reloc reloc =
object
inherit Ast.map
method loc _ = reloc
end
let interpolated_expr lexbuf _loc =
(* Parse [lexbuf], and generate the syntax tree for the corresponding expression.
......@@ -67,30 +73,18 @@ let interpolated_expr lexbuf _loc =
Literal(s,lexloc) ->
let _loc = camlp4loc lexloc in
<:expr< $str:s$ >>
| Variable (sl,fmt,lexloc) ->
let _loc = camlp4loc lexloc in
let rec translate_id sl =
match sl with
s :: ((s' :: _) as sl') ->
let moduleid_ast = <:expr< $uid:s$ >> in
let valueid_ast = translate_id sl' in
<:expr< $moduleid_ast$ . $valueid_ast$ >>
| [s] ->
<:expr< $lid:s$ >>
| _ ->
failwith "Xstrp4.here_expr"
in
let node = match fmt with
"%s" -> translate_id sl
| ("%d"|"%i") ->
let id = translate_id sl in
<:expr< $lid:"string_of_int"$ $id$ >>
| _ ->
let id = translate_id sl in
<:expr< ( ( $uid:"Printf"$ . $lid:"sprintf"$ )
$str:fmt$
)
$id$ >>
| Variable (id,fmt,lexloc) ->
let _loc = camlp4loc lexloc in
(* Relocate the ident to the new location *)
let id = (new camlp4reloc _loc)#ident id in
let node =
match fmt with
| "%s" ->
<:expr< $id:id$ >>
| ("%d"|"%i") ->
<:expr< Pervasives.string_of_int $id:id$ >>
| _ ->
<:expr< Printf.sprintf $str:fmt$ $id:id$ >>
in
node
| Textend -> failwith "Xstrp4.here_expr")
......
......@@ -5,20 +5,17 @@
{
open Xstrp4_here_types
open Camlp4.PreCast
type val_id = LC of string | UC of string | End_of_id
let _loc = Loc.ghost
let rec parse_val_id f buf =
let id = f buf in
match id with
UC s -> s :: parse_val_id f buf
| LC s -> [s]
| End_of_id -> []
let pos lexbuf = (Lexing.lexeme_start_p lexbuf, Lexing.lexeme_end_p lexbuf)
}
let ucletter = [ 'A' - 'Z' ]
let lcletter = [ 'a' - 'z' '_' ]
let acletter = ucletter | lcletter
let value_id = ( acletter+ '.' )* lcletter acletter *
let format = '%'
[ '0' '-' ' ' ]* (* no more modifiers are supported by Ocaml *)
......@@ -29,50 +26,29 @@ let format = '%'
)
rule token = parse
'$' ( ucletter acletter* '.' )* lcletter acletter*
{ let s = Lexing.lexeme lexbuf in
let buf = Lexing.from_string (String.sub s 1 (String.length s - 1)) in
let start_p = Lexing.lexeme_start_p lexbuf in
let end_p = Lexing.lexeme_end_p lexbuf in
Variable (parse_val_id value_identifier buf,
"%s",
({ start_p with Lexing.pos_cnum = start_p.Lexing.pos_cnum (* + 1 *) },
end_p))
}
| '$' '{' ( ucletter acletter* '.' )* lcletter acletter*
( ',' format )?
'}'
{ let s = Lexing.lexeme lexbuf in
let k_close = String.index s '}' in
let k_percent = try String.index s '%' with Not_found -> (-1) in
let buf = Lexing.from_string (String.sub s 2 (k_close - 1)) in
'$' (value_id as vid)
{ Variable (id [] (Lexing.from_string vid), "%s", pos lexbuf) }
| '$' '{' (value_id as vid) ( ',' (format as fmt))? '}'
{
let fmt =
if k_percent >= 0 then
String.sub s k_percent (String.length s - k_percent - 1)
else
"%s"
match fmt with
| Some s -> s
| None -> "%s"
in
let start_p = Lexing.lexeme_start_p lexbuf in
let end_p = Lexing.lexeme_end_p lexbuf in
let start = Lexing.lexeme_start lexbuf in
Variable (parse_val_id value_identifier buf,
fmt,
({ start_p with Lexing.pos_cnum = start_p.Lexing.pos_cnum (* + 2 *) },
{ end_p with Lexing.pos_cnum = end_p.Lexing.pos_cnum (* +
(if k_percent >= 0 then k_percent-1 else k_close) *) })
)
Variable (id [] (Lexing.from_string vid), fmt, pos lexbuf)
}
| '$'
{ failwith "Bad $ expander" }
| '\\' '\n'
{ Literal("", (Lexing.lexeme_start_p lexbuf, Lexing.lexeme_end_p lexbuf)) }
{ Literal("", pos lexbuf) }
| '\\' '$'
{ Literal("$", (Lexing.lexeme_start_p lexbuf, Lexing.lexeme_end_p lexbuf)) }
{ Literal("$", pos lexbuf) }
| '\\' [ '0'-'9' ] [ '0'-'9' ] [ '0'-'9' ]
{ let s = Lexing.lexeme lexbuf in
let n = int_of_string(String.sub s 1 3) in
let lit = Printf.sprintf "%c" (Char.chr n) in
Literal(lit, (Lexing.lexeme_start_p lexbuf, Lexing.lexeme_end_p lexbuf))
Literal(lit, pos lexbuf)
}
(*
| '\\' 'o' [ '0'-'7' ] [ '0'-'7' ] [ '0'-'7' ]
......@@ -86,31 +62,33 @@ rule token = parse
{ let s = Lexing.lexeme lexbuf in
let n = int_of_string("0" ^ String.sub s 1 3) in
let lit = Printf.sprintf "%c" (Char.chr n) in
Literal(lit, (Lexing.lexeme_start_p lexbuf, Lexing.lexeme_end_p lexbuf))
Literal(lit, pos lexbuf)
}
| '\\' _
{ let lit = Lexing.lexeme lexbuf in
Literal(lit, (Lexing.lexeme_start_p lexbuf, Lexing.lexeme_end_p lexbuf))
Literal(lit, pos lexbuf)
}
| [^ '$' '\\']+
{ let lit = Lexing.lexeme lexbuf in
Literal(lit, (Lexing.lexeme_start_p lexbuf, Lexing.lexeme_end_p lexbuf))
Literal(lit, pos lexbuf)
}
| eof
{ Textend }
| _
{ let lit = Lexing.lexeme lexbuf in
Literal(lit, (Lexing.lexeme_start_p lexbuf, Lexing.lexeme_end_p lexbuf))
Literal(lit, pos lexbuf)
}
and value_identifier = parse
ucletter acletter* '.'
{ let s = Lexing.lexeme lexbuf in
UC (String.sub s 0 (String.length s - 1))
}
| lcletter acletter*
{ LC(Lexing.lexeme lexbuf) }
and id acc = parse
(ucletter acletter*) as uid
{ id (Ast.IdUid (_loc, uid) :: acc) lexbuf }
| lcletter acletter* as lid
{ id (Ast.IdLid (_loc, lid) :: acc) lexbuf }
| '.'
{ id acc lexbuf }
| eof
{ End_of_id }
{
Camlp4.PreCast.Ast.idAcc_of_list (List.rev acc)
}
......@@ -3,9 +3,13 @@
*
*)
open Camlp4
open PreCast
open Ast
type here_clause =
Literal of (string * (Lexing.position * Lexing.position))
| Variable of (string list * string * (Lexing.position * Lexing.position))
| Variable of (ident * string * (Lexing.position * Lexing.position))
(* [ M1; M2; ...; value ],f,pos1,pos2
* <==> M1.M2. ... .value with format f from position pos1 to pos2
*)
......
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