103 lines
3.4 KiB
Scheme
103 lines
3.4 KiB
Scheme
#|
|
||
Features Tree, creates graphviz-compatible files from Scheme trees.
|
||
Copyright (C) 2019 Lucien "Phundrak" Cartier-Tilet
|
||
|
||
This program is free software: you can redistribute it and/or modify
|
||
it under the terms of the GNU General Public License as published by
|
||
the Free Software Foundation, either version 3 of the License, or
|
||
(at your option) any later version.
|
||
|
||
This program is distributed in the hope that it will be useful,
|
||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
GNU General Public License for more details.
|
||
|
||
You should have received a copy of the GNU General Public License
|
||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||
|#
|
||
|
||
(define (declare-node node-text node-generation)
|
||
(string-append (number->string node-generation)
|
||
"[label=\""
|
||
node-text
|
||
"\"];"))
|
||
|
||
(define (make-link previous-node current-node)
|
||
(string-append (number->string previous-node) " -- "
|
||
(number->string current-node) ";"))
|
||
|
||
(define (tree-to-dot-helper tree current-generation previous-generation)
|
||
;; Helper to ~tree-to-dot~ that translates a Scheme tree with any number of
|
||
;; children per node to a corresponding graphviz file that can be executed from
|
||
;; dot.
|
||
;; Arguments:
|
||
;; - tree :: tree to convert
|
||
;; - current-generation :: Generation number, incremented when changing from a node
|
||
;; to another node from the same generation, multiplied by 10 when going from
|
||
;; a node to one of its children.
|
||
;; - previous-generation :: Generation number from previous named node
|
||
(cond ((null? tree) "")
|
||
((atom? (car tree)) ;; '("text" () () ())
|
||
(string-append (declare-node (car tree) current-generation)
|
||
(make-link previous-generation current-generation)
|
||
(tree-to-dot-helper (cdr tree)
|
||
(+ 1 (* 10 current-generation))
|
||
current-generation)))
|
||
((list? (car tree)) ;; '(() () () ())
|
||
(string-append (tree-to-dot-helper (car tree) ;; child of current node
|
||
current-generation
|
||
previous-generation)
|
||
(tree-to-dot-helper (cdr tree) ;; sibling of current node
|
||
(+ 1 current-generation)
|
||
previous-generation)))))
|
||
|
||
(define (tree-to-dot tree)
|
||
;; Returns a graphviz’s dot-compatible string representing a Scheme tree
|
||
(if (null? tree) ""
|
||
(string-append
|
||
"graph{node[shape=plaintext];graph[bgcolor=\"transparent\"];"
|
||
(declare-node (car tree) 0)
|
||
(tree-to-dot-helper (cdr tree) 1 0)
|
||
"}")))
|
||
|
||
(define vowels
|
||
'("[vowel]"
|
||
("[back]"
|
||
("[tense]"
|
||
("[high]" ("ü"))
|
||
("{high}" ("ö")))
|
||
("{tense}"
|
||
("[high]" ("u"))
|
||
("{high}" ("o"))))
|
||
("{back}"
|
||
("[tense]"
|
||
("[high]" ("y"))
|
||
("{high}" ("ë")))
|
||
("{tense}"
|
||
("[high]" ("i"))
|
||
("{high}" ("e"))))))
|
||
|
||
(define syntax-tree
|
||
'("S"
|
||
("Obl")
|
||
("S'"
|
||
("NPerg"
|
||
("NP"))
|
||
("VP"
|
||
("NPdat"
|
||
("NP"))
|
||
("VP'"
|
||
("NPabs"
|
||
("NP"
|
||
("S")
|
||
("NP'"
|
||
("Adj")
|
||
("N"))))
|
||
("V'"
|
||
("Mood")
|
||
("Tense")
|
||
("V")
|
||
("Neg")))))))
|
||
|
||
(display (tree-to-dot vowels))
|