translator: fix bogus error reporting that caused lisp errors
[maxima.git] / src / trutil.lisp
blob72d93d00ffba66d40c0e3e78b5858f76bddbc913
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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11 (in-package :maxima)
13 (macsyma-module trutil)
15 (defun tr-gensym ()
16 (intern (symbol-name (gensym "TR-GENSYM")) :maxima))
18 (defun push-defvar (var val)
19 ;; makes sure there is a form in the beginning of the
20 ;; file that insures the special variable is declared and bound.
21 (or (member var defined_variables :test #'eq)
22 ;; $NO_DEFAULT says that the user takes responsibility for binding.
23 (eq $define_variable '$no_default)
24 ;; $MODE is same, but double-checks with the declarations available.
25 (and (eq $define_variable '$mode)
26 (tr-get-mode var))
27 (do ((l *pre-transl-forms* (cdr l)))
28 ((null l)
29 ;; push one with a priority of 1, which will be over-rided
30 ;; by any user-specified settings.
31 (if (eq $define_variable '$mode)
32 (tr-format (intl:gettext "note: variable ~:M being given a default assignment ~:M~%")
33 var (if (atom val) val
34 ;; strip off the quote
35 (cadr val))))
36 (push-pre-transl-form `(def-mtrvar ,var ,val 1)))
37 (let ((form (car l)))
38 (and (eq (car form) 'def-mtrvar)
39 (eq (cadr form) var)
40 (return ()))))))
42 (defun push-pre-transl-form (form)
43 (cond ((member form *pre-transl-forms* :test #'equal))
45 (push form *pre-transl-forms*)
46 (and *in-translate*
47 (let ((winp nil))
48 (unwind-protect (progn (eval form) (setq winp t))
49 (unless winp
50 (barfo "Bad *pre-transl-forms*"))))))))
52 (defun tr-nargs-check (form &optional (args-p nil) (nargs (length (cdr form))))
53 ;; the maclisp args info format is NIL meaning no info,
54 ;; probably a lexpr. or cons (min . max)
55 (and args-p
56 (let ((nargs (length (cdr form)))
57 (min (or (car args-p) (cdr args-p)))
58 (max (cdr args-p)))
59 (cond ((and min (< nargs min))
60 (tr-format (intl:gettext "error: too few arguments supplied to ~:@M~%~:M~%")
61 (caar form)
62 form))
63 ((and max (> nargs max))
64 (tr-format (intl:gettext "error: too many arguments supplied to ~:@M~%~:M~%")
65 (caar form)
66 form)))))
67 nargs) ;; return the number of arguments.