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
13(macsyma-module mutils)
14
15;;; General purpose Macsyma utilities.  This file contains runtime functions
16;;; which perform operations on Macsyma functions or data, but which are
17;;; too general for placement in a particular file.
18;;;
19;;; Every function in this file is known about externally.
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
30(defmfun $assoc (key ielist &optional default)
31  (let ((elist (if (listp ielist)
32                   (margs ielist)
33                   (merror
34                     (intl:gettext "assoc: second argument must be a list; found: ~:M")
35                     ielist))))
36    (if (and (listp elist)
37             (every #'(lambda (x) (and (listp x) (= 3 (length x)))) elist))
38	(let ((found (find key elist :test #'alike1 :key #'second)))
39	  (if found (third found) default))
40	(merror (intl:gettext "assoc: every list element must be an expression with two arguments; found: ~:M") ielist))))
41
42;;; (ASSOL item A-list)
43;;;
44;;;  Like ASSOC, but uses ALIKE1 as the comparison predicate rather
45;;;  than EQUAL.
46;;;
47;;;  Meta-Synonym:	(ASS #'ALIKE1 ITEM ALIST)
48
49(defun assol (item alist)
50  (dolist (pair alist)
51    (if (alike1 item (car pair)) (return pair))))
52
53(defun assolike (item alist)
54  (cdr (assol item alist)))
55
56;;; (MEMALIKE X L)
57;;;
58;;;  Searches for X in the list L, but uses ALIKE1 as the comparison predicate
59;;;  (which is similar to EQUAL, but ignores header flags other than the ARRAY
60;;;  flag)
61;;;
62;;;  Conceptually, the function is the same as
63;;;
64;;;    (when (find x l :test #'alike1) l)
65;;;
66;;;  except that MEMALIKE requires a list rather than a general sequence, so the
67;;;  host lisp can probably generate faster code.
68(defun memalike (x l)
69  (do ((l l (cdr l)))
70      ((null l))
71    (when (alike1 x (car l)) (return l))))
72
73;;; Return the first duplicate element of the list LIST, or NIL if there
74;;; are no duplicates present in LIST.  The function KEY is applied to
75;;; each element of the list before comparison (or uses the element itself
76;;; if KEY is NIL), and the comparison is done with the function TEST.
77;;;
78;;; This was written with "small" lists in mind.  The original use case
79;;; was finding duplicates in parameter lists of functions, etc.
80;;;    - Kris Katterjohn 06/2017
81(defun find-duplicate (list &key (test #'eql) key)
82  (declare (optimize (speed 3)))
83  (declare (type (or function null) key)
84           (type function test))
85  (let ((seen nil))
86    (dolist (e list)
87      (let ((i (if key (funcall key e) e)))
88        (when (member i seen :test test)
89          (return-from find-duplicate e))
90        (push i seen)))))
91
92;;; Return a Maxima gensym.
93;;;
94;;; N.B. Maxima gensyms are interned, so they are not Lisp gensyms.
95;;; This function can return the same symbol multiple times, it can
96;;; return a symbol that was created and used elsewhere, etc.
97;;;
98;;; Maxima produces some expressions that contain Maxima gensyms, so
99;;; the use of uninterned symbols instead can cause confusion (since
100;;; these print like any other symbol).
101(defmfun $gensym (&optional x)
102  (typecase x
103    (null
104     (intern (symbol-name (gensym "$G")) :maxima))
105    (string
106     (intern
107       (symbol-name (gensym (format nil "$~a" (maybe-invert-string-case x))))
108       :maxima))
109    ((integer 0)
110     (let ((*gensym-counter* x))
111       (intern (symbol-name (gensym "$G")) :maxima)))
112    (t
113     (merror
114       (intl:gettext
115         "gensym: Argument must be a nonnegative integer or a string. Found: ~M") x))))
116