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

Diff of /typing/typer.ml

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

revision 1754 by abate, Tue Jul 10 19:20:22 2007 UTC revision 1755 by abate, Tue Jul 10 19:20:31 2007 UTC
# Line 77  Line 77 
77  let ident env loc t =  let ident env loc t =
78    protect_error_ns loc (Ns.map_attr env.ns) t    protect_error_ns loc (Ns.map_attr env.ns) t
79    
 let has_value id env =  
   try match Env.find (Ident.ident (Ns.map_attr env.ns id)) env.ids with  
     | Val t -> true  
     | _ -> false  
   with Not_found | Ns.UnknownPrefix _ -> false  
   
80  let parse_atom env loc t = Atoms.V.mk (qname env loc t)  let parse_atom env loc t = Atoms.V.mk (qname env loc t)
81    
82  let parse_ns env loc ns =  let parse_ns env loc ns =
# Line 151  Line 145 
145    
146  let value_name_ok id env =  let value_name_ok id env =
147    try match Env.find id env.ids with    try match Env.find id env.ids with
148      | Val t -> true      | Val _ | EVal _ -> true
149      | _ -> false      | _ -> false
150    with Not_found -> true    with Not_found -> true
151    
# Line 252  Line 246 
246      | Type t -> t      | Type t -> t
247      | _ -> raise Not_found      | _ -> raise Not_found
248    
 let check_local_value env loc id =  
   try match Env.find id env.ids with  
     | Val _ -> ()  
     | _ ->  error loc "This identifier does not refer to a value"  
   with Not_found -> error loc "Unbound identifier"  
   
249  let find_value id env =  let find_value id env =
250    try match Env.find id env.ids with    try match Env.find id env.ids with
251      | Val t -> t      | Val t | EVal (_,_,t) -> t
252      | _ -> raise Not_found      | _ -> raise Not_found
253    with Not_found -> assert false    with Not_found -> assert false
254    
255    let do_open env cu =
256      let env_cu = !from_comp_unit cu in
257      let ids =
258        Env.fold
259          (fun n d ids ->
260             let d = match d with
261               | Val t -> EVal (cu,n,t)
262               | d -> d in
263             Env.add n d ids)
264          env_cu.ids
265          env.ids in
266      { env with
267          ids = ids;
268          ns = Ns.merge_tables env.ns env_cu.ns }
269    
270    
271    let type_open env loc ids =
272      match find_global env loc ids with
273        | ECDuce cu -> do_open env cu
274        | _ -> error loc "This path does not refer to a CDuce unit"
275    
276  module IType = struct  module IType = struct
277    open Typepat    open Typepat
278    
# Line 637  Line 646 
646          in          in
647          exp loc Fv.empty e          exp loc Fv.empty e
648      | None ->      | None ->
649          check_local_value env loc id;          try match Env.find id env.ids with
650          exp loc (Fv.singleton id) (Typed.Var id)            | Val _ -> exp loc (Fv.singleton id) (Typed.Var id)
651              | EVal (cu,id,t) -> exp loc Fv.empty (Typed.ExtVar (cu,id,t))
652              | _ ->  error loc "This identifier does not refer to a value"
653            with Not_found -> error loc "Unbound identifier"
654    
655    
656  and abstraction env loc a =  and abstraction env loc a =
657    let iface =    let iface =
Legend:
Removed from v.1754  
changed lines
  Added in v.1755
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5