aboutsummaryrefslogtreecommitdiffstats
path: root/common/PrintAST.ml
diff options
context:
space:
mode:
authorXavier Leroy <xavierleroy@users.noreply.github.com>2015-04-01 18:28:02 +0200
committerXavier Leroy <xavierleroy@users.noreply.github.com>2015-04-01 18:28:02 +0200
commit95ba79b10e832025bbc9843f9d14614f7dff0fcb (patch)
tree8ca03b99cf6be2aab8c7b266196569019a2a7f13 /common/PrintAST.ml
parent68e2ce02f8d69b26c9cea6e0d338f855cbea3ace (diff)
parente11b3b885a6d359925b86743b89698cc6757157a (diff)
downloadcompcert-95ba79b10e832025bbc9843f9d14614f7dff0fcb.tar.gz
compcert-95ba79b10e832025bbc9843f9d14614f7dff0fcb.zip
Merge pull request #34 from AbsInt/extended-annotations
Extended annotations
Diffstat (limited to 'common/PrintAST.ml')
-rw-r--r--common/PrintAST.ml25
1 files changed, 25 insertions, 0 deletions
diff --git a/common/PrintAST.ml b/common/PrintAST.ml
index c0eab04f..52aa963a 100644
--- a/common/PrintAST.ml
+++ b/common/PrintAST.ml
@@ -54,3 +54,28 @@ let name_of_external = function
| EF_annot(text, targs) -> sprintf "annot %S" (extern_atom text)
| EF_annot_val(text, targ) -> sprintf "annot_val %S" (extern_atom text)
| EF_inline_asm text -> sprintf "inline_asm %S" (extern_atom text)
+
+let rec print_annot_arg px oc = function
+ | AA_base x -> px oc x
+ | AA_int n -> fprintf oc "int %ld" (camlint_of_coqint n)
+ | AA_long n -> fprintf oc "long %Ld" (camlint64_of_coqint n)
+ | AA_float n -> fprintf oc "float %F" (camlfloat_of_coqfloat n)
+ | AA_single n -> fprintf oc "single %F" (camlfloat_of_coqfloat32 n)
+ | AA_loadstack(chunk, ofs) ->
+ fprintf oc "%s[sp + %ld]" (name_of_chunk chunk) (camlint_of_coqint ofs)
+ | AA_addrstack(ofs) ->
+ fprintf oc "sp + %ld" (camlint_of_coqint ofs)
+ | AA_loadglobal(chunk, id, ofs) ->
+ fprintf oc "%s[&%s + %ld]"
+ (name_of_chunk chunk) (extern_atom id) (camlint_of_coqint ofs)
+ | AA_addrglobal(id, ofs) ->
+ fprintf oc "&%s + %ld" (extern_atom id) (camlint_of_coqint ofs)
+ | AA_longofwords(hi, lo) ->
+ fprintf oc "longofwords(%a, %a)"
+ (print_annot_arg px) hi (print_annot_arg px) lo
+
+let rec print_annot_args px oc = function
+ | [] -> ()
+ | [a] -> print_annot_arg px oc a
+ | a1 :: al ->
+ fprintf oc "%a, %a" (print_annot_arg px) a1 (print_annot_args px) al