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
|
;;; -*- Mode:LISP; Package:MACSYMA -*-
; ** (c) Copyright 1981 Massachusetts Institute of Technology **
(macsyma-module format)
(declare (special $floatformat $floatint $floatfrac $floatprec $floatwidth
$floatoptions $aliases stringdisp $lispdisp aliaslist)
(*expr print-fixed-field-floating print-fixed-precision-floating
string*1 assqr))
(defmvar $floatformat nil)
(defmvar $floatint 1)
(defmvar $floatfrac 2)
(defmvar $floatprec 3)
(defmvar $floatwidth 10.)
(defmvar $floatoptions nil)
(defprop print-fixed-field-floating (fformat fasl dsk liblsp) autoload)
(defprop print-fixed-precision-floating (fformat fasl dsk liblsp) autoload)
(defun number-exploden (form)
(cond ((and $floatformat (floatp form))
((lambda (list)
(cond ((null list) (exploden form))
((= $floatwidth 0) (delete 32. list))
(t list)))
(cond ((eq $floatformat '$f)
(print-fixed-field-floating
form (cond ((= $floatwidth 0) 15.) (t $floatwidth)) $floatfrac
(cons 'exploden (and $floatoptions
(mapcar 'stripdollar
(cdr $floatoptions))))))
(t
(print-fixed-precision-floating
form (cond ((= $floatwidth 0) 15.) (t $floatwidth)) $floatprec
(cons 'exploden (and $floatoptions
(mapcar 'stripdollar
(cdr $floatoptions))))
(cond ((numberp $floatint) $floatint)
(t (cdr $floatint))))))))
(t (exploden form))))
(declare (eval (read)))
(setsyntax '/# 'macro 'tyi)
(defun makestring (form)
((lambda (dummy)
(cond ((numberp form) (number-exploden form))
((and (setq dummy (get form 'reversealias)) (not (and (memq form $aliases) (get form 'noun))))
(exploden dummy))
(t (setq dummy (exploden form))
(cond ((= #$ (car dummy)) (cdr dummy))
((and stringdisp (= #& (car dummy))) (cons #" (nconc (cdr dummy) (list #"))))
((or (= #% (car dummy)) (= #& (car dummy))) (cdr dummy))
($lispdisp (cons #? dummy))
(t dummy)))))
nil))
(defun string* (x)
(or (and (numberp x) (number-exploden x))
((lambda (u) (cond (u (string*1 (car u))))) (assqr x aliaslist))
(string*1 x)))
(declare (eval (read)))
(setsyntax '/# 'macro nil)
(sstatus uuolinks)
|
