Репозиторий Sisyphus
Последнее обновление: 1 октября 2023 | Пакетов: 18631 | Посещений: 37501723
en ru br
Репозитории ALT
S:5.4.3-alt1
5.1: 4.14-alt1.M51.1
4.1: 3.9-alt8.M41.4
4.0: 3.1-alt6
3.0: 2.0-alt0.10.1
www.altlinux.org/Changes

Группа :: Система/Настройка/Прочее
Пакет: alterator

 Главная   Изменения   Спек   Патчи   Sources   Загрузить   Gear   Bugs and FR  Repocop 

Патч: alterator-5.1-eval-set-fix.patch
Скачать


diff --git a/alterator/interfaces/guile/security/wrap.scm b/alterator/interfaces/guile/security/wrap.scm
index 6966ebd..17b00ab 100644
--- a/alterator/interfaces/guile/security/wrap.scm
+++ b/alterator/interfaces/guile/security/wrap.scm
@@ -44,9 +44,36 @@
   (let* ((result (prepare-definitions <instructions>))
          (defs (car result))
          (insts (cdr result)))
-    `(let ,(map (lambda(x) (list x #f)) defs)
-       ,@(let ((convert (map (lambda(x) (if (definition? x) `(set! ,@(cdr x)) x)) insts)))
-           (if (eq? (car insts) 'list) (list convert) convert)))))
+    `(let ,(append (map (lambda(x) (list x #f)) defs)
+                   `((:list: '())))
+       ,@(let ((convert (map (lambda(x)
+                               (if (definition? x)
+                                   `(set! ,@(cdr x))
+                                   x))
+                             insts)))
+           (if (eq? (car insts) 'list)
+               (append
+                (fold (lambda (x xs)
+                        (if (and (pair? x)
+                                 (eq? (car x) 'set!))
+                            (append xs (list x))
+                            (if (or (null? xs)
+                                    (not (eq? (cadr (last xs)) ':list:)))
+                                (append xs
+                                  (list
+                                   `(set! :list:
+                                      (append :list:
+                                       ,(append `(list) (list x))))))
+                                (append (drop-right xs 1)
+                                  (list
+                                   `(set! :list:
+                                      (append :list:
+                                       ,(append (cadr (cdaddr (last xs)))
+                                                (list x)))))))))
+                      `()
+                      (cdr convert))
+                `(:list:))
+               convert)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
дизайн и разработка: Vladimir Lettiev aka crux © 2004-2005, Andrew Avramenko aka liks © 2007-2008
текущий майнтейнер: Michael Shigorin