diff --git a/ivette/api/server_tsc.ml b/ivette/api/server_tsc.ml index 248761af45efaf202e4f30ac9e4edc35d84b6015..67920d57a0efe34b280bade299d33f559dd29af4 100644 --- a/ivette/api/server_tsc.ml +++ b/ivette/api/server_tsc.ml @@ -188,6 +188,10 @@ let rec makeDecoder ~safe ?self ~names fmt js = | Jrecord jfs -> jsafe ~safe "Record" (jrecord ~makeSafe) fmt jfs | Jtuple jts -> jtry ~safe (jtuple ~makeSafe) fmt jts +let makeLooseNeedSafe = function + | Pkg.Jtuple _ | Pkg.Jarray _ -> true + | _ -> false + let makeRootDecoder ~safe ~self ~names fmt js = let open Pkg in match js with @@ -414,12 +418,13 @@ let makeDeclaration fmt names d = type ranking = { mutable rank : int ; mutable mark : int Pkg.IdMap.t ; + index : Pkg.declInfo Pkg.IdMap.t ; } let depends d = match d.Pkg.d_kind with - | D_loose(id,(Jtuple _ | Jarray _)) -> [Pkg.Derived.safe id] - | D_safe(id,_) -> [Pkg.Derived.loose id] + | D_loose(id,t) when makeLooseNeedSafe t -> [Pkg.Derived.safe id] + | D_safe(id,t) when not (makeLooseNeedSafe t) -> [Pkg.Derived.loose id] | D_array _ -> let id = d.d_ident in let data = Pkg.Derived.data id in @@ -439,13 +444,20 @@ let next m id = m.mark <- Pkg.IdMap.add id r m.mark ; m.rank <- succ r -let mark m d = +let rec mark m d = let id = d.Pkg.d_ident in if not (Pkg.IdMap.mem id m.mark) then - ( List.iter (next m) (depends d) ; next m id ) + ( List.iter (mark_id m) (depends d) ; next m id ) + +and mark_id m id = + try mark m (Pkg.IdMap.find id m.index) + with Not_found -> () let ranking ds = - let m = { rank = 0 ; mark = Pkg.IdMap.empty } in + let index = List.fold_left + (fun m d -> Pkg.IdMap.add d.Pkg.d_ident d m) + Pkg.IdMap.empty ds in + let m = { rank = 0 ; mark = Pkg.IdMap.empty ; index } in List.iter (mark m) ds ; let rk = m.mark in let getRank a = try Pkg.IdMap.find a.Pkg.d_ident rk with Not_found -> 0 in