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

Diff of /typing/typer.ml

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

revision 228 by abate, Tue Jul 10 17:16:34 2007 UTC revision 229 by abate, Tue Jul 10 17:17:01 2007 UTC
# Line 42  Line 42 
42    | ITimes of ti * ti    | ITimes of ti * ti
43    | IXml of ti * ti    | IXml of ti * ti
44    | IArrow of ti * ti    | IArrow of ti * ti
45    | IRecord of bool * (Types.label * bool * ti) list    | IOptional of ti
46      | IRecord of bool * (Types.label * ti) list
47    | ICapture of id    | ICapture of id
48    | IConstant of id * Types.const    | IConstant of id * Types.const
49    
# Line 264  Line 265 
265    | Prod (t1,t2) -> cons loc (ITimes (compile env t1, compile env t2))    | Prod (t1,t2) -> cons loc (ITimes (compile env t1, compile env t2))
266    | XmlT (t1,t2) -> cons loc (IXml (compile env t1, compile env t2))    | XmlT (t1,t2) -> cons loc (IXml (compile env t1, compile env t2))
267    | Arrow (t1,t2) -> cons loc (IArrow (compile env t1, compile env t2))    | Arrow (t1,t2) -> cons loc (IArrow (compile env t1, compile env t2))
268      | Optional t -> cons loc (IOptional (compile env t))
269    | Record (o,r) ->    | Record (o,r) ->
270        cons loc (IRecord (o, List.map (fun (l,o,t) -> l,o,compile env t) r))        cons loc (IRecord (o, List.map (fun (l,t) -> l,compile env t) r))
271    | Constant (x,v) -> cons loc (IConstant (x,v))    | Constant (x,v) -> cons loc (IConstant (x,v))
272    | Capture x -> cons loc (ICapture x)    | Capture x -> cons loc (ICapture x)
273    
# Line 298  Line 300 
300             | IDiff (s1,s2)             | IDiff (s1,s2)
301             | ITimes (s1,s2) | IXml (s1,s2)             | ITimes (s1,s2) | IXml (s1,s2)
302             | IArrow (s1,s2) -> comp_fv s1; comp_fv s2             | IArrow (s1,s2) -> comp_fv s1; comp_fv s2
303             | IRecord (_,r) -> List.iter (fun (l,opt,s) -> comp_fv s) r             | IOptional r -> comp_fv r
304               | IRecord (_,r) -> List.iter (fun (l,s) -> comp_fv s) r
305             | IType _ -> ()             | IType _ -> ()
306             | ICapture x             | ICapture x
307             | IConstant (x,_) -> comp_fv_res := IdSet.add x !comp_fv_res             | IConstant (x,_) -> comp_fv_res := IdSet.add x !comp_fv_res
# Line 331  Line 334 
334      | ITimes (s1,s2) -> Types.times (typ_node s1) (typ_node s2)      | ITimes (s1,s2) -> Types.times (typ_node s1) (typ_node s2)
335      | IXml (s1,s2) ->   Types.xml (typ_node s1) (typ_node s2)      | IXml (s1,s2) ->   Types.xml (typ_node s1) (typ_node s2)
336      | IArrow (s1,s2) -> Types.arrow (typ_node s1) (typ_node s2)      | IArrow (s1,s2) -> Types.arrow (typ_node s1) (typ_node s2)
337        | IOptional s -> Types.Record.or_absent (typ seen s)
338      | IRecord (o,r) ->      | IRecord (o,r) ->
339          Types.record'          Types.record'
340            (o,List.map (fun (l,o,s) -> (l,(o,typ_node s))) r)            (o,List.map (fun (l,s) -> (l,typ_node s)) r)
341      | ICapture x | IConstant (x,_) -> assert false      | ICapture x | IConstant (x,_) -> assert false
342    
343  and typ_node s : Types.node =  and typ_node s : Types.node =
# Line 377  Line 381 
381        raise (Patterns.Error "Difference not allowed in patterns")        raise (Patterns.Error "Difference not allowed in patterns")
382    | ITimes (s1,s2) -> Patterns.times (pat_node s1) (pat_node s2)    | ITimes (s1,s2) -> Patterns.times (pat_node s1) (pat_node s2)
383    | IXml (s1,s2) -> Patterns.xml (pat_node s1) (pat_node s2)    | IXml (s1,s2) -> Patterns.xml (pat_node s1) (pat_node s2)
384    | IRecord (o,r) ->    | IOptional _ ->
       let pats = ref [] in  
       let aux (l,o,s) =  
         if IdSet.is_empty (fv s) then (l,(o,type_node s))  
         else  
           if o then  
385              raise              raise
386                (Patterns.Error                (Patterns.Error
387                   "Optional field not allowed in record patterns")                   "Optional field not allowed in record patterns")
388            else (    | IRecord (o,r) ->
389          let pats = ref [] in
390          let aux (l,s) =
391            if IdSet.is_empty (fv s) then (l,type_node s)
392            else
393              (
394              pats := Patterns.record l (pat_node s) :: !pats;              pats := Patterns.record l (pat_node s) :: !pats;
395              (l,(false,Types.any_node))              (l,Types.any_node)
396            ) in            ) in
397        let constr = Types.record' (o,List.map aux r) in        let constr = Types.record' (o,List.map aux r) in
398        List.fold_left Patterns.cap (Patterns.constr constr) !pats        List.fold_left Patterns.cap (Patterns.constr constr) !pats
# Line 792  Line 796 
796    | RecordLitt r ->    | RecordLitt r ->
797        let r =        let r =
798          List.map          List.map
799            (fun (l,e) -> (l,(false,Types.cons (compute_type env e))))            (fun (l,e) -> (l,Types.cons (compute_type env e)))
800            r in            r in
801        Types.record' (false,r)        Types.record' (false,r)
802    | _ -> assert false    | _ -> assert false
Legend:
Removed from v.228  
changed lines
  Added in v.229
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5