sorry it's in such a bad state but this didn't go very far

so hopefully i get farther with the other method and this branch is
lost to history. but in case it's not, lol
This commit is contained in:
cqc
2023-05-11 18:56:57 -05:00
parent c07921e697
commit a45395857d
2 changed files with 32 additions and 8 deletions

View File

@ -719,6 +719,11 @@ let str_of_pat (pat : value general_pattern) =
let str_of_ident = Ident.name let str_of_ident = Ident.name
let unique_str_of_ident = Ident.unique_name let unique_str_of_ident = Ident.unique_name
let unique_str_of_ident_pat x =
match x.pat_desc with
| Tpat_var (s, _) -> F.str "%a" P.fmt_ident s
| _ -> str_of_pat x
let pp_value_binding_list ppf (vbl : Typedtree.value_binding list) = let pp_value_binding_list ppf (vbl : Typedtree.value_binding list) =
Fmt.pf ppf "%a" Fmt.pf ppf "%a"
(Fmt.parens (Fmt.parens
@ -727,16 +732,21 @@ let pp_value_binding_list ppf (vbl : Typedtree.value_binding list) =
let unique_node_count = ref 0 let unique_node_count = ref 0
let vertex_of_primary_value (exp : Typedtree.expression) : Gr.Vertex.t let vertex_of_exp (exp : Typedtree.expression) : Gr.Vertex.t =
= (* primary isn't well defined here, it's whatever i choosen for src nodes atm *)
(* sorry that the use of the word primary is so abusive *)
match exp.exp_desc with match exp.exp_desc with
| Texp_ident (path, _longident, _value_desc) -> | Texp_ident (path, _longident, _value_desc) ->
{ {
name = F.str "%a" P.fmt_path path; name = F.str "%a" P.fmt_path path;
attr = [ `Label (F.str "{{}|<out>%s}" (str_of_exp exp)) ]; attr = [ `Label (F.str "{{<in>}|<out>%s}" (str_of_exp exp)) ];
subgraph = None; subgraph = None;
} }
| Texp_construct _ ->
{
Gr.Vertex.default with
name = F.str "_Texp_construct/%d" !unique_node_count;
attr = [ `Label (F.str "{<out>%s}" (str_of_exp exp)) ];
}
| Texp_constant _ -> | Texp_constant _ ->
{ {
Gr.Vertex.default with Gr.Vertex.default with
@ -799,7 +809,7 @@ let graph_of_impl (s : Typedtree.structure) : Gr.t =
let open Typedtree in let open Typedtree in
match exp.exp_desc with match exp.exp_desc with
| Texp_apply (_exp, list) -> | Texp_apply (_exp, list) ->
let src = vertex_of_primary_value exp in let src = vertex_of_exp exp in
(* Tast_iterator.default_iterator.expr iter exp *) (* Tast_iterator.default_iterator.expr iter exp *)
(* skip _exp *) (* skip _exp *)
List.fold_left List.fold_left
@ -850,7 +860,7 @@ let graph_of_impl (s : Typedtree.structure) : Gr.t =
let src = let src =
labeled_vertex labeled_vertex
(unique_str_of_ident param) (unique_str_of_ident param)
(F.str "{{<0>function %s}|{%s}}" (F.str "{{<in>function %s}|{%s}}"
(unique_str_of_ident param) (unique_str_of_ident param)
(fst (fst
(List.fold_left (List.fold_left
@ -878,12 +888,14 @@ let graph_of_impl (s : Typedtree.structure) : Gr.t =
`TailportRecord (F.str "%d" i); `TailportRecord (F.str "%d" i);
]; ];
}, },
labeled_vertex (str_of_pat c_lhs) "{<in>|LOL}" ); labeled_vertex
(unique_str_of_ident_pat c_lhs)
"{<in>|LOL}" );
Stack.pop_opt dst_stk |> ignore) Stack.pop_opt dst_stk |> ignore)
cases; cases;
src src
| _ -> | _ ->
let src = vertex_of_primary_value exp in let src = vertex_of_exp exp in
Stack.push (src, 0) dst_stk; Stack.push (src, 0) dst_stk;
Tast_iterator.default_iterator.expr iter exp; Tast_iterator.default_iterator.expr iter exp;
Stack.pop_opt dst_stk |> ignore; Stack.pop_opt dst_stk |> ignore;

View File

@ -1,4 +1,16 @@
* usage:
evaulate the following in ur ocaml toplevel (`$ ocaml`):
```
#use_output "dune ocaml top";;
Dot_of_tast.dot_of_tast "let rec fact n = if n = 0 then 1. else float n *. fact (n - 1)";;
```
run in shell to see output:
```
$ xdot x.dot
```
** current development pattern ** current development pattern