/[svn]/typing/typer.ml
ViewVC logotype

Diff of /typing/typer.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 969 by abate, Tue Jul 10 18:14:40 2007 UTC revision 1096 by abate, Tue Jul 10 18:22:13 2007 UTC
# Line 20  Line 20 
20    | Type of Types.t    | Type of Types.t
21    | Val of Types.t    | Val of Types.t
22    
23    module UEnv = Map.Make(U)
24    
25  type t = {  type t = {
26    ids : item Env.t;    ids : item Env.t;
27    ns: Ns.table;    ns: Ns.table;
28    cu: Types.CompUnit.t Env.t;    cu: Types.CompUnit.t UEnv.t;
29  }  }
30    
31  let hash _ = failwith "Typer.hash"  let hash _ = failwith "Typer.hash"
# Line 50  Line 52 
52    let ids =    let ids =
53      Serialize.Get.env Id.deserialize deserialize_item Env.add Env.empty s in      Serialize.Get.env Id.deserialize deserialize_item Env.add Env.empty s in
54    let ns = Ns.deserialize_table s in    let ns = Ns.deserialize_table s in
55    { ids = ids; ns = ns; cu = Env.empty }    { ids = ids; ns = ns; cu = UEnv.empty }
56    
57    
58  let empty_env = {  let empty_env = {
59    ids = Env.empty;    ids = Env.empty;
60    ns = Ns.empty_table;    ns = Ns.empty_table;
61    cu = Env.empty;    cu = UEnv.empty;
62  }  }
63    
64  let from_comp_unit = ref (fun cu -> assert false)  let from_comp_unit = ref (fun cu -> assert false)
65    
66  let enter_cu x cu env =  let enter_cu x cu env =
67    { env with cu = Env.add (ident x) cu env.cu }    { env with cu = UEnv.add x cu env.cu }
68    
69  let find_cu loc x env =  let find_cu x env =
70    try Env.find x env.cu    try UEnv.find x env.cu
71    with Not_found ->    with Not_found -> Types.CompUnit.mk x
     raise_loc_generic loc  
       ("Unbound compunit prefix " ^ (Ident.to_string x))  
72    
73    
74  let enter_type id t env =  let enter_type id t env =
# Line 82  Line 82 
82      | Val _ -> raise Not_found      | Val _ -> raise Not_found
83    
84  let find_type_global loc cu id env =  let find_type_global loc cu id env =
85    let cu = find_cu loc cu env in    let cu = find_cu cu env in
86    let env = !from_comp_unit cu in    let env = !from_comp_unit cu in
87    find_type id env    find_type id env
88    
# Line 173  Line 173 
173  exception ShouldHave2 of Types.descr * string * Types.descr  exception ShouldHave2 of Types.descr * string * Types.descr
174  exception WrongLabel of Types.descr * label  exception WrongLabel of Types.descr * label
175  exception UnboundId of id * bool  exception UnboundId of id * bool
176    exception UnboundExtId of Types.CompUnit.t * id
177  exception Error of string  exception Error of string
178    
179  let raise_loc loc exn = raise (Location (loc,`Full,exn))  let raise_loc loc exn = raise (Location (loc,`Full,exn))
# Line 493  Line 494 
494                  with Not_found -> PCapture v)                  with Not_found -> PCapture v)
495           | cu, v ->           | cu, v ->
496               try               try
497                 let cu = ident (U.mk cu) in                 let cu = U.mk cu in
498                 PType (find_type_global p.loc cu (ident v) env.penv_tenv)                 PType (find_type_global p.loc cu (ident v) env.penv_tenv)
499               with Not_found ->               with Not_found ->
500                 raise_loc_generic p.loc                 raise_loc_generic p.loc
# Line 842  Line 843 
843          | "", id -> let id = ident id in          | "", id -> let id = ident id in
844            exp loc (Fv.singleton id) (Typed.Var id)            exp loc (Fv.singleton id) (Typed.Var id)
845          | cu, id ->          | cu, id ->
846              let cu = find_cu loc (ident (U.mk cu)) env in              let cu = find_cu (U.mk cu) env in
847              exp loc Fv.empty (Typed.ExtVar (cu, ident id)))              exp loc Fv.empty (Typed.ExtVar (cu, ident id)))
848    | Apply (e1,e2) ->    | Apply (e1,e2) ->
849        let (fv1,e1) = expr env loc e1 and (fv2,e2) = expr env loc e2 in        let (fv1,e1) = expr env loc e1 and (fv2,e2) = expr env loc e2 in
# Line 1101  Line 1102 
1102        let t =        let t =
1103          try find_value_global cu s env          try find_value_global cu s env
1104          with Not_found ->          with Not_found ->
1105            raise_loc loc (UnboundId (s, false) ) in            raise_loc loc (UnboundExtId (cu,s) ) in
1106        verify loc t constr        verify loc t constr
1107    | Cst c ->    | Cst c ->
1108        verify loc (Types.constant c) constr        verify loc (Types.constant c) constr
Legend:
Removed from v.969  
changed lines
  Added in v.1096
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5