diff --git a/src/figures.ml b/src/figures.ml index ce6c40b..8fde8dc 100644 --- a/src/figures.ml +++ b/src/figures.ml @@ -4,26 +4,107 @@ open Box (* a named box intended to be used as a pointer which implies empty content *) let named_ptr name = box ~fill:Color.lightgreen ~name (tex " ") -(* a named box intended to be used as a block metadata containing ptr *) -let named_meta_ptr name = box ~name ~fill:Color.lightred (tex "") +(* a named scalar *) +let named_scalar ~name v = box ~fill:Color.lightcyan ~name (tex v) + +(* a named taggeg pointer *) +let named_tagged_ptr name = + hbox ~stroke:(Some Color.black) ~fill:Color.lightgreen + [ box ~stroke:None (tex "") ~name; tex ~fill:Color.lightred "" ] + +(* a named scalar *) +let named_tagged_scalar ~name v = + hbox ~stroke:(Some Color.black) ~fill:Color.lightcyan ~name + [ box ~stroke:None (tex v); tex ~fill:Color.lightmagenta "" ] + +let tagged_scalar v = + hbox ~stroke:(Some Color.black) ~fill:Color.lightcyan + [ box ~stroke:None (tex v); tex ~fill:Color.lightmagenta "" ] + +type scalar = + | Int of int + | Float of float + +let value_to_string = function + | Int n -> string_of_int n + | Float f -> string_of_float f + +let name_box name = tex (Format.sprintf "\\texttt{%s}:" name) + +module Stack = struct + type value = + | Unboxed_ptr of string + | Unboxed_scalar of string * scalar + | Tagged_ptr of string + | Tagged_scalar of string * scalar + + type t = value list + + let value_to_box = function + | Unboxed_ptr name -> hbox [ name_box name; named_ptr name ] + | Unboxed_scalar (name, v) -> + let scalar = value_to_string v in + hbox [ name_box name; named_scalar ~name scalar ] + | Tagged_ptr name -> hbox [ name_box name; named_tagged_ptr name ] + | Tagged_scalar (name, v) -> + let scalar = value_to_string v in + hbox [ name_box name; named_tagged_scalar ~name scalar ] + + let to_box l = + let l = List.map value_to_box l in + vbox ~padding:(Num.em 2.) [ tex "stack:"; vbox ~pos:`Right l ] +end (* a named box intended to be used as a block metadata containing scalar *) let named_meta_scalar name = box ~name ~fill:Color.lightmagenta (tex "") -(* a named box intended to be used as a block metadata containing scalar *) -let named_meta_unboxed_float name = box ~name ~fill:Color.purple (tex "") +(* a named box intended to be used as a block metadata containing ptr *) +let named_meta_ptr name = box ~name ~fill:Color.lightred (tex "") -(* a named scalar *) -let named_scalar ~name v = box ~fill:Color.lightcyan ~name (tex v) +module Block = struct + type tagged = + | Tagged_scalar of int + | Tagged_ptr of string -(* a block of pointers, all elements are named, the first one is a metadata box all others are ptr boxes *) -let ptr_block name names = - hblock @@ (named_meta_ptr name :: List.map named_ptr names) + type t = + | Unboxed_ptr of string * string list + | Unboxed_scalar of string * scalar list + | Tagged of string * tagged list + | Untagged of string * string list -(* a block of scalars, only the metadata is named, all other have content (the scalar value) *) -let scalar_block name values = - hblock - @@ (named_meta_scalar name :: List.map (tex ~fill:Color.lightcyan) values) + let named_meta_tagged name = box ~name ~fill:Color.lightblue (tex "") + + let named_meta_untagged name = box ~name ~fill:Color.lightblue (tex "") + + let tagged = function + | Tagged_scalar n -> + let v = string_of_int n in + tagged_scalar v + | Tagged_ptr name -> hbox [ named_tagged_ptr name ] + + let untagged v = tex v + + let to_box = function + | Unboxed_ptr (name, v) -> + hblock (named_meta_ptr name :: List.map named_ptr v) + | Unboxed_scalar (name, v) -> + let v = List.map value_to_string v in + hblock (named_meta_scalar name :: List.map (tex ~fill:Color.lightcyan) v) + | Tagged (name, v) -> hblock (named_meta_tagged name :: List.map tagged v) + | Untagged (name, v) -> + hblock (named_meta_untagged name :: List.map untagged v) + + let unboxed_ptr name v = to_box @@ Unboxed_ptr (name, v) + + let unboxed_scalar name v = to_box @@ Unboxed_scalar (name, v) + + let tagged name v = to_box @@ Tagged (name, v) + + let untagged name v = to_box @@ Untagged (name, v) +end + +(* a named box intended to be used as a block metadata containing scalar *) +let named_meta_unboxed_float name = box ~name ~fill:Color.purple (tex "") (* a block of unboxed floats *) let unboxed_floats_block name values = @@ -34,41 +115,32 @@ let unboxed_floats_block name values = let scalar_array name values = hblock ~name (List.map (tex ~fill:Color.lightcyan) values) -(* a stack ptr entry, name is the variable name and the pointer box will also be named after it *) -let stack_ptr name = - hbox [ tex (Format.sprintf "\\texttt{%s}:" name); named_ptr name ] - -(* a stack scalar entry, s is the variable name and the pointer box will also be named after it *) -let stack_scalar ~name v = - hbox [ tex (Format.sprintf "\\texttt{%s}:" name); named_scalar ~name v ] - -(* a stack made of stack entries *) -let stack l = vbox ~padding:(Num.em 2.) [ tex "stack:"; vbox ~pos:`Right l ] - let figure_python_layout = let stack = - stack - [ stack_ptr "array1" - ; stack_ptr "array2" - ; stack_ptr "pair" - ; stack_ptr "x" + let open Stack in + to_box + [ Unboxed_ptr "array1" + ; Unboxed_ptr "array2" + ; Unboxed_ptr "pair" + ; Unboxed_ptr "x" ] in let heap = + let open Block in vbox ~padding:(Num.em 2.) [ tex "heap:" ; hbox ~padding:(Num.em 1.) - [ scalar_block "1_meta" [ "1" ] - ; scalar_block "2_meta" [ "2" ] - ; scalar_block "3_meta" [ "3" ] + [ unboxed_scalar "1_meta" [ Int 1 ] + ; unboxed_scalar "2_meta" [ Int 2 ] + ; unboxed_scalar "3_meta" [ Int 3 ] ] - ; ptr_block "array1_meta" [ "array1_1"; "array1_2"; "array1_3" ] - ; ptr_block "pair_meta" [ "pair_1"; "pair_2" ] - ; ptr_block "array2_meta" [ "array2_1"; "array2_2"; "array2_3" ] + ; unboxed_ptr "array1_meta" [ "array1_1"; "array1_2"; "array1_3" ] + ; unboxed_ptr "pair_meta" [ "pair_1"; "pair_2" ] + ; unboxed_ptr "array2_meta" [ "array2_1"; "array2_2"; "array2_3" ] ; hbox ~padding:(Num.em 1.) - [ scalar_block "42_meta" [ "42" ] - ; scalar_block "99_meta" [ "99" ] - ; scalar_block "666_meta" [ "666" ] + [ unboxed_scalar "42_meta" [ Int 42 ] + ; unboxed_scalar "99_meta" [ Int 99 ] + ; unboxed_scalar "666_meta" [ Int 666 ] ] ] in @@ -92,20 +164,22 @@ let figure_python_layout = let figure_python_layout2 = let stack = - stack - [ stack_ptr "array1" - ; stack_ptr "array2" - ; stack_ptr "pair" - ; stack_ptr "x" + let open Stack in + to_box + [ Unboxed_ptr "array1" + ; Unboxed_ptr "array2" + ; Unboxed_ptr "pair" + ; Unboxed_ptr "x" ] in let heap = + let open Block in vbox ~padding:(Num.em 2.) [ tex "heap:" - ; scalar_block "array1_meta" [ "1"; "2"; "3" ] - ; ptr_block "pair_meta" [ "pair_1"; "pair_2" ] - ; scalar_block "array2_meta" [ "42"; "99"; "666" ] - ; scalar_block "42_meta" [ "42" ] + ; unboxed_scalar "array1_meta" [ Int 1; Int 2; Int 3 ] + ; unboxed_ptr "pair_meta" [ "pair_1"; "pair_2" ] + ; unboxed_scalar "array2_meta" [ Int 42; Int 99; Int 666 ] + ; unboxed_scalar "42_meta" [ Int 42 ] ] in let figure = hbox ~padding:(Num.em 2.) [ stack; heap ] in @@ -122,19 +196,23 @@ let figure_python_layout2 = let figure_ocaml_layout = let stack = - stack - [ stack_ptr "array1" - ; stack_ptr "array2" - ; stack_ptr "pair" - ; stack_scalar ~name:"x" "42" + let open Stack in + to_box + [ Tagged_ptr "array1" + ; Tagged_ptr "array2" + ; Tagged_ptr "pair" + ; Tagged_scalar ("x", Int 42) ] in let heap = + let open Block in vbox ~padding:(Num.em 2.) [ tex "heap:" - ; scalar_block "array1_meta" [ "1"; "2"; "3" ] - ; ptr_block "pair_meta" [ "pair_1"; "pair_2" ] - ; scalar_block "array2_meta" [ "42"; "99"; "666" ] + ; tagged "array1_meta" + [ Tagged_scalar 1; Tagged_scalar 2; Tagged_scalar 3 ] + ; tagged "pair_meta" [ Tagged_ptr "pair_1"; Tagged_ptr "pair_2" ] + ; tagged "array2_meta" + [ Tagged_scalar 42; Tagged_scalar 99; Tagged_scalar 666 ] ] in let figure = hbox ~padding:(Num.em 2.) [ stack; heap ] in @@ -150,29 +228,31 @@ let figure_ocaml_layout = let figure_java_layout = let stack = - stack - [ stack_ptr "array1" - ; stack_ptr "array2" - ; stack_ptr "pair" - ; stack_scalar ~name:"x" "42" + let open Stack in + to_box + [ Unboxed_ptr "array1" + ; Unboxed_ptr "array2" + ; Unboxed_ptr "pair" + ; Unboxed_scalar ("x", Int 42) ] in let heap = + let open Block in vbox ~padding:(Num.em 2.) [ tex "heap:" ; scalar_array "array1_array" [ "1"; "2"; "3" ] ; hbox ~padding:(Num.em 1.) - [ scalar_block "1_meta" [ "1" ] - ; scalar_block "2_meta" [ "2" ] - ; scalar_block "3_meta" [ "3" ] + [ unboxed_scalar "1_meta" [ Int 1 ] + ; unboxed_scalar "2_meta" [ Int 2 ] + ; unboxed_scalar "3_meta" [ Int 3 ] ] - ; ptr_block "array1_meta" [ "array1_1"; "array1_2"; "array1_3" ] - ; ptr_block "pair_meta" [ "pair_1"; "pair_2" ] - ; ptr_block "array2_meta" [ "array2_1"; "array2_2"; "array2_3" ] + ; unboxed_ptr "array1_meta" [ "array1_1"; "array1_2"; "array1_3" ] + ; unboxed_ptr "pair_meta" [ "pair_1"; "pair_2" ] + ; unboxed_ptr "array2_meta" [ "array2_1"; "array2_2"; "array2_3" ] ; hbox ~padding:(Num.em 1.) - [ scalar_block "42_meta" [ "42" ] - ; scalar_block "99_meta" [ "99" ] - ; scalar_block "666_meta" [ "666" ] + [ unboxed_scalar "42_meta" [ Int 42 ] + ; unboxed_scalar "99_meta" [ Int 99 ] + ; unboxed_scalar "666_meta" [ Int 666 ] ] ] in @@ -279,13 +359,18 @@ let figure_python_block2 = let figure_ocaml_float1 = let figure = + let open Block in vbox ~padding:(Num.em 2.) - [ scalar_block "meta_abc" [ "$12.13$" ] + [ untagged "meta_abc" [ "$12.13$" ] ; hbox ~padding:(Num.em 1.) - [ ptr_block "array" [ "array_1"; "array_2"; "array_3" ] - ; scalar_block "meta_pi" [ "$6.28318530717958623$" ] + [ tagged "array" + [ Tagged_ptr "array_1" + ; Tagged_ptr "array_2" + ; Tagged_ptr "array_3" + ] + ; untagged "meta_pi" [ "$6.28318530717958623$" ] ] - ; scalar_block "meta_42" [ "$42.0$" ] + ; untagged "meta_42" [ "$42.0$" ] ] in let ptr a b = Helpers.box_pointer_arrow (get a figure) (get b figure) in @@ -305,19 +390,21 @@ let figure_ocaml_float2 = let figure_wasm_layout = let stack = - stack - [ stack_ptr "array1" - ; stack_ptr "array2" - ; stack_ptr "pair" - ; stack_scalar ~name:"x" "42" + let open Stack in + to_box + [ Unboxed_ptr "array1" + ; Unboxed_ptr "array2" + ; Unboxed_ptr "pair" + ; Unboxed_scalar ("x", Int 42) ] in let heap = + let open Block in vbox ~padding:(Num.em 2.) [ tex "heap:" - ; scalar_block "array1_meta" [ "1"; "2"; "3" ] - ; ptr_block "pair_meta" [ "pair_1"; "pair_2" ] - ; scalar_block "array2_meta" [ "42"; "99"; "666" ] + ; unboxed_scalar "array1_meta" [ Int 1; Int 2; Int 3 ] + ; unboxed_ptr "pair_meta" [ "pair_1"; "pair_2" ] + ; unboxed_scalar "array2_meta" [ Int 42; Int 99; Int 666 ] ] in let figure = hbox ~padding:(Num.em 2.) [ stack; heap ] in