Код:
~ER\STR\STR-TO-NUMBERasm.F
\ STR>NUM \ a u — ? err| n 0
VOCABULARY LISP
ALSO LISP DEFINITIONS
\ типизация
-1 CONSTANT ??? \ неопределенно
0 CONSTANT NIL \ конец списка. спец. флаг
1 CONSTANT NUM \ число
\ что должна возвращать КАЖДАЯ функция на уровне форта:
\ зн. объектов
\ тип объектов
\ кол-во объектов
VECT OBJECT-FIND-L \ n a u — zn type n+1 true| n a u false
VECT SFIND-L \ a u — xt 0
\ лисповский интерпретатор
: INTERPRET
PARSE-NAME SFIND-L >R
0
BEGIN
PARSE-NAME
2DUP S" )" COMPARE
WHILE
OBJECT-FIND-L
0=
IF
SFIND-L
SWAP >R
EXECUTE
R> + \ суммируем кол-во объектов
THEN
\ проверка состояния стека
." GL: " DEPTH .SN CR
REPEAT
2DROP
;
: ( INTERPRET ;
\ пример лисповской функции +
: num+num \ zn1 t1 zn2 t2 .. znn tn n — zn type 1
>R
R@ 0= IF -2000 THROW THEN
NUM <> IF -2001 THROW THEN
-1 RP@ +!
>R
BEGIN
RP@ CELL+ @ WHILE
NUM <> IF -2001 THROW THEN
R> + >R
-1 RP@ CELL+ +!
REPEAT
R> NUM 1
RDROP
;
VECT +
' num+num TO +
: num-test
2DUP STR>NUM IF DROP 0 EXIT THEN
>R \ r: — num
2DROP
1+ >R \ r: num — num n
RP@ CELL+ @
NUM
R>
RDROP
TRUE
;
: sfind-test
SFIND 0= IF -2003 THROW THEN
;
' num-test TO OBJECT-FIND-L
' sfind-test TO SFIND-L
\EOF
пример:
( + 2 3 ( + 5 5 ( + 1 1 1 1 1 ) ) ( + 100 ) )
Соб-но безполезный лисп-интерпретатор с двумя функциями: + и NOOP
При желании эту развлекалку можно расширить, превратив во что-то более полезное.