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