Commit d8958714 authored by Pietro Abate's avatar Pietro Abate

[r2004-07-13 21:15:18 by afrisch] Merge in branch ocaml308

Original author: afrisch
Date: 2004-07-13 21:15:19+00:00
parent 4080a54a
......@@ -254,7 +254,7 @@ validate: $(VALIDATE_OBJECTS:.cmo=.$(EXTENSION)) tools/validate.$(EXTENSION)
cdo2ml: ocamliface/cdo2ml.ml
@echo "Build $@"
$(HIDE)ocamlc -o $@ -pp camlp4o -I +camlp4 camlp4.cma pr_o.cmo $^
$(HIDE)ocamlc -o $@ -pp camlp4o -I +camlp4 odyl.cma camlp4.cma pr_o.cmo $^
.PHONY: compute_depend
compute_depend: $(DEPEND_OCAMLDEP)
......
......@@ -43,7 +43,7 @@ let mk ((typing,compile,code),types,ext) =
stub = None
}
let magic = "CDUCE:compunit:00003"
let magic = "CDUCE:compunit:00004"
let obj_path = ref [ "" ]
......@@ -159,7 +159,8 @@ let rec compile verbose name id src =
try Parser.prog input
with
| Stdpp.Exc_located (_, (Location _ as e)) -> raise e
| Stdpp.Exc_located ((i,j), e) -> raise_loc i j e
(* | Stdpp.Exc_located ((i,j), e) -> raise_loc i j e *)
| Stdpp.Exc_located ((i,j), e) -> raise_loc i.Lexing.pos_cnum j.Lexing.pos_cnum e
in
close_in ic;
let argv = ident (U.mk "argv") in
......
#load "q_MLast.cmo";;
let loc = (-1,-1)
let loc = (Lexing.dummy_pos, Lexing.dummy_pos)
let usage =
"Usage: cdo2ml [-static] <module>.cdo
......
......@@ -74,7 +74,7 @@ let mk_var _ =
let mk_vars = List.map mk_var
let loc = (-1,-1)
let loc = (Lexing.dummy_pos,Lexing.dummy_pos)
let let_in p e body =
<:expr< let $list:[ p, e ]$ in $body$ >>
......
......@@ -197,14 +197,14 @@ let read_cmi name =
let (unf,n) = unfold t in
if n !=0 then unsupported "polymorphic value";
values := (Ident.name id, t, unf) :: !values
| Tsig_type (id,t) ->
| Tsig_type (id,t,_) ->
Format.fprintf ppf "%a@." (Printtyp.type_declaration id) t
| Tsig_value (_,_) -> unsupported "external value"
| Tsig_exception (_,_) -> unsupported "exception"
| Tsig_module (_,_) -> unsupported "module"
| Tsig_modtype (_,_) -> unsupported "module type"
| Tsig_class (_,_) -> unsupported "class"
| Tsig_cltype (_,_) -> unsupported "class type"
| Tsig_value _ -> unsupported "external value"
| Tsig_exception _ -> unsupported "exception"
| Tsig_module _ -> unsupported "module"
| Tsig_modtype _ -> unsupported "module type"
| Tsig_class _ -> unsupported "class"
| Tsig_cltype _ -> unsupported "class type"
) sg;
(Buffer.contents buf, !values)
......
......@@ -9,8 +9,15 @@ open Printf
let () = Grammar.error_verbose := true
*)
let tloc (i,j) = (i.Lexing.pos_cnum,j.Lexing.pos_cnum)
let nopos = (Lexing.dummy_pos, Lexing.dummy_pos)
let mk loc x = Location.mk (tloc loc) x
exception Error of string
let error (i,j) s = Location.raise_loc i j (Error s)
let error loc s = error (tloc loc) s
let gram = Grammar.gcreate Ulexer.lex
......@@ -28,7 +35,7 @@ let pat = Grammar.Entry.create gram "type/pattern expression"
let regexp = Grammar.Entry.create gram "type/pattern regexp"
let keyword = Grammar.Entry.create gram "keyword"
let exp pos e = LocatedExpr (loc_of_pos pos,e)
let exp pos e = LocatedExpr (loc_of_pos (tloc pos),e)
let rec multi_prod loc = function
| [ x ] -> x
......@@ -71,8 +78,8 @@ let localize_exn f =
try f ()
with
| Stdpp.Exc_located (_, (Location _ as e)) -> raise e
| Stdpp.Exc_located ((i,j), e) -> raise_loc i j e
(* | Stdpp.Exc_located ((i,j), e) -> raise_loc i j e *)
| Stdpp.Exc_located ((i,j), e) -> raise_loc i.Lexing.pos_cnum j.Lexing.pos_cnum e
let is_fun_decl =
Grammar.Entry.of_parser gram "[is_fun_decl]"
......
......@@ -150,6 +150,21 @@ let raise_clean e =
(* reinit encoding ? *)
raise e
let pos_of_int i =
{ Lexing.pos_fname = "";
Lexing.pos_lnum = 0;
Lexing.pos_bol = 0;
Lexing.pos_cnum = i }
let make_stream_and_location f =
Token.make_stream_and_flocation
(fun () ->
let (tok,(i,j)) = f () in
(tok, (pos_of_int i, pos_of_int j))
)
let tok_func cs =
let lb = L.from_var_enc_stream enc cs in
(lexer ("#!" [^ '\n']* "\n")? -> ()) lb;
......@@ -169,7 +184,7 @@ let tok_func cs =
last_tok := fst tok;
tok
in
Token.make_stream_and_location next
make_stream_and_location next
let register_kw (s1,s2) =
if s1 = "" then
......
......@@ -8,7 +8,10 @@ open Query
#load "pa_extend.cmo";;
let exp pos e = LocatedExpr (loc_of_pos pos,e)
let tloc (i,j) = (i.Lexing.pos_cnum,j.Lexing.pos_cnum)
let mk loc x = Location.mk (tloc loc) x
let exp pos e = LocatedExpr (loc_of_pos (tloc pos),e)
let cst_nil = Const Sequence.nil_cst
let parse_ident = U.mk
......@@ -39,14 +42,14 @@ EXTEND
match z with
Some w ->
(w, exp loc
(Parser.if_then_else (Query.ast_of_bool(w,loc))
(Parser.if_then_else (Query.ast_of_bool(w,tloc loc))
(Pair (e,cst_nil))
cst_nil))
| None -> (True, exp loc (Pair(e,cst_nil)))
in
if !Query.nooptim
then Query.select(loc,fin,l)
else Query.selectOpt(loc,Pair (e,cst_nil),l,condi)
then Query.select(tloc loc,fin,l)
else Query.selectOpt(tloc loc,Pair (e,cst_nil),l,condi)
|
e = expr; "/@";
a = [IDENT|keyword]-> (* projection sur 1 attribut *)
......
......@@ -48,7 +48,7 @@ let print_symbolset ns ppf = function
(fun x -> V.print_quote ppf (ns,x)) l
| SymbolSet.Cofinite t ->
Format.fprintf ppf "@[`%a" V.print_any_in_ns ns;
List.iter (fun x -> Format.fprintf ppf " \@ %a" V.print_quote (ns,x)) t;
List.iter (fun x -> Format.fprintf ppf " \\@ %a" V.print_quote (ns,x)) t;
Format.fprintf ppf "@]"
include SortedList.FiniteCofiniteMap(Ns)(SymbolSet)
......@@ -72,7 +72,7 @@ let print s = match get s with
Format.fprintf ppf "Atom";
List.iter
(fun (ns,s) ->
Format.fprintf ppf " \@ (%a)" (print_symbolset ns) s)
Format.fprintf ppf " \\@ (%a)" (print_symbolset ns) s)
l ]
type 'a map = 'a Imap.s Imap.s
......
......@@ -421,13 +421,27 @@ struct
end
(* See PR#2920 in OCaml BTS *)
and NodeT : Custom.T with type t = Node.t =
struct
type t = Node.t
let dump x = Node.dump x
let check x = Node.check x
let equal x = Node.equal x
let hash x = Node.hash x
let compare x = Node.compare x
let serialize x = Node.serialize x
let deserialize x = Node.deserialize x
end
(* It is also possible to use Boolean instead of Bool here;
need to analyze when each one is more efficient *)
and BoolPair : Bool.S with type elem = Node.t * Node.t =
Bool.Make(Custom.Pair(Node)(Node))
Bool.Make(Custom.Pair(NodeT)(NodeT))
and BoolRec : Bool.S with type elem = bool * Node.t label_map =
Bool.Make(Custom.Pair(Custom.Bool)(LabelSet.MakeMap(Node)))
Bool.Make(Custom.Pair(Custom.Bool)(LabelSet.MakeMap(NodeT)))
module DescrHash = Hashtbl.Make(Descr)
module DescrMap = Map.Make(Descr)
......
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