From 51409af2fdae622a85f8f03683362cdffa9c6960 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 25 Jun 2015 10:23:50 +0200 Subject: [PATCH] move expression-AST converter to type.ml --- interp.ml | 136 +----------------------------------------------------- type.ml | 131 +++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 132 insertions(+), 135 deletions(-) diff --git a/interp.ml b/interp.ml index 33ec0d65ac7..26515acb2de 100644 --- a/interp.ml +++ b/interp.ml @@ -209,8 +209,6 @@ let enc_hash_ref = ref (fun h -> assert false) let enc_array_ref = ref (fun l -> assert false) let dec_array_ref = ref (fun v -> assert false) let enc_string_ref = ref (fun s -> assert false) -let make_ast_ref = ref (fun _ -> assert false) -let make_complex_type_ref = ref (fun _ -> assert false) let encode_tvar_ref = ref (fun _ -> assert false) let decode_path_ref = ref (fun _ -> assert false) let decode_import_ref = ref (fun _ -> assert false) @@ -228,9 +226,7 @@ let encode_texpr (e:Type.texpr) : value = (!encode_texpr_ref) e let decode_texpr (v:value) : Type.texpr = (!decode_texpr_ref) v let encode_clref (c:tclass) : value = (!encode_clref_ref) c let enc_hash (h:('a,'b) Hashtbl.t) : value = (!enc_hash_ref) h -let make_ast (e:texpr) : Ast.expr = (!make_ast_ref) e let enc_string (s:string) : value = (!enc_string_ref) s -let make_complex_type (t:Type.t) : Ast.complex_type = (!make_complex_type_ref) t let encode_tvar (v:tvar) : value = (!encode_tvar_ref) v let decode_path (v:value) : Ast.type_path = (!decode_path_ref) v let encode_import (i:Ast.import) : value = (!encode_import_ref) i @@ -2398,7 +2394,7 @@ let macro_lib = VString (Digest.to_hex (Digest.string (Marshal.to_string v [Marshal.Closures]))) ); "to_complex", Fun1 (fun v -> - try encode_complex_type (make_complex_type (decode_type v)) + try encode_complex_type (TExprToExpr.convert_type (decode_type v)) with Exit -> VNull ); "unify", Fun2 (fun t1 t2 -> @@ -2634,7 +2630,7 @@ let macro_lib = ); "get_typed_expr", Fun1 (fun e -> let e = decode_texpr e in - encode_expr (make_ast e) + encode_expr (TExprToExpr.convert_expr e) ); "store_typed_expr", Fun1 (fun e -> let e = try decode_texpr e with Invalid_expr -> error() in @@ -4971,137 +4967,9 @@ let rec make_const e = (* ---------------------------------------------------------------------- *) (* TEXPR-TO-AST-EXPR *) -open Ast - -let tpath p mp pl = - if snd mp = snd p then - CTPath { - tpackage = fst p; - tname = snd p; - tparams = List.map (fun t -> TPType t) pl; - tsub = None; - } - else CTPath { - tpackage = fst mp; - tname = snd mp; - tparams = List.map (fun t -> TPType t) pl; - tsub = Some (snd p); - } -let rec make_type = function - | TMono r -> - (match !r with - | None -> raise Exit - | Some t -> make_type t) - | TEnum (e,pl) -> - tpath e.e_path e.e_module.m_path (List.map make_type pl) - | TInst({cl_kind = KTypeParameter _} as c,pl) -> - tpath ([],snd c.cl_path) ([],snd c.cl_path) (List.map make_type pl) - | TInst (c,pl) -> - tpath c.cl_path c.cl_module.m_path (List.map make_type pl) - | TType (t,pl) as tf -> - (* recurse on type-type *) - if (snd t.t_path).[0] = '#' then make_type (follow tf) else tpath t.t_path t.t_module.m_path (List.map make_type pl) - | TAbstract (a,pl) -> - tpath a.a_path a.a_module.m_path (List.map make_type pl) - | TFun (args,ret) -> - CTFunction (List.map (fun (_,_,t) -> make_type t) args, make_type ret) - | TAnon a -> - begin match !(a.a_status) with - | Statics c -> tpath ([],"Class") ([],"Class") [tpath c.cl_path c.cl_path []] - | EnumStatics e -> tpath ([],"Enum") ([],"Enum") [tpath e.e_path e.e_path []] - | _ -> - CTAnonymous (PMap.foldi (fun _ f acc -> - { - cff_name = f.cf_name; - cff_kind = FVar (mk_ot f.cf_type,None); - cff_pos = f.cf_pos; - cff_doc = f.cf_doc; - cff_meta = f.cf_meta; - cff_access = []; - } :: acc - ) a.a_fields []) - end - | (TDynamic t2) as t -> - tpath ([],"Dynamic") ([],"Dynamic") (if t == t_dynamic then [] else [make_type t2]) - | TLazy f -> - make_type ((!f)()) - -and mk_ot t = - match follow t with - | TMono _ -> None - | _ -> (try Some (make_type t) with Exit -> None) - -let rec make_ast e = - let full_type_path t = - let mp,p = match t with - | TClassDecl c -> c.cl_module.m_path,c.cl_path - | TEnumDecl en -> en.e_module.m_path,en.e_path - | TAbstractDecl a -> a.a_module.m_path,a.a_path - | TTypeDecl t -> t.t_module.m_path,t.t_path - in - if snd mp = snd p then p else (fst mp) @ [snd mp],snd p - in - let mk_path = expr_of_type_path in - let mk_ident = function - | "`trace" -> Ident "trace" - | n -> Ident n - in - let eopt = function None -> None | Some e -> Some (make_ast e) in - ((match e.eexpr with - | TConst c -> - EConst (tconst_to_const c) - | TLocal v -> EConst (mk_ident v.v_name) - | TArray (e1,e2) -> EArray (make_ast e1,make_ast e2) - | TBinop (op,e1,e2) -> EBinop (op, make_ast e1, make_ast e2) - | TField (e,f) -> EField (make_ast e, Type.field_name f) - | TTypeExpr t -> fst (mk_path (full_type_path t) e.epos) - | TParenthesis e -> EParenthesis (make_ast e) - | TObjectDecl fl -> EObjectDecl (List.map (fun (f,e) -> f, make_ast e) fl) - | TArrayDecl el -> EArrayDecl (List.map make_ast el) - | TCall (e,el) -> ECall (make_ast e,List.map make_ast el) - | TNew (c,pl,el) -> ENew ((match (try make_type (TInst (c,pl)) with Exit -> make_type (TInst (c,[]))) with CTPath p -> p | _ -> assert false),List.map make_ast el) - | TUnop (op,p,e) -> EUnop (op,p,make_ast e) - | TFunction f -> - let arg (v,c) = v.v_name, false, mk_ot v.v_type, (match c with None -> None | Some c -> Some (EConst (tconst_to_const c),e.epos)) in - EFunction (None,{ f_params = []; f_args = List.map arg f.tf_args; f_type = mk_ot f.tf_type; f_expr = Some (make_ast f.tf_expr) }) - | TVar (v,eo) -> - EVars ([v.v_name, mk_ot v.v_type, eopt eo]) - | TBlock el -> EBlock (List.map make_ast el) - | TFor (v,it,e) -> - let ein = (EIn ((EConst (Ident v.v_name),it.epos),make_ast it),it.epos) in - EFor (ein,make_ast e) - | TIf (e,e1,e2) -> EIf (make_ast e,make_ast e1,eopt e2) - | TWhile (e1,e2,flag) -> EWhile (make_ast e1, make_ast e2, flag) - | TSwitch (e,cases,def) -> - let cases = List.map (fun (vl,e) -> - List.map make_ast vl,None,(match e.eexpr with TBlock [] -> None | _ -> Some (make_ast e)) - ) cases in - let def = match eopt def with None -> None | Some (EBlock [],_) -> Some None | e -> Some e in - ESwitch (make_ast e,cases,def) - | TEnumParameter _ -> - (* these are considered complex, so the AST is handled in TMeta(Meta.Ast) *) - assert false - | TTry (e,catches) -> ETry (make_ast e,List.map (fun (v,e) -> v.v_name, (try make_type v.v_type with Exit -> assert false), make_ast e) catches) - | TReturn e -> EReturn (eopt e) - | TBreak -> EBreak - | TContinue -> EContinue - | TThrow e -> EThrow (make_ast e) - | TCast (e,t) -> - let t = (match t with - | None -> None - | Some t -> - let t = (match t with TClassDecl c -> TInst (c,[]) | TEnumDecl e -> TEnum (e,[]) | TTypeDecl t -> TType (t,[]) | TAbstractDecl a -> TAbstract (a,[])) in - Some (try make_type t with Exit -> assert false) - ) in - ECast (make_ast e,t) - | TMeta ((Meta.Ast,[e1,_],_),_) -> e1 - | TMeta (m,e) -> EMeta(m,make_ast e)) - ,e.epos) ;; -make_ast_ref := make_ast; -make_complex_type_ref := make_type; encode_complex_type_ref := encode_ctype; enc_array_ref := enc_array; dec_array_ref := dec_array; diff --git a/type.ml b/type.ml index c67aba1ddb2..b774adf5d4a 100644 --- a/type.ml +++ b/type.ml @@ -2129,5 +2129,134 @@ let map_expr_type f ft fv e = | TMeta (m,e1) -> {e with eexpr = TMeta(m, f e1); etype = ft e.etype } +module TExprToExpr = struct + let tpath p mp pl = + if snd mp = snd p then + CTPath { + tpackage = fst p; + tname = snd p; + tparams = List.map (fun t -> TPType t) pl; + tsub = None; + } + else CTPath { + tpackage = fst mp; + tname = snd mp; + tparams = List.map (fun t -> TPType t) pl; + tsub = Some (snd p); + } + + let rec convert_type = function + | TMono r -> + (match !r with + | None -> raise Exit + | Some t -> convert_type t) + | TEnum (e,pl) -> + tpath e.e_path e.e_module.m_path (List.map convert_type pl) + | TInst({cl_kind = KTypeParameter _} as c,pl) -> + tpath ([],snd c.cl_path) ([],snd c.cl_path) (List.map convert_type pl) + | TInst (c,pl) -> + tpath c.cl_path c.cl_module.m_path (List.map convert_type pl) + | TType (t,pl) as tf -> + (* recurse on type-type *) + if (snd t.t_path).[0] = '#' then convert_type (follow tf) else tpath t.t_path t.t_module.m_path (List.map convert_type pl) + | TAbstract (a,pl) -> + tpath a.a_path a.a_module.m_path (List.map convert_type pl) + | TFun (args,ret) -> + CTFunction (List.map (fun (_,_,t) -> convert_type t) args, convert_type ret) + | TAnon a -> + begin match !(a.a_status) with + | Statics c -> tpath ([],"Class") ([],"Class") [tpath c.cl_path c.cl_path []] + | EnumStatics e -> tpath ([],"Enum") ([],"Enum") [tpath e.e_path e.e_path []] + | _ -> + CTAnonymous (PMap.foldi (fun _ f acc -> + { + cff_name = f.cf_name; + cff_kind = FVar (mk_ot f.cf_type,None); + cff_pos = f.cf_pos; + cff_doc = f.cf_doc; + cff_meta = f.cf_meta; + cff_access = []; + } :: acc + ) a.a_fields []) + end + | (TDynamic t2) as t -> + tpath ([],"Dynamic") ([],"Dynamic") (if t == t_dynamic then [] else [convert_type t2]) + | TLazy f -> + convert_type ((!f)()) + + and mk_ot t = + match follow t with + | TMono _ -> None + | _ -> (try Some (convert_type t) with Exit -> None) + + let rec convert_expr e = + let full_type_path t = + let mp,p = match t with + | TClassDecl c -> c.cl_module.m_path,c.cl_path + | TEnumDecl en -> en.e_module.m_path,en.e_path + | TAbstractDecl a -> a.a_module.m_path,a.a_path + | TTypeDecl t -> t.t_module.m_path,t.t_path + in + if snd mp = snd p then p else (fst mp) @ [snd mp],snd p + in + let mk_path = expr_of_type_path in + let mk_ident = function + | "`trace" -> Ident "trace" + | n -> Ident n + in + let eopt = function None -> None | Some e -> Some (convert_expr e) in + ((match e.eexpr with + | TConst c -> + EConst (tconst_to_const c) + | TLocal v -> EConst (mk_ident v.v_name) + | TArray (e1,e2) -> EArray (convert_expr e1,convert_expr e2) + | TBinop (op,e1,e2) -> EBinop (op, convert_expr e1, convert_expr e2) + | TField (e,f) -> EField (convert_expr e, field_name f) + | TTypeExpr t -> fst (mk_path (full_type_path t) e.epos) + | TParenthesis e -> EParenthesis (convert_expr e) + | TObjectDecl fl -> EObjectDecl (List.map (fun (f,e) -> f, convert_expr e) fl) + | TArrayDecl el -> EArrayDecl (List.map convert_expr el) + | TCall (e,el) -> ECall (convert_expr e,List.map convert_expr el) + | TNew (c,pl,el) -> ENew ((match (try convert_type (TInst (c,pl)) with Exit -> convert_type (TInst (c,[]))) with CTPath p -> p | _ -> assert false),List.map convert_expr el) + | TUnop (op,p,e) -> EUnop (op,p,convert_expr e) + | TFunction f -> + let arg (v,c) = v.v_name, false, mk_ot v.v_type, (match c with None -> None | Some c -> Some (EConst (tconst_to_const c),e.epos)) in + EFunction (None,{ f_params = []; f_args = List.map arg f.tf_args; f_type = mk_ot f.tf_type; f_expr = Some (convert_expr f.tf_expr) }) + | TVar (v,eo) -> + EVars ([v.v_name, mk_ot v.v_type, eopt eo]) + | TBlock el -> EBlock (List.map convert_expr el) + | TFor (v,it,e) -> + let ein = (EIn ((EConst (Ident v.v_name),it.epos),convert_expr it),it.epos) in + EFor (ein,convert_expr e) + | TIf (e,e1,e2) -> EIf (convert_expr e,convert_expr e1,eopt e2) + | TWhile (e1,e2,flag) -> EWhile (convert_expr e1, convert_expr e2, flag) + | TSwitch (e,cases,def) -> + let cases = List.map (fun (vl,e) -> + List.map convert_expr vl,None,(match e.eexpr with TBlock [] -> None | _ -> Some (convert_expr e)) + ) cases in + let def = match eopt def with None -> None | Some (EBlock [],_) -> Some None | e -> Some e in + ESwitch (convert_expr e,cases,def) + | TEnumParameter _ -> + (* these are considered complex, so the AST is handled in TMeta(Meta.Ast) *) + assert false + | TTry (e,catches) -> ETry (convert_expr e,List.map (fun (v,e) -> v.v_name, (try convert_type v.v_type with Exit -> assert false), convert_expr e) catches) + | TReturn e -> EReturn (eopt e) + | TBreak -> EBreak + | TContinue -> EContinue + | TThrow e -> EThrow (convert_expr e) + | TCast (e,t) -> + let t = (match t with + | None -> None + | Some t -> + let t = (match t with TClassDecl c -> TInst (c,[]) | TEnumDecl e -> TEnum (e,[]) | TTypeDecl t -> TType (t,[]) | TAbstractDecl a -> TAbstract (a,[])) in + Some (try convert_type t with Exit -> assert false) + ) in + ECast (convert_expr e,t) + | TMeta ((Meta.Ast,[e1,_],_),_) -> e1 + | TMeta (m,e) -> EMeta(m,convert_expr e)) + ,e.epos) + +end + let print_if b e = - if b then print_endline (s_expr_pretty "" (s_type (print_context())) e) \ No newline at end of file + if b then print_endline (s_expr_pretty "" (s_type (print_context())) e)