Плагин: Автостроки [Обновление 20/03/2012 18:03]

[VoidVolker]

Плагин предназначен для замены слова EVAL-SUBST. Позволяет создавать "умные" сроки, словом "одинарная кавычка": такие строки сами находят подстроки вида %<some_code%, код сразу же интерпретируется(в режиме компиляции - компилируется), при этом оставшийся текст автоматически дописывается к подстроке словом S+. В результате на стеке остается необходимая строка со всеми необходимым подстановками. При этом память, занятая промежуточными строками освобождается автоматически. Что позволяет избавиться от утечек памяти. Не освобождается только результирующая строка. Компиляция кода позволяет значительно ускорить расчет строки, по сравнению с EVAL-SUBST. В строках возможно использование символа экранирования для добавления в строку служебных символов. Плагин добавляет сборщик мусора для слова S+.

Code: Select all

\ Файл:       Autostrings.spf
\ Автор:      VoidVolker
\ Дата:       20/03/2012 18:03
\ Версия:     3.8
\ Описание:
\  Строки с саморазворачивающимися подстроками и эскейп-последовательностями.
\ 1. Строка вида 
\     " Число: %12345 N>S% Текстовая переменная: %ACTIVE-WINDOW% |nПеревод строки|n |qКавычки|q"
\   разворачивается в следующий код:
\     S" Число: " 12345 N>S S+  S" Текстовая переменная: " S+ ACTIVE-WINDOW S+
\     S"  |nПеревод строки|n |qКавычки|q" S+
\   В режиме компиляции подстрокам между % и % сразу же делается EVALUATE (т.е. код компилируется)
\   и далее автоматически компилируется S+
\   В режиме интерпретации код в подстроках просто интерпретируется, а S+ выполняется
\   Длина строк может быть более 255 символов.
\ 2. Поддерживаются т.н. "эскейп-последовательности" - т.е. определенные последовательности
\   символов будут сразу же заменяться на соответсвующие им символы.
\     |   -> 
\     ||  ->  |
\     |p  ->  %
\     |q  ->  "
\     |t  ->  <табуляция> 9
\     |v  ->  <вертикальная табуляция> 0xB
\     |r  ->  <возврат картеки>  0xD
\     |n  ->  <перевод строки> crlf  0x0D0A
\ Так же добавлены слова s" z" c" c поддержкой эскейп-последовательностей
\ Отличия от стандартных строк:
\   Во время выполнения кода в подстроках на стеке лежит собираемая строка;
\   Для чисел необходимо принудительно делать N>S - контроль глубины стека отсутствует,
\    т.е. код ОБЯЗАН ВОЗВРАЩАТЬ СТРОКУ, иначе будет исключение.
\ Автоматическая уборка мусора: после сложения двух строк запоминается адрес новой строки, и после
\    следующего сложения строк, адрес предыдущей строки освобождается. Для освобождения строки,
\    полученной в итоге, следует использовать слово LAS-FREE
\ LAS-FREE   \ ( -- ) \ Освободить память, занятую словом S+ при сложении строк.
\ Сборщик мусора для слова S+
\  TRASH(   \ ( -- ) \ Начать сбор мусора. Все строки, созданные словом S+ будут попадать в корзину.
\ Для ручного добавления или извлечения адресов используйте слова TRASH! и TRASH@ (только адреса,
\ выделенные словом ALLOCATE)
\  )TRASH   \ ( -- ) \ Закончить сбор мусора. Все адреса, находящиеся в корзине будут освобождены. Слово S+ больше не будет добавлять адреса в корзину.
\  TRASH!   \ ( addr -- ) \ Отправить адрес со стека в корзину. Только между слов TRASH( и )TRASH
\  TRASH@   \ ( -- addr ) \ Получить адрес из корзины.  Только между слов TRASH( и )TRASH

MODULE: AUTOSTRINGS_MODULE
  \ ### Поддержка эскейп-последовательностей ###

  USER esc-u1
  USER esc-a1

  : esc-c,
    esc-a1 @ C!
    esc-a1 1+!
  ;

