You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
36 lines
1.4 KiB
Scheme
36 lines
1.4 KiB
Scheme
|
|
(define src "/home/mflatt/proj/mred/mzscheme/src/exnsrc.ss")
|
|
(define dest "/home/cormac/plt/mrspidey/Sba/exn-hierarchy.ss")
|
|
(when (file-exists? dest) (delete-file dest))
|
|
|
|
(with-input-from-file src
|
|
(lambda ()
|
|
(let ([x (read)])
|
|
(with-output-to-file dest
|
|
(lambda ()
|
|
(letrec
|
|
([trav
|
|
(lambda (tree parent)
|
|
(match tree
|
|
[(name fields+strings . subtrees)
|
|
(let* ( [fields (filter symbol? fields+strings)]
|
|
[s (symbol->string name)]
|
|
[name (if (memq (string-ref s 0) '(#\* #\+))
|
|
(string->symbol
|
|
(substring s 1 (string-length s)))
|
|
name)]
|
|
[name (if parent (symbol-append parent ': name) name)])
|
|
(display
|
|
`(define-struct
|
|
,(if parent
|
|
`(,name ,(symbol-append 'struct: parent))
|
|
name)
|
|
,fields))
|
|
(newline)
|
|
(for-each
|
|
(lambda (subtree) (trav subtree name))
|
|
subtrees))]
|
|
['- (void)]
|
|
[(? string?) (void)]))])
|
|
(trav x #f)))))))
|