/usr/share/maxima/5.41.0/src/transq.lisp is in maxima-src 5.41.0-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 | ;;; -*- Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The data in this file contains enhancments. ;;;;;
;;; ;;;;;
;;; Copyright (c) 1984,1987 by William Schelter,University of Texas ;;;;;
;;; All rights reserved ;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compilation environment for TRANSLATED MACSYMA code. ;;;
;;; (c) Copyright 1980 Massachusetts Institute of Technology ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :maxima)
;;; this are COMPILE-TIME macros for TRANSLATE MACSYMA code.
(macsyma-module transq macro)
(load-macsyma-macros transm)
(defmacro def-mtrvar (v a &optional (priority 1))
(declare (ignore priority))
;; ignored variable around for TRANSLATED files pre
;; 3:03pm Thursday, 11 March 1982 -gjc
`(progn
(declare-top (special ,v))
(if (or (not (boundp ',v))
;; a SYMBOL SET to ITSELF is considered to be
;; UNBOUND for our purposes in Macsyma.
(eq ,v ',v))
(setq ,v ,a))))
(define-compiler-macro mfunction-call (f &rest l &aux l1)
(setq l1 l)
(cond ((or (fboundp f)
(get f 'once-translated)
(get f 'translated))
(cons f l1))
(t `(lispm-mfunction-call-aux ',f ', l1 (list ,@ l1) nil))))
;;; macros for compiled environments.
;;; (FUNGEN&ENV-for-meval <eval vars list> <late eval vars list> . <EXP>)
;;; will define a function globally with a unique name
;;; (defun <name> <list of variables> <exp>). And return
;;; `((<name>) ,@<eval>> . <late eval>). The resulting expression may
;;; then be passed to a function which will bind variables from
;;; the <late eval vars list> and possibly other variables free in
;;; <exp> and then call MEVAL on the expression.
;;; the expression was translated using TR-LAMBDA.
(defvar *infile-name-key* '||
"This is a key gotten from the infile name, in the interpreter
other completely hackish things with FSUBRS will go on.")
(defmacro pop-declare-statement (l)
`(and (not (atom (car ,l)))
(eq (caar ,l) 'declare)
(pop ,l)))
;;; Lambda expressions emitted by the translator.
;; lambda([u,...],...) where any free unquoted variable in the body is
;; either unbound or globally bound or locally bound in some
;; non-enclosing block. At this point, BODY has already the correct
;; special declarations for elements of ARGL.
(defmacro m-tlambda (argl &body body)
`(function
(lambda ,argl
,@body)))
;; lambda([u,...,[v]],...) with the same condition as above.
(defmacro m-tlambda& (argl &rest body)
`(function (lambda (,@(reverse (cdr (reverse argl)))
&rest ,@(last argl))
,(pop-declare-statement body)
(setq ,(car (last argl))
(cons '(mlist) ,(car (last argl))))
,@ body)))
;; lambda([u,...],...) with free unquoted variables in the body which
;; have a local binding in some enclosing block, but no global one,
;; i.e, the complement of the condition for m-tlambda above.
(defmacro m-tlambda&env ((reg-argl env-argl) &body body)
(declare (ignore env-argl))
`(function
(lambda ,reg-argl
;;(,@(or (pop-declare-statement body) '(declare)) (special ,@env-argl))
,@body)))
;; lambda([u,...,[v]],...) with the same condition as above.
(defmacro m-tlambda&env& ((reg-argl env-argl) &body body)
(declare (ignore env-argl))
(let ((last-arg (car (last reg-argl))))
`(function
(lambda (,@(butlast reg-argl) &rest ,last-arg)
;;(,@(or (pop-declare-statement body) '(declare)) (special ,@env-argl))
,(pop-declare-statement body)
(setq ,last-arg (cons '(mlist) ,last-arg))
,@body))))
;; Problem: You can pass a lambda expression around in macsyma
;; because macsyma "general-rep" has a CAR which is a list.
;; Solution: Just as well anyway.
;;the lexical scoping handles the environment in most cases
;;and it is messy to queue things
;;; this is the important case for numerical hackery.
;;; This is not optimal code.
;;; I.E. IT SUCKS ROCKS.
(defmacro set-vals-into-list (argl var)
(do ((j 0 (1+ j))
(argl argl (cdr argl))
(l nil `((setf (nth ,j ,var) ,(car argl)) ,@l)))
((null argl) `(progn ,@l))))
|