From 5b63a63d37dfd004e28104cd66a845c59c048a77 Mon Sep 17 00:00:00 2001 From: Tim Daly Date: Tue, 19 May 2015 15:51:45 -0400 Subject: [PATCH] src/interp/c-doc.lisp merge c-doc functions, removed The functions are all in bookvol9 (compiler). This file was merged and removed. --- changelog | 2 + patch | 5 +- src/axiom-website/patches.html | 2 + src/interp/c-doc.lisp.pamphlet | 1845 ---------------------------------------- 4 files changed, 7 insertions(+), 1847 deletions(-) delete mode 100644 src/interp/c-doc.lisp.pamphlet diff --git a/changelog b/changelog index 214643d..94398d1 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ +20150519 tpd src/axiom-website/patches.html 20150519.05.tpd.patch +20150519 tpd src/interp/c-doc.lisp merge c-doc functions, removed 20150519 tpd src/axiom-website/patches.html 20150519.04.tpd.patch 20150519 tpd books/bookvol5 rewrite character handling functions 20150519 tpd books/bookvol9 rewrite character handling functions diff --git a/patch b/patch index 8ca1fb2..eb9263f 100644 --- a/patch +++ b/patch @@ -1,3 +1,4 @@ -src/interp/vmlisp.lisp rewrite character handling functions +src/interp/c-doc.lisp merge c-doc functions, removed -Use common lisp native forms. +The functions are all in bookvol9 (compiler). +This file was merged and removed. diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 3f0c3b3..2438308 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -5070,6 +5070,8 @@ Makefile clean up dangling files
src/interp/vmlisp.lisp remove define-macro
20150519.04.tpd.patch src/interp/vmlisp.lisp rewrite character handling functions
+20150519.05.tpd.patch +src/interp/c-doc.lisp merge c-doc functions, removed
diff --git a/src/interp/c-doc.lisp.pamphlet b/src/interp/c-doc.lisp.pamphlet deleted file mode 100644 index c3b33bd..0000000 --- a/src/interp/c-doc.lisp.pamphlet +++ /dev/null @@ -1,1845 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp c-doc.lisp} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\begin{chunk}{*} - -(IN-PACKAGE "BOOT" ) - -;getDoc(conName,op,modemap) == -; [dc,target,sl,pred,D] := simplifyModemap modemap -; sig := [target,:sl] -; null atom dc => -; sig := SUBST('$,dc,sig) -; sig := SUBLISLIS($FormalMapVariableList,rest dc,sig) -; getDocForDomain(conName,op,sig) -; if argList := IFCDR getOfCategoryArgument pred then -; SUBLISLIS($FormalMapArgumentList,argList,sig) -; sig := SUBST('$,dc,sig) -; getDocForCategory(conName,op,sig) - -;(DEFUN |getDoc| (|conName| |op| |modemap|) -; (PROG (|LETTMP#1| |dc| |target| |sl| |pred| D |argList| |sig|) -; (declare (special |$FormalMapArgumentList|)) -; (RETURN -; (PROGN -; (setq |LETTMP#1| (|simplifyModemap| |modemap|)) -; (setq |dc| (CAR |LETTMP#1|)) -; (setq |target| (CADR |LETTMP#1|)) -; (setq |sl| (CADDR |LETTMP#1|)) -; (setq |pred| (CADDDR |LETTMP#1|)) -; (setq D (CAR (CDDDDR |LETTMP#1|))) -; (setq |sig| (CONS |target| |sl|)) -; (COND -; ((NULL (ATOM |dc|)) (setq |sig| (MSUBST '$ |dc| |sig|)) -; (setq |sig| -; (SUBLISLIS |$FormalMapVariableList| (CDR |dc|) -; |sig|)) -; (|getDocForDomain| |conName| |op| |sig|)) -; ('T -; (COND -; ((setq |argList| -; (IFCDR (|getOfCategoryArgument| |pred|))) -; (SUBLISLIS |$FormalMapArgumentList| |argList| |sig|))) -; (setq |sig| (MSUBST '$ |dc| |sig|)) -; (|getDocForCategory| |conName| |op| |sig|))))))) - -;getOfCategoryArgument pred == -; pred is [fn,:.] and MEMQ(fn,'(AND OR NOT)) => -; or/[getOfCategoryArgument x for x in rest pred] -; pred is ['ofCategory,'_*1,form] => form -; nil - -;(DEFUN |getOfCategoryArgument| (|pred|) -; (PROG (|fn| |ISTMP#1| |ISTMP#2| |form|) -; (RETURN -; (SEQ (COND -; ((AND (CONSP |pred|) -; (PROGN (setq |fn| (QCAR |pred|)) 'T) -; (member |fn| '(AND OR NOT))) -; (PROG (G166100) -; (setq G166100 NIL) -; (RETURN -; (DO ((G166106 NIL G166100) -; (G166107 (CDR |pred|) (CDR G166107)) -; (|x| NIL)) -; ((OR G166106 (ATOM G166107) -; (PROGN (SETQ |x| (CAR G166107)) NIL)) -; G166100) -; (SEQ (EXIT (SETQ G166100 -; (OR G166100 -; (|getOfCategoryArgument| |x|))))))))) -; ((AND (CONSP |pred|) (EQ (QCAR |pred|) '|ofCategory|) -; (PROGN -; (setq |ISTMP#1| (QCDR |pred|)) -; (AND (CONSP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) '*1) -; (PROGN -; (setq |ISTMP#2| (QCDR |ISTMP#1|)) -; (AND (CONSP |ISTMP#2|) -; (EQ (QCDR |ISTMP#2|) NIL) -; (PROGN -; (setq |form| (QCAR |ISTMP#2|)) -; 'T)))))) -; |form|) -; ('T NIL)))))) - -;getDocForCategory(name,op,sig) == -; getOpDoc(constructor? name,op,sig) or -; or/[getOpDoc(constructor? x,op,sig) for x in whatCatCategories name] - -;(DEFUN |getDocForCategory| (|name| |op| |sig|) -; (PROG () -; (RETURN -; (SEQ (OR (|getOpDoc| (|constructor?| |name|) |op| |sig|) -; (PROG (G166122) -; (setq G166122 NIL) -; (RETURN -; (DO ((G166128 NIL G166122) -; (G166129 (|whatCatCategories| |name|) -; (CDR G166129)) -; (|x| NIL)) -; ((OR G166128 (ATOM G166129) -; (PROGN (SETQ |x| (CAR G166129)) NIL)) -; G166122) -; (SEQ (EXIT (SETQ G166122 -; (OR G166122 -; (|getOpDoc| (|constructor?| |x|) -; |op| |sig|))))))))))))) - -;getDocForDomain(name,op,sig) == -; getOpDoc(constructor? name,op,sig) or -; or/[getOpDoc(constructor? x,op,sig) for x in whatCatExtDom name] - -;(DEFUN |getDocForDomain| (|name| |op| |sig|) -; (PROG () -; (RETURN -; (SEQ (OR (|getOpDoc| (|constructor?| |name|) |op| |sig|) -; (PROG (G166140) -; (setq G166140 NIL) -; (RETURN -; (DO ((G166146 NIL G166140) -; (G166147 (|whatCatExtDom| |name|) -; (CDR G166147)) -; (|x| NIL)) -; ((OR G166146 (ATOM G166147) -; (PROGN (SETQ |x| (CAR G166147)) NIL)) -; G166140) -; (SEQ (EXIT (SETQ G166140 -; (OR G166140 -; (|getOpDoc| (|constructor?| |x|) -; |op| |sig|))))))))))))) - -;getOpDoc(abb,op,:sigPart) == -; u := LASSOC(op,GETDATABASE(abb,'DOCUMENTATION)) -; $argList : local := $FormalMapVariableList -; _$: local := '_$ -; sigPart is [sig] => or/[d for [s,:d] in u | sig = s] -; u - -;(DEFUN |getOpDoc| (&REST G166194 &AUX |sigPart| |op| |abb|) -; (DSETQ (|abb| |op| . |sigPart|) G166194) -; (PROG (|$argList| $ |u| |sig| |s| |d|) -; (DECLARE (SPECIAL |$argList| $ |$FormalMapVariableList|)) -; (RETURN -; (SEQ (PROGN -; (setq |u| -; (LASSOC |op| (GETDATABASE |abb| 'DOCUMENTATION))) -; (setq |$argList| |$FormalMapVariableList|) -; (setq $ '$) -; (COND -; ((AND (CONSP |sigPart|) (EQ (QCDR |sigPart|) NIL) -; (PROGN (setq |sig| (QCAR |sigPart|)) 'T)) -; (PROG (G166163) -; (setq G166163 NIL) -; (RETURN -; (DO ((G166171 NIL G166163) -; (G166172 |u| (CDR G166172)) -; (G166158 NIL)) -; ((OR G166171 (ATOM G166172) -; (PROGN -; (SETQ G166158 (CAR G166172)) -; NIL) -; (PROGN -; (PROGN -; (setq |s| (CAR G166158)) -; (setq |d| (CDR G166158)) -; G166158) -; NIL)) -; G166163) -; (SEQ (EXIT (COND -; ((BOOT-EQUAL |sig| |s|) -; (SETQ G166163 (OR G166163 |d|)))))))))) -; ('T |u|))))))) - -;readForDoc fn == -; $bootStrapMode: local:= true -; _/RQ_-LIB_-1 [fn,'SPAD] - -;(DEFUN |readForDoc| (|fn|) -; (PROG (|$bootStrapMode|) -; (DECLARE (SPECIAL |$bootStrapMode|)) -; (RETURN -; (PROGN -; (setq |$bootStrapMode| 'T) -; (/RQ-LIB-1 (CONS |fn| (CONS 'SPAD NIL))))))) - -;--======================================================================= -;-- Transformation of ++ comments -;--======================================================================= -;checkExtractItemList l == --items are separated by commas or end of line -; acc := nil --l is list of remaining lines -; while l repeat --stop when you get to a line with a colon -; m := MAXINDEX first l -; k := charPosition(char '_:,first l,0) -; k <= m => return nil -; acc := [first l,:acc] -; l := rest l -; "STRCONC"/[x for x in NREVERSE acc] - -(DEFUN |checkExtractItemList| (|l|) - (PROG (|m| |k| |acc|) - (RETURN - (SEQ (PROGN - (setq |acc| NIL) - (DO () ((NULL |l|) NIL) - (SEQ (EXIT (PROGN - (setq |m| (MAXINDEX (CAR |l|))) - (setq |k| - (|charPosition| (|char| '|:|) - (CAR |l|) 0)) - (COND - ((<= |k| |m|) (RETURN NIL)) - ('T - (setq |acc| (CONS (CAR |l|) |acc|)) - (setq |l| (CDR |l|)))))))) - (PROG (G166663) - (setq G166663 "") - (RETURN - (DO ((G166668 (NREVERSE |acc|) (CDR G166668)) - (|x| NIL)) - ((OR (ATOM G166668) - (PROGN (SETQ |x| (CAR G166668)) NIL)) - G166663) - (SEQ (EXIT (SETQ G166663 (STRCONC G166663 |x|)))))))))))) - -;removeBackslashes s == -; s = '"" => '"" -; (k := charPosition($charBack,s,0)) < #s => -; k = 0 => removeBackslashes SUBSTRING(s,1,nil) -; STRCONC(SUBSTRING(s,0,k),removeBackslashes SUBSTRING(s,k + 1,nil)) -; s - -(DEFUN |removeBackslashes| (|s|) - (PROG (|k|) - (declare (special |$charBack|)) - (RETURN - (COND - ((BOOT-EQUAL |s| "") "") - ((> (|#| |s|) (setq |k| (|charPosition| |$charBack| |s| 0))) - (COND - ((EQL |k| 0) (|removeBackslashes| (SUBSTRING |s| 1 NIL))) - ('T - (STRCONC (SUBSTRING |s| 0 |k|) - (|removeBackslashes| - (SUBSTRING |s| (+ |k| 1) NIL)))))) - ('T |s|))))) - -;checkNumOfArgs conform == -; conname := opOf conform -; constructor? conname or (conname := abbreviation? conname) => -; #GETDATABASE(conname,'CONSTRUCTORARGS) -; nil --signals error - -(DEFUN |checkNumOfArgs| (|conform|) - (PROG (|conname|) - (RETURN - (PROGN - (setq |conname| (|opOf| |conform|)) - (COND - ((OR (|constructor?| |conname|) - (setq |conname| (|abbreviation?| |conname|))) - (|#| (GETDATABASE |conname| 'CONSTRUCTORARGS))) - ('T NIL)))))) - -;checkIsValidType form == main where -;--returns ok if correct, form is wrong number of arguments, nil if unknown -; main == -; atom form => 'ok -; [op,:args] := form -; conname := (constructor? op => op; abbreviation? op) -; null conname => nil -; fn(form,GETDATABASE(conname,'COSIG)) -; fn(form,coSig) == -; #form ^= #coSig => form -; or/[null checkIsValidType x for x in rest form for flag in rest coSig | flag] -; => nil -; 'ok - -(DEFUN |checkIsValidType,fn| (|form| |coSig|) - (PROG () - (RETURN - (SEQ (IF (NEQUAL (|#| |form|) (|#| |coSig|)) (EXIT |form|)) - (IF (PROG (G166927) - (setq G166927 NIL) - (RETURN - (DO ((G166935 NIL G166927) - (G166936 (CDR |form|) (CDR G166936)) - (|x| NIL) - (G166937 (CDR |coSig|) (CDR G166937)) - (|flag| NIL)) - ((OR G166935 (ATOM G166936) - (PROGN (SETQ |x| (CAR G166936)) NIL) - (ATOM G166937) - (PROGN (SETQ |flag| (CAR G166937)) NIL)) - G166927) - (SEQ (EXIT (COND - (|flag| (SETQ G166927 - (OR G166927 - (NULL - (|checkIsValidType| |x|))))))))))) - (EXIT NIL)) - (EXIT '|ok|))))) - -(DEFUN |checkIsValidType| (|form|) - (PROG (|op| |args| |conname|) - (RETURN - (COND - ((ATOM |form|) '|ok|) - ('T (setq |op| (CAR |form|)) (setq |args| (CDR |form|)) - (setq |conname| - (COND - ((|constructor?| |op|) |op|) - ('T (|abbreviation?| |op|)))) - (COND - ((NULL |conname|) NIL) - ('T - (|checkIsValidType,fn| |form| - (GETDATABASE |conname| 'COSIG))))))))) - -;checkGetLispFunctionName s == -; n := #s -; (k := charPosition(char '_|,s,1)) and k < n and -; (j := charPosition(char '_|,s,k + 1)) and j < n => SUBSTRING(s,k + 1,j-k-1) -; checkDocError ['"Ill-formed lisp expression : ",s] -; 'illformed - -(DEFUN |checkGetLispFunctionName| (|s|) - (PROG (|n| |k| |j|) - (RETURN - (PROGN - (setq |n| (|#| |s|)) - (COND - ((AND (setq |k| (|charPosition| (|char| '|\||) |s| 1)) - (> |n| |k|) - (setq |j| - (|charPosition| (|char| '|\||) |s| - (+ |k| 1))) - (> |n| |j|)) - (SUBSTRING |s| (+ |k| 1) - (- (- |j| |k|) 1))) - ('T - (|checkDocError| - (CONS "Ill-formed lisp expression : " - (CONS |s| NIL))) - '|illformed|)))))) - -;checkGetStringBeforeRightBrace u == -; acc := nil -; while u repeat -; x := first u -; x = $charRbrace => return "STRCONC"/(NREVERSE acc) -; acc := [x,:acc] -; u := rest u - -(DEFUN |checkGetStringBeforeRightBrace| (|u|) - (PROG (|x| |acc|) - (declare (special |$charRbrace|)) - (RETURN - (SEQ (PROGN - (setq |acc| NIL) - (DO () ((NULL |u|) NIL) - (SEQ (EXIT (PROGN - (setq |x| (CAR |u|)) - (COND - ((BOOT-EQUAL |x| |$charRbrace|) - (RETURN - (PROG (G166979) - (setq G166979 "") - (RETURN - (DO - ((G166984 (NREVERSE |acc|) - (CDR G166984)) - (G166968 NIL)) - ((OR (ATOM G166984) - (PROGN - (SETQ G166968 - (CAR G166984)) - NIL)) - G166979) - (SEQ - (EXIT - (SETQ G166979 - (STRCONC G166979 G166968))))))))) - ('T (setq |acc| (CONS |x| |acc|)) - (setq |u| (CDR |u|))))))))))))) - -;-- checkTranVerbatim u == -;-- acc := nil -;-- while u repeat -;-- x := first u -;-- x = '"\begin" and checkTranVerbatimMiddle u is [middle,:r] => -;-- acc := [$charRbrace,:middle,$charLbrace,'"\spadpaste",:acc] -;-- u := r -;-- if x = '"\spadcommand" then x := '"\spadpaste" -;-- acc := [x,:acc] -;-- u := rest u -;-- NREVERSE acc -;-- -;-- checkTranVerbatimMiddle u == -;-- (y := IFCAR (v := IFCDR u)) = $charLbrace and -;-- (y := IFCAR (v := IFCDR v)) = '"verbatim" and -;-- (y := IFCAR (v := IFCDR v)) = $charRbrace => -;-- w := IFCDR v -;-- middle := nil -;-- while w and (z := first w) ^= '"\end" repeat -;-- middle := [z,:middle] -;-- w := rest w -;-- if (y := IFCAR (w := IFCDR w)) = $charLbrace and -;-- (y := IFCAR (w := IFCDR w)) = '"verbatim" and -;-- (y := IFCAR (w := IFCDR w)) = $charRbrace then -;-- u := IFCDR w -;-- else -;-- checkDocError '"Missing \end{verbatim}" -;-- u := w -;-- [middle,:u] -;-- -;-- checkTranVerbatim1 u == -;-- acc := nil -;-- while u repeat -;-- x := first u -;-- x = '"\begin" and (y := IFCAR (v := IFCDR u)) = $charLbrace and -;-- (y := IFCAR (v := IFCDR v)) = '"verbatim" and -;-- (y := IFCAR (v := IFCDR v)) = $charRbrace => -;-- w := IFCDR v -;-- middle := nil -;-- while w and (z := first w) ^= '"\end" repeat -;-- middle := [z,:middle] -;-- w := rest w -;-- if (y := IFCAR (w := IFCDR w)) = $charLbrace and -;-- (y := IFCAR (w := IFCDR w)) = '"verbatim" and -;-- (y := IFCAR (w := IFCDR w)) = $charRbrace then -;-- u := IFCDR w -;-- acc := [$charRbrace,:middle,$charLbrace,'"\spadpaste",:acc] -;-- if x = '"\spadcommand" then x := '"\spadpaste" -;-- acc := [x,:acc] -;-- u := rest u -;-- NREVERSE acc -;appendOver [head,:tail] == -; acc := LASTNODE head -; for x in tail repeat -; end := LASTNODE x -; RPLACD(acc,x) -; acc := end -; head - -(DEFUN |appendOver| (G167000) - (PROG (|head| |tail| |end| |acc|) - (RETURN - (SEQ (PROGN - (setq |head| (CAR G167000)) - (setq |tail| (CDR G167000)) - (setq |acc| (LASTNODE |head|)) - (DO ((G167015 |tail| (CDR G167015)) (|x| NIL)) - ((OR (ATOM G167015) - (PROGN (SETQ |x| (CAR G167015)) NIL)) - NIL) - (SEQ (EXIT (PROGN - (setq |end| (LASTNODE |x|)) - (RPLACD |acc| |x|) - (setq |acc| |end|))))) - |head|))))) - -;checkRemoveComments lines == -; while lines repeat -; do -; line := checkTrimCommented first lines -; if firstNonBlankPosition line >= 0 then acc := [line,:acc] -; lines := rest lines -; NREVERSE acc - -(DEFUN |checkRemoveComments| (|lines|) - (PROG (|line| |acc|) - (RETURN - (SEQ (PROGN - (DO () ((NULL |lines|) NIL) - (SEQ (EXIT (PROGN - (|do| (PROGN - (setq |line| - (|checkTrimCommented| - (CAR |lines|))) - (COND - ((>= - (|firstNonBlankPosition| - |line|) - 0) - (setq |acc| - (CONS |line| |acc|))) - ('T NIL)))) - (setq |lines| (CDR |lines|)))))) - (NREVERSE |acc|)))))) - -;checkTrimCommented line == -; n := #line -; k := htcharPosition(char '_%,line,0) -; --line beginning with % is a comment -; k = 0 => '"" -; --remarks beginning with %% are comments -; k >= n - 1 or line.(k + 1) ^= char '_% => line -; k < #line => SUBSTRING(line,0,k) -; line - -(DEFUN |checkTrimCommented| (|line|) - (PROG (|n| |k|) - (RETURN - (PROGN - (setq |n| (|#| |line|)) - (setq |k| (|htcharPosition| (|char| '%) |line| 0)) - (COND - ((EQL |k| 0) "") - ((OR (>= |k| (- |n| 1)) - (NEQUAL (ELT |line| (+ |k| 1)) (|char| '%))) - |line|) - ((> (|#| |line|) |k|) (SUBSTRING |line| 0 |k|)) - ('T |line|)))))) - -;htcharPosition(char,line,i) == -; m := #line -; k := charPosition(char,line,i) -; k = m => k -; k > 0 => -; line.(k - 1) ^= $charBack => k -; htcharPosition(char,line,k + 1) -; 0 - -(DEFUN |htcharPosition| (|char| |line| |i|) - (PROG (|m| |k|) - (declare (special |$charBack|)) - (RETURN - (PROGN - (setq |m| (|#| |line|)) - (setq |k| (|charPosition| |char| |line| |i|)) - (COND - ((BOOT-EQUAL |k| |m|) |k|) - ((> |k| 0) - (COND - ((NEQUAL (ELT |line| (- |k| 1)) |$charBack|) - |k|) - ('T (|htcharPosition| |char| |line| (+ |k| 1))))) - ('T 0)))))) - -;checkAddMacros u == -; acc := nil -; verbatim := false -; while u repeat -; x := first u -; acc := -; x = '"\end{verbatim}" => -; verbatim := false -; [x, :acc] -; verbatim => [x, :acc] -; x = '"\begin{verbatim}" => -; verbatim := true -; [x, :acc] -; y := LASSOC(x,$HTmacs) => [:y,:acc] -; [x,:acc] -; u := rest u -; NREVERSE acc - -(DEFUN |checkAddMacros| (|u|) - (PROG (|x| |verbatim| |y| |acc|) - (declare (special |$HTmacs|)) - (RETURN - (SEQ (PROGN - (setq |acc| NIL) - (setq |verbatim| NIL) - (DO () ((NULL |u|) NIL) - (SEQ (EXIT (PROGN - (setq |x| (CAR |u|)) - (setq |acc| - (COND - ((BOOT-EQUAL |x| - "\\end{verbatim}") - (setq |verbatim| NIL) - (CONS |x| |acc|)) - (|verbatim| (CONS |x| |acc|)) - ((BOOT-EQUAL |x| - "\\begin{verbatim}") - (setq |verbatim| 'T) - (CONS |x| |acc|)) - ((setq |y| - (LASSOC |x| |$HTmacs|)) - (APPEND |y| |acc|)) - ('T (CONS |x| |acc|)))) - (setq |u| (CDR |u|)))))) - (NREVERSE |acc|)))))) - -;checkIndentedLines(u, margin) == -; verbatim := false -; u2 := nil -; for x in u repeat -; k := firstNonBlankPosition x -; k = -1 => -; verbatim => u2 := [:u2, $charFauxNewline] -; u2 := [:u2, '"\blankline "] -; s := SUBSTRING(x, k, nil) -; s = '"\begin{verbatim}" => -; verbatim := true -; u2 := [:u2, s] -; s = '"\end{verbatim}" => -; verbatim := false -; u2 := [:u2, s] -; verbatim => u2 := [:u2, SUBSTRING(x, margin, nil)] -; margin = k => u2 := [:u2, s] -; u2 := [:u2, STRCONC('"\indented{",princ-to-string(k-margin),'"}{",checkAddSpaceSegments(s,0),'"}")] -; u2 - -(DEFUN |checkIndentedLines| (|u| |margin|) - (PROG (|k| |s| |verbatim| |u2|) - (declare (special |$charFauxNewline|)) - (RETURN - (SEQ (PROGN - (setq |verbatim| NIL) - (setq |u2| NIL) - (DO ((G167153 |u| (CDR G167153)) (|x| NIL)) - ((OR (ATOM G167153) - (PROGN (SETQ |x| (CAR G167153)) NIL)) - NIL) - (SEQ (EXIT (PROGN - (setq |k| (|firstNonBlankPosition| |x|)) - (COND - ((BOOT-EQUAL |k| (- 1)) - (COND - (|verbatim| - (setq |u2| - (APPEND |u2| - (CONS |$charFauxNewline| NIL)))) - ('T - (setq |u2| - (APPEND |u2| - (CONS - "\\blankline " - NIL)))))) - ('T (setq |s| (SUBSTRING |x| |k| NIL)) - (COND - ((BOOT-EQUAL |s| - "\\begin{verbatim}") - (setq |verbatim| 'T) - (setq |u2| - (APPEND |u2| (CONS |s| NIL)))) - ((BOOT-EQUAL |s| - "\\end{verbatim}") - (setq |verbatim| NIL) - (setq |u2| - (APPEND |u2| (CONS |s| NIL)))) - (|verbatim| - (setq |u2| - (APPEND |u2| - (CONS - (SUBSTRING |x| |margin| NIL) - NIL)))) - ((BOOT-EQUAL |margin| |k|) - (setq |u2| - (APPEND |u2| (CONS |s| NIL)))) - ('T - (setq |u2| - (APPEND |u2| - (CONS - (STRCONC - "\\indented{" - (princ-to-string - (- |k| - |margin|)) - "}{" - (|checkAddSpaceSegments| - |s| 0) - "}") - NIL))))))))))) - |u2|))))) - -;newString2Words l == -; not STRINGP l => [l] -; m := MAXINDEX l -; m = -1 => NIL -; i := 0 -; [w while newWordFrom(l,i,m) is [w,i]] - -(DEFUN |newString2Words| (|l|) - (PROG (|m| |ISTMP#1| |w| |ISTMP#2| |i|) - (RETURN - (SEQ (COND - ((NULL (STRINGP |l|)) (CONS |l| NIL)) - ('T (setq |m| (MAXINDEX |l|)) - (COND - ((BOOT-EQUAL |m| (- 1)) NIL) - ('T (setq |i| 0) - (PROG (G167196) - (setq G167196 NIL) - (RETURN - (DO () - ((NULL (PROGN - (setq |ISTMP#1| - (|newWordFrom| |l| |i| |m|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (setq |w| (QCAR |ISTMP#1|)) - (setq |ISTMP#2| - (QCDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (setq |i| - (QCAR |ISTMP#2|)) - 'T)))))) - (NREVERSE0 G167196)) - (SEQ (EXIT (SETQ G167196 (CONS |w| G167196))))))))))))))) - -;newWordFrom(l,i,m) == -; while i <= m and l.i = " " repeat i := i + 1 -; i > m => NIL -; buf := '"" -; ch := l.i -; ch = $charFauxNewline => [$stringFauxNewline, i+ 1] -; done := false -; while i <= m and not done repeat -; ch := l.i -; ch = $charBlank or ch = $charFauxNewline => done := true -; buf := STRCONC(buf,ch) -; i := i + 1 -; [buf,i] - -(DEFUN |newWordFrom| (|l| |i| |m|) - (PROG (|ch| |done| |buf|) - (declare (special |$charFauxNewline| |$charBlank| |$stringFauxNewline|)) - (RETURN - (SEQ (PROGN - (DO () - ((NULL (AND (<= |i| |m|) - (BOOT-EQUAL (ELT |l| |i|) '| |))) - NIL) - (SEQ (EXIT (setq |i| (+ |i| 1))))) - (COND - ((> |i| |m|) NIL) - ('T (setq |buf| "") - (setq |ch| (ELT |l| |i|)) - (COND - ((BOOT-EQUAL |ch| |$charFauxNewline|) - (CONS |$stringFauxNewline| (CONS (+ |i| 1) NIL))) - ('T (setq |done| NIL) - (DO () ((NULL (AND (<= |i| |m|) (NULL |done|))) NIL) - (SEQ (EXIT (PROGN - (setq |ch| (ELT |l| |i|)) - (COND - ((OR (BOOT-EQUAL |ch| |$charBlank|) - (BOOT-EQUAL |ch| - |$charFauxNewline|)) - (setq |done| 'T)) - ('T - (setq |buf| - (STRCONC |buf| |ch|)) - (setq |i| (+ |i| 1)))))))) - (CONS |buf| (CONS |i| NIL))))))))))) - -;checkGetArgs u == -; NOT STRINGP u => nil -; m := MAXINDEX u -; k := firstNonBlankPosition(u) -; k > 0 => checkGetArgs SUBSTRING(u,k,nil) -; stringPrefix?('"\spad{",u) => -; k := getMatchingRightPren(u,6,char '_{,char '_}) or m -; checkGetArgs SUBSTRING(u,6,k-6) -; (i := charPosition(char '_(,u,0)) > m => nil -; (u . m) ^= char '_) => nil -; while (k := charPosition($charComma,u,i + 1)) < m repeat -; acc := [trimString SUBSTRING(u,i + 1,k - i - 1),:acc] -; i := k -; NREVERSE [SUBSTRING(u,i + 1,m - i - 1),:acc] - -(DEFUN |checkGetArgs| (|u|) - (PROG (|m| |k| |acc| |i|) - (declare (special |$charComma|)) - (RETURN - (SEQ (COND - ((NULL (STRINGP |u|)) NIL) - ('T (setq |m| (MAXINDEX |u|)) - (setq |k| (|firstNonBlankPosition| |u|)) - (COND - ((> |k| 0) (|checkGetArgs| (SUBSTRING |u| |k| NIL))) - ((|stringPrefix?| "\\spad{" |u|) - (setq |k| - (OR (|getMatchingRightPren| |u| 6 (|char| '{) - (|char| '})) - |m|)) - (|checkGetArgs| - (SUBSTRING |u| 6 (- |k| 6)))) - ((> (setq |i| (|charPosition| (|char| '|(|) |u| 0)) - |m|) - NIL) - ((NEQUAL (ELT |u| |m|) (|char| '|)|)) NIL) - ('T - (DO () - ((NULL (> |m| - (setq |k| - (|charPosition| |$charComma| - |u| (+ |i| 1))))) - NIL) - (SEQ (EXIT (PROGN - (setq |acc| - (CONS - (|trimString| - (SUBSTRING |u| (+ |i| 1) - (- - (- |k| |i|) - 1))) - |acc|)) - (setq |i| |k|))))) - (NREVERSE - (CONS (SUBSTRING |u| (+ |i| 1) - (- (- |m| |i|) - 1)) - |acc|)))))))))) - -;checkAddIndented(x,margin) == -; k := firstNonBlankPosition x -; k = -1 => '"\blankline " -; margin = k => x -; STRCONC('"\indented{",princ-to-string(k-margin),'"}{",checkAddSpaceSegments(SUBSTRING(x,k,nil),0),'"}") - -(DEFUN |checkAddIndented| (|x| |margin|) - (PROG (|k|) - (RETURN - (PROGN - (setq |k| (|firstNonBlankPosition| |x|)) - (COND - ((BOOT-EQUAL |k| (- 1)) - "\\blankline ") - ((BOOT-EQUAL |margin| |k|) |x|) - ('T - (STRCONC "\\indented{" - (princ-to-string (- |k| |margin|)) - "}{" - (|checkAddSpaceSegments| (SUBSTRING |x| |k| NIL) 0) - "}"))))))) - -;checkAddSpaceSegments(u,k) == -; m := MAXINDEX u -; i := charPosition($charBlank,u,k) -; m < i => u -; j := i -; while (j := j + 1) < m and u.j = (char '_ ) repeat 'continue -; n := j - i --number of blanks -; n > 1 => STRCONC(SUBSTRING(u,0,i),'"\space{", -; princ-to-string n,'"}",checkAddSpaceSegments(SUBSTRING(u,i + n,nil),0)) -; checkAddSpaceSegments(u,j) - -(DEFUN |checkAddSpaceSegments| (|u| |k|) - (PROG (|m| |i| |j| |n|) - (declare (special |$charBlank|)) - (RETURN - (SEQ (PROGN - (setq |m| (MAXINDEX |u|)) - (setq |i| (|charPosition| |$charBlank| |u| |k|)) - (COND - ((> |i| |m|) |u|) - ('T (setq |j| |i|) - (DO () - ((NULL (AND (> |m| (setq |j| (+ |j| 1))) - (BOOT-EQUAL (ELT |u| |j|) - (|char| '| |)))) - NIL) - (SEQ (EXIT '|continue|))) - (setq |n| (- |j| |i|)) - (COND - ((> |n| 1) - (STRCONC (SUBSTRING |u| 0 |i|) - "\\space{" (princ-to-string |n|) - "}" - (|checkAddSpaceSegments| - (SUBSTRING |u| (+ |i| |n|) NIL) 0))) - ('T (|checkAddSpaceSegments| |u| |j|)))))))))) - -;checkTrim($x,lines) == main where -; main == -; s := [wherePP first lines] -; for x in rest lines repeat -; j := wherePP x -; if not MEMQ(j,s) then -; checkDocError [$x,'" has varying indentation levels"] -; s := [j,:s] -; [trim y for y in lines] -; wherePP(u) == -; k := charPosition($charPlus,u,0) -; k = #u or charPosition($charPlus,u,k + 1) ^= k + 1 => -; systemError '" Improper comment found" -; k -; trim(s) == -; k := wherePP(s) -; return SUBSTRING(s,k + 2,nil) -; m := MAXINDEX s -; n := k + 2 -; for j in (k + 2)..m while s.j = $charBlank repeat (n := n + 1) -; SUBSTRING(s,n,nil) - -(DEFUN |checkTrim,trim| (|s|) - (PROG (|k| |m| |n|) - (declare (special |$charBlank|)) - (RETURN - (SEQ (setq |k| (|checkTrim,wherePP| |s|)) - (RETURN (SUBSTRING |s| (+ |k| 2) NIL)) - (setq |m| (MAXINDEX |s|)) (setq |n| (+ |k| 2)) - (DO ((|j| (+ |k| 2) (+ |j| 1))) - ((OR (> |j| |m|) - (NULL (BOOT-EQUAL (ELT |s| |j|) |$charBlank|))) - NIL) - (SEQ (EXIT (setq |n| (+ |n| 1))))) - (EXIT (SUBSTRING |s| |n| NIL)))))) - -(DEFUN |checkTrim,wherePP| (|u|) - (PROG (|k|) - (declare (special |$charPlus|)) - (RETURN - (SEQ (setq |k| (|charPosition| |$charPlus| |u| 0)) - (IF (OR (BOOT-EQUAL |k| (|#| |u|)) - (NEQUAL (|charPosition| |$charPlus| |u| - (+ |k| 1)) - (+ |k| 1))) - (EXIT (|systemError| - " Improper comment found"))) - (EXIT |k|))))) - -(DEFUN |checkTrim| (|$x| |lines|) - (DECLARE (SPECIAL |$x|)) - (PROG (|j| |s|) - (RETURN - (SEQ (PROGN - (setq |s| - (CONS (|checkTrim,wherePP| (CAR |lines|)) NIL)) - (DO ((G167356 (CDR |lines|) (CDR G167356)) (|x| NIL)) - ((OR (ATOM G167356) - (PROGN (SETQ |x| (CAR G167356)) NIL)) - NIL) - (SEQ (EXIT (PROGN - (setq |j| (|checkTrim,wherePP| |x|)) - (COND - ((NULL (member |j| |s|)) - (|checkDocError| - (CONS |$x| - (CONS - " has varying indentation levels" - NIL))) - (setq |s| (CONS |j| |s|))) - ('T NIL)))))) - (PROG (G167366) - (setq G167366 NIL) - (RETURN - (DO ((G167371 |lines| (CDR G167371)) (|y| NIL)) - ((OR (ATOM G167371) - (PROGN (SETQ |y| (CAR G167371)) NIL)) - (NREVERSE0 G167366)) - (SEQ (EXIT (SETQ G167366 - (CONS (|checkTrim,trim| |y|) - G167366)))))))))))) - -;checkExtract(header,lines) == -; while lines repeat -; line := first lines -; k := firstNonBlankPosition line --k gives margin of Description: -; substring?(header,line,k) => return nil -; lines := rest lines -; null lines => nil -; u := first lines -; j := charPosition(char '_:,u,k) -; margin := k -; firstLines := -; (k := firstNonBlankPosition(u,j + 1)) ^= -1 => -; [SUBSTRING(u,j + 1,nil),:rest lines] -; rest lines -; --now look for another header; if found skip all rest of these lines -; acc := nil -; for line in firstLines repeat -; do -; m := #line -; (k := firstNonBlankPosition line) = -1 => 'skip --include if blank -; k > margin => 'skip --include if idented -; not UPPER_-CASE_-P line.k => 'skip --also if not upcased -; (j := charPosition(char '_:,line,k)) = m => 'skip --or if not colon, or -; (i := charPosition(char '_ ,line,k+1)) < j => 'skip --blank before colon -; return nil -; acc := [line,:acc] -; NREVERSE acc - -(DEFUN |checkExtract| (|header| |lines|) - (PROG (|line| |u| |margin| |firstLines| |m| |k| |j| |i| |acc|) - (RETURN - (SEQ (PROGN - (DO () ((NULL |lines|) NIL) - (SEQ (EXIT (PROGN - (setq |line| (CAR |lines|)) - (setq |k| - (|firstNonBlankPosition| |line|)) - (COND - ((|substring?| |header| |line| |k|) - (RETURN NIL)) - ('T (setq |lines| (CDR |lines|)))))))) - (COND - ((NULL |lines|) NIL) - ('T (setq |u| (CAR |lines|)) - (setq |j| (|charPosition| (|char| '|:|) |u| |k|)) - (setq |margin| |k|) - (setq |firstLines| - (COND - ((NEQUAL (setq |k| - (|firstNonBlankPosition| |u| - (+ |j| 1))) - (- 1)) - (CONS (SUBSTRING |u| (+ |j| 1) NIL) - (CDR |lines|))) - ('T (CDR |lines|)))) - (setq |acc| NIL) - (DO ((G167406 |firstLines| (CDR G167406)) - (|line| NIL)) - ((OR (ATOM G167406) - (PROGN (SETQ |line| (CAR G167406)) NIL)) - NIL) - (SEQ (EXIT (PROGN - (|do| (PROGN - (setq |m| (|#| |line|)) - (COND - ((BOOT-EQUAL - (setq |k| - (|firstNonBlankPosition| - |line|)) - (- 1)) - '|skip|) - ((> |k| |margin|) '|skip|) - ((NULL - (UPPER-CASE-P - (ELT |line| |k|))) - '|skip|) - ((BOOT-EQUAL - (setq |j| - (|charPosition| - (|char| '|:|) |line| |k|)) - |m|) - '|skip|) - ((> |j| - (setq |i| - (|charPosition| - (|char| '| |) |line| - (+ |k| 1)))) - '|skip|) - ('T (RETURN NIL))))) - (setq |acc| (CONS |line| |acc|)))))) - (NREVERSE |acc|)))))))) - -;checkFixCommonProblem u == -; acc := nil -; while u repeat -; x := first u -; x = $charLbrace and MEMBER(next := IFCAR rest u,$HTspadmacros) and -; (IFCAR IFCDR rest u ^= $charLbrace) => -; checkDocError ['"Reversing ",next,'" and left brace"] -; acc := [$charLbrace,next,:acc] --reverse order of brace and command -; u := rest rest u -; acc := [x,:acc] -; u := rest u -; NREVERSE acc - -(DEFUN |checkFixCommonProblem| (|u|) - (PROG (|x| |next| |acc|) - (declare (special |$charLbrace| |$HTspadmacros|)) - (RETURN - (SEQ (PROGN - (setq |acc| NIL) - (DO () ((NULL |u|) NIL) - (SEQ (EXIT (PROGN - (setq |x| (CAR |u|)) - (COND - ((AND (BOOT-EQUAL |x| |$charLbrace|) - (|member| - (setq |next| (IFCAR (CDR |u|))) - |$HTspadmacros|) - (NEQUAL (IFCAR (IFCDR (CDR |u|))) - |$charLbrace|)) - (|checkDocError| - (CONS "Reversing " - (CONS |next| - (CONS - " and left brace" - NIL)))) - (setq |acc| - (CONS |$charLbrace| - (CONS |next| |acc|))) - (setq |u| (CDR (CDR |u|)))) - ('T (setq |acc| (CONS |x| |acc|)) - (setq |u| (CDR |u|)))))))) - (NREVERSE |acc|)))))) - -;checkDecorate u == -; count := 0 -; spadflag := false --means OK to wrap single letter words with \s{} -; mathSymbolsOk := false -; acc := nil -; verbatim := false -; while u repeat -; x := first u -; if not verbatim then -; if x = '"\em" then -; if count > 0 then -; mathSymbolsOk := count - 1 -; spadflag := count - 1 -; else checkDocError ['"\em must be enclosed in braces"] -; if MEMBER(x,'("\spadpaste" "\spad" "\spadop")) then mathSymbolsOk := count -; if MEMBER(x,'("\s" "\spadtype" "\spadsys" "\example" "\andexample" "\spadop" "\spad" "\spadignore" "\spadpaste" "\spadcommand" "\footnote")) then spadflag := count -; else if x = $charLbrace then -; count := count + 1 -; else if x = $charRbrace then -; count := count - 1 -; if mathSymbolsOk = count then mathSymbolsOk := false -; if spadflag = count then spadflag := false -; else if not mathSymbolsOk and MEMBER(x,'("+" "*" "=" "==" "->")) then -; if $checkingXmptex? then -; checkDocError ["Symbol ",x,'" appearing outside \spad{}"] -; acc := -; x = '"\end{verbatim}" => -; verbatim := false -; [x, :acc] -; verbatim => [x, :acc] -; x = '"\begin{verbatim}" => -; verbatim := true -; [x, :acc] -; x = '"\begin" and first (v := IFCDR u) = $charLbrace and -; first (v := IFCDR v) = '"detail" and first (v := IFCDR v) = $charRbrace -; => -; u := v -; ['"\blankline ",:acc] -; x = '"\end" and first (v := IFCDR u) = $charLbrace and -; first (v := IFCDR v) = '"detail" and first (v := IFCDR v) = $charRbrace -; => -; u := v -; acc -; x = char '_$ or x = '"$" => ['"\$",:acc] -; x = char '_% or x = '"%" => ['"\%",:acc] -; x = char '_, or x = '"," => ['",{}",:acc] -; x = '"\spad" => ['"\spad",:acc] -; STRINGP x and DIGITP x.0 => [x,:acc] -; null spadflag and -; (CHARP x and ALPHA_-CHAR_-P x and not MEMQ(x,$charExclusions) or -; MEMBER(x,$argl)) => [$charRbrace,x,$charLbrace,'"\spad",:acc] -; null spadflag and ((STRINGP x and not x.0 = $charBack and DIGITP(x.(MAXINDEX x))) or MEMBER(x,'("true" "false"))) => -; [$charRbrace,x,$charLbrace,'"\spad",:acc] --wrap x1, alpha3, etc -; xcount := #x -; xcount = 3 and x.1 = char 't and x.2 = char 'h => -; ['"th",$charRbrace,x.0,$charLbrace,'"\spad",:acc] -; xcount = 4 and x.1 = char '_- and x.2 = char 't and x.3 = char 'h => -; ['"-th",$charRbrace,x.0,$charLbrace,'"\spad",:acc] -; xcount = 2 and x.1 = char 'i or --wrap ei, xi, hi -; null spadflag and xcount > 0 and xcount < 4 and not MEMBER(x,'("th" "rd" "st")) and -; hasNoVowels x => --wrap words with no vowels -; [$charRbrace,x,$charLbrace,'"\spad",:acc] -; [checkAddBackSlashes x,:acc] -; u := rest u -; NREVERSE acc - -(DEFUN |checkDecorate| (|u|) - (PROG (|x| |count| |mathSymbolsOk| |spadflag| |verbatim| |v| |xcount| |acc|) - (declare (special |$charLbrace| |$charRbrace| |$charBack| |$argl| - |$charExclusions| |$checkingXmptex?|)) - (RETURN - (SEQ (PROGN - (setq |count| 0) - (setq |spadflag| NIL) - (setq |mathSymbolsOk| NIL) - (setq |acc| NIL) - (setq |verbatim| NIL) - (DO () ((NULL |u|) NIL) - (SEQ (EXIT (PROGN - (setq |x| (CAR |u|)) - (COND - ((NULL |verbatim|) - (COND - ((BOOT-EQUAL |x| "\\em") - (COND - ((> |count| 0) - (setq |mathSymbolsOk| - (- |count| 1)) - (setq |spadflag| - (- |count| 1))) - ('T - (|checkDocError| - (CONS - "\\em must be enclosed in braces" - NIL)))))) - (COND - ((|member| |x| - '("\\spadpaste" "\\spad" - "\\spadop")) - (setq |mathSymbolsOk| |count|))) - (COND - ((|member| |x| - '("\\s" "\\spadtype" "\\spadsys" - "\\example" "\\andexample" - "\\spadop" "\\spad" - "\\spadignore" "\\spadpaste" - "\\spadcommand" "\\footnote")) - (setq |spadflag| |count|)) - ((BOOT-EQUAL |x| |$charLbrace|) - (setq |count| (+ |count| 1))) - ((BOOT-EQUAL |x| |$charRbrace|) - (setq |count| - (- |count| 1)) - (COND - ((BOOT-EQUAL |mathSymbolsOk| - |count|) - (setq |mathSymbolsOk| NIL))) - (COND - ((BOOT-EQUAL |spadflag| |count|) - (setq |spadflag| NIL)) - ('T NIL))) - ((AND (NULL |mathSymbolsOk|) - (|member| |x| - '("+" "*" "=" "==" "->"))) - (COND - (|$checkingXmptex?| - (|checkDocError| - (CONS '|Symbol | - (CONS |x| - (CONS - " appearing outside \\spad{}" - NIL))))) - ('T NIL))) - ('T NIL)))) - (setq |acc| - (COND - ((BOOT-EQUAL |x| - "\\end{verbatim}") - (setq |verbatim| NIL) - (CONS |x| |acc|)) - (|verbatim| (CONS |x| |acc|)) - ((BOOT-EQUAL |x| - "\\begin{verbatim}") - (setq |verbatim| 'T) - (CONS |x| |acc|)) - ((AND - (BOOT-EQUAL |x| - "\\begin") - (BOOT-EQUAL - (CAR - (setq |v| (IFCDR |u|))) - |$charLbrace|) - (BOOT-EQUAL - (CAR - (setq |v| (IFCDR |v|))) - "detail") - (BOOT-EQUAL - (CAR - (setq |v| (IFCDR |v|))) - |$charRbrace|)) - (setq |u| |v|) - (CONS - "\\blankline " - |acc|)) - ((AND - (BOOT-EQUAL |x| - "\\end") - (BOOT-EQUAL - (CAR - (setq |v| (IFCDR |u|))) - |$charLbrace|) - (BOOT-EQUAL - (CAR - (setq |v| (IFCDR |v|))) - "detail") - (BOOT-EQUAL - (CAR - (setq |v| (IFCDR |v|))) - |$charRbrace|)) - (setq |u| |v|) |acc|) - ((OR - (BOOT-EQUAL |x| (|char| '$)) - (BOOT-EQUAL |x| - "$")) - (CONS "\\$" |acc|)) - ((OR - (BOOT-EQUAL |x| (|char| '%)) - (BOOT-EQUAL |x| - "%")) - (CONS "\\%" |acc|)) - ((OR - (BOOT-EQUAL |x| (|char| '|,|)) - (BOOT-EQUAL |x| - ",")) - (CONS ",{}" |acc|)) - ((BOOT-EQUAL |x| - "\\spad") - (CONS "\\spad" - |acc|)) - ((AND (STRINGP |x|) - (DIGITP (ELT |x| 0))) - (CONS |x| |acc|)) - ((AND (NULL |spadflag|) - (OR - (AND (CHARP |x|) - (ALPHA-CHAR-P |x|) - (NULL - (member |x| - |$charExclusions|))) - (|member| |x| |$argl|))) - (CONS |$charRbrace| - (CONS |x| - (CONS |$charLbrace| - (CONS "\\spad" - |acc|))))) - ((AND (NULL |spadflag|) - (OR - (AND (STRINGP |x|) - (NULL - (BOOT-EQUAL (ELT |x| 0) - |$charBack|)) - (DIGITP - (ELT |x| (MAXINDEX |x|)))) - (|member| |x| - '("true" "false")))) - (CONS |$charRbrace| - (CONS |x| - (CONS |$charLbrace| - (CONS "\\spad" - |acc|))))) - ('T (setq |xcount| (|#| |x|)) - (COND - ((AND (EQL |xcount| 3) - (BOOT-EQUAL (ELT |x| 1) - (|char| '|t|)) - (BOOT-EQUAL (ELT |x| 2) - (|char| '|h|))) - (CONS "th" - (CONS |$charRbrace| - (CONS (ELT |x| 0) - (CONS |$charLbrace| - (CONS - "\\spad" - |acc|)))))) - ((AND (EQL |xcount| 4) - (BOOT-EQUAL (ELT |x| 1) - (|char| '-)) - (BOOT-EQUAL (ELT |x| 2) - (|char| '|t|)) - (BOOT-EQUAL (ELT |x| 3) - (|char| '|h|))) - (CONS "-th" - (CONS |$charRbrace| - (CONS (ELT |x| 0) - (CONS |$charLbrace| - (CONS - "\\spad" - |acc|)))))) - ((OR - (AND (EQL |xcount| 2) - (BOOT-EQUAL (ELT |x| 1) - (|char| '|i|))) - (AND (NULL |spadflag|) - (> |xcount| 0) - (> 4 |xcount|) - (NULL - (|member| |x| - '("th" "rd" "st"))) - (|hasNoVowels| |x|))) - (CONS |$charRbrace| - (CONS |x| - (CONS |$charLbrace| - (CONS - "\\spad" - |acc|))))) - ('T - (CONS - (|checkAddBackSlashes| |x|) - |acc|)))))) - (setq |u| (CDR |u|)))))) - (NREVERSE |acc|)))))) - -;hasNoVowels x == -; max := MAXINDEX x -; x.max = char 'y => false -; and/[not isVowel(x.i) for i in 0..max] - -(DEFUN |hasNoVowels| (|x|) - (PROG (|max|) - (RETURN - (SEQ (PROGN - (setq |max| (MAXINDEX |x|)) - (COND - ((BOOT-EQUAL (ELT |x| |max|) (|char| '|y|)) NIL) - ('T - (PROG (G167501) - (setq G167501 'T) - (RETURN - (DO ((G167507 NIL (NULL G167501)) - (|i| 0 (QSADD1 |i|))) - ((OR G167507 (QSGREATERP |i| |max|)) - G167501) - (SEQ (EXIT (SETQ G167501 - (AND G167501 - (NULL - (|isVowel| (ELT |x| |i|))))))))))))))))) - -;isVowel c == -; EQ(c,char 'a) or EQ(c,char 'e) or EQ(c,char 'i) or EQ(c,char 'o) or EQ(c,char 'u) or -; EQ(c,char 'A) or EQ(c,char 'E) or EQ(c,char 'I) or EQ(c,char 'O) or EQ(c,char 'U) - -(DEFUN |isVowel| (|c|) - (OR (EQ |c| (|char| '|a|)) (EQ |c| (|char| '|e|)) - (EQ |c| (|char| '|i|)) (EQ |c| (|char| '|o|)) - (EQ |c| (|char| '|u|)) (EQ |c| (|char| 'A)) (EQ |c| (|char| 'E)) - (EQ |c| (|char| 'I)) (EQ |c| (|char| 'O)) (EQ |c| (|char| 'U)))) - -;checkAddBackSlashes s == -; (CHARP s and (c := s)) or (#s = 1 and (c := s.0)) => -; MEMQ(s,$charEscapeList) => STRCONC($charBack,c) -; s -; k := 0 -; m := MAXINDEX s -; insertIndex := nil -; while k <= m repeat -; do -; char := s.k -; char = $charBack => k := k + 2 -; MEMQ(char,$charEscapeList) => return (insertIndex := k) -; k := k + 1 -; insertIndex => checkAddBackSlashes STRCONC(SUBSTRING(s,0,insertIndex),$charBack,s.k,SUBSTRING(s,insertIndex + 1,nil)) -; s - -(DEFUN |checkAddBackSlashes| (|s|) - (PROG (|c| |m| |char| |insertIndex| |k|) - (declare (special |$charBack| |$charEscapeList|)) - (RETURN - (SEQ (COND - ((OR (AND (CHARP |s|) (setq |c| |s|)) - (AND (EQL (|#| |s|) 1) (setq |c| (ELT |s| 0)))) - (COND - ((member |s| |$charEscapeList|) - (STRCONC |$charBack| |c|)) - ('T |s|))) - ('T (setq |k| 0) (setq |m| (MAXINDEX |s|)) - (setq |insertIndex| NIL) - (DO () ((NULL (<= |k| |m|)) NIL) - (SEQ (EXIT (PROGN - (|do| (PROGN - (setq |char| (ELT |s| |k|)) - (COND - ((BOOT-EQUAL |char| |$charBack|) - (setq |k| (+ |k| 2))) - ((member |char| |$charEscapeList|) - (RETURN - (setq |insertIndex| |k|)))))) - (setq |k| (+ |k| 1)))))) - (COND - (|insertIndex| - (|checkAddBackSlashes| - (STRCONC (SUBSTRING |s| 0 |insertIndex|) - |$charBack| (ELT |s| |k|) - (SUBSTRING |s| (+ |insertIndex| 1) - NIL)))) - ('T |s|)))))))) - -;checkAddSpaces u == -; null u => nil -; null rest u => u -; space := $charBlank -; u2 := nil -; for i in 1.. for f in u repeat -; -- want newlines before and after begin/end verbatim and between lines -; -- since this might be written to a file, we can't really use -; -- newline characters. The Browser and HD will do the translation -; -- later. -; if f = '"\begin{verbatim}" then -; space := $charFauxNewline -; if null u2 then u2 := [space] -; if i > 1 then u2 := [:u2, space, f] -; else u2 := [:u2, f] -; if f = '"\end{verbatim}" then -; u2 := [:u2, space] -; space := $charBlank -; u2 - -(DEFUN |checkAddSpaces| (|u|) - (PROG (|u2| |space|) - (declare (special |$charBlank| |$charFauxNewline|)) - (RETURN - (SEQ (COND - ((NULL |u|) NIL) - ((NULL (CDR |u|)) |u|) - ('T (setq |space| |$charBlank|) (setq |u2| NIL) - (DO ((|i| 1 (QSADD1 |i|)) (G167557 |u| (CDR G167557)) - (|f| NIL)) - ((OR (ATOM G167557) - (PROGN (SETQ |f| (CAR G167557)) NIL)) - NIL) - (SEQ (EXIT (PROGN - (COND - ((BOOT-EQUAL |f| - "\\begin{verbatim}") - (setq |space| |$charFauxNewline|) - (COND - ((NULL |u2|) - (setq |u2| (CONS |space| NIL))) - ('T NIL)))) - (COND - ((> |i| 1) - (setq |u2| - (APPEND |u2| - (CONS |space| (CONS |f| NIL))))) - ('T - (setq |u2| - (APPEND |u2| (CONS |f| NIL))))) - (COND - ((BOOT-EQUAL |f| - "\\end{verbatim}") - (setq |u2| - (APPEND |u2| - (CONS |space| NIL))) - (setq |space| |$charBlank|)) - ('T NIL)))))) - |u2|)))))) - -;checkSplitBrace x == -; CHARP x => [x] -; #x = 1 => [x.0] -; (u := checkSplitBackslash x) -; and rest u => "append"/[checkSplitBrace y for y in u] -; m := MAXINDEX x -; (u := checkSplitOn x) -; and rest u => "append"/[checkSplitBrace y for y in u] -; (u := checkSplitPunctuation x) -; and rest u => "append"/[checkSplitBrace y for y in u] -; [x] - -(DEFUN |checkSplitBrace| (|x|) - (PROG (|m| |u|) - (RETURN - (SEQ (COND - ((CHARP |x|) (CONS |x| NIL)) - ((EQL (|#| |x|) 1) (CONS (ELT |x| 0) NIL)) - ((AND (setq |u| (|checkSplitBackslash| |x|)) (CDR |u|)) - (PROG (G167644) - (setq G167644 NIL) - (RETURN - (DO ((G167649 |u| (CDR G167649)) (|y| NIL)) - ((OR (ATOM G167649) - (PROGN (SETQ |y| (CAR G167649)) NIL)) - G167644) - (SEQ (EXIT (SETQ G167644 - (APPEND G167644 - (|checkSplitBrace| |y|))))))))) - ('T (setq |m| (MAXINDEX |x|)) - (COND - ((AND (setq |u| (|checkSplitOn| |x|)) (CDR |u|)) - (PROG (G167655) - (setq G167655 NIL) - (RETURN - (DO ((G167660 |u| (CDR G167660)) (|y| NIL)) - ((OR (ATOM G167660) - (PROGN (SETQ |y| (CAR G167660)) NIL)) - G167655) - (SEQ (EXIT (SETQ G167655 - (APPEND G167655 - (|checkSplitBrace| |y|))))))))) - ((AND (setq |u| (|checkSplitPunctuation| |x|)) - (CDR |u|)) - (PROG (G167666) - (setq G167666 NIL) - (RETURN - (DO ((G167671 |u| (CDR G167671)) (|y| NIL)) - ((OR (ATOM G167671) - (PROGN (SETQ |y| (CAR G167671)) NIL)) - G167666) - (SEQ (EXIT (SETQ G167666 - (APPEND G167666 - (|checkSplitBrace| |y|))))))))) - ('T (CONS |x| NIL))))))))) - -;checkSplitBackslash x == -; not STRINGP x => [x] -; m := MAXINDEX x -; (k := charPosition($charBack,x,0)) < m => -; m = 1 or ALPHA_-CHAR_-P(x . (k + 1)) => --starts with a backslash so.. -; (k := charPosition($charBack,x,1)) < m => --..see if there is another -; [SUBSTRING(x,0,k),:checkSplitBackslash SUBSTRING(x,k,nil)] -- yup -; [x] --no, just return line -; k = 0 => --starts with backspace but x.1 is not a letter; break it up -; [SUBSTRING(x,0,2),:checkSplitBackslash SUBSTRING(x,2,nil)] -; u := SUBSTRING(x,0,k) -; v := SUBSTRING(x,k,2) -; k + 1 = m => [u,v] -; [u,v,:checkSplitBackslash SUBSTRING(x,k + 2,nil)] -; [x] - -(DEFUN |checkSplitBackslash| (|x|) - (PROG (|m| |k| |u| |v|) - (declare (special |$charBack|)) - (RETURN - (COND - ((NULL (STRINGP |x|)) (CONS |x| NIL)) - ('T (setq |m| (MAXINDEX |x|)) - (COND - ((> |m| (setq |k| (|charPosition| |$charBack| |x| 0))) - (COND - ((OR (EQL |m| 1) (ALPHA-CHAR-P (ELT |x| (+ |k| 1)))) - (COND - ((> |m| - (setq |k| (|charPosition| |$charBack| |x| 1))) - (CONS (SUBSTRING |x| 0 |k|) - (|checkSplitBackslash| (SUBSTRING |x| |k| NIL)))) - ('T (CONS |x| NIL)))) - ((EQL |k| 0) - (CONS (SUBSTRING |x| 0 2) - (|checkSplitBackslash| (SUBSTRING |x| 2 NIL)))) - ('T (setq |u| (SUBSTRING |x| 0 |k|)) - (setq |v| (SUBSTRING |x| |k| 2)) - (COND - ((BOOT-EQUAL (+ |k| 1) |m|) - (CONS |u| (CONS |v| NIL))) - ('T - (CONS |u| - (CONS |v| - (|checkSplitBackslash| - (SUBSTRING |x| (+ |k| 2) NIL))))))))) - ('T (CONS |x| NIL)))))))) - -;checkSplitPunctuation x == -; CHARP x => [x] -; m := MAXINDEX x -; m < 1 => [x] -; lastchar := x.m -; lastchar = $charPeriod and x.(m - 1) = $charPeriod => -; m = 1 => [x] -; m > 3 and x.(m-2) = $charPeriod => -; [:checkSplitPunctuation SUBSTRING(x,0,m-2),'"..."] -; [:checkSplitPunctuation SUBSTRING(x,0,m-1),'".."] -; lastchar = $charPeriod or lastchar = $charSemiColon or lastchar = $charComma -; => [SUBSTRING(x,0,m),lastchar] -; m > 1 and x.(m - 1) = $charQuote => [SUBSTRING(x,0,m - 1),SUBSTRING(x,m-1,nil)] -; (k := charPosition($charBack,x,0)) < m => -; k = 0 => -; m = 1 or HGET($htMacroTable,x) or ALPHA_-CHAR_-P x.1 => [x] -; v := SUBSTRING(x,2,nil) -; [SUBSTRING(x,0,2),:checkSplitPunctuation v] -; u := SUBSTRING(x,0,k) -; v := SUBSTRING(x,k,nil) -; [:checkSplitPunctuation u,:checkSplitPunctuation v] -; (k := charPosition($charDash,x,1)) < m => -; u := SUBSTRING(x,k + 1,nil) -; [SUBSTRING(x,0,k),$charDash,:checkSplitPunctuation u] -; [x] - -(DEFUN |checkSplitPunctuation| (|x|) - (PROG (|m| |lastchar| |v| |k| |u|) - (declare (special |$charDash| |$htMacroTable| |$charBack| |$charQuote| - |$charComma| |$charSemiColon| |$charPeriod| - |$charPeriod|)) - (RETURN - (COND - ((CHARP |x|) (CONS |x| NIL)) - ('T (setq |m| (MAXINDEX |x|)) - (COND - ((> 1 |m|) (CONS |x| NIL)) - ('T (setq |lastchar| (ELT |x| |m|)) - (COND - ((AND (BOOT-EQUAL |lastchar| |$charPeriod|) - (BOOT-EQUAL (ELT |x| (- |m| 1)) - |$charPeriod|)) - (COND - ((EQL |m| 1) (CONS |x| NIL)) - ((AND (> |m| 3) - (BOOT-EQUAL (ELT |x| (- |m| 2)) - |$charPeriod|)) - (APPEND (|checkSplitPunctuation| - (SUBSTRING |x| 0 (- |m| 2))) - (CONS "..." NIL))) - ('T - (APPEND (|checkSplitPunctuation| - (SUBSTRING |x| 0 (- |m| 1))) - (CONS ".." NIL))))) - ((OR (BOOT-EQUAL |lastchar| |$charPeriod|) - (BOOT-EQUAL |lastchar| |$charSemiColon|) - (BOOT-EQUAL |lastchar| |$charComma|)) - (CONS (SUBSTRING |x| 0 |m|) (CONS |lastchar| NIL))) - ((AND (> |m| 1) - (BOOT-EQUAL (ELT |x| (- |m| 1)) - |$charQuote|)) - (CONS (SUBSTRING |x| 0 (- |m| 1)) - (CONS (SUBSTRING |x| (- |m| 1) NIL) - NIL))) - ((> |m| (setq |k| (|charPosition| |$charBack| |x| 0))) - (COND - ((EQL |k| 0) - (COND - ((OR (EQL |m| 1) (HGET |$htMacroTable| |x|) - (ALPHA-CHAR-P (ELT |x| 1))) - (CONS |x| NIL)) - ('T (setq |v| (SUBSTRING |x| 2 NIL)) - (CONS (SUBSTRING |x| 0 2) - (|checkSplitPunctuation| |v|))))) - ('T (setq |u| (SUBSTRING |x| 0 |k|)) - (setq |v| (SUBSTRING |x| |k| NIL)) - (APPEND (|checkSplitPunctuation| |u|) - (|checkSplitPunctuation| |v|))))) - ((> |m| (setq |k| (|charPosition| |$charDash| |x| 1))) - (setq |u| (SUBSTRING |x| (+ |k| 1) NIL)) - (CONS (SUBSTRING |x| 0 |k|) - (CONS |$charDash| (|checkSplitPunctuation| |u|)))) - ('T (CONS |x| NIL)))))))))) - -;checkSplitOn(x) == -; CHARP x => [x] -; l := $charSplitList -; m := MAXINDEX x -; while l repeat -; char := first l -; do -; m = 0 and x.0 = char => return (k := -1) --special exit -; k := charPosition(char,x,0) -; k > 0 and x.(k - 1) = $charBack => [x] -; k <= m => return k -; l := rest l -; null l => [x] -; k = -1 => [char] -; k = 0 => [char,SUBSTRING(x,1,nil)] -; k = MAXINDEX x => [SUBSTRING(x,0,k),char] -; [SUBSTRING(x,0,k),char,:checkSplitOn SUBSTRING(x,k + 1,nil)] - -(DEFUN |checkSplitOn| (|x|) - (PROG (|m| |char| |k| |l|) - (declare (special |$charBack| |$charSplitList|)) - (RETURN - (SEQ (COND - ((CHARP |x|) (CONS |x| NIL)) - ('T (setq |l| |$charSplitList|) - (setq |m| (MAXINDEX |x|)) - (DO () ((NULL |l|) NIL) - (SEQ (EXIT (PROGN - (setq |char| (CAR |l|)) - (|do| (COND - ((AND (EQL |m| 0) - (BOOT-EQUAL (ELT |x| 0) |char|)) - (RETURN - (setq |k| - (- 1)))) - ('T - (setq |k| - (|charPosition| |char| |x| 0)) - (COND - ((AND (> |k| 0) - (BOOT-EQUAL - (ELT |x| - (- |k| 1)) - |$charBack|)) - (CONS |x| NIL)) - ((<= |k| |m|) (RETURN |k|)))))) - (setq |l| (CDR |l|)))))) - (COND - ((NULL |l|) (CONS |x| NIL)) - ((BOOT-EQUAL |k| (- 1)) (CONS |char| NIL)) - ((EQL |k| 0) - (CONS |char| (CONS (SUBSTRING |x| 1 NIL) NIL))) - ((BOOT-EQUAL |k| (MAXINDEX |x|)) - (CONS (SUBSTRING |x| 0 |k|) (CONS |char| NIL))) - ('T - (CONS (SUBSTRING |x| 0 |k|) - (CONS |char| - (|checkSplitOn| - (SUBSTRING |x| (+ |k| 1) NIL)))))))))))) - -;checkInteger s == -; CHARP s => false -; s = '"" => false -; and/[DIGIT_-CHAR_-P s.i for i in 0..MAXINDEX s] - -(DEFUN |checkInteger| (|s|) - (PROG () - (RETURN - (SEQ (COND - ((CHARP |s|) NIL) - ((BOOT-EQUAL |s| "") NIL) - ('T - (PROG (G167927) - (setq G167927 'T) - (RETURN - (DO ((G167933 NIL (NULL G167927)) - (G167934 (MAXINDEX |s|)) (|i| 0 (QSADD1 |i|))) - ((OR G167933 (QSGREATERP |i| G167934)) - G167927) - (SEQ (EXIT (SETQ G167927 - (AND G167927 - (DIGIT-CHAR-P (ELT |s| |i|))))))))))))))) - -;--======================================================================= -;-- Code for creating a personalized report for ++ comments -;--======================================================================= -;docreport(nam) == -;--creates a report for person "nam" using file "whofiles" -; OBEY '"rm docreport.input" -; OBEY STRCONC('"echo _")bo setOutStream('",princ-to-string nam,'")_" > temp.input") -; OBEY '"cat docreport.header temp.input > docreport.input" -; OBEY STRCONC('"awk '/",princ-to-string nam,'"/ {printf(_")co %s.spad\n_",$2)}' whofiles > temp.input") -; OBEY '"cat docreport.input temp.input > temp1.input" -; OBEY '"cat temp1.input docreport.trailer > docreport.input" -; OBEY '"rm temp.input" -; OBEY '"rm temp1.input" -; SETQ(_/EDITFILE,'"docreport.input") -; _/RQ() - -(DEFUN |docreport| (|nam|) - (PROGN - (OBEY "rm docreport.input") - (OBEY (STRCONC "echo \")bo setOutStream('" - (princ-to-string |nam|) ")\" > temp.input")) - (OBEY "cat docreport.header temp.input > docreport.input") - (OBEY (STRCONC "awk '/" (princ-to-string |nam|) - "/ {printf(\")co %s.spad\\n\",$2)}' whofiles > temp.input")) - (OBEY "cat docreport.input temp.input > temp1.input") - (OBEY "cat temp1.input docreport.trailer > docreport.input") - (OBEY "rm temp.input") - (OBEY "rm temp1.input") - (SETQ /EDITFILE "docreport.input") - (/RQ))) - -;setOutStream nam == -; filename := STRCONC('"/tmp/",princ-to-string nam,".docreport") -; $outStream := MAKE_-OUTSTREAM filename - -(DEFUN |setOutStream| (|nam|) - (PROG (|filename|) - (declare (special |$outStream|)) - (RETURN - (PROGN - (setq |filename| - (STRCONC "/tmp/" (princ-to-string |nam|) - (INTERN ".docreport" "BOOT"))) - (setq |$outStream| (MAKE-OUTSTREAM |filename|)))))) - -;--======================================================================= -;-- Report Documentation Error -;--======================================================================= - -\end{chunk} -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} -- 1.7.5.4