parserUtils.ml

(** Time-stamp: <modified the 17/12/2007 (at 17:49) by Erwan Jahier> *)


(* Une collection de "meta fonctions" pour faciliter la vie *)


(*------------------------------------------------------
flat_flagged_list
--------------------------------------------------------
Entre :
--------
- inlist : ('a list * 'b) list
- makeitem : 'a -> 'b -> c' 
--------------------------------------------------------
Sortie :
--------
- outlist : c' list
--------------------------------------------------------
Effets de bords :
---------------
- aucun en interne
- makeitem est appele de gauche  droite
--------------------------------------------------------
Exemple :
-----------------
flat_flagged_list [ ([a1;a2;a3], b1) ; ([a4;a5], b2) ] f
<=>
let c1 = (f a1 b1) in
let c2 = (f a2 b1) in
let c3 = (f a3 b1) in
let c4 = (f a4 b2) in
let c5 = (f a5 b2) in
[ c1; c2; c3; c4; c5 ]
------------------------------------------------------*)
let flat_flagged_list 
    (inlist:   ('a list * 'b) list)
    (makeitem: 'a -> 'b -> 'c) 
    = (
      (*g: concatene les 'c list*)
      let g (cl: 'c  list) ((al: 'a list) , (b: 'b)) = (
	(*f: fabrique un 'c *)
	let f (a: 'a) = makeitem a b in 
	  List.append cl (List.map f al) 
      ) in 
	(*on folde g sur inlist*)
	List.fold_left g [] inlist
    )

let _ = assert (
  (flat_flagged_list 
     [ (["a1";"a2";"a3"], "b1") ; (["a4";"a5"], "b2") ] 
     (fun a b -> a ^ "-" ^ b))
  = 
    ["a1-b1"; "a2-b1"; "a3-b1"; "a4-b2"; "a5-b2"]
  )

(*------------------------------------------------------
flat_twiced_flagged_list
--------------------------------------------------------
mme principe mais avec deux niveaux de flags :

let mk a b c = (a,b,c)

let toto =
[
([ ([1;2;3], "a"); ([4;5], "b") ], "X") ;
([ ([6], "c"); ([7;8], "d"); ([9], "e")  ], "Y") ;
( [ ([10], "f") ]   , "Z")
]

  let l = flat_twice_flagged_list toto mk
  ------------------------------------------------------*)
let flat_twice_flagged_list 
    (inlist:   (('a list * 'b) list * 'c) list )
    (makeitem: 'a -> 'b -> 'c -> 'd ) 
    = (
      let g (dl: 'd list) ((albl: ('a list * 'b) list), (c: 'c)) = (
	let h (dl: 'd list) ((al: 'a list), (b: 'b)) = (
	  let f (a: 'a) = makeitem a b c in
	    List.append dl (List.map f al)
	) in
	  List.fold_left h dl albl
      ) in
	List.fold_left g [] inlist
    )