1(in-package :maxima)
2
3#+ignore
4(defmspec $makelist (x)
5  (setq x (cdr x))
6  (prog (n form arg a b c d lv)
7     (setq n (length x))
8     (cond
9       ((= n 0) (return '((mlist))))
10       ((= n 1)
11        (setq form (first x))
12        (return
13          `((mlist) ,(meval `(($ev) ,@(list (list '(mquote) form)))))))
14       ((= n 2)
15        (setq form (first x))
16        (setq b ($float (meval (second x))))
17        (if (numberp b)
18            (return
19              (do
20               ((m 1 (1+ m)) (ans))
21               ((> m b) (cons '(mlist) (nreverse ans)))
22                (push (meval `(($ev) ,@(list (list '(mquote) form))))
23                      ans)))
24            (merror (intl:gettext "makelist: second argument must evaluate to a number; found: ~M") b)))
25       ((= n 3)
26        (setq form (first x))
27        (setq arg (second x))
28        (setq b (meval (third x)))
29        (if ($listp b)
30            (setq lv (mapcar #'(lambda (u) (list '(mquote) u)) (cdr b)))
31            (progn
32              (setq b ($float (meval b)))
33              (if ($numberp b)
34                  (return
35                    (do
36                     ((m 1 (1+ m)) (ans))
37                     ((> m b) (cons '(mlist) (nreverse ans)))
38                      (push
39                       (meval
40                        `(($ev) ,@(list (list '(mquote) form)
41                                        (list '(mequal) arg m)))) ans)))
42                (merror (intl:gettext "makelist: third argument must be a number or a list; found: ~M") b)))))
43       ((= n 4)
44        (setq form (first x))
45        (setq arg (second x))
46        (setq a (meval (third x)))
47        (setq b (meval (fourth x)))
48        (setq d ($float (meval `((mplus) ,b ((mtimes) ,a -1)))))
49        (if (numberp d)
50            (setq lv (interval2 a 1 d))
51            (merror (intl:gettext "makelist: the fourth argument minus the third one must evaluate to a number; found: ~M") d)))
52       ((= n 5)
53        (setq form (first x))
54        (setq arg (second x))
55        (setq a (meval (third x)))
56        (setq b (meval (fourth x)))
57        (setq c (meval (fifth x)))
58        (setq d ($float
59                 (meval
60                  `((mtimes) ((mplus) ,b ((mtimes) ,a -1)) ((mexpt) ,c -1)))))
61        (if (numberp d)
62            (setq lv (interval2 a c d))
63            (merror (intl:gettext "makelist: the fourth argument minus the third one, divided by the fifth one must evaluate to a number; found: ~M") d)))
64       (t (merror (intl:gettext "makelist: maximum 5 arguments allowed; found: ~M.~%To create a list with sublists, use nested makelist commands.") n)))
65
66     (return
67       (do ((lv lv (cdr lv))
68	    (ans))
69	   ((null lv) (cons '(mlist) (nreverse ans)))
70	 (push (meval `(($ev)
71			,@(list (list '(mquote) form)
72				(list '(mequal) arg (car lv)))))
73	       ans)))))
74
75
76(defmspec $makelist (x)
77  (setq x (cdr x))
78  (prog (n form arg a b c d lv)
79     (setq n (length x))
80     (cond
81       ((= n 0) (return '((mlist))))
82       ((= n 1)
83        (setq form (first x))
84        (return
85          `((mlist) ,(meval `(($ev) ,@(list (list '(mquote) form)))))))
86       ((= n 2)
87        (setq form (first x))
88        (setq b ($float (meval (second x))))
89        (if (numberp b)
90            (return
91              (do
92               ((m 1 (1+ m)) (ans))
93               ((> m b) (cons '(mlist) (nreverse ans)))
94                (push (meval `(($ev) ,@(list (list '(mquote) form))))
95                      ans)))
96            (merror (intl:gettext "makelist: second argument must evaluate to a number; found: ~M") b)))
97       ((= n 3)
98        (setq form (first x))
99        (setq arg (second x))
100        (setq b (meval (third x)))
101        (if ($listp b)
102            (setq lv (mapcar #'(lambda (u) (list '(mquote) u)) (cdr b)))
103	  (return(simple_makelist5 form arg 1 (meval b) 1))
104   ))
105       ((= n 4)
106        (setq form (first x))
107        (setq arg (second x))
108        (setq a (meval (third x)))
109        (setq b (meval (fourth x)))
110        (setq d ($float (meval `((mplus) ,b ((mtimes) ,a -1)))))
111        (if (not (numberp d))
112            (merror (intl:gettext "makelist: the fourth argument minus the third one must evaluate to a number; found: ~M") d))
113	(return (simple_makelist5 form arg a b 1)))
114       ((= n 5)
115        (setq form (first x))
116        (setq arg (second x))
117        (setq a (meval (third x)))
118        (setq b (meval (fourth x)))
119        (setq c (meval (fifth x)))
120        (setq d ($float
121                 (meval
122                  `((mtimes) ((mplus) ,b ((mtimes) ,a -1)) ((mexpt) ,c -1)))))
123        (if (not(numberp d))
124	  (merror (intl:gettext "makelist: the fourth argument minus the third one, divided by the fifth one must evaluate to a number; found: ~M") d))
125
126	(return (simple_makelist5 form arg a b 1)))
127       (t (merror (intl:gettext "makelist: maximum 5 arguments allowed; found: ~M.~%To create a list with sublists, use nested makelist commands.") n)))
128
129     (return
130       (do ((lv lv (cdr lv))
131	    (ans))
132	   ((null lv) (cons '(mlist) (nreverse ans)))
133	 (push (meval `(($ev)
134			,@(list (list '(mquote) form)
135				(list '(mequal) arg (car lv)))))
136	       ans)))))
137
138  (defun simple_makelist5 (form arg a b c)  ; a, b, numbers. arg is symbol.
139      (progv (list arg) '(0)
140	(do ((count a (+ c count))
141	     (ans))
142	    ((> count b) (cons '(mlist)(nreverse ans)))
143	  (set arg count) ; this should be the counter. "set" is deprecated tho
144	  (push (meval form) ans))))
145
146