From 5353d0ef3a7856882774fe934b41e6e9613c7998 Mon Sep 17 00:00:00 2001 From: Daniel de Rauglaudre Date: Fri, 28 Sep 2001 13:38:31 +0000 Subject: [PATCH] - git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@3809 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02 --- camlp4/ocaml_src/camlp4/ast2pt.ml | 61 ++++++++++++------------------- 1 file changed, 23 insertions(+), 38 deletions(-) diff --git a/camlp4/ocaml_src/camlp4/ast2pt.ml b/camlp4/ocaml_src/camlp4/ast2pt.ml index 3093deb52..1e3fafee8 100644 --- a/camlp4/ocaml_src/camlp4/ast2pt.ml +++ b/camlp4/ocaml_src/camlp4/ast2pt.ml @@ -52,20 +52,8 @@ let mkfield loc d = {pfield_desc = d; pfield_loc = mkloc loc};; let mkcty loc d = {pcty_desc = d; pcty_loc = mkloc loc};; let mkpcl loc d = {pcl_desc = d; pcl_loc = mkloc loc};; -(* shared strings for bootstrap comparisons (and smaller object files) -value shd = - let tab = Hashtbl.create 701 in - fun s -> - try Hashtbl.find tab s with - [ Not_found -> do { Hashtbl.add tab s s; s } ] -; -... but no more implemented because semantic problems with Ocaml: -let x = "bar" and y = "bar"; x.[0] <- 'c'; print_string y;; -*) -let shd x = x;; -(**) -let lident s = Lident (shd s);; -let ldot l s = Ldot (l, shd s);; +let lident s = Lident s;; +let ldot l s = Ldot (l, s);; let conv_con = let t = Hashtbl.create 73 in @@ -143,7 +131,7 @@ let rec ctyp = | TyQuo (_, s), t -> t, s | _ -> error loc "incorrect alias type" in - mktyp loc (Ptyp_alias (ctyp t, shd i)) + mktyp loc (Ptyp_alias (ctyp t, i)) | TyAny loc -> mktyp loc Ptyp_any | TyApp (loc, _, _) as f -> let (f, al) = ctyp_fa [] f in @@ -163,7 +151,7 @@ let rec ctyp = | TyLid (loc, s) -> mktyp loc (Ptyp_constr (lident s, [])) | TyMan (loc, _, _) -> error loc "type manifest not allowed here" | TyOlb (loc, lab, _) -> error loc "labeled type not allowed here" - | TyQuo (loc, s) -> mktyp loc (Ptyp_var (shd s)) + | TyQuo (loc, s) -> mktyp loc (Ptyp_var s) | TyRec (loc, _) -> error loc "record type not allowed here" | TySum (loc, _) -> error loc "sum type not allowed here" | TyTup (loc, tl) -> mktyp loc (Ptyp_tuple (List.map ctyp tl)) @@ -198,8 +186,8 @@ let mktype loc tl cl tk tm = ;; let mkmutable m = if m then Mutable else Immutable;; let mkprivate m = if m then Private else Public;; -let mktrecord (n, m, t) = shd n, mkmutable m, ctyp t;; -let mkvariant (c, tl) = shd c, List.map ctyp tl;; +let mktrecord (n, m, t) = n, mkmutable m, ctyp t;; +let mkvariant (c, tl) = c, List.map ctyp tl;; let type_decl tl cl = function TyMan (loc, t, TyRec (_, ltl)) -> @@ -220,7 +208,7 @@ let type_decl tl cl = mktype (loc_of_ctyp t) tl cl Ptype_abstract m ;; -let mkvalue_desc t p = {pval_type = ctyp t; pval_prim = List.map shd p};; +let mkvalue_desc t p = {pval_type = ctyp t; pval_prim = p};; let option f = function @@ -342,7 +330,7 @@ let rec patt = | PaLid (_, s), p -> p, s | _ -> error loc "incorrect alias pattern" in - mkpat loc (Ppat_alias (patt p, shd i)) + mkpat loc (Ppat_alias (patt p, i)) | PaAnt (_, p) -> patt p | PaAny loc -> mkpat loc Ppat_any | PaApp (loc, _, _) as f -> @@ -377,7 +365,7 @@ let rec patt = | PaInt (loc, s) -> mkpat loc (Ppat_constant (Const_int (int_of_string s))) | PaFlo (loc, s) -> mkpat loc (Ppat_constant (Const_float s)) | PaLab (loc, _, _) -> error loc "labeled pattern not allowed here" - | PaLid (loc, s) -> mkpat loc (Ppat_var (shd s)) + | PaLid (loc, s) -> mkpat loc (Ppat_var s) | PaOlb (loc, _, _, _) -> error loc "labeled pattern not allowed here" | PaOrp (loc, p1, p2) -> mkpat loc (Ppat_or (patt p1, patt p2)) | PaRng (loc, p1, p2) -> @@ -503,7 +491,7 @@ let rec expr = Pexp_apply (mkexp loc (Pexp_ident (array_function "Array" "set")), ["", expr e1; "", expr e2; "", expr v]) - | ExLid (_, lab) -> Pexp_setinstvar (shd lab, expr v) + | ExLid (_, lab) -> Pexp_setinstvar (lab, expr v) | ExSte (_, e1, e2) -> Pexp_apply (mkexp loc (Pexp_ident (array_function "String" "set")), @@ -519,7 +507,7 @@ let rec expr = | ExFor (loc, i, e1, e2, df, el) -> let e3 = ExSeq (loc, el) in let df = if df then Upto else Downto in - mkexp loc (Pexp_for (shd i, expr e1, expr e2, df, expr e3)) + mkexp loc (Pexp_for (i, expr e1, expr e2, df, expr e3)) | ExFun (loc, [PaLab (_, lab, p), w, e]) -> mkexp loc (Pexp_function (lab, None, [patt p, when_expr e w])) | ExFun (loc, [PaOlb (_, lab, p, eo), w, e]) -> @@ -587,7 +575,7 @@ and when_expr e = Some w -> mkexp (loc_of_expr e) (Pexp_when (expr w, expr e)) | None -> expr e and mklabexp (lab, e) = patt_label_long_id lab, expr e -and mkideexp (ide, e) = shd ide, expr e +and mkideexp (ide, e) = ide, expr e and mktype_decl (c, tl, td, cl) = let cl = List.map @@ -596,13 +584,13 @@ and mktype_decl (c, tl, td, cl) = ctyp t1, ctyp t2, mkloc loc) cl in - shd c, type_decl tl cl td + c, type_decl tl cl td and module_type = function MtAcc (loc, _, _) as f -> mkmty loc (Pmty_ident (module_type_long_id f)) | MtApp (loc, _, _) as f -> mkmty loc (Pmty_ident (module_type_long_id f)) | MtFun (loc, n, nt, mt) -> - mkmty loc (Pmty_functor (shd n, module_type nt, module_type mt)) + mkmty loc (Pmty_functor (n, module_type nt, module_type mt)) | MtLid (loc, s) -> mkmty loc (Pmty_ident (lident s)) | MtSig (loc, sl) -> mkmty loc (Pmty_signature (List.fold_right sig_item sl [])) @@ -618,14 +606,12 @@ and sig_item s l = | SgDcl (loc, sl) -> List.fold_right sig_item sl l | SgDir (loc, _, _) -> l | SgExc (loc, n, tl) -> - mksig loc (Psig_exception (shd n, List.map ctyp tl)) :: l - | SgExt (loc, n, t, p) -> - mksig loc (Psig_value (shd n, mkvalue_desc t p)) :: l + mksig loc (Psig_exception (n, List.map ctyp tl)) :: l + | SgExt (loc, n, t, p) -> mksig loc (Psig_value (n, mkvalue_desc t p)) :: l | SgInc (loc, mt) -> mksig loc (Psig_include (module_type mt)) :: l - | SgMod (loc, n, mt) -> mksig loc (Psig_module (shd n, module_type mt)) :: l + | SgMod (loc, n, mt) -> mksig loc (Psig_module (n, module_type mt)) :: l | SgMty (loc, n, mt) -> - mksig loc (Psig_modtype (shd n, Pmodtype_manifest (module_type mt))) :: - l + mksig loc (Psig_modtype (n, Pmodtype_manifest (module_type mt))) :: l | SgOpn (loc, id) -> mksig loc (Psig_open (long_id_of_string_list loc id)) :: l | SgTyp (loc, tdl) -> mksig loc (Psig_type (List.map mktype_decl tdl)) :: l @@ -636,7 +622,7 @@ and module_expr = | MeApp (loc, me1, me2) -> mkmod loc (Pmod_apply (module_expr me1, module_expr me2)) | MeFun (loc, n, mt, me) -> - mkmod loc (Pmod_functor (shd n, module_type mt, module_expr me)) + mkmod loc (Pmod_functor (n, module_type mt, module_expr me)) | MeStr (loc, sl) -> mkmod loc (Pmod_structure (List.fold_right str_item sl [])) | MeTyc (loc, me, mt) -> @@ -651,14 +637,13 @@ and str_item s l = | StDcl (loc, sl) -> List.fold_right str_item sl l | StDir (loc, _, _) -> l | StExc (loc, n, tl) -> - mkstr loc (Pstr_exception (shd n, List.map ctyp tl)) :: l + mkstr loc (Pstr_exception (n, List.map ctyp tl)) :: l | StExp (loc, e) -> mkstr loc (Pstr_eval (expr e)) :: l | StExt (loc, n, t, p) -> - mkstr loc (Pstr_primitive (shd n, mkvalue_desc t p)) :: l + mkstr loc (Pstr_primitive (n, mkvalue_desc t p)) :: l | StInc (loc, me) -> mkstr loc (Pstr_include (module_expr me)) :: l - | StMod (loc, n, me) -> mkstr loc (Pstr_module (shd n, module_expr me)) :: l - | StMty (loc, n, mt) -> - mkstr loc (Pstr_modtype (shd n, module_type mt)) :: l + | StMod (loc, n, me) -> mkstr loc (Pstr_module (n, module_expr me)) :: l + | StMty (loc, n, mt) -> mkstr loc (Pstr_modtype (n, module_type mt)) :: l | StOpn (loc, id) -> mkstr loc (Pstr_open (long_id_of_string_list loc id)) :: l | StTyp (loc, tdl) -> mkstr loc (Pstr_type (List.map mktype_decl tdl)) :: l