diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet
index 2e11891..a7f8f80 100644
--- a/books/bookvol9.pamphlet
+++ b/books/bookvol9.pamphlet
@@ -3965,12 +3965,14 @@ The READLOOP calls preparseReadLine which returns a pair of the form
(catch 'spad_reader (|doSystemCommand| (subseq line 1))))
)
(prog (($linelist linelist) $echolinestack num line i l psloc
- instring pcount comsym strsym oparsym cparsym n ncomsym
+ instring pcount comsym strsym oparsym cparsym n ncomsym tmp1
(sloc -1) continue (parenlev 0) ncomblock lines locs nums functor)
(declare (special $linelist $echolinestack |$byConstructors| $skipme
|$constructorsSeen| $preparse-last-line))
READLOOP
- (dcq (num . line) (preparseReadLine linelist))
+ (setq tmp1 (preparseReadLine linelist))
+ (setq num (car tmp1))
+ (setq line (cdr tmp1))
(unless (stringp line)
(preparse-echo linelist)
(cond
@@ -4084,129 +4086,6 @@ REREAD
(pair (nreverse nums) (parsepiles (nreverse locs) (nreverse lines)))))
(go READLOOP))))
-;(defun preparse1 (linelist)
-; (prog (($linelist linelist) $echolinestack num a i l psloc
-; instring pcount comsym strsym oparsym cparsym n ncomsym
-; (sloc -1) (continue nil) (parenlev 0) (ncomblock ())
-; (lines ()) (locs ()) (nums ()) functor)
-; (declare (special $linelist $echolinestack |$byConstructors| $skipme
-; |$constructorsSeen| $preparse-last-line))
-;READLOOP
-; (dcq (num . a) (preparseReadLine linelist))
-; (unless (stringp a)
-; (preparse-echo linelist)
-; (cond
-; ((null lines) (return nil))
-; (ncomblock (fincomblock nil nums locs ncomblock nil)))
-; (return
-; (pair (nreverse nums) (parsepiles (nreverse locs) (nreverse lines)))))
-; ; this is a command line, don't parse it
-; (when (and (null lines) (> (length a) 0) (eq (char a 0) #\) ))
-; (preparse-echo linelist)
-; (setq $preparse-last-line nil) ;don't reread this line
-; (setq line a)
-; (catch 'spad_reader (|doSystemCommand| (subseq line 1)))
-; (go READLOOP))
-; (setq l (length a))
-; ; if we get a null line, read the next line
-; (when (eq l 0) (go READLOOP))
-; ; otherwise we have to parse this line
-; (setq psloc sloc)
-; (setq i 0)
-; (setq instring nil)
-; (setq pcount 0)
-;STRLOOP ;; handle things that need ignoring, quoting, or grouping
-; ; are we in a comment, quoting, or grouping situation?
-; (setq strsym (or (position #\" a :start i ) l))
-; (setq comsym (or (search "--" a :start2 i ) l))
-; (setq ncomsym (or (search "++" a :start2 i ) l))
-; (setq oparsym (or (position #\( a :start i ) l))
-; (setq cparsym (or (position #\) a :start i ) l))
-; (setq n (min strsym comsym ncomsym oparsym cparsym))
-; (cond
-; ; nope, we found no comment, quoting, or grouping
-; ((= n l) (go NOCOMS))
-; ((escaped a n))
-; ; scan until we hit the end of the string
-; ((= n strsym) (setq instring (not instring)))
-; (instring)
-; ;; handle -- comments by ignoring them
-; ((= n comsym)
-; (setq a (subseq a 0 n))
-; (go NOCOMS)) ; discard trailing comment
-; ;; handle ++ comments by chunking them together
-; ((= n ncomsym)
-; (setq sloc (indent-pos a))
-; (cond
-; ((= sloc n)
-; (when (and ncomblock (not (= n (car ncomblock))))
-; (fincomblock num nums locs ncomblock linelist)
-; (setq ncomblock nil))
-; (setq ncomblock (cons n (cons a (ifcdr ncomblock))))
-; (setq a ""))
-; (t
-; (push (strconc (make-full-cvec n " ") (substring a n ())) $linelist)
-; (setq $index (1- $index))
-; (setq a (subseq a 0 n))))
-; (go NOCOMS))
-; ; know how deep we are into parens
-; ((= n oparsym) (setq pcount (1+ pcount)))
-; ((= n cparsym) (setq pcount (1- pcount))))
-; (setq i (1+ n))
-; (go STRLOOP)
-;NOCOMS
-; ; remember the indentation level
-; (setq sloc (indent-pos a))
-; (setq a (string-right-trim " " a))
-; (when (null sloc)
-; (setq sloc psloc)
-; (go READLOOP))
-; ; handle line that ends in a continuation character
-; (cond
-; ((eq (elt a (maxindex a)) #\_)
-; (setq continue t)
-; (setq a (subseq a (maxindex a))))
-; ((setq continue nil)))
-; ; test for skipping constructors
-; (when (and (null lines) (= sloc 0))
-; (if (and |$byConstructors|
-; (null (search "==>" a))
-; (not
-; (member
-; (setq functor
-; (intern (substring a 0 (strposl ": (=" a 0 nil))))
-; |$byConstructors|)))
-; (setq $skipme 't)
-; (progn
-; (push functor |$constructorsSeen|)
-; (setq $skipme nil))))
-; ; is this thing followed by ++ comments?
-; (when (and lines (eql sloc 0))
-; (when (and ncomblock (not (zerop (car ncomblock))))
-; (fincomblock num nums locs ncomblock linelist))
-; (when (not (is-console in-stream))
-; (setq $preparse-last-line (nreverse $echolinestack)))
-; (return
-; (pair (nreverse nums) (parsepiles (nreverse locs) (nreverse lines)))))
-; (when (> parenlev 0)
-; (push nil locs)
-; (setq sloc psloc)
-; (go REREAD))
-; (when ncomblock
-; (fincomblock num nums locs ncomblock linelist)
-; (setq ncomblock ()))
-; (push sloc locs)
-;REREAD
-; (preparse-echo linelist)
-; (push a lines)
-; (push num nums)
-; (setq parenlev (+ parenlev pcount))
-; (when (and (is-console in-stream) (not continue))
-; (setq $preparse-last-line nil)
-; (return
-; (pair (nreverse nums) (parsepiles (nreverse locs) (nreverse lines)))))
-; (go READLOOP)))
-
\end{chunk}
\defun{parsepiles}{parsepiles}
@@ -4272,8 +4151,10 @@ leave it alone."
\calls{preparseReadLine}{preparseReadLine}
\begin{chunk}{defun preparseReadLine}
(defun preparseReadLine (x)
- (let (line ind)
- (dcq (ind . line) (preparseReadLine1))
+ (let (line ind tmp1)
+ (setq tmp1 (preparseReadLine1))
+ (setq ind (car tmp1))
+ (setq line (cdr tmp1))
(cond
((not (stringp line)) (cons ind line))
((zerop (size line)) (cons ind line))
@@ -4301,8 +4182,10 @@ leave it alone."
\calls{skip-ifblock}{storeblanks}
\begin{chunk}{defun skip-ifblock}
(defun skip-ifblock (x)
- (let (line ind)
- (dcq (ind . line) (preparseReadLine1))
+ (let (line ind tmp1)
+ (setq tmp1 (preparseReadLine1))
+ (setq ind (car tmp1))
+ (setq line (cdr tmp1))
(cond
((not (stringp line))
(cons ind line))
@@ -6994,6 +6877,129 @@ $\rightarrow$
\end{chunk}
+\defun{displayMissingFunctions}{displayMissingFunctions}
+\calls{displayMissingFunctions}{member}
+\calls{displayMissingFunctions}{getmode}
+\calls{displayMissingFunctions}{sayBrightly}
+\calls{displayMissingFunctions}{bright}
+\calls{displayMissingFunctions}{formatUnabbreviatedSig}
+\usesdollar{displayMissingFunctions}{env}
+\usesdollar{displayMissingFunctions}{formalArgList}
+\usesdollar{displayMissingFunctions}{CheckVectorList}
+\begin{chunk}{defun displayMissingFunctions}
+(defun |displayMissingFunctions| ()
+ (let (i loc exp)
+ (declare (special |$env| |$formalArgList| |$CheckVectorList|))
+ (unless |$CheckVectorList|
+ (setq loc nil)
+ (setq exp nil)
+ (loop for cvl in |$CheckVectorList| do
+ (unless (cdr cvl)
+ (if (and (null (|member| (caar cvl) |$formalArgList|))
+ (pairp (|getmode| (caar cvl) |$env|))
+ (eq (qcar (|getmode| (caar cvl) |$env|)) '|Mapping|))
+ (push (list (caar cvl) (cadar cvl)) loc)
+ (push (list (caar cvl) (cadar cvl)) exp))))
+ (when loc
+ (|sayBrightly| (cons '|%l| (|bright| " Missing Local Functions:")))
+ (setq i 0)
+ (loop for item in loc do
+ (|sayBrightly|
+ (cons " [" (cons (incf i) (cons "]"
+ (append (|bright| (first item))
+ (cons '|: | (|formatUnabbreviatedSig| (second item))))))))))
+ (when exp
+ (|sayBrightly| (cons '|%l| (|bright| " Missing Exported Functions:")))
+ (setq i 0)
+ (loop for item in exp do
+ (|sayBrightly|
+ (cons " [" (cons (incf i) (cons "]"
+ (append (|bright| (first item))
+ (cons '|: | (|formatUnabbreviatedSig| (second item)))))))))))))
+
+\end{chunk}
+
+\defun{makeFunctorArgumentParameters}{makeFunctorArgumentParameters}
+\begin{chunk}{defun makeFunctorArgumentParameters}
+(defun |makeFunctorArgumentParameters| (argl sigl target)
+ (labels (
+ (augmentSig (s ss)
+ (let (u)
+ (declare (special |$ConditionalOperators|))
+ (if ss
+ (progn
+ (loop for u in ss do (push (rest u) |$ConditionalOperators|))
+ (if (and (pairp s) (eq (qcar s) '|Join|))
+ (progn
+ (if (setq u (assq 'category ss))
+ (msubst (append u ss) u s)
+ (cons '|Join|
+ (append (rest s) (list (cons 'category (cons '|package| ss)))))))
+ (list '|Join| s (cons 'category (cons '|package| ss)))))
+ s)))
+ (fn (a s)
+ (declare (special |$CategoryFrame|))
+ (if (|isCategoryForm| s |$CategoryFrame|)
+ (if (and (pairp s) (eq (qcar s) '|Join|))
+ (|genDomainViewList0| a (rest s))
+ (list (|genDomainView| a a s '|getDomainView|)))
+ (list a)))
+ (findExtras (a target)
+ (cond
+ ((and (pairp target) (eq (qcar target) '|Join|))
+ (reduce #'|union|
+ (loop for x in (qcdr target)
+ collect (findExtras a x))))
+ ((and (pairp target) (eq (qcar target) 'category))
+ (reduce #'|union|
+ (loop for x in (qcdr (qcdr target))
+ collect (findExtras1 a x))))))
+ (findExtras1 (a x)
+ (cond
+ ((and (pairp x) (or (eq (qcar x) 'and)) (eq (qcar x) 'or))
+ (reduce #'|union|
+ (loop for y in (rest x) collect (findExtras1 a y))))
+ ((and (pairp x) (eq (qcar x) 'if)
+ (pairp (qcdr x)) (pairp (qcdr (qcdr x)))
+ (pairp (qcdr (qcdr (qcdr x))))
+ (eq (qcdr (qcdr (qcdr (qcdr x)))) nil))
+ (|union| (findExtrasP a (second x))
+ (|union|
+ (findExtras1 a (third x))
+ (findExtras1 a (fourth x)))))))
+ (findExtrasP (a x)
+ (cond
+ ((and (pairp x) (or (eq (qcar x) 'and)) (eq (qcar x) 'or))
+ (reduce #'|union|
+ (loop for y in (rest x) collect (findExtrasP a y))))
+ ((and (pairp x) (eq (qcar x) '|has|)
+ (pairp (qcdr x)) (pairp (qcdr (qcdr x)))
+ (pairp (qcdr (qcdr (qcdr x))))
+ (eq (qcdr (qcdr (qcdr (qcdr x)))) nil))
+ (|union| (findExtrasP a (second x))
+ (|union|
+ (findExtras1 a (third x))
+ (findExtras1 a (fourth x)))))
+ ((and (pairp x) (eq (qcar x) '|has|)
+ (pairp (qcdr x)) (equal (qcar (qcdr x)) a)
+ (pairp (qcdr (qcdr x)))
+ (eq (qcdr (qcdr (qcdr x))) nil)
+ (pairp (qcar (qcdr (qcdr x))))
+ (eq (qcar (qcar (qcdr (qcdr x)))) 'signature))
+ (list (third x)))))
+
+ )
+ (let (|$alternateViewList| |$forceAdd| |$ConditionalOperators|)
+ (declare (special |$alternateViewList| |$forceAdd| |$ConditionalOperators|))
+ (setq |$alternateViewList| nil)
+ (setq |$forceAdd| t)
+ (setq |$ConditionalOperators| nil)
+ (mapcar #'reduce
+ (loop for a in argl for s in sigl do
+ (fn a (augmentSig s (findExtras a target))))))))
+
+\end{chunk}
+
\section{Indirect called comp routines}
In the {\bf compExpression} function there is the code:
\begin{verbatim}
@@ -13337,8 +13343,10 @@ Return a pointer to the Nth cons of X, counting 0 as the first cons.
\calls{skip-to-endif}{skip-to-endif}
\begin{chunk}{defun skip-to-endif}
(defun skip-to-endif (x)
- (let (line ind)
- (dcq (ind . line) (preparseReadLine1))
+ (let (line ind tmp1)
+ (setq tmp1 (preparseReadLine1))
+ (setq ind (car tmp1))
+ (setq line (cdr tmp1))
(cond
((not (stringp line)) (cons ind line))
((initial-substring line ")endif") (preparseReadLine x))
@@ -16208,6 +16216,7 @@ if \verb|$InteractiveMode| then use a null outputstream
\getchunk{defun def-rename}
\getchunk{defun def-rename1}
\getchunk{defun disallowNilAttribute}
+\getchunk{defun displayMissingFunctions}
\getchunk{defun displayPreCompilationErrors}
\getchunk{defun dollarTran}
\getchunk{defun drop}
@@ -16257,6 +16266,7 @@ if \verb|$InteractiveMode| then use a null outputstream
\getchunk{defun macroExpandInPlace}
\getchunk{defun macroExpandList}
\getchunk{defun makeCategoryPredicates}
+\getchunk{defun makeFunctorArgumentParameters}
\getchunk{defun makeSimplePredicateOrNil}
\getchunk{defun make-string-adjustable}
\getchunk{defun make-symbol-of}
diff --git a/changelog b/changelog
index 38bf18b..cf2b1d5 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,6 @@
+20110530 tpd src/axiom-website/patches.html 20110530.01.tpd.patch
+20110530 tpd src/interp/define.lisp treeshake compiler
+20110530 tpd books/bookvol9 treeshake compiler
20110528 tpd src/axiom-website/patches.html 20110528.01.tpd.patch
20110528 tpd src/interp/define.lisp treeshake compiler
20110528 tpd books/bookvol9 treeshake compiler
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index 11cb988..ed3a2d4 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -3516,5 +3516,7 @@ Makefile.pamphlet VERSION = May 2011
src/axiom-website/download.html add ubuntu
20110528.01.tpd.patch
books/bookvol9 treeshake compiler
+20110530.01.tpd.patch
+books/bookvol9 treeshake compiler