На этом шаге мы рассмотрим работу со стеком.

Функция PUSH помещает S-выражение в стек:

    (PUSH S-выражение Стек)

Вызов PUSH добавляет в начало списка, являющегося значением атома Стек, S-выражение, обновляя значение атома Стек.

Функция POP выталкивает элемент из стека. Ее синтаксис:

    (POP Стек)

Пример 1.

   $ (SETQ Y (4 5))
   (4 5)
   $ (PUSH (3) Y)
   ((3) 4 5)
   $ (POP Y)
   (3)
   $ Y
   (4 5)

Замечание. Функцию PUSH в версии muLISP81 можно определить следующим образом:

   (DEFUN PUSH (LAMBDA (A STACK)
      (SETQ STACK (CONS A (EVAL STACK)))
   ))

Пример 2. Копирование NUM символов строки ALPHABET в список TOWER.

   (DEFUN MKTOWER (LAMBDA (NUM ALPHABET TOWER)
      (LOOP
         ( (ZEROP NUM) (REVERSE TOWER) )
         (PUSH (POP ALPHABET) TOWER)
         (SETQ NUM (- NUM 1))
      )
   ))

Текст этой функции можно взять здесь.

Пример 3. Вывод списка на экран.

   (DEFUN PRNSTR (LAMBDA (LST)
      (LOOP
         ( (NULL LST) )
         (PRIN1 (POP LST))
      )
   ))

Текст этой функции можно взять здесь.

Пример 4. Функция GENSYM является конструктором атомов, который возвращает новое имя для атома вида G****, где **** является числом, увеличивающимся на единицу при каждом новом вызове функции GENSYM.

   (SETQ GENSYM 0)
   (DEFUN GENSYM (LAMBDA (NUM LST)
      (SETQ NUM (- 4 (LENGTH GENSYM)))
      (LOOP
         ( (ZEROP NUM) )
         ( PUSH 0 LST )
         ( SETQ NUM (- NUM 1)) )
      (PROG1
         (PACK (NCONC (CONS (QUOTE G) LST) (LIST GENSYM)))
         (SETQ GENSYM (+ GENSYM 1)) )
   ))

Текст этой функции можно взять здесь.

Пример 5. Функция, заменяющая атом Y на число, равное глубине вхождения атома Y в список LST в данной позиции списка, например, если

   Y = A
   LST = ((A B) A (C (A (A D)))),

то в результате получим: ((2 B) 1 (C (3 (4 D))))

   (DEFUN MAIN (LAMBDA (Y LST)
      (SETQ W (COPY LST LST Y))
      (COPY1 W W)
   ))
   ; ---------------------------- ;
   (DEFUN COPY (LAMBDA (LST LST1 Y)
   ; Построение списка, конгруэнтного списку LST и    ;
   ; содержащего различные (!) атомы вида G*** вместо ;
   ; вхождений атома Y                                ;
      (COND ( (NULL LST) NIL )
            ( (AND (ATOM LST) (EQ LST Y))  (GENSYM) )
            ( (AND (ATOM LST) (NOT (EQ LST Y))) LST )
            (  T  (CONS (COPY (CAR LST) LST1 Y)
                        (COPY (CDR LST) LST1 Y)
                  )
            )
      )
   ))
   ; --------------------------- ;
   (DEFUN COPY1 (LAMBDA (LST LST1)
   ; Построение списка, конгруэнтного списку LST и со-   ;
   ; держащего "глубины погружения" атомов G*** в список ;
   ; LST вместо них самих                                ;
       (COND ( (NULL LST) NIL )
             ( (AND (ATOM LST)
                    (EQ (CAR (UNPACK LST)) G))
                  (POISK LST LST1) )
             ( (AND (ATOM LST)
                    (NOT (EQ (CAR (UNPACK LST)) G)))
                  LST )
             (  T  (CONS (COPY1 (CAR LST) LST1)
                         (COPY1 (CDR LST) LST1)) )
       )
   ))
   ; ----------- ;
   (SETQ GENSYM 0)
   (DEFUN GENSYM (LAMBDA (NUM LST)
   ; Формирование новых атомов ;
      (SETQ NUM (- 4 (LENGTH GENSYM)))
      (LOOP
          ( (ZEROP NUM) )
          ( PUSH 0 LST )
          ( SETQ NUM (- NUM 1)) )
      (PROG1
          (PACK (NCONC (CONS (QUOTE G) LST) (LIST GENSYM)))
          (SETQ GENSYM (+ GENSYM 1))
      )
   ))
   ; ------------------------ ;
   (DEFUN POISK (LAMBDA (X LST)
   ; Нахождение "глубины погружения" X в список LST ;
      (COND ( (MEMBER X LST) 1 )
            ( (MEMBER2 X (CAR LST))
                        (+ 1 (POISK X (CAR LST))) )
            (   T   (POISK X (CDR LST)) )
      )
   ))
   ; -------------------------- ;
   (DEFUN MEMBER2 (LAMBDA (X LST)
   ; Предикат MEMBER2 устанавливает вхождение элемента X ;
   ; в многоуровневый список LST                         ;
      (COND ( (NULL LST) NIL)
            (  T  (OR (COND ( (ATOM (CAR LST))
                                  (EQ X (CAR LST)) )
                            (  T  (MEMBER2 X (CAR LST)) )
                      )
                      (MEMBER2 X (CDR LST))) )
      )
   ))

Текст этой функции можно взять здесь.

Замечание. Опишем функции POP и PUSH для версии muLISP85.

Функция (POP SYMBOL) возвращает "верхушку" (CAR) стека (списка), который называется SYMBOL, и заменяет значение SYMBOL на оставшуюся часть (CDR) стека. Например:

   $ (SETQ STACK-LIST '(A B C D E F))
   (A B C D E F)
   $ (POP STACK-LIST)
   A
   $ (POP STACK-LIST)
   B
   $ (POP STACK-LIST)
   C
   $ STACK-LIST
   (D E F)

Если SYMBOL не является символом, то возникает прерывание по ошибке "Несимвольный аргумент".

Если значение SYMBOL - не точечная пара, то функция POP возвращает NIL.

Данная специальная функция - это LISP-аналог выражения на машинном языке, предназначенного для выборки информации из "верхушки" стека.

Приведем реализацию функции в виде макроса:

   (DEFMACRO POP (SYM)
      (LIST 'PROG1
            (LIST 'CAR SYM)
            (LIST 'SETQ SYM (LIST 'CDR SYM)))
   )

Функция (PUSH FORM SYMBOL) оценивает FORM, "проталкивает" результат в стек (в SYMBOL) и заменяет значение SYMBOL на увеличенный стек. Функция PUSH возвращает увеличенный стек (список). Например:

   $ (SETQ STACK-LIST NIL)
   NIL
   $ (PUSH 'A STACK-LIST)
   (A)
   $ (PUSH 'B STACK-LIST)
   (B A)
   $ (PUSH 'C STACK-LIST)
   (C B A)
   $ STACK-LIST
   (C B A)

Если SYMBOL не является символом, то возникает прерывание по ошибке "Несимвольный аргумент".

Данная функция - это LISP-аналог выражения на машинном языке, предназначенного для размещения информации в "верхушке" стека.

Приведем реализацию функции в виде макроса:

   (DEFMACRO PUSH (OBJ SYM)
      (LIST 'SETQ SYM
           (LIST 'CONS OBJ SYM))
   )

Со следующего шага мы начнем рассматривать работу с файлами.

Предыдущий шаг Содержание Следующий шаг