viewcvs.cgi/tests/build_types.ml


  (* some experiments with hand construction of CDuce types *)

let xml =
  Types.xml'
    (Types.atom (Atoms.atom (Atoms.mk_ascii "xml")))
    Types.empty_closed_record
    Types.Int.any
;;
let choice =
  Types.choice_of_list [ Builtin_defs.bool; Builtin_defs.string; Builtin_defs.int ]
;;
let seq =
  Sequence.seq_of_list [ Builtin_defs.bool; Builtin_defs.string; Builtin_defs.int ]
;;
let reco =  (* closed record with two fields *)
  Types.rec_of_list ~opened:false ["foo", Builtin_defs.int; "bar", Builtin_defs.bool]
;;
let opt_reco =  (* closed record with two required and one optional fields *)
  Types.rec_of_list' ~opened:false [
    false, "foo", Builtin_defs.int;
    false, "bar", Builtin_defs.bool;
    true, "baz", Builtin_defs.string;
  ]
;;
let concat =  (* TODO ... ask Alain: how to concatenate two star types? *)
  let int_star = (Sequence.star Builtin_defs.bool) in
  let bool_star = (Sequence.star Builtin_defs.int) in
(*   Sequence.concat int_star bool_star *)
  Sequence.flatten (Sequence.seq_of_list [ int_star; bool_star ])
;;
let rex =
  let elem = Ast.Elem (Location.mknoloc (Ast.Internal xml)) in
  let nil = Location.mknoloc (Ast.Internal Sequence.nil_type) in
  let rex =
    (Ast.Seq ((Ast.Seq (Ast.Star elem, elem)), (Ast.Seq (elem, Ast.Star elem))))
  in
  let ast_rex = Location.mknoloc (Ast.Regexp (rex, nil)) in
  print_endline (Ast.string_of_regexp rex);
  Types.descr (Typer.typ ast_rex)
(*   Typer.typ' (Typer.real_compile (Typer.derecurs Typer.TypeEnv.empty ast_rex)) *)
;;

let string = Sequence.star Types.Char.any ;;
Types.Print.print Format.std_formatter rex;
Format.fprintf Format.std_formatter "\n"

1
2	(* some experiments with hand construction of CDuce types *)
3
4	let xml =
5	Types.xml'
6	(Types.atom (Atoms.atom (Atoms.mk_ascii "xml")))
7	Types.empty_closed_record
8	Types.Int.any
9	;;
10	let choice =
11	Types.choice_of_list [ Builtin_defs.bool; Builtin_defs.string; Builtin_defs.int ]
12	;;
13	let seq =
14	Sequence.seq_of_list [ Builtin_defs.bool; Builtin_defs.string; Builtin_defs.int ]
15	;;
16	let reco = (* closed record with two fields *)
17	Types.rec_of_list ~opened:false ["foo", Builtin_defs.int; "bar", Builtin_defs.bool]
18	;;
19	let opt_reco = (* closed record with two required and one optional fields *)
20	Types.rec_of_list' ~opened:false [
21	false, "foo", Builtin_defs.int;
22	false, "bar", Builtin_defs.bool;
23	true, "baz", Builtin_defs.string;
24	]
25	;;
26	let concat = (* TODO ... ask Alain: how to concatenate two star types? *)
27	let int_star = (Sequence.star Builtin_defs.bool) in
28	let bool_star = (Sequence.star Builtin_defs.int) in
29	(* Sequence.concat int_star bool_star *)
30	Sequence.flatten (Sequence.seq_of_list [ int_star; bool_star ])
31	;;
32	let rex =
33	let elem = Ast.Elem (Location.mknoloc (Ast.Internal xml)) in
34	let nil = Location.mknoloc (Ast.Internal Sequence.nil_type) in
35	let rex =
36	(Ast.Seq ((Ast.Seq (Ast.Star elem, elem)), (Ast.Seq (elem, Ast.Star elem))))
37	in
38	let ast_rex = Location.mknoloc (Ast.Regexp (rex, nil)) in
39	print_endline (Ast.string_of_regexp rex);
40	Types.descr (Typer.typ ast_rex)
41	(* Typer.typ' (Typer.real_compile (Typer.derecurs Typer.TypeEnv.empty ast_rex)) *)
42	;;
43
44	let string = Sequence.star Types.Char.any ;;
45	Types.Print.print Format.std_formatter rex;
46	Format.fprintf Format.std_formatter "\n"
47