104 lines
3.6 KiB
Scheme
104 lines
3.6 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))
|