Last update 1999/08/07

Scheme�����n�̐��� ��1��

(C)���R���V
���f�]�ڂ͋֎~�A�����N�̓t���[
�뎚�E���̎w�E�͊��}


�Q�[���ƃX�N���v�g

�͂��A�܂���ɂ���čs��������΂�����Ȋ��ł��B

�Ƃ����Ă��A���������Ԏ��̐S�̑傫�ȕ������߂Ă������ł͂���܂��B

����͌���̏����n�̕K�v���ɂ‚��Ă̖��ł��B

�Q�[������A����RPG�E�A�h�x���`���[�Ȃǂ́u�V�i���I�v�̏d�v�����������̂����̂ɕK�v�s�Œ��Ȃ��̂ɁA�u�C�x���g�X�N���v�g�̏����n�v�Ƃ������̂�����܂��B�l�b�g�ł����������u�C�x���g�X�N���v�g�̏����n�v�ɂ‚��čl����l�����Ȃ��Ȃ��̂��A���������K�v���̕\���ƌ�����ł��傤�B

�������A�������������n�́A���ꂼ��̃v���O���}���Ǝ��̕��@�Ńv���W�F�N�g���Ƃɍ�蒼���Ă���̂�����ł��B���ꂪ�A�R�[�h�̍ė��p�A�Ђ��Ắu�C�y�ɃQ�[�������v��ł̑傫�ȏ�Q�ɂȂ��Ă���͊ԈႢ����܂���B�V�i���I�X�N���v�g�h���u����RPG�AADV�A�V�~�����[�V����RPG�Ȃǂ���邽�߂ɂ͂������������n���K���K�v�ɂȂ�̂ɂ��ւ�炸�A�����́u������m��Ȃ��l�ɂ͌����ĈՂ������̂ł͂Ȃ��v�u������m���Ă�l�ɂƂ��Ă����Ȃ�ʓ|�Ȃ��̂ł���v����ł��B

���󂪂����Ȃ̂͂Ȃ����H ����ɂ́A�ȉ��̂悤�ȗ��R������ƍl���Ă��܂��B

���ꂼ��ɂ‚��čl���Ă݂܂��傤�B

����d�l�̍���

�����ɁAGNU�̎�Ɏ҃��`���[�h�E�X�g�[���}���́u�Ȃ�Tcl�ł͂��߂��H �v�Ƃ����_���i�̘a��j������܂��i���҂������‚���܂���ł����B��񋁃��j�BTcl�Ƃ́A���̓���UNIX�ł��Ȃ蕁�y���Ă����X�N���v�g����ł����A�X�g�[���}���́i�����I�Ȏv�f����������������܂��񂪁j�����ے肵����ŁAGNU�v���W�F�N�g�ɋ��ʂ̋@�\�g������̕K�v����i���܂����B

���̘_���ŐG����Ă���_��̒��ł����ŏd�v�Ȃ̂́A��܂��Ɍ����Ĉȉ���2�‚ł��B

�ȈՌ���̊ȈՌ��ꂽ��䂦��́A����̗p�r��z�肷�邱�Ƃɂ���āA���̗p�r�ւ̊ȕ֐��i�Z���L�q�ő傫�Ȍ��ʂ𓾂���j��񋟂������ɁA�ėp�����]���ɂ��Ă��邱�Ƃł��B

���̂��߁A�ȈՌ���ł́A���̊ȈՌ���̑z�肷�鉞�p�͈͂𒴂���Ƃ������đ傫�ȘJ�͂��K�v�ɂȂ邱�Ƃ����X����܂��B�v���O���~���O�Ƃ͊������Ƃ����Ă��Ă����Ȃ���̂ŁA���ꂪ�Q�[���̃X�N���v�g�ł���΂Ȃ����炻���ł���ƌ����Ă悢�ł��傤�B

�܂��A����̉��p�͈͂�z�肵���ȈՌ���ł́A�����炻�̌���Ɋ���Ă����̃m�E�n�E�������ɐ����܂���B���̌����z�肵���J���‹��̃T�|�[�g������ł��B���ǁA����ȃX�N���v�g������v���W�F�N�g���Ƃɍ�邭�炢��������n�[�h�R�[�f�B���O��������܂��A�Ƃ���������̂ł��B

����v���O���~���O�̓��

����v���O���~���O�͓���ƈ�ʂɎv���Ă��܂��B����͂���Ӗ��������A����Ӗ��Ԉ���Ă��܂��B

���ہA�ꂩ�玩���ō��Ƃ�����A�i���ꂪ�傫���ւ�邱�Ƃł͂���܂����j����͓�����Ԃ̂����邱�Ƃł���ƌ��킴��𓾂Ȃ��ł��傤�B

���������ꂾ���ɁA���̒��ɂ͂�����T�|�[�g����c�[�����������񂠂�̂ł��B������g���΁A���Ȃ�̎��Ԃ�ߖ񂷂邱�Ƃ��ł��܂��B

���Ƃ��΁A�ȉ��̏�������邱�Ƃɂ���āA�{���������v���O���~���O�̓�����y�����邱�Ƃ��ł��܂��B

�܂�lex�ɂ‚��āB����́A�v���O���}���������X�N���v�g����A�u�����͊�v�ƌĂ΂��e�L�X�g���g�[�N���i�P��̂悤�ȉ�͏�̒P�ʁj�ɕ�������v���O�����������I�ɐ�������c�[���ł��B�����͎͂菑�����Ă�����قǓ�����̂ł͂Ȃ��̂ł����A�ƂĂ��ʓ|�Ń����e�i���X�̑�ςȂ��̂ł��B�����Ŏ菑�����������ɂ�����g���΁A���K�\����u��ԁv���g���ĉ�͂��ȒP�ɍs�����Ƃ��ł��܂��B

����yacc�ɂ‚��āB����́u�\����͊�v�ƌĂ΂��A�g�[�N���̕��т𕪐͂��āu�\���؁v�ƌĂ΂������\������邽�߂̃c�[���ł��B�����lex�Ɠ����悤�ȗ��R�ŁA�菑���������yacc�X�N���v�g��������yacc�ɏ�������������J�������E�����e�i���X�̖ʂŐ��i�����I�ł��B

���́u�ȒP�ȕ��@�v�ɂ‚��āB�����n������ł͐�������܂ł�����܂���ˁB���ꂾ���łȂ��A���@���ȒP�ɂ���ƁA�����I�ɂ������b�g������܂��B�\�����ȒP���ƁA�i���Ƃ��΃N���X���t�@�����X�c�[���Ȃǂ́j�J���‹�����y�ɊJ���ł���悤�ɂȂ�̂ł��B����͌����ĕ���Ȃ������b�g�ƌ����Ă悢�ł��傤�B

����Ɂu���@�����v�ɂ‚��āB�J�Ԃ̌���ɂ́A�V���^�b�N�X�V���K�[�ƌĂ΂��A�{���K�v�łȂ����R�[�f�B���O�̌������̂��߂ɐ݂����Ă�����ʂȕ��@���������Ă��邱�Ƃ���������܂��B���������V���^�b�N�X�V���K�[�̓T�|�[�g�c�[���̍쐬�Ȃǂɂ��ז��ɂȂ邱�Ƃ������̂ŁA����Ă��܂��̂���ł��B

�Ō�ɃC���v�������g�Ɏg������ɂ‚��āB��قǐ��������悤�ɁA����̉�͂Ƃ̓e�L�X�g��؍\���ɕϊ����邱�Ɓi�����܂łł���Ό�͓���Ȃ��j�ƌ����Ă��ߌ��ł͂Ȃ��̂ŁA������T�|�[�g����@�\������ɂ���΁A�����͊i�i�ɂ��₷���Ȃ�܂��B�������A���s�����ȂǂƂ̌��ˍ���������̂ŁA���܂�}�C�i�[�Ȍ����I�Ԃ̂��l�����̂ł��傤�B

���ʉ��̓��

�������炢���Ă��܂��܂��傤�B���݂ł́A�E�B���h�E�v���O���~���O�̈�ʉ��ɂ��u�R�[���o�b�N�v�Ƃ����T�O�̕��y��ADLL�̂悤�ȋ��L���C�u�����̑��݂������āA���ʉ��͂��قǓ���͂���܂���B�d�v�Ȃ̂́A���������O������̃A�N�Z�X�ɑς�����悤�ɁA�u���͂̓t�@�C�����炾���v�Ƃ��u�O���֐����Ăяo���@�\���Ȃ��v�ȂǂƂ������������‚��Ȃ��悤�ɂ��邾���ł��B

���ʂ̏����n

�ȏ�̂悤�Ȋϓ_����A�Q�[���Ɋւ�炸�g����i�‚܂�PDS�����A�I�[�v���\�[�X�E�I�[�v���A�[�L�e�N�`���́j�����n�͕K�v�ł���A���Ž����”\�ł���Ǝ��͍l���܂����B�����ł������낤�Ƃ����̂��A���̃v���W�F�N�g�̊�{���O�ł��B

�Ȃ�scheme��I�񂾂��H

�Ȃ�scheme��I�񂾂��H ����́A��������܂łɌ������Ƃ̂���u������������v�̒��ŁA�����Ƃ��V���v���Ŕ��������@�������A�_��ȍ\���������邱�Ƃł��B

scheme��lisp�̔h�����ł���A�c��オ���Ă��܂���CommonLisp�̔��Ȃ��璍�Ӑ[���ŏ����̋@�\�������c�����A�������ꂽ����ł��B

scheme�̃v���O����������Ε�����Ǝv���܂����A�قƂ�ǁu�\�[�X���؍\���v�ƌ����Ă��ߌ��ł͂Ȃ��قǃV���v���ȍ\���ɂȂ��Ă���A�ق��̌���Ɍ�����悤�ȕ��ꂪ����܂���i�����scheme�ƌ������lisp�S�ʂ̓����ł��j�B���������č\����͂��ȒP�ł���A�T�|�[�g�c�[�����ȒP�ɍ��܂��B�܂��u���X�g������g�ݍ��݂̋@�\�ł���v�Ƃ��A�u�f�[�^�ƃR�[�h�̕\�L�`���������v�ȂǁA���܂��܂ȏ_��ȋ@�\�������Ă��܂��B���낢��Ȍ���̕��@�����Ă��܂������A�͂����肢���Ă���قǃQ�[�������̌��������܂���B

���_�Ƃ��ẮA�J�b�R���炯�Ń\�[�X���ǂ݂ɂ����Ƃ������Ƃ��������܂��B����͂悭������悤�Ɂu�ŏ������v�Ȃ̂œ��ɐS�z�v��܂���B�܂�emacs���g����Ȃ�A�I�[�g�C���f���g���������߁A�ق��̃G�f�B�^��C�̃R�[�h��������菑���₷�����炢�ł��i�t�Ɍ����ƁA�J�b�R�̑Ή��������Ă���Ȃ��G�f�B�^���Ǝ኱�X�g���X������܂��j�B

scheme�ɂ‚��Ă������ɓ��傪����悤�Ȃ̂ŁA���Ă݂�Ƃ悢�ł��傤�B

����

�J���‹�

���Ĕ\�����͂��̂��炢�ɂ��āA���ۂɎ������n�߂܂��傤�B

�܂��ȉ��̂悤�ȊJ���‹���z�肵�܂����B

scheme��I�񂾗��R�ɂ‚��Ă͑O�ɏq�ׂ܂����B

�����́E�\����͂�flex�Ebison�iGNU��lex�Eyacc�j��p����̂́A�P���Ɏg���̂Ǝg��Ȃ��̂Ƃł͂܂������J�͂��Ⴄ����ł��B�̂ƈ���āA���ł�flex��bison�ō��ꂽ�v���O���������p���pOK�i�炵���j�̂ŁA���̂܂܂œ��ɖ��Ȃ��Ǝv���܂����Ascheme�̏ꍇ�����́E�\����͂Ƃ��ɂ���Ȃɓ�����̂ł͂Ȃ��i�������‚Ď��͂��ׂĎ菑����scheme���ʓ|��CommonLisp��parser�Elexer�����������Ƃ�����j�̂ŁA�l�q�����ď����������Ǝv���܂��B

����Ɏ��������C++���g�����Ƃɂ‚��āBC++�ł́A���X�g�E�����񂱂��t�@�[�X�g�N���X�I�u�W�F�N�g�ł͂���܂��񂪁A���݂ł�STL�Astring�̑��݂łقڂ���ɏ�����ȕւ��𓾂��܂��B����𗘗p���邱�Ƃɂ���āA�����ȗʂ̘J�͂��팸�ł��邱�Ƃ��\�z�ł��܂��B

flex�Ebison��cygnus win32�̂��̂��AC++�R���p�C���ɂ�VC++���g���܂��B

������

�O�q�̂悤�ɁA�����͂�flex���g���܂��B

���ۂɂ͈ȉ��̂悤�ȃX�N���v�g�������܂����B

// ��ꕔ
%{
#include <io.h>
#include <FlexLexer.h>
#include "parser.cpp.h"    // ��ނȂ�
#define isatty _isatty
int mylineno = 0;
%}
// ���
letter 	[\x00-\xff]
kanji 	([\x80-\xff]{letter})
mark 	[\!\$\%\&\*\+\-\.\/\:\<\=\>\?\@\^\_~]
alpha 	[A-Za-z]
digit 	[0-9]
ws 	[ \t\n]
com 	\;
cr 	\n
escape 	\\
escaped ({escape}{letter})
dquote 	\"
ident 	({kanji}|{mark}|{alpha}|{digit})*
comment {com}[^\n]*{cr}
string 	{dquote}([^{escape}{dquote}]|{escaped})*{dquote}

%%
// ��O��
{cr} mylineno++;

{ws}+        	/* skip blanks and tabs */
{comment}    	/* skip comment */

\.            	{return DOT;}
{ident}        	{return IDENTIFIER;}
{string}    	{return STRING;}
\(            	{return LPAR;}
\)            	{return RPAR;}
\#            	{return SHARP;}
\'            	{return QUOTE;}

%%
// ��l��
int yywrap(void)
{
    return 1;
}

�ȒP�ɐ������Ă����܂��傤�B���Ȃ݂ɁA���̐F�̕����͕֋X��‚������̂Ŏ��ۂ̃X�N���v�g�ɂ͂���܂���B

flex�́A���̃X�N���v�g��ǂ�ŁA�����͂��s��C�iC++�j�\�[�X���o�͂��܂��B

��ꕔ�́Aflex���o�͂���\�[�X�̐擪�ɂ��̂܂ܑ}������镔���ł��B��ʂɃC���N���[�h�w��Ȃǂ��s���܂��B

��񕔂ł͕ʖ��̒�`���s���Ă��܂��B�}�N����`�̂悤�Ȃ��̂��Ǝv���ĉ������B���ۂɂ́A�����̖��O���ʂ̏ꏊ�Ɍ����ƉE���̂��̂ɒu���������܂��B�E���̕�����͐��K�\���ł��B

��O�����d�v�ȕ����ł��B��{�I�ɂ́A�������}�b�`���镶����A�E�����}�b�`�����Ƃ��̓����\���Ă��܂��B�����ł́A�g�[�N���̎�ނ��\����͊�ɓn�������Ȃ̂ŁA{return xxx;}�̗���ɂȂ��Ă��܂��B

��l�����o�͂ɒlj�����镔���ŁAflex���o�͂��Ȃ��i���K�v�Ƃ���j�R�[�h�������̂���ȗp�r�ɂȂ�܂��B

����ȏ�̏ڂ������ɂ‚��ẮA���̕ӂ����Q�Ƃ��Ă��������B

�\����́A�̑O�Ƀf�[�^�\��

���͍\����́A�Ƃ��������Ƃ���ł����A���̑O�ɍ\���؂��ǂ������\���Ŏ��‚����l���Ȃ���΂Ȃ�܂���B�Ƃ����̂��Ayacc������Ă����͓̂��ʂ̃p�^�[���Ƀ}�b�`���O���邱�Ƃ���������ł��B

�����ł́A���Ԑ���O��Ƃ���C++�Ő݌v���邱�Ƃɂ��܂����B

�\���؂̂悤�ȃf�[�^�\�������ꍇ�A�\���؂̂��ׂẴm�[�h��������N���X�i�����ł�IObject�Ƃ��܂��傤�j����h������̂͂܂����R�ƌ����Ă悢�ł����A���̊��N���X�ɂǂ̂悤�ȃC���^�[�t�F�C�X���������邩�ɂ‚��ẮA�I�������헪�͑傫�������Ĉȉ���2�‚ɂȂ�܂��B

�܂�Composite�f�U�C���p�^�[���ɂ‚��āBComposite�f�U�C���p�^�[���ł́A���Ƃ��΁u���̃I�u�W�F�N�g��������ł���Ɖ��肵�Ă��̕�����Ƃ��Ă̒l���擾�������Ƃ��v��z�肵�Ċ��N���X�Ɂu������Ƃ��Ă̒l���擾����v���\�b�h��u���܂��B�������ꎞ�������ŁA�V���{���Ƃ��āA���X�g�Ƃ��Ă̒l���擾���邽�߂ɂ������p�̃��\�b�h��lj����Ă������ƂɂȂ�܂��B

���̃p�^�[���̒����́A�g���Ƃ��ɂ��������_�E���L���X�g�𔺂��^���肪�K�v�Ȃ����Ƃł��B�t�ɂ��̃p�^�[���̌��_�́A�u�‚����ė��p���v���Ȃ����Ƃł��BIObject����V�����h���N���X�𓱓�����Ƃ��ɁA���̔h���N���X�ɕK�v�ȃC���^�[�t�F�C�X��IObject�ł����z�֐��錾���Ȃ���΂Ȃ�Ȃ�����ł��B

�����dynamic_cast��O��Ƃ����ŏ����̃C���^�[�t�F�C�X�ɂ‚��āB������ł́AIObject����h�������V�����N���X�𓱓�����Ƃ��ɂ�IObject�Ɏ��������K�v���Ȃ����߁A�u�‚����ė��p�v���”\�ł��B�������Ȃ���A���ۂɂ��̃N���X�̃I�u�W�F�N�g�ɓ������������Ƃ��ɂ́A�^�𔻒肵�ă_�E���L���X�g���s��Ȃ���΂Ȃ�܂���B

�ł͂��̏ꍇ�A�ǂ����I�Ԃ̂��悢�̂ł��傤���B

lisp�̃C���^�v���^��݌v�����o�����猾���΁A���̏ꍇ�͈��|�I�ɑO�҂ł��B��{�I�ɁA�V�X�e�������猩�Ė��m�̔h���N���X���ォ��lj������Ƃ������Ƃ��قڂ��肦�Ȃ����߁A�u�‚����ė��p���v�ɂ‚��čl����K�v������܂���B�܂��A���ꏈ���V�X�e���ł́u���[�U�̃~�X�v�����풃�ю��ŁA�I�u�W�F�N�g�ɂ������Ė{�����̃I�u�W�F�N�g�ɑ΂��čs���Ă͂Ȃ�Ȃ����삪�s���邱�Ƃ�����������܂��񂪁A���́u�~�X�v���m���Ƀg���b�v���Ȃ���΂Ȃ�܂���B���̍ۂɁA�u���N���X�̉��z�֐���throw���C���v�������g���Ă����A�I�[�o�[���C�h����Ă��Ȃ����肻�ꂪ���s�����v�悤�ɂ��Ă�����p����ϗL���Ȃ̂ł��B�������Ă������ƂŁA�Ăяo�����ŃI�u�W�F�N�g�̌^�`�F�b�N������K�v���قڂȂ��Ȃ�܂��B�ⓚ���p�ő�����s���Ă��܂��΁A�Ԉ���Ă���Ƃ��ɂ͓I�m�ɗ�O���ˏo����邩��ł��B

�Ƃ����킯�ō�����̂��ȉ��̃w�b�_�t�@�C���ł��B��X�I�u�W�F�N�g�̉i�������T�|�[�g���邱�Ƃ��l���āA�����‚��̃N���X����������Ă��܂����iDataBase,IClass,IWriter,IReader�Ȃǁj�A��{��IObject�Ƃ��̔h���N���X�ł��B

#if !defined(VSCHEME_HPP)
#define VSCHEME_HPP

#include <string>
#include <map>
#include <set>
#include <vector>
#include <list>

namespace vscheme {

/*============================================================================
*
* class IClass
*
* AbstractFactory
*
*==========================================================================*/

class IObject;
class IWriter;
class IReader;
class IClass {
public:
    IClass(void){}
    virtual ~IClass(void){}

    virtual IClass*     clone(void)const=0;
    virtual IObject*    create_object(void)const=0;
#if 0
    virtual void        write_object(IWriter&,IObject*)const=0;
    virtual void        read_object (IReader&,IObject*)const=0;
#endif

    virtual const char* get_name(void)const=0;

};

template <class T>
class Class : public IClass {
public:
    Class(void){}
    ~Class(void){}

    IClass*         clone(void)const
    {
        return new Class<T>;
    }
    IObject*        create_object(void)const
    {
        return new T;
    }
#if 0
    void            write_object(IWriter& w,IObject* o)const
    {
        w << (*((T*)o));
    }
    void            read_object (IReader& r,IObject* o)const
    {
        r >> (*((T*)o));
    }
#endif
    const char*     get_name(void)const
    {
        return typeid(T).name();
    }
};


/*============================================================================
*
* class DataBase
*
* �I�u�W�F�N�g�Ǘ�
*
*==========================================================================*/

template <class BaseObject>
struct GarbageFinder {
public:
    bool operator()(BaseObject* o)
    {
        return !o->get_mark();
    }

};

template <class BaseObject>
class DataBase {
public:
    DataBase(void){}
    virtual ~DataBase(void){}

    void                register_class(IClass* c)
    {
        vClasses.push_back(c->clone());
    }

    template <class T>
    BaseObject*         create(Class<T>& c)
    {
        BaseObject* o=c.create_object();
        vObjects.insert(o);
        return o;
    }

    void                destroy(BaseObject* o)
    {
        vObjects.remove(o);
        o->destroy();
    }

    void                clear(void)
    {
        foreach(std::set<BaseObject*>,vObjects,i){
            (*i)->destroy();
        }
        vObjects.clear();
        vNames.clear();
    }
    void                name_object(BaseObject* o,const std::string& s)
    {
        assert(o!=NULL);
        vNames[s]=o;
    }

    BaseObject*         get_named_object(const std::string& s)
    {
        return vNames[s];
    }

    void                collect_garbage(void)
    {

        // ���ׂẴI�u�W�F�N�g�̃}�[�N������
        {foreach(std::set<BaseObject*>,vObjects,i){
            (*i)->set_mark(false);
        }}
        // �������炽�ǂ��I�u�W�F�N�g�Ƀ}�[�N���‚���
        {foreach(std::map<std::string,BaseObject*>,vNames,i){
            if((*i).second!=NULL){
                (*i).second->mark();
            }
        }}
        // �}�[�N�̕t���ĂȂ��I�u�W�F�N�g���폜
        std::remove_if(
            vObjects.begin(),
            vObjects.end(),
            GarbageFinder<BaseObject>());
    }

    void save_to_stream(const std::ostream&){}
    void load_from_stream(const std::istream&){}

    std::set<BaseObject*>::const_iterator begin(void)const
    {return vObjects.begin();}
    std::set<BaseObject*>::const_iterator end (void)const
    {return vObjects.end();}

private:
    std::set<IClass*>                    vClasses;
    std::set<BaseObject*>                vObjects;
    std::map<std::string,BaseObject*>    vNames;

};

/*============================================================================
*
* class IObject
*
* �I�u�W�F�N�g�C���^�[�t�F�C�X
*
*==========================================================================*/

class Context;
class IObject {
public:
    IObject(void){}
    virtual ~IObject(void){}
    
    virtual void        destroy(void)                    {delete this;}
    virtual void        set_mark(bool f)                 {vMark=f;}
    virtual bool        get_mark(void)                   {return vMark;}
    virtual void        mark(void)                       =0;
    virtual void        print(std::ostream&)             =0;
    virtual void        eval(Context&)                   {}

    // as boolean
    virtual void        set_boolean(bool)                {throw 1;}
    virtual bool        get_boolean(void)                {throw 1;}

    // as symbol
    virtual void        set_name(const std::string& s)   {throw 1;}
    virtual std::string get_name(void)                   {throw 1;}
    virtual void        set_bind(IObject*)               {throw 1;}
    virtual IObject*    get_bind(IObject*)               {throw 1;}

    // as cons
    virtual void        set_car(IObject*)                {throw 1;}
    virtual void        set_cdr(IObject*)                {throw 1;}
    virtual IObject*    get_car(void)                    {throw 1;}
    virtual IObject*    get_cdr(void)                    {throw 1;}

    // as continuation
    virtual void        set_next(IObject*)               {throw 1;}
    virtual void        set_sexp(IObject*)               {throw 1;}
    virtual IObject*    get_next(void)                   {throw 1;}
    virtual IObject*    get_sexp(void)                   {throw 1;}

    // as string
    virtual void        set_string(const std::string& s) {throw 1;}
    virtual std::string get_string(void)                 {throw 1;}

    // as vector
    virtual void        set_elements(IObject*)           {throw 1;}
    virtual IObject*    get_elements(void)               {throw 1;}

private:
    bool vMark;

};

/*============================================================================
*
* class Nil
*
* Nil [()�̂���]
*
*==========================================================================*/

class Nil : public IObject {
public:
    Nil(void){}
    ~Nil(void){}

    void mark(void);
    void print(std::ostream&);

private:

};

/*============================================================================
*
* class Boolean
*
* �^�U�l (#f,#t)
*
*==========================================================================*/

class Boolean : public IObject {
public:
    Boolean(void){}
    ~Boolean(void){}

    void mark(void);
    void print(std::ostream&);

    // as boolean
    void        set_boolean(bool);
    bool        get_boolean(void);
    
private:
    bool        vBoolean;
    
};

/*============================================================================
*
* class Symbol
*
* �V���{��
*
*==========================================================================*/

class Symbol : public IObject {
public:
    Symbol(void){vBind=NULL;}
    ~Symbol(void){}

    void mark(void);
    void print(std::ostream&);

    // as symbol
    void        set_name(const std::string& s)    ;
    std::string get_name(void)                    ;
    void        set_bind(IObject*)                ;
    IObject*    get_bind(void)                    ;

private:
    std::string vName;
    IObject*    vBind;
};

/*============================================================================
*
* class Cons
*
* �R���X
*
*==========================================================================*/

class Cons : public IObject {
public:
    Cons(void){vCar=NULL;vCdr=NULL;}
    ~Cons(void){}

    void mark(void);
    void print(std::ostream&);

    // as cons
    void        set_car(IObject*)    ;
    void        set_cdr(IObject*)    ;
    IObject*    get_car(void)        ;
    IObject*    get_cdr(void)        ;

private:
    IObject*    vCar;
    IObject*    vCdr;

};

/*============================================================================
*
* class Continuation
*
* �p��
*
*==========================================================================*/

class Continuation : public IObject {
public:
    Continuation(void){vNext=NULL;vSExp=NULL;}
    ~Continuation(void){}

    void mark(void);
    void print(std::ostream&);

    // as continuation
    void        set_next(IObject*)    ;
    void        set_sexp(IObject*)    ;
    IObject*    get_next(void)        ;
    IObject*    get_sexp(void)        ;

private:
    IObject*    vNext;
    IObject*    vSExp;

};

/*============================================================================
*
* class String
*
* ������
*
*==========================================================================*/

class String : public IObject {
public:
    String(void){}
    ~String(void){}

    void mark(void);
    void print(std::ostream&);

    // as string
    void        set_string(const std::string& s);
    std::string get_string(void)                ;

private:
    std::string vString;

};

/*============================================================================
*
* class Vector
*
* �x�N�^
*
*==========================================================================*/

class Vector : public IObject {
public:
    Vector(void){}
    ~Vector(void){}

    void mark(void);
    void print(std::ostream&);

    // as vector
    void        set_elements(IObject*)    ;
    IObject*    get_elements(void)        ;

private:
    std::vector<IObject*>    vVector;
    
};

/*============================================================================
*
* class Context
*
* �]���R���e�L�X�g
*
*==========================================================================*/

class Context {
public:
    DataBase<IObject>       db;
    IObject*                nil;
    IObject*                quote;
    IObject*                b_false;
    IObject*                b_true;
};

}

extern int    yylex();
extern void yyerror(char*);
extern int    yyparse();
extern char* yytext;
extern int    yyleng;
extern vscheme::Context* pc;

#endif

�\�����

���āA���悢��{�Ԃ̍\����͂ł��B��{�I�ɂ�yacc�ɔC���邾���ł����Alisp�̍\���͂ƂĂ��ȒP�Ȃ��̂Ȃ̂ŁA����قǓ�����Ƃ͂���܂���B

�Ƃ͌����Ă�yacc��������Ȃ��ƕ�����Ȃ��Ǝv���܂����Ayacc�̐���������̂͂������ɑ�ςȂ̂ŁA�s�̂̏��ЂȂǂ��Q�l�ɂ��Ă��������i�c�O�Ȃ���K���ȓ��{��web���\�[�X�͌��‚���܂���ł����j�B

����́A�ȉ��̂悤��bison�X�N���v�g�������܂����B�|�C���g�́A�\���p�^�[���Ƀ}�b�`���閈�ɃI�u�W�F�N�g�𐶐����A�����ڑ����邱�Ƃł��B

pc�̓O���[�o���ϐ��ŁAparse_context�̗��ƍl���Ă��������B

pc->db.create(vscheme::Class<vscheme::Symbol>())

�́A

new vscheme::Symbol

�Ɠ����ł���ƍl���Ė�肠��܂���B

%{
#include <iostream>
#include <malloc.h>
#include "VScheme.hpp"
#define alloca _alloca
#define YYSTYPE vscheme::IObject*
%}
%token IDENTIFIER 
%token STRING
%token LPAR
%token RPAR
%token SHARP
%token QUOTE
%token DOT
%%
toplevel : /* �� */
        | toplevel sexp 
            {    
                $2->print(std::cout);
            }
;
sexp:    IDENTIFIER                
            {
                vscheme::IObject* o=
                    pc->db.create(vscheme::Class<vscheme::Symbol>());
                o->set_name(yytext);
                $$=o;
            }                
        | STRING                
            {
                vscheme::IObject* o=
                    pc->db.create(vscheme::Class<vscheme::String>());
                o->set_string(std::string(yytext+1,yyleng-2));
                $$=o;
            }
        | LPAR slist    
            {
                $$=$2;
            }
        | SHARP LPAR slist    
            {
                vscheme::IObject* o=
                    pc->db.create(vscheme::Class<vscheme::Vector>());
                o->set_elements($3);
                $$=o;
            }
        | QUOTE sexp            
            {
                vscheme::IObject* o=
                    pc->db.create(vscheme::Class<vscheme::Cons>());
                o->set_car(pc->quote);
                o->set_cdr($2);
                $$=o;
            }
;
slist:    DOT sexp RPAR
            {
                $$=$2;
            }
        | RPAR
            {
                $$=pc->nil;
            }
        | sexp slist
            {
                vscheme::IObject* o=
                    pc->db.create(vscheme::Class<vscheme::Cons>());
                o->set_car($1);
                o->set_cdr($2);
                $$=o;
            }
;
%%

�I�u�W�F�N�g�̎���

�Ō�̓I�u�W�F�N�g�̃C���^�[�t�F�C�X�̎����A����уp�[�T�̌Ăяo�������ł��B

���̕ӂ͂܂����������ł����A�K�v�ɉ����ď���������΂悢�ł��傤�B

// VScheme.cpp : �R���\�[�� �A�v���P�[�V�����p�̃G���g�� �|�C���g�̒�`
//

#include "stdafx.h"
#include "VScheme.hpp"

void yyerror(char* p)
{
	printf("error: %s\n",p);
}

int main(int argc, char* argv[])
{
	pc->nil 	=pc->db.create(vscheme::Class<vscheme::Nil>());
	pc->quote	=pc->db.create(vscheme::Class<vscheme::Symbol>());
	pc->quote->set_name("quote");
	pc->b_true	=pc->db.create(vscheme::Class<vscheme::Boolean>());
	pc->b_true->set_boolean(true);
	pc->b_false =pc->db.create(vscheme::Class<vscheme::Boolean>());
	pc->b_false->set_boolean(false);

	return yyparse();
}

vscheme::Context parse_context;
vscheme::Context* pc=&parse_context;

namespace vscheme {

#define MARK_OBJECT(x) if((x)!=NULL && !(x)->get_mark())(x)->mark()

/*============================================================================
 *
 * class Nil 
 *
 * 
 *
 *==========================================================================*/
// Nil �������� 

//****************************************************************
// mark
void Nil::mark(void)
{
}

//****************************************************************
// print
void Nil::print(std::ostream& os)
{
	os << "()";    
}

// Nil �����܂�

/*============================================================================
 *
 * class Boolean 
 *
 * �^�U�l (#f,#t)
 *
 *==========================================================================*/
// Boolean �������� 

//****************************************************************
// mark
void Boolean::mark(void)
{
}

//****************************************************************
// print
void Boolean::print(std::ostream& os)
{
	if(vBoolean){
		os << "#t";
	} else {
		os << "#f";
	}
}

//****************************************************************
// set_boolean
void		Boolean::set_boolean(bool f)
{
	vBoolean=f;
}

//****************************************************************
// get_boolean
bool		Boolean::get_boolean(void)
{
	return vBoolean;
}

// Boolean �����܂� 

/*============================================================================
 *
 * class Symbol 
 *
 * 
 *
 *==========================================================================*/
// Symbol �������� 

//****************************************************************
// mark
void Symbol::mark(void)
{
	set_mark(true);
	MARK_OBJECT(vBind);
}

//****************************************************************
// print
void Symbol::print(std::ostream& os)
{
	os << vName;
}

//****************************************************************
// set_name
void		Symbol::set_name(const std::string& s)		 
{
	vName=s;
}

//****************************************************************
// get_name
std::string Symbol::get_name(void)				
{
	return vName;
}

//****************************************************************
// set_bind
void		Symbol::set_bind(IObject* o)		   
{
	vBind=o;
}

//****************************************************************
// get_bind
IObject*	Symbol::get_bind(void)				
{
	return vBind;
}

// Symbol �����܂� 

/*============================================================================
 *
 * class Cons 
 *
 * 
 *
 *==========================================================================*/
// Cons �������� 

//****************************************************************
// mark
void Cons::mark(void)
{
	set_mark(true);
	MARK_OBJECT(vCar);
	MARK_OBJECT(vCdr);
}

//****************************************************************
// print
void Cons::print(std::ostream& os)
{
	os << '(';
	vCar->print(os);
	IObject* p=vCdr;
	while(typeid(*p)==typeid(Cons)){
		os << ' ';
		p->get_car()->print(os);
		p=p->get_cdr();
	}
	if(typeid(*p)==typeid(Nil)){
		os << ')';
	} else {
		os << " . ";
		p->print(os);
	}
}

//****************************************************************
// set_car
void		Cons::set_car(IObject* o)	 
{
	vCar=o;
}

//****************************************************************
// set_cdr
void		Cons::set_cdr(IObject* o)	
{
	vCdr=o;
}

//****************************************************************
// get_car
IObject*	Cons::get_car(void) 	  
{
	return vCar;
}

//****************************************************************
// get_cdr
IObject*	Cons::get_cdr(void) 	  
{
	return vCdr;
}

// Cons �����܂� 

/*============================================================================
 *
 * class Continuation 
 *
 * 
 *
 *==========================================================================*/
// Continuation �������� 

//****************************************************************
// mark
void Continuation::mark(void)
{
	set_mark(true);
	MARK_OBJECT(vNext);
	MARK_OBJECT(vSExp);
}

//****************************************************************
// print
void Continuation::print(std::ostream& os)
{
	os << "#<continuation>";
}

//****************************************************************
// set_next
void		Continuation::set_next(IObject* o)	
{
	vNext=o;
}

//****************************************************************
// set_sexp
void		Continuation::set_sexp(IObject* o)	 
{
	vSExp=o;
}

//****************************************************************
// get_next
IObject*	Continuation::get_next(void)	  
{
	return vNext;
}

//****************************************************************
// get_sexp
IObject*	Continuation::get_sexp(void)	  
{
	return vSExp;
}

// Continuation �����܂� 

/*============================================================================
 *
 * class String 
 *
 * 
 *
 *==========================================================================*/
// String �������� 

//****************************************************************
// mark
void String::mark(void)
{
	set_mark(true);
}

//****************************************************************
// print
void String::print(std::ostream& os)
{
	os << '"' << vString << '"';
}

//****************************************************************
// set
void		String::set_string(const std::string& s) 
{
	vString=s;
}

//****************************************************************
// get
std::string String::get_string(void)		
{
	return vString;
}

// String �����܂� 

/*============================================================================
 *
 * class Vector 
 *
 * 
 *
 *==========================================================================*/
// Vector �������� 

//****************************************************************
// mark
void Vector::mark(void)
{
	set_mark(true);
	for(std::vector<vscheme::IObject*>::iterator i=vVector.begin();
		i!=vVector.end();
		i++){
		MARK_OBJECT(*i);
	}
}

//****************************************************************
// print
void Vector::print(std::ostream& os)
{
	os << "#<vector>";
}

//****************************************************************
// set
void		Vector::set_elements(IObject* o)
{
}

//****************************************************************
// get
IObject*	Vector::get_elements(void)		
{
	return NULL;
}

// Vector �����܂� 

} // namespace vscheme

�����ň�x�e

���āAlisp�̃\�[�X�t�@�C����ǂ�ō\���؂̍\�z�܂łł���悤�ɂȂ�܂����B

�Ƃ�����������lisp�ischeme)�͎����Ă��܂��̂ŁA�����܂ł̎����ł��łɂ����̋@�\�𗘗p�����_��ȃf�[�^�x�[�X�Ƃ��Ă̎g�������ł��܂��B

�܂����̍\���؂����ۂɕ]�����镔�����c���Ă��܂����Alisp�́u�]���v�͂ƂĂ��P���Ȃ̂ŁA�����܂łłł���ΑS���ł��������R�ł��B��͂������A�I�u�W�F�N�g�̖������̕�������������΂��������ł��B

�@

�c�c�ƌ��������Ƃ���ł����A�c�O�Ȃ��炱��ɂ́u�]����lisp�Ȃ�΁v�Ƃ����A���������‚��܂��B

scheme�̏ꍇ�A�p���Ƃ����ƂĂ��厖�ȃI�u�W�F�N�g������܂��B���ꂪ�΂��ĈӖ��̂Ȃ����܂��I�ȋ@�\�ł���Ζ�������΍ςނ��ƂȂ̂ł����A���ꂪscheme�̍\���ォ�Ȃ�厖�ȏ�ɁA�Ђ���Ƃ�����Q�[���v���O���~���O�ɂ��v�V�I�Ȃقǖ𗧂‚����m��Ȃ��@�\�Ȃ̂ł��B

�ꉞ���̒��ɂ͂ǂ�����΂悢���Ƃ�����܂��Ȑ݌v�͗����Ă���i���̐݌v�͑O�o�̃\�[�X�ɂ��ꕔ����Ă���j�̂ŁA����i�ƌ����Ă����������Ō�j�͂�����l����Ƃ��납��n�߂����Ǝv���܂��B

����̃\�[�X

����̃\�[�X���܂Ƃ߂����̂��A�b�v���[�h���Ă����܂��B

vsch001.lzh


(C) 1998 Naoyuki Hirayama. All rights reserved.