Re: [Caml-list] string_of_polymorphic

[pad@ryxa.irisa.fr]

Luca Pascali <pasckosky2000@yahoo.it> writes:

> Hi everyone and Happy 2005.
> 
> As the subject says, my aim is to write a function that is able to
> covert into a string a generic polymorphic constructor, or at least its
> name, without using patter matching.
> Something like the operation that the ocaml toplevel already does:
> 
> # let a = `Hi;;
> val a : [> `Hi ] = `Hi
> -------------------^    I'd like to have this string
> 
> I tried using the Obj module, but I got only segmentation faults.
> I know that the Obj module has not to be used, but what I want to write
> will be placed into a library with a signature like this:
> 
> val string_of_polymorphic : [> `Dummy ] -> string

I have a function generic_print that can do some of the stuff you want
(but it is done in a ugly way):
example: 
 let _ =
  (print_string (generic_print [[1;3];[2;9;8];[3;4]] "int list list");
   print_string (generic_print [1;3;2;9;8;3;4] "int list");
   print_string (generic_print `Hi "[> `Hi | `Ho]") in
  ()

==>
[[1; 3]; [2; 9; 8]; [3; 4]]
[1; 3; 2; 9; 8; 3; 4]
`Hi






code:

(*********************************************************************************************************) 
(*
 a poor's man    haskell 'show' function for O'Caml

 requirment: must have a 'corresponding' toplevel called calc.top 
 (but your program can be a normal program, even a natively compiled  program)

 cons:
    need provide type information (via string so not robust)
    slow
    ugly
 pro:
    it works    

 compilation:
  ocamlc unix.cma str.cma  generic_print.ml -o test_generic
  ocamlmktop -o calc.top unix.cma str.cma  generic_print.ml 

 example:
  let _ = print_string (generic_print [[1;3];[2;9;8];[3;4]] "int list list" in
  let _ = print_string (generic_print [1;3;2;9;8;3;4] "int list") in
  (see end of file)
 
 test:
  ./test_generic
  ==> 
   [[1; 3]; [2; 9; 8]; [3; 4]]
   [1; 3; 2; 9; 8; 3; 4]

*)


(*********************************************************************************************************) 

let write_value valu filename = 
  let chan = open_out filename in
  ((* output_value chan valu;*)  (* <=> Marshal.to_channel *)
   Marshal.to_channel chan valu [Marshal.Closures];
   close_out chan) 

let get_value filename = 
  let chan = open_in filename in
  let x = input_value chan in (* <=> Marshal.from_channel  *)
  (close_in chan; x)

let (=~) s re = Str.string_match (Str.regexp re) s 0 

(* beurk, side effect code, but hey, it is convenient *)
let (matched: int -> string -> string) = fun i s -> 
  Str.matched_group i s

let matched1 = fun s -> matched 1 s

let cat file = 
  let chan = open_in file in
  let rec aux ()  = 
    try 
      (* cant do input_line chan::aux() cos ocaml eval from right to left ! *)
      let l = input_line chan in
      l :: aux ()
    with End_of_file -> [] in
  aux()

let (+>) o f = f o

let rec drop_while p = function
  | [] -> []
  | x::xs -> if p x then drop_while p xs else x::xs	

let (unlines: string list -> string) = fun s -> (String.concat "\n" s)

let tail = List.tl

let pr s = (print_string s; print_string "\n"; flush stdout)

(*********************************************************************************************************) 

(* TODO optimisation: use a pipe, so dont fork each time for each print (and will be reentrant) *)
let (generic_print: 'a -> string -> string) = fun v typ -> 
  (write_value v "/tmp/generic_print";
   ignore(Unix.system("printf 'let (v:" ^ typ ^ ") = Generic_print.get_value \"/tmp/generic_print\" in v;;' | ./calc.top > /tmp/result_generic_print")); 
   cat "/tmp/result_generic_print" 
    +> drop_while (fun e -> not (e =~ "^#.*")) 
    +> tail
    +> (fun xs -> 
      let (hd, tl) = (List.hd xs, List.tl xs) in 
      if (hd =~ ".*=[ ]*\\(.*\\)") 
      then (matched1 hd::tl) +> unlines 
      else "error in generic_print, not good format:" ^ (unlines xs)
       )
  )

(*********************************************************************************************************) 
(* example:   *)
let main () = 
  (pr (generic_print [[1;3];[2;9;8];[3;4]] "int list list");
   pr (generic_print [1;3;2;9;8;3;4] "int list");
   pr (generic_print `Hi "[> `Hi | `Ho]");
  )
let _ = if not !Sys.interactive then (main ())





> 
> Thanks in advance to anyone for hints, or links, or wathever help you
> can give me.
> 
> Luca