Skip to content

Instantly share code, notes, and snippets.

@masukomi
Created June 26, 2020 21:17
Show Gist options
  • Save masukomi/8d302b9b7e03a4b46d30fb56e7afddb2 to your computer and use it in GitHub Desktop.
Save masukomi/8d302b9b7e03a4b46d30fb56e7afddb2 to your computer and use it in GitHub Desktop.
#lang sicp
; A collection of functions
; that can be added to your functions
; to have them produce graphviz dot notation
; as they're run.
;
; ;-------------
; ; Usage inside functions to be graphed
;
; (define (parent-function num)
;
; (define self (node-with-args "parent-function" (list num) #t))
; (called-node self)
; (branching-call) ; to other-function
; (let ((x (other-function num)))
; (if (> x 0)
; (begin
; (calling-self self)
; (parent-function x))
; )
;
; ))
;
; (define (other-function num)
; (define self (node-with-args "other-function" (list num) #t))
; (called-node self)
; (end-branch)
; (- num 1))
;
;
; ;---------
; ; usage outside functions to be graphed
; (start-digraph "exampleCode")
; (calling-node "main")
; (parent-function 6)
; (display-independent-lines independent-lines)
; (end-digraph)
;
; produces this graphvis "dot" data
; digraph exampleCode {
; "main"->"n1_parent-function_3"->"n2_other-function_3";
; "n1_parent-function_3"->"n3_parent-function_2"->"n4_other-function_2";
; "n3_parent-function_2"->"n5_parent-function_1"->"n6_other-function_1";
;
; }
; GENERATES this graph
; .─────.
; ( main )
; `─────'
; │
; ▼
; .───────────────────────.
; ( n1_parent-│unction_3 )
; `───────────┼───────────'
; ┌───────────────┴───────────────┐
; │ │
; ▼ ▼
; .───────────────────────. .───────────────────────.
; ( n2_other-function_3 ) ( n3_parent-function_2 )
; `───────────────────────' `───────────────────────'
; │
; ┌───────────────┴───────────────┐
; ▼ ▼
; .───────────────────────. .───────────────────────.
; ( n4_other-function_2 ) ( n5_parent-function_1 )
; `───────────────────────' `───────────────────────'
; │
; ▼
; .───────────────────────.
; ( n6_other-function_1 )
; `───────────────────────'
; digraph digraphName {
(define (start-digraph name)
(display "digraph ")
(display name)
(display " {\n"))
; }
(define (end-digraph)
(display "\n}")
)
; "node"
(define (display-node node)
(display "\"")
(display node)
(display "\""))
(define in-chain #f)
; [->] "node"
; will only prints the arrow ->
; if in a calling chain
(define (calling-node node)
(if in-chain
(display "->"))
(display-node node)
(display "->")
(set! in-chain #t)
)
; "node"
(define (called-node node)
(display-node node))
; -> | node ->
; when in a chain to self
; it is assumed that called-node
; will be displayed at the begging of self
(define (calling-self self)
(if in-chain
(display "->")
(begin
(display-node self)
(display "->")
)))
; used when you're making a call to
; another function and will be
; calling something else from this level
; prints a "->"
(define (branching-call)
(display "->"))
; used when at the end of a branch chain
; prints a semicolon and ends the
; current calling chain.
; result is that the next call
; comes from the parent node
(define (end-branch)
(set! in-chain #f)
(display ";\n"))
; creates a node name for graphviz
; Most of the time you'll want to set include-count to #t
; this causes "n<number>_" to be prepended to the node name.
; this causes it to be a unique node AND the number
; helps you to see what order things were called in.
; If you want all calls to the same function
; with the same arguments to go to the same
; node in the graph set include-count to #f
(define (node-with-args node args include-count)
(define all (append (list node) args))
(if include-count
(set! all (append (list (get-next-count)) all)))
(define (join list string)
(cond ((> (length list) 1)
(join
(cdr list)
(string-append
string
(stringify
(if (list? (car list))
(list->comma-string (car list))
(car list)))
"_")))
((= (length list) 1)
(if (list? (car list))
(string-append string (list->comma-string list))
(string-append string
(stringify (car list)))))
(else string)))
(join all ""))
(define node-counter 0)
(define independent-lines '())
(define (get-next-count)
(set! node-counter (+ node-counter 1))
(string-append "n" (number->string node-counter)))
; dashed-connection used to display connections between things
; within a function.
(define (dashed-connection node-a node-b label)
(set! independent-lines
(append independent-lines
(list
(string-append
"\""
node-a
"\"->\""
node-b
" [style=dotted"
(if (string? label)
(string-append
",label=\""
label
"\"")
"")
"];\n")))))
(define (display-independent-lines indie-lines)
(if (list? indie-lines)
(if (> (length indie-lines) 0)
(begin
(display (car indie-lines))
(display-independent-lines indie-lines)))
(display indie-lines)))
;(define (extend-chain)
; (display " -> "))
(define (end-node-chain)
(display ";\n")
(set! in-chain #f))
(define (stringify x)
(cond ((string? x) x)
((number? x) (number->string x))))
(define (list->comma-string alist)
(define (join alist string)
(cond ((> (length alist) 1)
(join
(cdr alist)
(string-append
string
(car alist)
",")))
((= (length alist) 1)
(if (list? (car alist))
(string-append string (join (car alist) ""))
(string-append string (car alist))))
(else string))
)
;(join alist "")
(if (= (length alist) 0)
"null"
(join alist ""))
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment