share/numeric/format.lisp

   1 ;;; -*- Mode:LISP; Package:MACSYMA -*-
   2
   3 ;       ** (c) Copyright 1981 Massachusetts Institute of Technology **
   4
   5 (macsyma-module format)
   6
   7 (declare (special $floatformat $floatint $floatfrac $floatprec $floatwidth
   8                   $floatoptions $aliases $stringdisp $lispdisp))
   9
  10 (defmvar $floatformat nil)
  11 (defmvar $floatint 1)
  12 (defmvar $floatfrac 2)
  13 (defmvar $floatprec 3)
  14 (defmvar $floatwidth 10.)
  15 (defmvar $floatoptions nil)
  16
  17 (defprop print-fixed-field-floating (fformat fasl dsk liblsp) autoload)
  18 (defprop print-fixed-precision-floating (fformat fasl dsk liblsp) autoload)
  19
  20 (defun number-exploden (form)
  21        (cond ((and $floatformat (floatp form))
  22               ((lambda (list)
  23                        (cond ((null list) (exploden form))
  24                              ((= $floatwidth 0) (delete 32. list))
  25                              (t list)))
  26                (cond ((eq $floatformat '$f)
  27                       (print-fixed-field-floating
  28                        form (cond ((= $floatwidth 0) 15.) (t $floatwidth)) $floatfrac
  29                        (cons 'exploden (and $floatoptions
  30                                             (mapcar 'stripdollar
  31                                                     (cdr $floatoptions))))))
  32                      (t
  33                       (print-fixed-precision-floating
  34                        form (cond ((= $floatwidth 0) 15.) (t $floatwidth)) $floatprec
  35                        (cons 'exploden (and $floatoptions
  36                                             (mapcar 'stripdollar
  37                                                     (cdr $floatoptions))))
  38                         (cond ((numberp $floatint) $floatint)
  39                               (t (cdr $floatint))))))))
  40               (t (exploden form))))
  41
  42 (declare (eval (read)))
  43 (setsyntax '/# 'macro 'tyi)
  44
  45 (defun makestring (form)
  46   ((lambda (dummy)
  47     (cond ((numberp form) (number-exploden form))
  48           ((and (setq dummy (get form 'reversealias))
  49                 (not (and (member form $aliases :test #'eq) (get form 'noun))))
  50            (exploden dummy))
  51           (t (setq dummy (exploden form))
  52              (cond ((= #$ (car dummy)) (cdr dummy))
  53                    ((and $stringdisp (stringp form)) (cons #" (nconc dummy (list #"))))
  54                    ((= #% (car dummy)) (cdr dummy))
  55                    ($lispdisp (cons #? dummy))
  56                    (t dummy)))))
  57    nil))
  58
  59 (defun string* (x)
  60   (or (and (numberp x) (number-exploden x))
  61       (string*1 x)))
  62
  63 (declare (eval (read)))
  64
  65 (setsyntax '/# 'macro nil)