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