On Nov 10, 2007 2:13 PM, Jon Harrop <jon@ffconsultancy.com> wrote:
> On Saturday 10 November 2007 15:43, Bünzli Daniel wrote:
> > Le 10 nov. 07 à 15:58, Jon Harrop a écrit :
> > > Functional unparsing requires a lot more code,

First let me say that formats are an Opt-in feature: don't like don't
use it. Although on a theoretical point of view I'm not fond of it I
use it on a daily basis. I guess you could say it's a pragmatic
solution. On one hand formats are a hack on the other they are very
useful (and AFAIK there's no way to implement parser combinators in
functional unparsing). That being said functional uparsing printf's
are not as bad as make them sound. It is also a very useful technique
to master: it is the answer to a general class of problems and can be
an elegant to hairy problems. A typical example could be function
transformations composition (take f°g°h when you want f ,g and h to
have eventual additional parameters).

That being there are more succinct solutions to the "printf" problem,
some of them have probably not be found. This is part of a family of
problems you could call the "folding" family. Here are some of the
hacks I know of, I 'd be interested in learning new ones:


let string_of_string s = s
(*
  I) Functional unparsing.

  This technique was first detailed by Olivier Danvy
  (http://www.brics.dk/RS/98/12/).
*)

type ('a,'b) format = (string -> 'a) -> string -> 'b
let (!)f : (_,_) format = fun k acc v -> k (acc ^ (f v))
let (++) (f:(_,_)format) (g:(_,_)format) : (_,_)format = fun x -> f (g x)
let int: (_,_) format = fun x -> !string_of_int x
let string : (_,_) format = fun x -> !string_of_int x
let sprintf (f:(_,_) format) = f (fun s -> s) ""

let myformat:(_,_) format =
  fun x -> (lit "expecting an int:\""++ int ++ lit "\"and a
string:\""++ string ++ lit "\";") x
let _ = sprintf myformat

(*
  Mlton style folding....

  The formats resulting from this solution are very terse. Type-checking is
  very involved and cannot be abstracted easily.

  The mechanics behind are explained on mlton's web page (http://mlton.org/Fold)

  I believe this hack should be attribute to Stephen Weeks.
*)
let endf acc f = f acc

module Fold =
struct
 let fold a f g = g a f
 let step0 h a f = fold (h a) f
 let step1 h a f b = fold (h b a) f
end

module Foldr =
struct
  let foldr a f = Fold.fold  f (fun g -> g a)
  let step0 h = Fold.step0 (fun g x -> g (h x))
  let step1 h = Fold.step1 (fun b g x -> g (h b x))
end

let (!) f = fun z -> Foldr.step1 (fun s k ((+),acc,stop) a -> k
((+),(acc + (f a)  + s),stop)) z;;
let (<<) s = Foldr.foldr (fun (_,acc,stop) -> stop acc) (fun k init
stop (+) -> k ((+),init+s,stop))
let (>>) = endf

let sprintf f =
  f (Buffer.create 17) (Buffer.contents) (fun b s -> Buffer.add_string b s;b)


let int k = !string_of_int k
let string k = !string_of_string k


let _ = sprintf ((<<)"expecting an int:\""int"\"and a string:\""string"\";"(>>))

(*
  Rectypes

  This one is by me... it requires -rectypes and is a lot more useless than the
  previous ones... I just felt like putting it down anyways
*)

type ('a,'b) acc = (?peak:('b -> unit) -> 'a -> ('a,'b) acc)

let makeAcc init (+) : (_,_) acc  =
  let rec aux acc ?peak =
  (match peak with
   | Some f -> f acc
   | None -> ());
    fun v -> aux (acc+v)
  in aux init

let (|>) x f = f x
let peak (acc:(_,'a) acc) : 'a =
  let res = ref None in
  let set v = res := Some v in
  ignore (acc ~peak:set);
  match !res with
  | Some v -> v
  | None -> assert false

let _ =
  let sum = makeAcc 0 (+) in
  sum 3 4 5 6 |> peak

Till
-- 
http://till-varoquaux.blogspot.com/