(****************************************************************************)
(*                                                                          *)
(*                                   OCaml                                  *)
(*                                                                          *)
(*                            INRIA Rocquencourt                            *)
(*                                                                          *)
(*  Copyright  2007  Institut  National  de  Recherche en Informatique et   *)
(*  en Automatique.  All rights reserved.  This file is distributed under   *)
(*  the terms of the GNU Library General Public License, with the special   *)
(*  exception on linking described in LICENSE at the top of the Camlp4      *)
(*  source tree.                                                            *)
(*                                                                          *)
(****************************************************************************)

open Camlp4.PreCast;;
let foldr_funs = ref [];;
let foldl_funs = ref [];;
AstFilters.register_str_item_filter begin
  Ast.map_expr begin function
  | <:expr@loc< def_foldr $lid:name$ $e$ >> ->
      foldr_funs := (name, e) :: !foldr_funs; <:expr@loc<()>>
  | <:expr@loc< def_foldl $lid:name$ $e$ >> ->
      foldl_funs := (name, e) :: !foldl_funs; <:expr@loc<()>>
  | e -> e
  end
end#str_item;;
AstFilters.register_str_item_filter begin
  Ast.map_expr begin function
  | <:expr@loc< $lid:name$($tup:e$) >> when List.mem_assoc name !foldl_funs ->
      let op = List.assoc name !foldl_funs in
      let rec foldl =
        function
        | [] -> assert false
        | [x] -> x
        | x :: xs -> <:expr@loc< $op$ $foldl xs$ $x$ >>
      in foldl (List.rev (Ast.list_of_expr e []))
  | <:expr@loc< $lid:name$($tup:e$) >> when List.mem_assoc name !foldr_funs ->
      let op = List.assoc name !foldr_funs in
      let rec foldr =
        function
        | [] -> assert false
        | [x] -> x
        | x :: xs -> <:expr@loc< $op$ $x$ $foldr xs$ >>
      in foldr (Ast.list_of_expr e [])
  | e -> e
  end
end#str_item;;
(*

AstFilters.register_str_item_filter begin
  Ast.map_expr begin function
  | <:expr@loc< foldl($lid:op$, $e$) >> ->
      let rec foldl =
        function
        | [] -> assert false
        | [x] -> x
        | x :: xs -> <:expr@loc< $lid:op$ $foldl xs$ $x$ >>
      in foldl (List.rev (Ast.list_of_expr e []))
  | <:expr@loc< foldr($lid:op$, $e$) >> ->
      let rec foldr =
        function
        | [] -> assert false
        | [x] -> x
        | x :: xs -> <:expr@loc< $lid:op$ $x$ $foldr xs$ >>
      in foldr (Ast.list_of_expr e [])
  | e -> e
  end
end#str_item;;

AstFilters.register_str_item_filter begin
  Ast.map_expr begin function
  | <:expr@loc< \!+ ($tup:e$) >> ->
      begin match Ast.list_of_expr e [] with
      | [] | [_] -> assert false
      | x :: xs -> List.fold_left (fun acc x -> <:expr@loc< $acc$ + $x$ >>) x xs
      end
  | <:expr< \!+ $e$ >> -> e
  | e -> e
  end
end#str_item;;
*)