diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index ebd976a..29aa34d 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -17452,6 +17452,28 @@ TPDHERE: Note that this function also seems to parse out )except \end{chunk} +\defun{compiledLookupCheck}{compiledLookupCheck} +\calls{compiledLookupCheck}{compiledLookup} +\calls{compiledLookupCheck}{keyedSystemError} +\calls{compiledLookupCheck}{formatSignature} +\begin{chunk}{defun compiledLookupCheck} +(defun |compiledLookupCheck| (op sig dollar) + (let (fn) + (setq fn (|compiledLookup| op sig dollar)) + (cond + ((and (null fn) (eq op '^)) + (setq fn (|compiledLookup| '** sig dollar))) + ((and (null fn) (eq op '**)) + (setq fn (|compiledLookup| '^ sig dollar))) + (t nil)) + (cond + ((null fn) + (|keyedSystemError| 'S2NR0001 + (list op (|formatSignature| sig) (elt dollar 0)))) + (t fn)))) + +\end{chunk} + \defdollar{functionTable} \begin{chunk}{initvars} (defvar |$functionTable| nil) @@ -36707,7 +36729,6 @@ the source file without any path information. We hash the constructor abbreviation to pamphlet file name. \calls{make-databases}{localdatabase} \calls{make-databases}{getEnv} -\calls{make-databases}{oldCompilerAutoloadOnceTrigger} \calls{make-databases}{browserAutoloadOnceTrigger} \calls{make-databases}{mkTopicHashTable} \calls{make-databases}{buildLibdb} @@ -36809,7 +36830,6 @@ constructor abbreviation to pamphlet file name. 'make-database)) ;browse.daase (load (concatenate 'string (|getEnv| "AXIOM") "/autoload/topics")) ;; hack - (|oldCompilerAutoloadOnceTrigger|) (|browserAutoloadOnceTrigger|) (|mkTopicHashTable|) (setq |$constructorList| nil) ;; affects buildLibdb @@ -38408,6 +38428,178 @@ an AssociationList representation \end{chunk} +\defun{compiledLookup}{compiledLookup} +\calls{compiledLookup}{isDomain} +\calls{compiledLookup}{NRTevalDomain} +\begin{chunk}{defun compiledLookup} +(defun |compiledLookup| (op sig dollar) + (unless (|isDomain| dollar) (setq dollar (|NRTevalDomain| dollar))) + (|basicLookup| op sig dollar dollar)) + +\end{chunk} + +\defun{basicLookup}{basicLookup} +\calls{basicLookup}{spadcall} +\calls{basicLookup}{hashCode?} +\calls{basicLookup}{opIsHasCat} +\calls{basicLookup}{HasCategory} +\calls{basicLookup}{hashType} +\calls{basicLookup}{hashString} +\calls{basicLookup}{error} +\calls{basicLookup}{vecp} +\calls{basicLookup}{isNewWorldDomain} +\calls{basicLookup}{oldCompLookup} +\calls{basicLookup}{lookupInDomainVector} +\refsdollar{basicLookup}{hashSeg} +\refsdollar{basicLookup}{hashOpSet} +\refsdollar{basicLookup}{hashOpApply} +\refsdollar{basicLookup}{hashOp0} +\refsdollar{basicLookup}{hashOp1} +\begin{chunk}{defun basicLookup} +(defun |basicLookup| (op sig domain dollar) + (let (hashPercent box dispatch lookupFun hashSig val boxval) + (declare (special |$hashSeg| |$hashOpSet| |$hashOpApply| |$hashOp0| + |$hashOp1|)) + (cond + ((vecp domain) + (if (|isNewWorldDomain| domain) + (|oldCompLookup| op sig domain dollar) + (|lookupInDomainVector| op sig domain dollar))) + (t + (setq hashPercent + (if (vecp dollar) + (|hashType| (elt dollar 0) 0) + (|hashType| dollar 0))) + (setq box (cons nil nil)) + (cond + ((null (vecp (setq dispatch (car domain)))) + (|error| '|bad domain format|)) + (t + (setq lookupFun (elt dispatch 3)) + (cond + ((eql (elt dispatch 0) 0) + (setq hashSig + (cond + ((|hashCode?| sig) sig) + ((|opIsHasCat| op) (|hashType| sig hashPercent)) + (t (|hashType| (cons '|Mapping| sig) hashPercent)))) + (when (symbolp op) + (cond + ((eq op '|Zero|) (setq op |$hashOp0|)) + ((eq op '|One|) (setq op |$hashOp1|)) + ((eq op '|elt|) (setq op |$hashOpApply|)) + ((eq op '|setelt|) (setq op |$hashOpSet|)) + (t (setq op (|hashString| (symbol-name op)))))) + (cond + ((setq val + (car + (spadcall (cdr domain) dollar op hashSig box nil lookupFun))) + val) + ((|hashCode?| sig) nil) + ((or (> (|#| sig) 1) (|opIsHasCat| op)) nil) + ((setq boxval + (spadcall (cdr dollar) dollar op + (|hashType| (car sig) hashPercent) + box nil lookupFun)) + (cons #'identity (car boxval))) + (t nil))) + ((|opIsHasCat| op) (|HasCategory| domain sig)) + (t + (when (|hashCode?| op) + (cond + ((eql op |$hashOp1|) (setq op '|One|)) + ((eql op |$hashOp0|) (setq op '|Zero|)) + ((eql op |$hashOpApply|) (setq op '|elt|)) + ((eql op |$hashOpSet|) (setq op '|setelt|)) + ((eql op |$hashSeg|) (setq op 'segment)))) + (cond + ((and (|hashCode?| sig) (eql sig hashPercent)) + (spadcall + (car (spadcall (cdr dollar) dollar op '($) box nil lookupFun)))) + (t + (car + (spadcall (cdr dollar) dollar op sig box nil lookupFun)))))))))))) + +\end{chunk} + +\defun{lookupInDomainVector}{lookupInDomainVector} +\calls{lookupInDomainVector}{basicLookupCheckDefaults} +\calls{lookupInDomainVector}{spadcall} +\begin{chunk}{defun lookupInDomainVector} +(defun |lookupInDomainVector| (op sig domain dollar) + (if (consp domain) + (|basicLookupCheckDefaults| op sig domain domain) + (spadcall op sig dollar (elt domain 1)))) + +\end{chunk} + +\defun{basicLookupCheckDefaults}{basicLookupCheckDefaults} +\calls{basicLookupCheckDefaults}{vecp} +\calls{basicLookupCheckDefaults}{error} +\calls{basicLookupCheckDefaults}{hashType} +\calls{basicLookupCheckDefaults}{hashCode?} +\calls{basicLookupCheckDefaults}{hashString} +\calls{basicLookupCheckDefaults}{spadcall} +\refsdollar{basicLookupCheckDefaults}{lookupDefaults} +\begin{chunk}{defun basicLookupCheckDefaults} +(defun |basicLookupCheckDefaults| (op sig domain dollar) + (declare (ignore domain)) + (let (box dispatch lookupFun hashPercent hashSig) + (declare (special |$lookupDefaults|)) + (setq box (cons nil nil)) + (cond + ((null (vecp (setq dispatch (car dollar)))) + (|error| '|bad domain format|)) + (t + (setq lookupFun (elt dispatch 3)) + (cond + ((eql (elt dispatch 0) 0) + (setq hashPercent + (if (vecp dollar) + (|hashType| (elt dollar 0) 0) + (|hashType| dollar 0))) + (setq hashSig + (if (|hashCode?| sig) + sig + (|hashType| (cons '|Mapping| sig) hashPercent))) + (when (symbolp op) (setq op (|hashString| (symbol-name op)))) + (car (spadcall (cdr dollar) dollar op hashSig + box (null |$lookupDefaults|) lookupFun))) + (t + (car (spadcall (cdr dollar) dollar op sig box + (null |$lookupDefaults|) lookupFun)))))))) + +\end{chunk} + +\defun{oldCompLookup}{oldCompLookup} +\calls{oldCompLookup}{lookupInDomainVector} +\defsdollar{oldCompLookup}{lookupDefaults} +\begin{chunk}{defun oldCompLookup} +(defun |oldCompLookup| (op sig domvec dollar) + (let (|$lookupDefaults| u) + (declare (special |$lookupDefaults|)) + (setq |$lookupDefaults| nil) + (cond + ((setq u (|lookupInDomainVector| op sig domvec dollar)) + u) + (t + (setq |$lookupDefaults| t) + (|lookupInDomainVector| op sig domvec dollar))))) + +\end{chunk} + +\defun{NRTevalDomain}{NRTevalDomain} +\calls{NRTevalDomain}{qcar} +\calls{NRTevalDomain}{eval} +\calls{NRTevalDomain}{evalDomain} +\begin{chunk}{defun NRTevalDomain} +(defun |NRTevalDomain| (form) + (if (and (consp form) (eq (qcar form) 'setelt)) + (|eval| form) + (|evalDomain| form))) + +\end{chunk} + \section{Plot3d} We catch numeric errors and throw a different failure than normal. The trapNumericErrors macro will return a pair of the the form @@ -40706,6 +40898,8 @@ This needs to work off the internal exposure list, not the file. \getchunk{defun assertCond} \getchunk{defun augmentTraceNames} +\getchunk{defun basicLookup} +\getchunk{defun basicLookupCheckDefaults} \getchunk{defun break} \getchunk{defun breaklet} \getchunk{defun brightprint} @@ -40743,6 +40937,8 @@ This needs to work off the internal exposure list, not the file. \getchunk{defun commandUserLevelError} \getchunk{defun compareposns} \getchunk{defun compileBoot} +\getchunk{defun compiledLookup} +\getchunk{defun compiledLookupCheck} \getchunk{defun compressOpen} \getchunk{defun constoken} \getchunk{defun copyright} @@ -40996,6 +41192,7 @@ This needs to work off the internal exposure list, not the file. \getchunk{defun loadLibNoUpdate} \getchunk{defun localdatabase} \getchunk{defun localnrlib} +\getchunk{defun lookupInDomainVector} \getchunk{defun loopIters2Sex} \getchunk{defun lotsof} \getchunk{defun ltrace} @@ -41259,7 +41456,9 @@ This needs to work off the internal exposure list, not the file. \getchunk{defun npWhile} \getchunk{defun npWith} \getchunk{defun npZeroOrMore} +\getchunk{defun NRTevalDomain} +\getchunk{defun oldCompLookup} \getchunk{defun oldHistFileName} \getchunk{defun openOutputLibrary} \getchunk{defun openserver} diff --git a/changelog b/changelog index 64e874d..734ca89 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20111015 tpd src/axiom-website/patches.html 20111015.01.tpd.patch +20110105 tpd src/interp/nrungo.lisp treeshake interpreter +20111015 tpd books/bookvol5 treeshake interpreter 20111011 tpd src/axiom-website/patches.html 20111011.01.tpd.patch 20111011 tpd books/bookvol9 treeshake compiler 20111011 tpd books/bookvol7.1 fix documentation diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 8cc4b65..97612b7 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3656,5 +3656,7 @@ books/bookvol9 treeshake compiler
books/bookvol10.* remove noweb, move to lisp tangle
20111011.01.tpd.patch src/interp/nruntime.lisp removed
+20111015.01.tpd.patch +books/bookvol5 treeshake interpreter
diff --git a/src/interp/nrungo.lisp.pamphlet b/src/interp/nrungo.lisp.pamphlet index 1c43d2e..6583983 100644 --- a/src/interp/nrungo.lisp.pamphlet +++ b/src/interp/nrungo.lisp.pamphlet @@ -13,222 +13,6 @@ (IN-PACKAGE "BOOT" ) -;--======================================================= -;-- Lookup From Interpreter -;--======================================================= -;NRTevalDomain form == -; form is ['SETELT,:.] => eval form -; evalDomain form - -(DEFUN |NRTevalDomain| (|form|) - (COND - ((AND (CONSP |form|) (EQ (QCAR |form|) 'SETELT)) (|eval| |form|)) - ('T (|evalDomain| |form|)))) - -;compiledLookup(op, sig, dollar) == -; if not isDomain dollar then dollar := NRTevalDomain dollar -; basicLookup(op, sig, dollar, dollar) - -(DEFUN |compiledLookup| (|op| |sig| |dollar|) - (PROGN - (COND - ((NULL (|isDomain| |dollar|)) - (SPADLET |dollar| (|NRTevalDomain| |dollar|)))) - (|basicLookup| |op| |sig| |dollar| |dollar|))) - -;basicLookup(op,sig,domain,dollar) == -; -- following case is for old domains like Record and Union -; -- or for getting operations out of yourself -; VECP domain => -; isNewWorldDomain domain => -- getting ops from yourself (or for defaults) -; oldCompLookup(op, sig, domain, dollar) -; -- getting ops from Record or Union -; lookupInDomainVector(op,sig,domain,dollar) -; hashPercent := -; VECP dollar => hashType(dollar.0,0) -; hashType(dollar,0) -; box := [nil] -; not VECP(dispatch := CAR domain) => error "bad domain format" -; lookupFun := dispatch.3 -; dispatch.0 = 0 => -- new compiler domain object -; hashSig := -; hashCode? sig => sig -; opIsHasCat op => hashType(sig, hashPercent) -; hashType(['Mapping,:sig], hashPercent) -; if SYMBOLP op then -; op = 'Zero => op := $hashOp0 -; op = 'One => op := $hashOp1 -; op = 'elt => op := $hashOpApply -; op = 'setelt => op := $hashOpSet -; op := hashString SYMBOL_-NAME op -; val:=CAR SPADCALL(CDR domain, dollar, op, hashSig, box, false, -; lookupFun) => val -; hashCode? sig => nil -; #sig>1 or opIsHasCat op => nil -; boxval := SPADCALL(CDR dollar, dollar, op, hashType(first sig, hashPercent), -; box, false, lookupFun) => -; [FUNCTION IDENTITY,: CAR boxval] -; nil -; opIsHasCat op => -; HasCategory(domain, sig) -; if hashCode? op then -; EQL(op, $hashOp1) => op := 'One -; EQL(op, $hashOp0) => op := 'Zero -; EQL(op, $hashOpApply) => op := 'elt -; EQL(op, $hashOpSet) => op := 'setelt -; EQL(op, $hashSeg) => op := 'SEGMENT -; hashCode? sig and EQL(sig, hashPercent) => -; SPADCALL CAR SPADCALL(CDR dollar, dollar, op, '($), box, false, lookupFun) -; CAR SPADCALL(CDR dollar, dollar, op, sig, box, false, lookupFun) - -(DEFUN |basicLookup| (|op| |sig| |domain| |dollar|) - (PROG (|hashPercent| |box| |dispatch| |lookupFun| |hashSig| |val| |boxval|) - (declare (special |$hashSeg| |$hashOpSet| |$hashOpApply| |$hashOp0| - |$hashOp1|)) - (RETURN - (COND - ((VECP |domain|) - (COND - ((|isNewWorldDomain| |domain|) - (|oldCompLookup| |op| |sig| |domain| |dollar|)) - ('T (|lookupInDomainVector| |op| |sig| |domain| |dollar|)))) - ('T - (SPADLET |hashPercent| - (COND - ((VECP |dollar|) (|hashType| (ELT |dollar| 0) 0)) - ('T (|hashType| |dollar| 0)))) - (SPADLET |box| (CONS NIL NIL)) - (COND - ((NULL (VECP (SPADLET |dispatch| (CAR |domain|)))) - (|error| '|bad domain format|)) - ('T (SPADLET |lookupFun| (ELT |dispatch| 3)) - (COND - ((EQL (ELT |dispatch| 0) 0) - (SPADLET |hashSig| - (COND - ((|hashCode?| |sig|) |sig|) - ((|opIsHasCat| |op|) - (|hashType| |sig| |hashPercent|)) - ('T - (|hashType| (CONS '|Mapping| |sig|) - |hashPercent|)))) - (COND - ((SYMBOLP |op|) - (COND - ((BOOT-EQUAL |op| '|Zero|) - (SPADLET |op| |$hashOp0|)) - ((BOOT-EQUAL |op| '|One|) - (SPADLET |op| |$hashOp1|)) - ((BOOT-EQUAL |op| '|elt|) - (SPADLET |op| |$hashOpApply|)) - ((BOOT-EQUAL |op| '|setelt|) - (SPADLET |op| |$hashOpSet|)) - ('T - (SPADLET |op| (|hashString| (SYMBOL-NAME |op|))))))) - (COND - ((SPADLET |val| - (CAR (SPADCALL (CDR |domain|) |dollar| |op| - |hashSig| |box| NIL |lookupFun|))) - |val|) - ((|hashCode?| |sig|) NIL) - ((OR (> (|#| |sig|) 1) (|opIsHasCat| |op|)) NIL) - ((SPADLET |boxval| - (SPADCALL (CDR |dollar|) |dollar| |op| - (|hashType| (CAR |sig|) |hashPercent|) - |box| NIL |lookupFun|)) - (CONS #'IDENTITY (CAR |boxval|))) - ('T NIL))) - ((|opIsHasCat| |op|) (|HasCategory| |domain| |sig|)) - ('T - (COND - ((|hashCode?| |op|) - (COND - ((EQL |op| |$hashOp1|) (SPADLET |op| '|One|)) - ((EQL |op| |$hashOp0|) (SPADLET |op| '|Zero|)) - ((EQL |op| |$hashOpApply|) (SPADLET |op| '|elt|)) - ((EQL |op| |$hashOpSet|) (SPADLET |op| '|setelt|)) - ((EQL |op| |$hashSeg|) (SPADLET |op| 'SEGMENT))))) - (COND - ((AND (|hashCode?| |sig|) (EQL |sig| |hashPercent|)) - (SPADCALL - (CAR (SPADCALL (CDR |dollar|) |dollar| |op| '($) - |box| NIL |lookupFun|)))) - ('T - (CAR (SPADCALL (CDR |dollar|) |dollar| |op| |sig| - |box| NIL |lookupFun|))))))))))))) - -;basicLookupCheckDefaults(op,sig,domain,dollar) == -; box := [nil] -; not VECP(dispatch := CAR dollar) => error "bad domain format" -; lookupFun := dispatch.3 -; dispatch.0 = 0 => -- new compiler domain object -; hashPercent := -; VECP dollar => hashType(dollar.0,0) -; hashType(dollar,0) -; hashSig := -; hashCode? sig => sig -; hashType( ['Mapping,:sig], hashPercent) -; if SYMBOLP op then op := hashString SYMBOL_-NAME op -; CAR SPADCALL(CDR dollar, dollar, op, hashSig, box, not $lookupDefaults, lookupFun) -; CAR SPADCALL(CDR dollar, dollar, op, sig, box, not $lookupDefaults, lookupFun) - -(DEFUN |basicLookupCheckDefaults| (|op| |sig| |domain| |dollar|) - (declare (ignore |domain|)) - (PROG (|box| |dispatch| |lookupFun| |hashPercent| |hashSig|) - (declare (special |$lookupDefaults|)) - (RETURN - (PROGN - (SPADLET |box| (CONS NIL NIL)) - (COND - ((NULL (VECP (SPADLET |dispatch| (CAR |dollar|)))) - (|error| '|bad domain format|)) - ('T (SPADLET |lookupFun| (ELT |dispatch| 3)) - (COND - ((EQL (ELT |dispatch| 0) 0) - (SPADLET |hashPercent| - (COND - ((VECP |dollar|) - (|hashType| (ELT |dollar| 0) 0)) - ('T (|hashType| |dollar| 0)))) - (SPADLET |hashSig| - (COND - ((|hashCode?| |sig|) |sig|) - ('T - (|hashType| (CONS '|Mapping| |sig|) - |hashPercent|)))) - (COND - ((SYMBOLP |op|) - (SPADLET |op| (|hashString| (SYMBOL-NAME |op|))))) - (CAR (SPADCALL (CDR |dollar|) |dollar| |op| |hashSig| - |box| (NULL |$lookupDefaults|) |lookupFun|))) - ('T - (CAR (SPADCALL (CDR |dollar|) |dollar| |op| |sig| |box| - (NULL |$lookupDefaults|) |lookupFun|)))))))))) - -;-- has cat questions lookup up twice if false -;-- replace with following ? -;-- not(opIsHasCat op) and -;-- (u := lookupInDomainVector(op,sig,domvec,domvec)) => u -;oldCompLookup(op, sig, domvec, dollar) == -; $lookupDefaults:local := nil -; u := lookupInDomainVector(op,sig,domvec,dollar) => u -; $lookupDefaults := true -; lookupInDomainVector(op,sig,domvec,dollar) - -(DEFUN |oldCompLookup| (|op| |sig| |domvec| |dollar|) - (PROG (|$lookupDefaults| |u|) - (DECLARE (SPECIAL |$lookupDefaults|)) - (RETURN - (PROGN - (SPADLET |$lookupDefaults| NIL) - (COND - ((SPADLET |u| - (|lookupInDomainVector| |op| |sig| |domvec| - |dollar|)) - |u|) - ('T (SPADLET |$lookupDefaults| 'T) - (|lookupInDomainVector| |op| |sig| |domvec| |dollar|))))))) - ;oldCompLookupNoDefaults(op, sig, domvec, dollar) == ; $lookupDefaults:local := nil ; lookupInDomainVector(op,sig,domvec,dollar) @@ -241,37 +25,6 @@ (SPADLET |$lookupDefaults| NIL) (|lookupInDomainVector| |op| |sig| |domvec| |dollar|))))) -;compiledLookupCheck(op,sig,dollar) == -; fn := compiledLookup(op,sig,dollar) -; -- NEW COMPILER COMPATIBILITY ON -; if (fn = nil) and (op = "^") then -; fn := compiledLookup("**",sig,dollar) -; else if (fn = nil) and (op = "**") then -; fn := compiledLookup("^",sig,dollar) -; -- NEW COMPILER COMPATIBILITY OFF -; fn = nil => -; keyedSystemError("S2NR0001",[op,formatSignature sig,dollar.0]) -; fn - -(DEFUN |compiledLookupCheck| (|op| |sig| |dollar|) - (PROG (|fn|) - (RETURN - (PROGN - (SPADLET |fn| (|compiledLookup| |op| |sig| |dollar|)) - (COND - ((AND (NULL |fn|) (BOOT-EQUAL |op| '^)) - (SPADLET |fn| (|compiledLookup| '** |sig| |dollar|))) - ((AND (NULL |fn|) (BOOT-EQUAL |op| '**)) - (SPADLET |fn| (|compiledLookup| '^ |sig| |dollar|))) - ('T NIL)) - (COND - ((NULL |fn|) - (|keyedSystemError| 'S2NR0001 - (CONS |op| - (CONS (|formatSignature| |sig|) - (CONS (ELT |dollar| 0) NIL))))) - ('T |fn|)))))) - ;--======================================================= ;-- Lookup From Compiled Code ;--======================================================= @@ -559,48 +312,19 @@ ; if null VECP addFormCell then addFormCell := eval addFormCell ; lookupInDomainVector(op,sig,addFormCell,dollar) ; nil - -(DEFUN |lookupInDomain| (|op| |sig| |addFormDomain| |dollar| |index|) - (PROG (|addFormCell|) - (RETURN - (SEQ (COND - ((SPADLET |addFormCell| (ELT |addFormDomain| |index|)) - (COND - ((INTEGERP (KAR |addFormCell|)) - (PROG (G166242) - (SPADLET G166242 NIL) - (RETURN - (DO ((G166248 NIL G166242) - (G166249 |addFormCell| (CDR G166249)) - (|i| NIL)) - ((OR G166248 (ATOM G166249) - (PROGN (SETQ |i| (CAR G166249)) NIL)) - G166242) - (SEQ (EXIT (SETQ G166242 - (OR G166242 - (|lookupInDomain| |op| |sig| - |addFormDomain| |dollar| |i|))))))))) - ('T - (COND - ((NULL (VECP |addFormCell|)) - (SPADLET |addFormCell| (|eval| |addFormCell|)))) - (|lookupInDomainVector| |op| |sig| |addFormCell| - |dollar|)))) - ('T NIL)))))) - -;lookupInDomainVector(op,sig,domain,dollar) == -; CONSP domain => basicLookupCheckDefaults(op,sig,domain,domain) -; slot1 := domain.1 -; SPADCALL(op,sig,dollar,slot1) - -(DEFUN |lookupInDomainVector| (|op| |sig| |domain| |dollar|) - (PROG (|slot1|) - (RETURN - (COND - ((CONSP |domain|) - (|basicLookupCheckDefaults| |op| |sig| |domain| |domain|)) - ('T (SPADLET |slot1| (ELT |domain| 1)) - (SPADCALL |op| |sig| |dollar| |slot1|)))))) +(defun |lookupInDomain| (op sig addFormDomain dollar index) + (let (addFormCell) + (when (setq addFormCell (elt addFormDomain index)) + (cond + ((integerp (kar addFormCell)) + (let (result) + (loop for i in addFormCell + do (setq result + (or result (|lookupInDomain| op sig addFormDomain dollar i)))) + result)) + (t + (unless (vecp addFormCell) (setq addFormCell (|eval| addFormCell))) + (|lookupInDomainVector| op sig addFormCell dollar)))))) ;--======================================================= ;-- Category Default Lookup (from goGet or lookupInAddChain)