dot.ml 2.92 KB
Newer Older
Aliaume Lopez's avatar
Aliaume Lopez committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32
(******
 *
 * Module pour la sortie en DOT 
 *
 * Aliaume Lopez 
 *
 * Crée le : Mar 14 jui 2016 09:59:21 BST
 *
 *)

open Utils;;

(* 
 * TODO
 *
 * UTILISER UN STRINGBUILDER plutôt que de la concaténation stupide ... 
 *
 *)

module SM = Map.Make (String);;

type dot      = string;;
type node_mod = string SM.t;;
type uid      = int;;


(* 
 * Crée les morceaux nécessaires à mettre au début 
 * et à la fin d'une description de circuit 
 *
 *)
let addPrelude   = 
Aliaume Lopez's avatar
Aliaume Lopez committed
33
    let debut = String.concat "\n" ["digraph G {"; "graph [rankdir=LR];"; "edge [arrowtail=none];\n"] in 
Aliaume Lopez's avatar
Aliaume Lopez committed
34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
    let fin   = "}" in 
    surround debut fin;;



(* Un compteur pour construire des uid de manière unique *)
let count = ref 0;;
let uid () = incr count; !count;; 


(*
 * Permet de construire les arguments à partir 
 * de modificateurs
 *
 *)
let renderMods m = m
    |> SM.bindings
    |> List.map (fun (x,y) -> x ^ "=" ^ y)
    |> String.concat ",";;

Aliaume Lopez's avatar
Aliaume Lopez committed
54 55 56 57 58 59
let mod_shape x     = SM.add "shape" x;;
let mod_color x     = SM.add "color" x;;
let mod_label x     = SM.add "label" ("\"" ^ x ^ "\"");;
let mod_style x     = SM.add "style" (surround "\"" "\"" x);;
let mod_width x     = SM.add "width" (string_of_float x);;
let mod_height x    = SM.add "height" (string_of_float x);;
60
let mod_fixedsize x = SM.add "fixedsize" ("\"" ^ (string_of_bool x) ^ "\"");;
Aliaume Lopez's avatar
Aliaume Lopez committed
61 62

(* 
Aliaume Lopez's avatar
Aliaume Lopez committed
63 64 65 66
 * Making a node id 
 *
 * Note : ports starts from 0 but they are displayed 
 * starting from 1, thus the (i+1) in the code 
Aliaume Lopez's avatar
Aliaume Lopez committed
67 68 69 70 71 72 73
 *
 *)
let mkLabel id port io = 
    match port with
        | None   -> "N" ^ string_of_int id 
        | Some i -> "N" ^ string_of_int id ^ ":" ^ io ^ string_of_int i;;

Aliaume Lopez's avatar
Aliaume Lopez committed
74 75
let mkNode nid mods = 
    "N" ^ string_of_int nid ^ " [" ^ renderMods mods ^ "]\n";;
Aliaume Lopez's avatar
Aliaume Lopez committed
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93

let emptyMod = SM.empty;;
let baseMod  = SM.singleton "shape" "record";;

(* Génère le label pour un noeud avec des entrées sorties *)
let inputsOutputs label n m =
    let inLabels   = List.map string_of_int (range n) in
    let outLabels  = List.map string_of_int (range m) in 
    let generate   = surround "\"{" "}\"" in 
    let lbls l nom = l 
                  |> List.map (fun id -> surround "<" ">" (nom ^ id) ^ id )
                  |> String.concat "|"
    in
    let labelFinal = surround "{" "}|" (lbls inLabels "in") ^ label ^ surround "|{" "}" (lbls outLabels "out")
                  |> generate 
    in 
    SM.add "label" labelFinal;;

Aliaume Lopez's avatar
Aliaume Lopez committed
94 95 96 97 98 99 100 101 102 103
(* 
 * Make a link between two nodes 
 *
 * i1 : first node 
 * i2 : second node 
 * x  : optionnal port (maybe int)
 * y  : optionnal port (maybe int)
 *
 *)
let mkLink  = fun i1 x i2 y -> 
Aliaume Lopez's avatar
Aliaume Lopez committed
104 105
    mkLabel i1 x "out" ^ " -> " ^ mkLabel i2 y "in" ^ "\n";;

Aliaume Lopez's avatar
Aliaume Lopez committed
106
(**
Aliaume Lopez's avatar
Aliaume Lopez committed
107 108 109
 *
 * syntax : {rank=min; ... } / {rank=max;  ... } 
 *
Aliaume Lopez's avatar
Aliaume Lopez committed
110
 *)
Aliaume Lopez's avatar
Aliaume Lopez committed
111 112
let rank_group rg l = 
    let s = surround ("{rank=" ^ rg ^ ";") "}\n" in
Aliaume Lopez's avatar
Aliaume Lopez committed
113 114
    l |> List.map (fun id -> mkLabel id None "") |> String.concat " " |> s;; 

Aliaume Lopez's avatar
Aliaume Lopez committed
115 116 117
let addDot  = (^);; 
let addDots = List.fold_left addDot "";;

Aliaume Lopez's avatar
Aliaume Lopez committed
118

119 120 121 122 123 124 125 126


(***** 
 *
 * TESTS UNITAIRES
 *
 ******)
let tests = [ ];;