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

Diff of /typing/typer.ml

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

revision 19 by abate, Tue Jul 10 16:58:37 2007 UTC revision 26 by abate, Tue Jul 10 16:59:08 2007 UTC
# Line 8  Line 8 
8  exception NonExhaustive of Types.descr  exception NonExhaustive of Types.descr
9  exception Constraint of Types.descr * Types.descr * string  exception Constraint of Types.descr * Types.descr * string
10  exception ShouldHave of Types.descr * string  exception ShouldHave of Types.descr * string
11    exception WrongLabel of Types.descr * Types.label
12    
13  let raise_loc loc exn = raise (Location (loc,exn))  let raise_loc loc exn = raise (Location (loc,exn))
14    
# Line 327  Line 328 
328        | Pair (e1,e2) ->        | Pair (e1,e2) ->
329            let (fv1,e1) = expr e1 and (fv2,e2) = expr e2 in            let (fv1,e1) = expr e1 and (fv2,e2) = expr e2 in
330            (Fv.union fv1 fv2, Typed.Pair (e1,e2))            (Fv.union fv1 fv2, Typed.Pair (e1,e2))
331          | Dot (e,l) ->
332              let (fv,e) = expr e in
333              (Fv.union Fv.empty fv,  Typed.Dot (e,l))
334        | RecordLitt r ->        | RecordLitt r ->
335            (* XXX TODO: check that no label appears twice *)            (* XXX TODO: check that no label appears twice *)
336            let fv = ref Fv.empty in            let fv = ref Fv.empty in
# Line 447  Line 451 
451        else        else
452          (ignore (type_check env e2 dom false); Types.Arrow.apply_noarg t1)          (ignore (type_check env e2 dom false); Types.Arrow.apply_noarg t1)
453    | Cst c -> Types.constant c    | Cst c -> Types.constant c
454      | Dot (e,l) ->
455          let t = type_check env e Types.Record.any true in
456             (try (Types.Record.project t l)
457              with Not_found -> raise_loc loc (WrongLabel(t,l)))
458    | RecordLitt r ->    | RecordLitt r ->
459        List.fold_left        List.fold_left
460          (fun accu (l,e) ->          (fun accu (l,e) ->
Legend:
Removed from v.19  
changed lines
  Added in v.26
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5