EXPORT

  : resolve-escape   \ ( a u a1 -- a1 u1 )
    esc-a1 !        \ a u
    2DUP +          \ a u ae
    SWAP esc-u1 !   \ a ae
    SWAP            \ ae a
    BEGIN           \ ae a
      DUP C@ DUP [CHAR] | =
        IF  \ ae a char
          DROP DUP 1+ C@ CASE
            [CHAR] | OF [CHAR] | esc-c, 1+ -1 esc-u1 +! ENDOF
            [CHAR] p OF [CHAR] % esc-c, 1+ -1 esc-u1 +! ENDOF
            [CHAR] q OF [CHAR] " esc-c, 1+ -1 esc-u1 +! ENDOF
            [CHAR] t OF   9 esc-c, 1+ -1 esc-u1 +! ENDOF
            [CHAR] v OF 0xB esc-c, 1+ -1 esc-u1 +! ENDOF
            [CHAR] r OF 0xD esc-c, 1+ -1 esc-u1 +! ENDOF
            [CHAR] n OF 0xD esc-c, 0xA esc-c, 1+ ENDOF
            DUP OF ENDOF
          ENDCASE
        ELSE
          esc-c,
        THEN
        1+
      2DUP =
    UNTIL
    2DROP
    esc-a1 @ esc-u1 @ - esc-u1 @
    0 esc-c,
  ;

  : _sliteral-code
    R>      \ acnt
    XCOUNT  \ astr u
    2DUP    \ astr u astr u
    +       \ astr u astr+u
    1+      \ astr u astr+u+1
    >R      \ astr u
  ;
 
  : sliteral  \ ( a u -- ) \ Использует счетчик в 4 байта, что позволяет работать со строками до 4 Гб.
    STATE @
      IF
        ['] _sliteral-code COMPILE,
        HERE >R 0 ,      \ a u R: a1 \ Отмечаем адрес счетчика и резервируем для него место
        HERE resolve-escape \ a1 u1 \ Вычисляем эскейп-последовательности
        DUP 1+ ALLOT        \ a1 u1 \ резервируем память, занятую новой строкой
        R> !                \ a1    \ сохраняем счетчик
        DROP                \ убираем адрес
      ELSE
        2DUP + 0 SWAP C!
        OVER resolve-escape
      THEN
  ; IMMEDIATE

  : cliteral  \ ( a u -- )
    STATE @
      IF
        ['] _CLITERAL-CODE COMPILE,
        HERE >R 0 C,    \ a u R: a1 \ Отмечаем адрес счетчика и резервируем для него место
        HERE resolve-escape \ a1 u1 \ Вычисляем эскейп-последовательности
        DUP 1+ ALLOT        \ a1 u1 \ резервируем память, занятую новой строкой
        R> C!               \ a1    \ сохраняем счетчик
        DROP                \ убираем адрес
      ELSE
        2DUP + 0 SWAP C!
        OVER DUP >R 1+ resolve-escape
        R> C! 1-
      THEN
  ; IMMEDIATE

  : zliteral  \ ( a u -- )
    STATE @
      IF
        ['] _ZLITERAL-CODE COMPILE,
        HERE >R 0 ,      \ a u R: a1 \ Отмечаем адрес счетчика и резервируем для него место
        HERE resolve-escape \ a1 u1 \ Вычисляем эскейп-последовательности
        DUP 1+ ALLOT        \ a1 u1 \ резервируем память, занятую новой строкой
        R> !                \ a1    \ сохраняем счетчик
        DROP                \ убираем адрес
      ELSE
        2DUP + 0 SWAP C!
        OVER resolve-escape
        DROP
      THEN
  ; IMMEDIATE

  \ То же самое, что и стандартные строки - только с поддержкой эскейп-последовательностей.
  : s"
    [CHAR] " PARSE [COMPILE] sliteral
  ; IMMEDIATE

  : c"
    [CHAR] " PARSE [COMPILE] cliteral
  ; IMMEDIATE

  : z"
    [CHAR] " PARSE [COMPILE] zliteral
  ; IMMEDIATE

DEFINITIONS

  \ ### Сборщик мусора для слова S+ ###
  1024 CONSTANT /TRASH                \ Объем корзины, 1-ая ячейка - текущий объем, -1-ая - предыдущая корзина
  USER-VALUE TRASH                    \ Корзина, фактически - переменная, по сути - стек

EXPORT

  : TRASH!   \ ( addr -- ) \ Отправить адрес со стека в корзину. Только между слов TRASH( и )TRASH
    TRASH @ /TRASH <
    IF
      TRASH 1+!
      TRASH  TRASH @ CELLS  +  !
    ELSE
      DROP ABORT" Переполнение корзины! Увеличьте объем корзины для сборки мусора. Константа /TRASH"
    THEN
  ;
 
  : TRASH@   \ ( -- addr ) \ Получить адрес из корзины.  Только между слов TRASH( и )TRASH
    TRASH @
    IF
      TRASH  TRASH @ CELLS  + @
      -1 TRASH +!
    ELSE
      ABORT" Корзина пустая! Нельзя извлечь то, чего нет."
    THEN
  ;

DEFINITIONS

  ' S+ VALUE 'S+
 
EXPORT

  WARNING @ WARNING OFF
  'S+ ->VECT S+
  WARNING !
  'S+ ->VECT S1+
 
DEFINITIONS

  : STR+   \ ( a1 u1 a2 u2 -- a3 u3 ) \ Сложить две строки, добавить адрес новой строки в корзину
    S1+ OVER TRASH!
  ;
 
  : TRASH-FREE   \ ( -- ) \ Очистить корзину
    TRASH @ IF
      TRASH CELL+ TRASH @ CELLS + TRASH CELL+ DO
        I @ FREE THROW
      CELL +LOOP
    THEN
  ;
 
  USER-VALUE las-addr

EXPORT

  : LAS-FREE   \ ( -- ) \ Освободить память, занятую словом S+ при сложении строк.
    las-addr IF las-addr FREE THROW THEN
  ;
 
  : TRASH(   \ ( -- ) \ Начать сбор мусора. Все строки, созданные словом S+ будут попадать в корзину. Для ручного добавления или извлечения адресов используйте слова TRASH! и TRASH@ (только адреса, выделенные словом ALLOCATE)
    /TRASH CELLS ALLOCATE THROW
    TRASH OVER ! CELL+ TO TRASH
    ['] STR+ TO S+
  ;
 
  : )TRASH   \ ( -- ) \ Закончить сбор мусора. Все адреса, находящиеся в корзине будут освобождены. Слово S+ больше не будет добавлять адреса в корзину.
    'S+ TO S+
    TRASH-FREE
    TRASH CELL - DUP @ TO TRASH
    FREE THROW
  ;

DEFINITIONS
 
  \ ### Автостроки ###

  USER astra      \ Начальный адрес строки для разбора
  USER astru      \ Длина строки для разбора
  USER astrea     \ Конечный адрес строки для разбора
  USER astrla     \ Адрес последней обработанной строки
  USER astrings   \ Счетчик подстрок - позволяет избавляться от пустых подстрок

  : (s+)  \ Интепретируем S+ только если на стеке 2 строки
    astrings @ 2 =
      IF
        STATE @
          IF
            POSTPONE S+
          ELSE
            S+
          THEN
        1 astrings !
      THEN
  ;

  : interpret-code   \ ( a u -- )
    EVALUATE
    astrings 1+! (s+)
  ;

  : interpret-str   \ ( a u -- ) \ Интерпретировать строку и слово S+
    DUP
      IF
        astrings 1+!
        [COMPILE] sliteral
        (s+)
      ELSE
        2DROP
      THEN
  ;

  USER-VECT <subst-resolve>
  0 VALUE (code-resolve)'
  0 VALUE (str-resolve)'

  : (code-resolve)   \ ( i -- )  \ Обработали код(подстрока)
    (str-resolve)' TO <subst-resolve>
    >R
    astrla @ 1+ R@ OVER - \ Получаем строку
    interpret-code        \ Интерпретируем код
    R> 1+ astrla !        \ Сохраняем текущий адрес
  ;
  ' (code-resolve) TO (code-resolve)'

  : (str-resolve)   \ ( i -- )  \ Обработали строку
    (code-resolve)' TO <subst-resolve>
    >R
    astrla @ R@ OVER -    \ Получаем строку
    interpret-str         \ Интерпретируем строку
    R> astrla !           \ Сохраняем текущий адрес
  ;
  ' (str-resolve) TO (str-resolve)'

  : )ATRASH
    \ Результирующую строку убираем из корзины
    TRASH @ IF TRASH@ TO las-addr THEN
    )TRASH
  ;
 
EXPORT

  : "" S" " ;   \ Пустая строка - слово лишним не будет

  : "   \ ( -- a u ) ( " строка" -> )
    \ Парсим строку
    [CHAR] " PARSE    \ a u
    DUP
      IF
        \ Инициализируем переменные и векторы
        astrings OFF
        (str-resolve)' TO <subst-resolve>
        2DUP + astrea !
        astru ! DUP astra ! astrla !
        \ Открываем корзину
        STATE @
          IF
            POSTPONE TRASH(
          ELSE
            TRASH(
          THEN
           
       
        \ Обрабатываем строку в цикле
        astrea @ astra @ DO
          I C@ [CHAR] % =
            IF
              I <subst-resolve>
            THEN
        LOOP
       
        \ И интерпретируем последний кусочек строки
        astrla @ astrea @ OVER - interpret-str
        \ Закрываем корзину
        STATE @
          IF
            POSTPONE )ATRASH
          ELSE
            )ATRASH
          THEN
      ELSE
        [COMPILE] SLITERAL
      THEN
  ; IMMEDIATE

;MODULE

\ Тесты скорости

\ : t1
  \ GetTickCount
  \ 10000 0 DO
    \ S" Число:%12345% %QUOTE%Кавычки%QUOTE%%CRLF%Перевод строки%CRLF%Процент %PERCENT%" EVAL-SUBST
    \ 2DROP
  \ LOOP
  \ GetTickCount - ABS .
\ ;

\ : t2
  \ GetTickCount
  \ 10000 0 DO
    \ " Число:%12345 N>S% |qКавычки|q|nПеревод строки|nПроцент |p"
    \ 2DROP
  \ LOOP
  \ GetTickCount - ABS . CR
\ ;

Предложения, комментарии?

[AlikasS]

а чем плохо?

Code: Select all

S" Число:%12345 N>S% %QUOTE%Кавычки%QUOTE% Перевод%CRLF%строки" EVAL-SUBST MsgBox \ MsgBox для примера

[VoidVolker]

а чем плохо?

Code: Select all

S" Число:%12345 N>S% %QUOTE%Кавычки%QUOTE% Перевод%CRLF%строки" EVAL-SUBST MsgBox \ MsgBox для примера

А тем, что медленно.

[AlikasS]

а чем плохо?

Code: Select all

S" Число:%12345 N>S% %QUOTE%Кавычки%QUOTE% Перевод%CRLF%строки" EVAL-SUBST MsgBox \ MsgBox для примера

А тем, что медленно.

ну тогда хорошо бы замеры опубликовать
и код для теста который можно запустить и самому померять

[VoidVolker]

Так ведь было уже. Да и так понятно, что EVALUATE замедляет сильно.

[AlikasS]

Так ведь было уже. Да и так понятно, что EVALUATE замедляет сильно.

объясни, мне не понятно сколько я потеряю на EVAL-SUBST
и сколько на твоем коде
и по мимо быстродейсвия, еще бы неплохо отследить съедаемую память и
ее высвобождение (нет ли утечек)
и стоит ли овчина.....
P.S. при всем прочем, может стоит заменить слово "
на что-нибудь уникальное ну типа V"
V" Число:%12345 N>S% %QUOTE%Кавычки%QUOTE% Перевод%CRLF%строки"

[VoidVolker]

Расход памяти:

Code: Select all

HERE
: m1 S" Число:%12345% %QUOTE%Кавычки%QUOTE% Перевод%CRLF%строки" EVAL-SUBST ;
HERE - ABS .

HERE
: m2 " Число:%12345 N>S% %QUOTE%Кавычки%QUOTE% Перевод%CRLF%строки" ;
HERE - ABS . CR

80 146
Ok


В моем варианте при компиляции памяти расходуется немного больше - т.к. компиляция каждого слова занимает 5 дополнительных байт, а строки: 5 байт вызов _SLITERAL-CODE, еще байт счетчик и еще один байт на 0 в конце.
Во время работы утечки памяти отсутствуют. Расход памяти немного больше, в принципе промежуточные буферы можно освобождать.
Быстродействие:

Code: Select all

: t1
  GetTickCount
  1000 0 DO
    S" Число:%12345% %QUOTE%Кавычки%QUOTE% Перевод%CRLF%строки" EVAL-SUBST
    2DROP
  LOOP
  GetTickCount - ABS .
;

: t2
  GetTickCount
  1000 0 DO
    " Число:%12345 N>S% %QUOTE%Кавычки%QUOTE% Перевод%CRLF%строки"
    2DROP
  LOOP
  GetTickCount - ABS . CR
;

t1 t2
2000 63
Ok


Во время работы мой вариант быстрее стандартного приблизительно в 30 раз для тестовой строки, но это на версии крона 1.91.1083 без хеширования, а на бете с хешированием не проверял.
Во время компиляции время обработки моей строки незначительно медленнее стандартной.

[VoidVolker]

Ап! Добавил эскейп-последовательности и слова с их поддержкой s" z" c".

Code: Select all

" Число:%12345 N>S% /qКавычки/q/nПеревод строки/nПроцент /p" TYPE

Число:12345 "Кавычки"
Перевод строки
Процент % Ok


[VoidVolker]

Ап! Исправлены ошибки с векторами - они были глобальными, а должны быть пользовательскими; немного упрощен код.

[VoidVolker]

Ап! Исправлена логическая ошибка интерпретации пустых строк.

[ascerdfg1]

Подскажите плиз примеры из жизни применения этого плагина. Или это банально: "работа с базами данных"?

[VoidVolker]

Подскажите плиз примеры из жизни применения этого плагина.

Есть же в первом сообщении - замена вот такого не сильно понятного кода:

Code: Select all

S" Число: " 12345 N>S S+  S" Текстовая переменная: " S+ ACTIVE-WINDOW S+
S"  /nПеревод строки/n /qКавычки/q" S+

на более простой без потери в скорости выполнения:

Code: Select all

" Число: %12345 N>S% Текстовая переменная: %ACTIVE-WINDOW% /nПеревод строки/n /qКавычки/q"

Плюс эскейп-последовательности.
Т.е. и в первом и во втором случае будет скомпилирован идентичный код, а вот более понятный и простой исходный код во втором случае.

Или это банально: "работа с базами данных"?

К работе с БД не имеет никакого отношения.
Если кому-то интересен данный плагин - то(если надо конечно) могу добавить и освобождение временных буферов, что позволит оперировать любыми строками в любом количестве в течении продолжительного времени без утечек памяти.

[VoidVolker]

Ап! Устранена логическая ошибка, возникающая при определении пустой строки(0 попадал в DO LOOP).

[VoidVolker]

Ап! Добавлено слово "" .

[VoidVolker]

Ап! Символ экранирования заменен на вертикальную черту | - ибо надоело удваивать слэши для линков. Добавлена поддержка строк более 255 символов - счетчик 4 байта теперь. Подробности смотреть в слове sliteral .