Skip to content

GitLab

Commit 81e81105 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2004-03-11 14:02:02 by jdemouth] Corrections. 

Original author: jdemouth
Date: 2004-03-11 14:02:02+00:00
parent cb7642d8
Hide whitespace changes
Inline Side-by-side
cdo2cmo/ml_generator.ml
View file @ 81e81105
......@@ -93,7 +93,7 @@ let rec dump fmt = function
dump_code fmt "cdo2cmo__val" code;
Format.fprintf fmt "@."
| Value ( name, slot, code ) ->
Format.fprintf fmt "let %s =" name;
Format.fprintf fmt "let %s = @." name;
Format.fprintf fmt "let cdo2cmo__val = @.";
Format.fprintf fmt "!CDuce_all.Eval.from_comp_unit cdo2cmo__cu %d in@." slot;
dump_code fmt "cdo2cmo__val" code
......@@ -139,7 +139,7 @@ and dump_code fmt name = function
| ( field, desc ) :: tl ->
Format.fprintf fmt "( CDuce_all.Ns.mk_ascii \"\", @.";
Format.fprintf fmt "CDuce_all.Encodings.Utf8.mk \"%s\" ), @. " field;
dump_code fmt ( Format.sprintf "%s.%s" name field ) desc;
dump_code fmt ( Format.sprintf "%s.%s;" name field ) desc;
print_list tl in
print_list list;
Format.fprintf fmt " ]@."
......@@ -173,7 +173,7 @@ and dump_code fmt name = function
Format.fprintf fmt ") = %s in@." name;
print_list 0 list
| To_CDuce_type id ->
Format.fprintf fmt "ocaml2cduce__%s %s" id name
Format.fprintf fmt "ocaml2cduce__%s %s@." id name
| To_CDuce_variant list ->
let rec print_proj n m =
if n < m then begin
......@@ -223,16 +223,16 @@ and dump_code fmt name = function
dump_code fmt lbl code1;
Format.fprintf fmt " in @.";
Format.fprintf fmt " let cdo2cmo__val = @.";
Format.fprintf fmt " try @.";
Format.fprintf fmt " CDuce_all.Eval.eval_apply cdo2cmo__val cdo2cmo__p @.";
Format.fprintf fmt " with CDuce_all.Value.CDuceExn t -> ( @.";
Format.fprintf fmt " match t with @.";
Format.fprintf fmt " | CDuce_all.Value.String_latin1 ( _, _, s, _ ) -> @.";
Format.fprintf fmt " raise ( Error s )@.";
Format.fprintf fmt " | CDuce_all.Value.String_utf8 ( _, _, t, _ ) -> @.";
Format.fprintf fmt " raise ( Error ( @.";
Format.fprintf fmt "CDuce_all.Encodings.Utf8.get_str t ) )@.";
Format.fprintf fmt " | _ -> assert false ) in@.";
Format.fprintf fmt " try @.";
Format.fprintf fmt " CDuce_all.Eval.eval_apply cdo2cmo__val cdo2cmo__p @.";
Format.fprintf fmt " with CDuce_all.Value.CDuceExn t -> ( @.";
Format.fprintf fmt " match t with @.";
Format.fprintf fmt " | CDuce_all.Value.String_latin1 ( _, _, s, _ ) -> @.";
Format.fprintf fmt " raise ( Error s )@.";
Format.fprintf fmt " | CDuce_all.Value.String_utf8 ( _, _, t, _ ) -> @.";
Format.fprintf fmt " raise ( Error ( @.";
Format.fprintf fmt " CDuce_all.Encodings.Utf8.get_str t ) )@.";
Format.fprintf fmt " | _ -> assert false ) in@.";
dump_code fmt "cdo2cmo__val" code2
| To_OCaml_int ->
Format.fprintf fmt " match CDuce_all.Value.inv_const %s with@." name;
......@@ -245,8 +245,8 @@ and dump_code fmt name = function
Format.fprintf fmt " | CDuce_all.Value.Pair (cdo2cmo__hd, cdo2cmo__tl) ->@.";
Format.fprintf fmt " let cdo2cmo__hd = ( @.";
dump_code fmt "cdo2cmo__hd" code;
Format.fprintf fmt " ) in cdo2cmo__seq ( list @@ [ cdo2cmo__hd ] ) @.";
Format.fprintf fmt " cdo2cmo__tl @.";
Format.fprintf fmt " ) in cdo2cmo__seq ( list @@ [ cdo2cmo__hd ] ) @.";
Format.fprintf fmt " cdo2cmo__tl @.";
Format.fprintf fmt " | CDuce_all.Value.Concat (cdo2cmo__l1, cdo2cmo__l2) ->@.";
Format.fprintf fmt " ( cdo2cmo__seq list cdo2cmo__l1 ) @@ @.";
Format.fprintf fmt " ( cdo2cmo__seq [] cdo2cmo__l2 )@.";
......@@ -254,11 +254,37 @@ and dump_code fmt name = function
Format.fprintf fmt " cdo2cmo__seq [] %s@." name
| To_OCaml_option code ->
Format.fprintf fmt " match %s with@." name;
Format.fprintf fmt " | CDuce_all.Value.nil -> None@.";
Format.fprintf fmt " | %s -> Some (@." name;
Format.fprintf fmt " | CDuce_all.Value.nil -> None@.";
Format.fprintf fmt " | %s -> Some (@." name;
dump_code fmt name code;
Format.fprintf fmt " )@."
| To_OCaml_record list -> assert false
| To_OCaml_record list ->
Format.fprintf fmt " match %s with@." name;
Format.fprintf fmt " | CDuce_all.Value.Record cdo2cmo__map ->@.";
let rec trans = function
| [] -> ()
| ( field, code )::tl ->
Format.fprintf fmt "let cdo2cmo__%s = @." field;
dump_code fmt (
"( CDuce_all.Ident.LabelMap.assoc ( " ^ (
"CDuce_all.Ident.LabelPool.mk ( CDuce_all.Ns.mk_ascii \"\","
) ^ (
Format.sprintf
"CDuce_all.Encodings.Utf8.mk \"%s\" ) ) cdo2cmo__map )" field
)
) code;
Format.fprintf fmt "in@.";
trans tl in
trans list;
let rec record = function
| [] -> ()
| ( field, _ ) :: tl ->
Format.fprintf fmt "%s = cdo2cmo__%s; " field field;
record tl in
Format.fprintf fmt "{ ";
record list;
Format.fprintf fmt " }@.";
Format.fprintf fmt "| _ -> assert false@."
| To_OCaml_string ->
Format.fprintf fmt " CDuce_all.Value.get_string_latin1 %s@." name
| To_OCaml_tuple list ->
......@@ -319,11 +345,11 @@ and dump_code fmt name = function
print_list tl in
Format.fprintf fmt " let cdo2cmo__atom, cdo2cmo__desc = match %s with @." name;
Format.fprintf fmt " | CDuce_all.Value.Atom cdo2cmo__atom -> @.";
Format.fprintf fmt " cdo2cmo__atom, CDuce_all.Value.nil @.";
Format.fprintf fmt " cdo2cmo__atom, CDuce_all.Value.nil @.";
Format.fprintf fmt " | CDuce_all.Value.Pair ( @.";
Format.fprintf fmt " CDuce_all.Value.Atom cdo2cmo__atom, @.";
Format.fprintf fmt " cdo2cmo__desc ) -> @.";
Format.fprintf fmt " cdo2cmo__atom, cdo2cmo__desc @.";
Format.fprintf fmt " CDuce_all.Value.Atom cdo2cmo__atom, @.";
Format.fprintf fmt " cdo2cmo__desc ) -> @.";
Format.fprintf fmt " cdo2cmo__atom, cdo2cmo__desc @.";
Format.fprintf fmt " | _ -> assert false in@.";
Format.fprintf fmt " match CDuce_all.Ns.QName.to_string ( @.";
Format.fprintf fmt " CDuce_all.Atoms.V.value cdo2cmo__atom )@.";
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment