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;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 9;;; Macros for TRANSL source compilation. ;;; 10;;; (c) Copyright 1980 Massachusetts Institute of Technology ;;; 11;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12 13(in-package :maxima) 14 15(macsyma-module transm macro) 16 17(defprop dcl maxdoc fasl-dir) 18 19(defmacro def%tr (name lambda-list &body body &aux definition) 20 (setq definition 21 (if (and (null body) (symbolp lambda-list)) 22 `(def-same%tr ,name ,lambda-list) 23 `(defun-prop (,name translate) ,lambda-list ,@body))) 24 `(eval-when (:compile-toplevel :execute :load-toplevel) 25 ,definition)) 26 27(defmacro def-same%tr (name same-as) 28 ;; right now MUST be used in the SAME file. 29 `(putprop ',name 30 (or (get ',same-as 'translate) 31 (maxima-error "DEF-SAME%TR: ~a has no TRANSLATE property, so I can't make an alias." ',same-as)) 32 'translate)) 33 34;;; declarations for the TRANSL PACKAGE. 35 36(declare-top 37 ;; The warning and error subsystem. 38 (special tr-abort ; set this T if you want to abort. 39 *translation-msgs-files*) ; the stream to print messages to. 40 ;; State variables. 41 (special *pre-transl-forms* ; push onto this, gets output first into the transl file. 42 *warned-un-declared-vars* 43 *warned-fexprs* 44 *warned-mode-vars* 45 warned-undefined-variables 46 transl-file 47 *in-compfile* 48 *in-translate-file* 49 *in-translate* 50 *untranslated-functions-called*)) 51 52(defmacro bind-transl-state (&rest forms) 53 ;; this binds all transl state variables to NIL. 54 ;; and binds user-settable variables to themselves. 55 ;; $TRANSCOMPILE for example can be set to TRUE while translating 56 ;; a file, yet will only affect that file. 57 ;; Called in 3 places, for compactness maybe this should be a PROGV 58 ;; which references a list of variables? 59 `(let (*warned-un-declared-vars* 60 *warned-fexprs* 61 *warned-mode-vars* 62 warned-undefined-variables 63 tr-abort 64 transl-file 65 *in-compfile* 66 *in-translate-file* 67 *in-translate* 68 *pre-transl-forms* 69 ($tr_semicompile $tr_semicompile) 70 (arrays nil) 71 (exprs nil) 72 (lexprs nil) 73 (fexprs nil) 74 (specials nil) 75 (declares nil) 76 ($transcompile $transcompile) 77 ($tr_numer $tr_numer) 78 defined_variables) 79 ,@forms)) 80 81(defun tr-format (sstring &rest argl &aux strs) 82 (if (consp *translation-msgs-files*) 83 (setq strs *translation-msgs-files*) 84 (setq strs (list *translation-msgs-files*))) 85 (loop for v in strs 86 do (apply #'mformat v sstring argl))) 87 88;; to use in mixing maxima and lisp 89;; (tr #$$f(x):=x+2$) 90(defmacro tr (u) 91 (and (consp u) 92 (eq (car u) 'quote) 93 (bind-transl-state (translate-macexpr-toplevel (second u))))) 94 95(defmacro maset (val ar &rest inds) 96 `(progn 97 (when (symbolp ,ar) 98 (setf ,ar (make-equal-hash-table ,(if (cdr inds) t nil)))) 99 (maset1 ,val ,ar ,@inds))) 100 101(defmacro maref (ar &rest inds) 102 (cond ((or (eql ar 'mqapply)(and (consp ar) (member 'mqapply ar :test #'eq))) 103 `(marrayref ,(first inds) ,@(cdr inds))) 104 ((consp ar)`(marrayref ,ar ,(first inds) ,@(cdr inds))) 105 (t 106 `(maref1 ,ar ,@inds)))) 107