Permalink
Browse files

added nesting level handling

removed heredoc for regexp again
created common condition for m4 macro invocations
added wrapper stub for macro hooks
  • Loading branch information...
1 parent c9a8a2b commit d5a8cfefbe505950eabdf70d319c43a95e5099c4 @e-user committed Jan 31, 2011
Showing with 23 additions and 13 deletions.
  1. +5 −5 src/m4-builtin.lisp
  2. +12 −5 src/m4-parser.lisp
  3. +6 −3 src/m4-util.lisp
View
@@ -116,8 +116,8 @@
"")
((and (= 1 (length args))
(m4-macro (car args) t)) ; builtin macro
- (error 'macro-defn-invocation-condition
- :macro (make-macro-token (m4-macro (car args) t) (car args))))
+ (signal 'macro-defn-invocation-condition
+ :macro (make-macro-token (m4-macro (car args) t) (car args))))
(t (macro-return
(apply #'concatenate 'string
(mapcar #'(lambda (name)
@@ -211,7 +211,7 @@
;; TODO traceon, traceoff, debugmode, debugfile
(defm4macro "dnl" () (:arguments-only nil)
- (error 'macro-dnl-invocation-condition))
+ (signal 'macro-dnl-invocation-condition))
(defm4macro "changequote" (&optional (start "`") (end "'")) (:arguments-only nil)
(prog1 ""
@@ -240,7 +240,7 @@
(read-sequence string stream)
string)))
(macro-invocation-condition (condition)
- (error condition))
+ (signal condition))
(condition ()
(format nil "cannot open `~a': Permission denied" original-arg))))))
(m4-include (path warnfn)
@@ -334,7 +334,7 @@
(macro-return (subseq string start end))
""))
(macro-invocation-condition (condition)
- (error condition))
+ (signal condition))
(condition ()
(m4-warn "non-numeric argument to builtin `substr'")
"")))
View
@@ -47,9 +47,13 @@
(defun call-m4-macro (macro macro-name args lexer)
(let ((*m4-parse-row* (lexer-row lexer))
(*m4-parse-column* (lexer-column lexer)))
- (if (not args)
- (funcall macro macro-name nil)
- (apply macro macro-name nil (split-merge args :separator)))))
+ (handler-case
+ (if (not args)
+ (funcall macro macro-name nil)
+ (apply macro macro-name nil (split-merge args :separator)))
+ (macro-condition (condition)
+ ; TODO
+ (signal condition)))))
(defun m4-out (word)
(with-m4-diversion-stream (out)
@@ -149,7 +153,9 @@
(m4-warn "end of file treated as newline"))))))))
(defun parse-m4-macro (lexer macro-name)
- (let ((macro (m4-macro macro-name)))
+ (let ((macro (m4-macro macro-name))
+ (level *m4-nesting-level*)
+ (*m4-nesting-level* (1+ *m4-nesting-level*)))
(if (not macro)
macro-name
(handler-case
@@ -202,11 +208,12 @@
(*m4-quote-end* "'")
(*m4-comment-start* "#")
(*m4-comment-end* "\\n")
- (*m4-macro-name* #>|>[_a-zA-Z]\w*|)
+ (*m4-macro-name* "[_a-zA-Z]\\w*")
(*m4-wrap-stack* (list))
(*m4-include-path* (append (reverse prepend-include-path) (list ".") include-path))
(*m4-diversion* 0)
(*m4-diversion-table* (make-m4-diversion-table output-stream))
+ (*m4-nesting-level* 0)
(lexer (make-instance 'm4-input-stream
:stream input-stream
:rules '((*m4-comment-start* . :comment-start)
View
@@ -21,13 +21,15 @@
(defstruct (macro-token (:constructor make-macro-token (m4macro name)))
m4macro name)
-(define-condition macro-invocation-condition (error)
+(define-condition macro-condition (error) ())
+
+(define-condition macro-invocation-condition (macro-condition)
((result :initarg :result
:reader macro-invocation-result)))
-(define-condition macro-dnl-invocation-condition (error) ())
+(define-condition macro-dnl-invocation-condition (macro-condition) ())
-(define-condition macro-defn-invocation-condition (error)
+(define-condition macro-defn-invocation-condition (macro-condition)
((macro :initarg :macro
:reader macro-defn-invocation-result)))
@@ -116,6 +118,7 @@ searched additionally passing ARGS."
(defvar *m4-include-path*)
(defvar *m4-diversion*)
(defvar *m4-diversion-table*)
+(defvar *m4-nesting-level*)
(defvar *m4-parse-row*)
(defvar *m4-parse-column*)

0 comments on commit d5a8cfe

Please sign in to comment.