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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
|
#! @GUILEINTERP@ \
-e main -s
!#
;;; Copyright (C) 2001, 2005 by Patrick Bernaud. All rights reserved
;;; See file COPYRIGHT for more information.
;;; This scripts is supposed to do the same things as notangle do.
;;; Its purpose it to avoid the need of a complete noweb installation
;;; to simply get the sources from a noweb file, provided the user
;;; has a Guile interpreter.
(use-modules (ice-9 getopt-long)
(ice-9 regex))
(debug-enable 'backtrace)
(define noweb-rootname "*")
(define noweb-filename #f)
(define code-chunks '())
(define def-regexp (make-regexp "^\<\<(.*)\>\>="))
(define ref-regexp (make-regexp "\<\<([^>]*)\>\>"))
(define end-regexp (make-regexp "^@\ ?"))
(define (tangle-step1)
;; reads and returns a code chunk
(define (read-code-chunk)
(let loop ((line (read-line (current-input-port) 'concat)))
(if (not (eof-object? line))
;; code chunk ends at line that match end-regexp (^@\ ?)
(if (regexp-exec end-regexp line)
;; reached end of chunk
'()
;; end not yet reached, continues the analyze
(append (list line)
(loop (read-line (current-input-port) 'concat)))))))
;; identifies code chunk and adds them to the association table
(let loop ((line ""))
(if (not (eof-object? line))
(begin
(and=> (regexp-exec def-regexp line)
(lambda (m)
(add-code-chunk (match:substring m 1) (read-code-chunk))))
(loop (read-line))))))
(define (tangle-step2)
;; search in the association table for a code chunk named name
;; and output its content recursively, looking for embedded references
(define (output-code-chunk name offset)
(let ((code (assoc-ref code-chunks name))
(first #t))
;; check there actually exists a code chunk with this name
(if code
;; yes, go on and process each line of the code chunk
(for-each
(lambda (line)
;; the offset must not be printed when it is the first line
;; of a code chunk
(if (not first) (display offset) (set! first #f))
;; search for one (or more) chunk reference in the current line
(let loop ((l line))
(cond ((regexp-exec ref-regexp l)
;; found a reference in the line, process it
=> (lambda (m)
(display (match:prefix m))
(output-code-chunk (match:substring m 1)
(string-append offset
(make-string
(match:start m)
#\space)))
(loop (match:suffix m))))
(else
;; no reference found, output the full line
(display l)))))
code)
(error (format #f "undefined chunk name: \<\<~a\>\>~%" name)))))
;; check there is a code chunk with name rootname
(if (assoc-ref code-chunks noweb-rootname)
;; ok, start tangling from rootname and null offset
(output-code-chunk noweb-rootname "")
(error (format #f "The root module \<\<~a\>\> was not defined.~%"
noweb-rootname))))
(define (tangle-noweb)
;; first reads the file and collect the code chunks
(tangle-step1)
;; then assemble them
(tangle-step2))
(define (add-code-chunk name code)
;; the last newline char of a code chunk must be removed
(let ((last (1- (length code))))
(if (>= last 0)
(list-set! code last (remove-newline (list-ref code last)))))
;; add a new entry for name to the association list code-chunks
;; or complete an entry if it already exists
(set! code-chunks
(assoc-set! code-chunks name
(let ((code-prev (assoc-ref code-chunks name)))
;; check if chunk is already defined
(if code-prev
;; yes, append new code
(append code-prev (list "\n") code)
;; otherwise, only associate name with code
code)))))
(define (remove-newline str)
(cond ((string-null? str) str)
((char=? (string-ref str (1- (string-length str))) #\newline)
(substring str 0 (1- (string-length str))))
(else str)))
(define option-spec
'((rootname (required? #f) (single-char #\R) (value #t))
(help (required? #f) (single-char #\h))
(version (required? #f) (single-char #\v))
))
(define (display-usage)
(display "Usage: notangle_guile [options...] [file]\n")
(display " --help, -h Show this usage information\n")
(display " --version, -v Show version information\n")
(display " --rootname=value, -Rvalue Set root code chunk name to value\n")
(exit))
(define (display-version)
(display "notangle_guile 20050224\n")
(exit))
(define (main args)
;; processing command line
(let* ((opts (getopt-long args option-spec))
(help-wanted (option-ref opts 'help #f))
(version-wanted (option-ref opts 'version #f))
(rootname (option-ref opts 'rootname #f))
(filename (option-ref opts '() #f)))
;; display version if -v flag
(if version-wanted (display-version))
;; display usage if -h flag
(if help-wanted (display-usage))
;; if a filename is given, filename is a string
;; else, filename is set to #f
(if (not (null? filename))
(if (file-exists? (car filename))
(set! noweb-filename (car filename))
(error (format #f "couldn't find file ~a~%" (car filename)))))
;; if rootname is given, rootname is a string
;; else, rootname is set to #f
(if (string? rootname)
(set! noweb-rootname rootname)))
;; start tangling
(if (string? noweb-filename)
;; work on a file
(with-input-from-file noweb-filename
tangle-noweb)
;; no file specified, work on current input port
(tangle-noweb)))
|
