(FILECREATED "25-Jun-86 01:47:01" {QV}<PEDERSEN>LISP>IDLARRAYMETHODS.;6 7911
changes to: (VARS IDLARRAYMETHODSCOMS)
(FNS APPLY-DYADIC-METHOD APPLY-MONADIC-METHOD APPLY-REDUCTION-METHOD
APPLY-SCAN-METHOD APPLY-NADIC-METHODMACRO MEDIAN-METHOD MEAN-METHOD
VARIANCE-METHOD PLUS-METHOD DIFFERENCE-METHOD QUOTIENT-METHOD TIMES-METHOD
MIN-METHOD MAX-METHOD IDL-MIN IDL-MAX RESIDUE-METHOD CEILING-METHOD
MINUS-METHOD FLOOR-METHOD)
previous date: " 6-Jun-86 11:47:15" {QV}<PEDERSEN>LISP>IDLARRAYMETHODS.;5)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT IDLARRAYMETHODSCOMS)
(RPAQQ IDLARRAYMETHODSCOMS ((* File created by Coms Manager.)
(FNS APPLY-DYADIC-METHOD APPLY-DYADIC-SPECIFIER APPLY-MONADIC-METHOD
APPLY-NADIC-METHODMACRO APPLY-REDUCTION-METHOD APPLY-SCAN-METHOD
DYADIC-MOST-SPECIFIC-NODE FIND-DYADIC-METHOD FIND-MONADIC-METHOD)
(RECORDS METHOD-TREE-NODE)
(VARS DYADIC-METHOD-TREES MONADIC-METHOD-TREES REDUCTION-METHOD-TREES
SCAN-METHOD-TREES)
(MACROS APPLY-NADIC-METHOD)))
(* File created by Coms Manager.)
(DEFINEQ
(APPLY-DYADIC-METHOD
[LAMBDA (METHODNAME LEFTIDLARRAY RIGHTIDLARRAY RESULT) (* jop: "24-Jun-86 23:49")
(* *)
(DECLARE (GLOBALVARS DYADIC-METHOD-TREES))
(LET ((SPECIFIC-METHOD (FIND-DYADIC-METHOD METHODNAME LEFTIDLARRAY RIGHTIDLARRAY
DYADIC-METHOD-TREES)))
(if SPECIFIC-METHOD
then (APPLY* SPECIFIC-METHOD LEFTIDLARRAY RIGHTIDLARRAY RESULT)
else (ERROR "No such method" METHODNAME])
(APPLY-DYADIC-SPECIFIER
[LAMBDA (LEFTGENARRAY RIGHTGENARRAY SPECIFIER) (* jop: " 9-May-86 12:28")
(* *)
(LET ((LSPECIFIER (CAR SPECIFIER))
(RSPECIFIER (CADR SPECIFIER)))
(AND (IDLARRAY-TYPEP LEFTGENARRAY LSPECIFIER)
(IDLARRAY-TYPEP RIGHTGENARRAY RSPECIFIER])
(APPLY-MONADIC-METHOD
[LAMBDA (METHODNAME IDLARRAY RESULT) (* jop: "24-Jun-86 23:50")
(* *)
(DECLARE (GLOBALVARS MONADIC-METHOD-TREES))
(LET ((SPECIFIC-METHOD (FIND-MONADIC-METHOD METHODNAME IDLARRAY MONADIC-METHOD-TREES)))
(if SPECIFIC-METHOD
then (APPLY* SPECIFIC-METHOD IDLARRAY RESULT)
else (ERROR "No such method"])
(APPLY-NADIC-METHODMACRO
[LAMBDA (ARGS) (* jop: "24-Jun-86 23:52")
(* *)
(LET ((METHODNAME (CAR ARGS))
(KEYARRAY (CADR ARGS)))
(BQUOTE (LET ((SPECIFIC-METHOD (FIND-MONADIC-METHOD , METHODNAME , KEYARRAY
MONADIC-METHOD-TREES)))
(DECLARE (GLOBALVARS MONADIC-METHOD-TREES))
(if SPECIFIC-METHOD
then (APPLY* SPECIFIC-METHOD ,@(CDR ARGS))
else (ERROR "No such nadic method" , METHODNAME])
(APPLY-REDUCTION-METHOD
[LAMBDA (FN IDLARRAY AXIS RESULT) (* jop: "25-Jun-86 00:22")
(* *)
(DECLARE (GLOBALVARS REDUCTION-METHOD-TREES))
(LET ((SPECIFIC-METHOD (FIND-MONADIC-METHOD FN IDLARRAY REDUCTION-METHOD-TREES)))
(if SPECIFIC-METHOD
then (APPLY* SPECIFIC-METHOD IDLARRAY AXIS RESULT)
else (ERROR "No such reduction method" FN])
(APPLY-SCAN-METHOD
[LAMBDA (METHODNAME IDLARRAY AXIS RESULT) (* jop: "25-Jun-86 00:22")
(* *)
(DECLARE (GLOBALVARS SCAN-METHOD-TREES))
(LET ((SPECIFIC-METHOD (FIND-MONADIC-METHOD METHODNAME IDLARRAY SCAN-METHOD-TREES)))
(if SPECIFIC-METHOD
then (APPLY* SPECIFIC-METHOD IDLARRAY RESULT)
else (ERROR "No such scan method" METHODNAME])
(DYADIC-MOST-SPECIFIC-NODE
[LAMBDA (METHODNAME LEFTIDLARRAY RIGHTIDLARRAY TREE) (* jop: " 9-May-86 12:28")
(* *)
(if (APPLY-DYADIC-SPECIFIER LEFTIDLARRAY RIGHTIDLARRAY (fetch (METHOD-TREE-NODE TYPE-SPECIFIER)
of TREE))
then (bind (CURRENTCHILDREN ←(fetch (METHOD-TREE-NODE CHILDREN) of TREE))
(MOSTSPECIFICNODE ←(if (LISTGET (fetch (METHOD-TREE-NODE METHODS) of TREE)
METHODNAME)
then TREE))
CURRENTNODE while [SETQ CURRENTNODE (for NODE in CURRENTCHILDREN
thereis (APPLY-DYADIC-SPECIFIER
LEFTIDLARRAY RIGHTIDLARRAY
(fetch (METHOD-TREE-NODE
TYPE-SPECIFIER)
of NODE]
do (SETQ CURRENTCHILDREN (fetch (METHOD-TREE-NODE CHILDREN) of CURRENTNODE))
(if (LISTGET (fetch (METHOD-TREE-NODE METHODS) of CURRENTNODE)
METHODNAME)
then (SETQ MOSTSPECIFICNODE CURRENTNODE)) finally (RETURN MOSTSPECIFICNODE])
(FIND-DYADIC-METHOD
[LAMBDA (METHODNAME LEFTIDLARRAY RIGHTIDLARRAY TREES) (* jop: " 9-May-86 12:25")
(* *)
(LET*[(NODE (bind RESULT for TREE in TREES thereis (SETQ RESULT (DYADIC-MOST-SPECIFIC-NODE
METHODNAME LEFTIDLARRAY
RIGHTIDLARRAY TREE))
finally (RETURN RESULT)))
(METHODS (AND NODE (fetch (METHOD-TREE-NODE METHODS) of NODE]
(LISTGET METHODS METHODNAME])
(FIND-MONADIC-METHOD
[LAMBDA (METHODNAME IDLARRAY TREES) (* jop: " 9-May-86 12:17")
(* *)
(LET*[(NODE (bind RESULT for TREE in TREES thereis (SETQ RESULT (MONADIC-MOST-SPECIFIC-NODE
METHODNAME IDLARRAY TREE))
finally (RETURN RESULT)))
(METHODS (AND NODE (fetch (METHOD-TREE-NODE METHODS) of NODE]
(LISTGET METHODS METHODNAME])
)
[DECLARE: EVAL@COMPILE
(RECORD METHOD-TREE-NODE (TYPE-SPECIFIER METHODS CHILDREN))
]
(RPAQQ DYADIC-METHOD-TREES [(((NUMERIC NIL)
(NUMERIC NIL))
NIL
((((NUMERIC 0)
(NUMERIC NIL))
NIL
((((NUMERIC 0)
(NUMERIC 0))
NIL NIL)))
(((NUMERIC NIL)
(NUMERIC 0))
NIL NIL)))
(((LOGICAL NIL)
(LOGICAL NIL))
NIL
((((LOGICAL 0)
(LOGICAL NIL))
NIL
((((LOGICAL 0)
(LOGICAL 0))
NIL NIL)))
(((LOGICAL NIL)
(LOGICAL 0))
NIL NIL)))
(((NIL NIL)
(NIL NIL))
(BLT GENERIC-BLT MEMBER GENERIC-MEMBER INDEXOF GENERIC-INDEXOF)
((((NIL 0)
(NIL NIL))
NIL
((((NIL 0)
(NIL 0))
NIL NIL)))
(((NIL NIL)
(NIL 0))
NIL NIL])
(RPAQQ MONADIC-METHOD-TREES [((NIL NIL)
NIL
(((NIL 0)
NIL NIL)
((NIL 1+)
(FILL GENERIC-FILL SORT GENERIC-SORT)
NIL])
(RPAQQ REDUCTION-METHOD-TREES (((NIL NIL)
NIL NIL)))
(RPAQQ SCAN-METHOD-TREES (((NIL NIL)
NIL NIL)))
(DECLARE: EVAL@COMPILE
(PUTPROPS APPLY-NADIC-METHOD MACRO (ARGS (APPLY-NADIC-METHODMACRO ARGS)))
)
(PUTPROPS IDLARRAYMETHODS COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1165 6624 (APPLY-DYADIC-METHOD 1175 . 1654) (APPLY-DYADIC-SPECIFIER 1656 . 2003) (
APPLY-MONADIC-METHOD 2005 . 2433) (APPLY-NADIC-METHODMACRO 2435 . 2995) (APPLY-REDUCTION-METHOD 2997
. 3441) (APPLY-SCAN-METHOD 3443 . 3878) (DYADIC-MOST-SPECIFIC-NODE 3880 . 5463) (FIND-DYADIC-METHOD
5465 . 6092) (FIND-MONADIC-METHOD 6094 . 6622)))))
STOP