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

Diff of /typing/typer.ml

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

revision 722 by abate, Tue Jul 10 17:58:48 2007 UTC revision 723 by abate, Tue Jul 10 17:58:57 2007 UTC
# Line 59  Line 59 
59    
60  let from_comp_unit = ref (fun cu -> assert false)  let from_comp_unit = ref (fun cu -> assert false)
61    
62    let enter_cu x cu env =
63      { env with cu = Env.add (ident x) cu env.cu }
64    
65    let find_cu loc x env =
66      try Env.find x env.cu
67      with Not_found ->
68        raise_loc_generic loc
69          ("Unbound compunit prefix " ^ (Ident.to_string x))
70    
71    
72  let enter_type id t env =  let enter_type id t env =
73    { env with ids = Env.add id (Type t) env.ids }    { env with ids = Env.add id (Type t) env.ids }
74  let enter_types l env =  let enter_types l env =
# Line 69  Line 79 
79      | Type t -> t      | Type t -> t
80      | Val _ -> raise Not_found      | Val _ -> raise Not_found
81    
82  let find_type_global cu id env =  let find_type_global loc cu id env =
83    let cu = Env.find cu env.cu in    let cu = find_cu loc cu env in
84    let env = !from_comp_unit cu in    let env = !from_comp_unit cu in
85    find_type id env    find_type id env
86    
# Line 99  Line 109 
109                  | _ -> ()) env.ids                  | _ -> ()) env.ids
110    
111    
 let enter_cu x cu env =  
   { env with cu = Env.add (ident x) cu env.cu }  
   
 let find_cu x env =  
   try Env.find x env.cu  
   with Not_found -> failwith ("Unbound compunit prefix " ^ (Ident.to_string x))  
112    
113  (* Namespaces *)  (* Namespaces *)
114    
# Line 445  Line 449 
449           | cu, v ->           | cu, v ->
450               try               try
451                 let cu = ident (U.mk cu) in                 let cu = ident (U.mk cu) in
452                 PType (find_type_global cu (ident v) env.penv_tenv)                 PType (find_type_global p.loc cu (ident v) env.penv_tenv)
453               with Not_found ->               with Not_found ->
454                 failwith ("Unbound external type " ^ cu ^ ":" ^ (U.to_string v)))                 raise_loc_generic p.loc
455                   ("Unbound external type " ^ cu ^ ":" ^ (U.to_string v)))
456    | SchemaVar (kind, schema, item) ->    | SchemaVar (kind, schema, item) ->
457        PType (derecurs_schema env kind schema item)        PType (derecurs_schema env kind schema item)
458    | Recurs (p,b) -> derecurs (derecurs_def env b) p    | Recurs (p,b) -> derecurs (derecurs_def env b) p
# Line 796  Line 801 
801          | "", id -> let id = ident id in          | "", id -> let id = ident id in
802            exp loc (Fv.singleton id) (Typed.Var id)            exp loc (Fv.singleton id) (Typed.Var id)
803          | cu, id ->          | cu, id ->
804              let cu = find_cu (ident (U.mk cu)) env in              let cu = find_cu loc (ident (U.mk cu)) env in
805              exp loc Fv.empty (Typed.ExtVar (cu, ident id)))              exp loc Fv.empty (Typed.ExtVar (cu, ident id)))
806    | Apply (e1,e2) ->    | Apply (e1,e2) ->
807        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
Legend:
Removed from v.722  
changed lines
  Added in v.723
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5