- 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
\ ;
Предложения, комментарии?