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 buildq) 14 15;; Exported functions are $BUILDQ and MBUILDQ-SUBST 16;; TRANSLATION property for $BUILDQ in MAXSRC;TRANS5 > 17 18;;************************************************************************** 19;;****** ****** 20;;****** BUILDQ: A backquote-like construct for Macsyma ****** 21;;****** ****** 22;;************************************************************************** 23 24;;DESCRIPTION: 25 26 27;; Syntax: 28 29;; BUILDQ([<varlist>],<expression>); 30 31;; <expression> is any single macsyma expression 32;; <varlist> is a list of elements of the form <atom> or <atom>:<value> 33 34 35;; Semantics: 36 37;; the <value>s in the <varlist> are evaluated left to right (the syntax 38;; <atom> is equivalent to <atom>:<atom>). then these values are substituted 39;; into <expression> in parallel. If any <atom> appears as a single 40;; argument to the special form SPLICE (i.e. SPLICE(<atom>) ) inside 41;; <expression>, then the value associated with that <atom> must be a macsyma 42;; list, and it is spliced into <expression> instead of substituted. 43 44;;SIMPLIFICATION: 45 46 47;; the arguments to $BUILDQ need to be protected from simplification until 48;; the substitutions have been carried out. This code should affect that. 49 50(defprop $buildq simpbuildq operators) 51(defprop %buildq simpbuildq operators) 52 53;; This is modeled after SIMPMDEF, SIMPLAMBDA etc. in JM;SIMP > 54 55(defun simpbuildq (x ignored simp-flags) 56 (declare (ignore ignored simp-flags)) 57 (cons '($buildq simp) (cdr x))) 58 59;; Note that supression of simplification is very important to the semantics 60;; of BUILDQ. Consider BUILDQ([A:'[B,C,D]],SPLICE(A)+SPLICE(A)); 61 62;; If no simplification takes place, $BUILDQ returns B+C+D+B+C+D. 63;; If the expression is simplified into 2*SPLICE(A), then 2*B*C*D results. 64 65 66 67;;INTERPRETIVE CODE: 68 69 70(defmspec $buildq (form) (setq form (cdr form)) 71 (cond ((or (null (cdr form)) 72 (cddr form)) 73 (merror (intl:gettext "buildq: expected exactly two arguments; found ~M") `(($buildq) ,@form))) 74 (t (mbuildq (car form) (cadr form))))) 75 76;; this macro definition is NOT equivalent because of the way lisp macros 77;; are currently handled in the macsyma interpreter. When the subr form 78;; is returned the arguments get MEVAL'd (and hence simplified) before 79;; we get ahold of them. 80 81;; Lisp MACROS, and Lisp FEXPR's are meaningless to the macsyma evaluator 82;; and should be ignored, the proper things to use are MFEXPR* and 83;; MMACRO properties. -GJC 84 85;;(DEFMACRO ($BUILDQ DEFMACRO-FOR-COMPILING T) 86;; (VARLIST . EXPRESSIONS) 87;; (COND ((OR (NULL VARLIST) 88;; (NULL EXPRESSIONS) 89;; (CDR EXPRESSIONS)) 90;; (DISPLA `(($BUILDQ) ,VARLIST ,@EXPRESSIONS)) 91;; (MERROR "`buildq' takes 2 args")) 92;; (T `(MBUILDQ ',VARLIST ',(CAR EXPRESSIONS))))) 93 94 95(defun mbuildq (substitutions expression) 96 (cond ((not ($listp substitutions)) 97 (merror (intl:gettext "buildq: first argument must be a list; found ~M") substitutions))) 98 (mbuildq-subst 99 (mapcar #'(lambda (form) ; make a variable/value alist 100 (cond ((symbolp form) 101 (cons form (meval form))) 102 ((and (eq (caar form) 'msetq) 103 (symbolp (cadr form))) 104 (cons (cadr form) (meval (caddr form)))) 105 (t 106 (merror (intl:gettext "buildq: variable must be a symbol or an assignment to a symbol; found ~M") 107 form 108 )))) 109 (cdr substitutions)) 110 expression)) 111 112 113;; this performs the substitutions for the variables in the expressions. 114;; it tries to be smart and only copy what list structure it has to. 115;; the first arg is an alist of pairs: (<variable> . <value>) 116;; the second arg is the macsyma expression to substitute into. 117 118(defun mbuildq-subst (alist expression) 119 (prog (new-car) 120 (cond ((atom expression) 121 (return (mbuildq-associate expression alist))) 122 ((atom (car expression)) 123 (setq new-car (mbuildq-associate (car expression) alist))) 124 ((mbuildq-splice-associate expression alist) 125 ; if the expression is a legal SPLICE, this clause is taken. 126 ; a SPLICE should never occur here. It corresponds to `,@form 127 128 (merror (intl:gettext "splice: encountered 'splice' in an unexpected place: ~M") expression)) 129 ((atom (caar expression)) 130 (setq new-car (mbuildq-associate (caar expression) alist)) 131 (cond ((eq new-car (caar expression)) 132 (setq new-car (car expression))) 133 ((atom new-car) 134 (setq new-car (cons new-car (cdar expression)))) 135 (t (return 136 `(,(cons 'mqapply (cdar expression)) 137 ,new-car 138 ,@(mbuildq-subst alist (cdr expression))))))) 139 ((setq new-car 140 (mbuildq-splice-associate (car expression) alist)) 141 (return (append (cdr new-car) 142 (mbuildq-subst alist (cdr expression))))) 143 (t (setq new-car (mbuildq-subst alist (car expression))))) 144 (return 145 (let ((new-cdr (mbuildq-subst alist (cdr expression)))) 146 (cond ((and (eq new-car (car expression)) 147 (eq new-cdr (cdr expression))) 148 expression) 149 (t (cons new-car new-cdr))))))) 150 151;; this function returns the appropriate thing to substitute for an atom 152;; appearing inside a backquote. If it's not in the varlist, it's the 153;; atom itself. 154 155(defun mbuildq-associate (atom alist) 156 (let ((form)) 157 (cond ((not (symbolp atom)) 158 atom) 159 ((setq form (assoc atom alist :test #'eq)) 160 (cdr form)) 161 ((setq form (assoc ($verbify atom) alist :test #'eq)) 162 ;trying to match a nounified substitution variable 163 (cond ((atom (cdr form)) 164 ($nounify (cdr form))) 165 ((member (caar (cdr form)) 166 '(mquote mlist mprog mprogn lambda) :test #'eq) 167 ;list gotten from the parser. 168 `((mquote) ,(cdr form))) 169 (t `( (,($nounify (caar (cdr form))) 170 ,@(cdar (cdr form))) 171 ,@(cdr (cdr form)))))) 172 ;; ((<verb> ...) ...) ==> ((<noun> ...) ...) 173 (t atom)))) 174 175;; this function decides whether the SPLICE is one of ours or not. 176;; the basic philosophy is that the SPLICE is ours if it has exactly 177;; one symbolic argument and that arg appears in the current varlist. 178;; if it's one of ours, this function returns the list it's bound to. 179;; otherwise it returns nil. Notice that the list returned is an 180;; MLIST and hence the cdr of the return value is what gets spliced in. 181 182(defun mbuildq-splice-associate (expression alist) 183 (and (eq (caar expression) '$splice) 184 (cdr expression) 185 (null (cddr expression)) 186 (let ((match (assoc (cadr expression) alist :test #'eq))) 187 (cond ((null match) () ) 188 ((not ($listp (cdr match))) 189 (merror (intl:gettext "buildq: 'splice' must return a list, but ~M returned: ~M~%") 190 expression (cdr match))) 191 (t (cdr match)))))) 192