Commit 2f8aca20 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2002-11-13 09:47:59 by cvscast] Empty log message

Original author: cvscast
Date: 2002-11-13 09:47:59+00:00
parent e200a720
......@@ -344,15 +344,19 @@ let register_global_types glb b =
module Fv = StringSet
let rec expr glb { loc = loc; descr = d } =
(* IDEA: introduce a node Loc in the AST to override nolocs
in sub-expressions *)
let rec expr loc' glb { loc = loc; descr = d } =
let loc = if loc = noloc then loc' else loc in
let (fv,td) =
match d with
| Forget (e,t) ->
let (fv,e) = expr glb e and t = typ glb t in
let (fv,e) = expr loc glb e and t = typ glb t in
(fv, Typed.Forget (e,t))
| Var s -> (Fv.singleton s, Typed.Var s)
| Apply (e1,e2) ->
let (fv1,e1) = expr glb e1 and (fv2,e2) = expr glb e2 in
let (fv1,e1) = expr loc glb e1 and (fv2,e2) = expr loc glb e2 in
(Fv.union fv1 fv2, Typed.Apply (e1,e2))
| Abstraction a ->
let iface = List.map (fun (t1,t2) -> (typ glb t1, typ glb t2))
......@@ -363,7 +367,7 @@ let rec expr glb { loc = loc; descr = d } =
let iface = List.map
(fun (t1,t2) -> (Types.descr t1, Types.descr t2))
iface in
let (fv0,body) = branches glb a.fun_body in
let (fv0,body) = branches loc glb a.fun_body in
let fv = match a.fun_name with
| None -> fv0
| Some f -> Fv.remove f fv0 in
......@@ -378,20 +382,21 @@ let rec expr glb { loc = loc; descr = d } =
)
| Cst c -> (Fv.empty, Typed.Cst c)
| Pair (e1,e2) ->
let (fv1,e1) = expr glb e1 and (fv2,e2) = expr glb e2 in
let (fv1,e1) = expr loc glb e1 and (fv2,e2) = expr loc glb e2 in
(Fv.union fv1 fv2, Typed.Pair (e1,e2))
| Xml (e1,e2) ->
let (fv1,e1) = expr glb e1 and (fv2,e2) = expr glb e2 in
let (fv1,e1) = expr loc glb e1 and (fv2,e2) = expr loc glb e2 in
(Fv.union fv1 fv2, Typed.Xml (e1,e2))
| Dot (e,l) ->
let (fv,e) = expr glb e in
let (fv,e) = expr loc glb e in
(fv, Typed.Dot (e,l))
| RecordLitt r ->
let fv = ref Fv.empty in
let r = List.sort (fun (l1,_) (l2,_) -> compare l1 l2) r in
let r = List.map
(fun (l,e) ->
let (fv2,e) = expr glb e in fv := Fv.union !fv fv2; (l,e))
let (fv2,e) = expr loc glb e
in fv := Fv.union !fv fv2; (l,e))
r in
let rec check = function
| (l1,_) :: (l2,_) :: _ when l1 = l2 ->
......@@ -401,20 +406,20 @@ let rec expr glb { loc = loc; descr = d } =
check r;
(!fv, Typed.RecordLitt r)
| Op (op,le) ->
let (fvs,ltes) = List.split (List.map (expr glb) le) in
let (fvs,ltes) = List.split (List.map (expr loc glb) le) in
let fv = List.fold_left Fv.union Fv.empty fvs in
(fv, Typed.Op (op,ltes))
| Match (e,b) ->
let (fv1,e) = expr glb e
and (fv2,b) = branches glb b in
let (fv1,e) = expr loc glb e
and (fv2,b) = branches loc glb b in
(Fv.union fv1 fv2, Typed.Match (e, b))
| Map (e,b) ->
let (fv1,e) = expr glb e
and (fv2,b) = branches glb b in
let (fv1,e) = expr loc glb e
and (fv2,b) = branches loc glb b in
(Fv.union fv1 fv2, Typed.Map (e, b))
| Try (e,b) ->
let (fv1,e) = expr glb e
and (fv2,b) = branches glb b in
let (fv1,e) = expr loc glb e
and (fv2,b) = branches loc glb b in
(Fv.union fv1 fv2, Typed.Try (e, b))
in
fv,
......@@ -423,12 +428,12 @@ let rec expr glb { loc = loc; descr = d } =
Typed.exp_descr = td;
}
and branches glb b =
and branches loc glb b =
let fv = ref Fv.empty in
let accept = ref Types.empty in
let b = List.map
(fun (p,e) ->
let (fv2,e) = expr glb e in
let (fv2,e) = expr loc glb e in
let p = pat glb p in
let fv2 = List.fold_right Fv.remove (Patterns.fv p) fv2 in
fv := Fv.union !fv fv2;
......@@ -446,6 +451,8 @@ let rec expr glb { loc = loc; descr = d } =
}
)
let expr = expr noloc
let let_decl glb p e =
let (_,e) = expr glb e in
{ Typed.let_pat = pat glb p;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment