home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / mutils.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  3.3 KB  |  94 lines

  1. ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;;     The data in this file contains enhancments.                    ;;;;;
  4. ;;;                                                                    ;;;;;
  5. ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
  6. ;;;     All rights reserved                                            ;;;;;
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;;     (c) Copyright 1980 Massachusetts Institute of Technology         ;;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. (in-package "MAXIMA")
  12. (macsyma-module mutils)
  13.  
  14. ;;; General purpose Macsyma utilities.  This file contains runtime functions 
  15. ;;; which perform operations on Macsyma functions or data, but which are
  16. ;;; too general for placement in a particular file.
  17. ;;;
  18. ;;; Every function in this file is known about externally.
  19.  
  20.  
  21. ;;; This function searches for the key in the left hand side of the input list
  22. ;;; of the form [x,y,z...] where each of the list elements is a expression of
  23. ;;; a binary operand and 2 elements.  For example x=1, 2^3, [a,b] etc.
  24. ;;; The key checked againts the first operand and and returns the second
  25. ;;; operand if the key is found.
  26. ;;; If the key is not found it either returns the default value if supplied or
  27. ;;; false.
  28. ;;; Author Dan Stanger 12/1/02
  29. (defmfun $assoc (key ielist &optional default)
  30.    (let ((elist (margs ielist)))
  31.       (if (every #'(lambda (x) (= 3 (length x))) elist)
  32.          (let ((found (find key elist :test #'alike1 :key #'second)))
  33.             (if found (third found) default))
  34.          (MERROR "Improper form for list:~%~M" ielist))))
  35.  
  36. ;;; This function works like the every function in lisp.
  37. ;;; It can take a list, or a positive number of arguments returning
  38. ;;; true if all its arguments are not false.
  39. ;;; Author Dan Stanger 12/1/02
  40. (defmfun $every (&rest args)
  41.   (let ((n (length args)))
  42.      (cond ((= n 0) (merror "Every must have at least 1 argument"))
  43.            ((= n 1)
  44.                (let ((args (first args)))
  45.                   (if (and ($listp args) (> ($length args) 0))
  46.                       (notany #'not (margs args))
  47.                       (if (and ($listp args) (= ($length args) 0)) nil args))))
  48.            (t (notany #'not args)))))
  49.  
  50. ;;; (ASSOL item A-list)
  51. ;;;
  52. ;;;  Like ASSOC, but uses ALIKE1 as the comparison predicate rather
  53. ;;;  than EQUAL.
  54. ;;;
  55. ;;;  Meta-Synonym:    (ASS #'ALIKE1 ITEM ALIST)
  56.  
  57. (DEFMFUN ASSOL (ITEM ALIST)
  58.   (DOLIST (PAIR ALIST)
  59.       (IF (ALIKE1 ITEM (CAR PAIR)) (RETURN PAIR))))
  60. ;;; 
  61.  
  62. (DEFMFUN ASSOLIKE (ITEM ALIST) 
  63.   (CDR (ASSOL ITEM ALIST)))
  64.  
  65. ; Old ASSOLIKE definition:
  66. ;
  67. ; (defun assolike (e l) 
  68. ;     (prog nil 
  69. ;      loop (cond ((null l) (return nil))
  70. ;             ((alike1 e (caar l)) (return (cdar l))))
  71. ;           (setq l (cdr l))
  72. ;           (go loop)))
  73.  
  74. ;;; (MEM #'ALIKE1 X L)
  75.  
  76. (DEFMFUN MEMALIKE (X L)
  77.   (DO ((L L (CDR L))) ((NULL L))
  78.       (COND ((ALIKE1 X (CAR L)) (RETURN L)))))
  79.  
  80. ;;;Do we want MACROS for these on MC and on Multics?? -Jim 1/29/81
  81. #+Multics
  82. (PROGN 'COMPILE
  83.   (DEFMFUN MSTRINGP (X)
  84.     (AND (SYMBOLP X)
  85.      (EQUAL (GETCHARN X 1) #\&)))
  86.  
  87.   (DEFMFUN MSTRING-TO-STRING (X)
  88.     (SUBSTRING (STRING X) 1))
  89.  
  90.   (DEFMFUN STRING-TO-MSTRING (X)
  91.     (MAKE-SYMBOL (STRING-APPEND "&" X)))
  92. )
  93.  
  94.