From 79902eeab82bc12f1b5216e431bd32dcc2243fe7 Mon Sep 17 00:00:00 2001 From: Hisashi Horikawa Date: Sat, 7 Sep 2024 21:40:29 +0900 Subject: [PATCH] =?UTF-8?q?evaluation=5Ftest=20=E6=9C=AA=E4=BA=86?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- environment.cpp | 35 +++++++++-------- environment.h | 18 +++++++++ evaluation.cpp | 81 ++++++++++++++++++--------------------- s_expr.h | 9 ++++- test/Makefile | 21 ++++++++-- test/environment_test.cpp | 12 ++---- test/evaluation_test.cpp | 56 ++++++++++++++++++++++++++- 7 files changed, 159 insertions(+), 73 deletions(-) diff --git a/environment.cpp b/environment.cpp index 36cba17..a12bee1 100644 --- a/environment.cpp +++ b/environment.cpp @@ -4,6 +4,7 @@ #include #include +#include using namespace icu; namespace my { @@ -43,10 +44,6 @@ EnvPtr function::bind_arguments(ListPtr eval_args) /////////////////////////////////////////////////////////////////////////// // class Environment -// TODO: インタプリタ class に移動 -EnvPtr global_env = std::make_shared(); - - Environment::Environment(EnvPtr outer) : m_outer(outer) { TRACE_ENV("Creating environment %p, outer=%p\n", this, m_outer.get() ); @@ -68,8 +65,8 @@ value_t Environment::find_value(const UnicodeString& symbol) return it->second.val; } - it = global_env->m_values.find(symbol); - if (it != global_env->m_values.end()) + it = globalEnv->m_values.find(symbol); + if (it != globalEnv->m_values.end()) return it->second.val; std::string u; @@ -85,8 +82,8 @@ FuncPtr Environment::find_function(const UnicodeString& symbol) return it->second; } - it = global_env->m_functions.find(symbol); - if (it != global_env->m_functions.end()) + it = globalEnv->m_functions.find(symbol); + if (it != globalEnv->m_functions.end()) return it->second; std::string u; @@ -104,15 +101,21 @@ void Environment::set_function(const UnicodeString& symbol, FuncPtr func) m_functions.insert(std::make_pair(symbol, func)); } -/* -Environment* Environment::getRoot() noexcept + +// TODO: インタプリタクラスへの移動 +EnvPtr globalEnv = std::make_shared(); + +void define_function(const icu::UnicodeString& name, + const icu::UnicodeString& params, + std::function func) { - // Work our way down the the global environment. - for (Environment* env = this; ; env = env->m_outer.get() ) { - if (!env->m_outer) - return env; - } + std::string u; + std::stringstream ss(params.toUTF8String(u) ); + value_t paramv = READ(ss); + ListPtr param_list = VALUE_CAST_CHECKED(list, paramv); + my::FuncPtr func_ptr = std::make_shared(name, param_list, func); + my::globalEnv->set_function(name, func_ptr); } -*/ + } // namespace my diff --git a/environment.h b/environment.h index cd41f60..ca6dedb 100644 --- a/environment.h +++ b/environment.h @@ -80,10 +80,20 @@ class Environment //: public RefCounted ~Environment(); // value を設定する + // (setq if 10) => これはエラー: PACKAGE-LOCK-VIOLATION. シンボルの束縛時にエラー. + // (let ((if 10)) (+ if 10)) => これは通る! 逆にこれがマクロを難しくする + // 定数への(再)代入はエラー. void set_value(const icu::UnicodeString& symbol, const value_t& value, bool constant); // function を設定する + // (defun if (x) (+ x 10)) => これはエラー: Special form is an illegal function name: IF. + // (defun list (x) (+ x 10)) #=> PACKAGE-LOCK-VIOLATION + // (defun nil (x) (+ x 10)) #=> PACKAGE-LOCK-VIOLATION. シンボルの束縛時にエラー + // 定数は set/find_value のほうなので、次は通る: + // * (defconstant fuga 10) + // FUGA + // * (defun fuga (x) (+ x 10)) void set_function(const icu::UnicodeString& symbol, FuncPtr value); // ローカルと, global environment から探す @@ -105,6 +115,14 @@ class Environment //: public RefCounted EnvPtr m_outer; }; +extern EnvPtr globalEnv; + +// global environment に関数を登録する +extern void define_function(const icu::UnicodeString& name, + const icu::UnicodeString& params, + std::function func); + + } // namespace my #endif // INCLUDE_ENVIRONMENT_H diff --git a/evaluation.cpp b/evaluation.cpp index 2ebcd65..055394a 100644 --- a/evaluation.cpp +++ b/evaluation.cpp @@ -57,18 +57,18 @@ struct Trampoline { b => 4 c => 7 */ -static Trampoline do_setq(std::shared_ptr args, EnvPtr env) +static Trampoline do_setq(std::shared_ptr form, EnvPtr env) { - if ( args->length() == 1) + if ( form->length() == 1) return Trampoline(nilValue); - if ( (args->length() % 2) == 0 ) + if ( (form->length() % 2) == 0 ) throw std::runtime_error("odd number of args to SETQ"); value_t ret; - for (int i = 1; i < args->length(); i += 2) { - std::shared_ptr id = VALUE_CAST_CHECKED(symbol, args->at(i)); + for (int i = 1; i < form->length(); i += 2) { + std::shared_ptr id = VALUE_CAST_CHECKED(symbol, form->at(i)); // 定数へ代入しようとしてエラーがありうる - ret = EVAL(args->at(i + 1), env); + ret = EVAL(form->at(i + 1), env); env->set_value(id->name(), ret, false); } @@ -113,37 +113,37 @@ if test-form then-form [else-form] => result* (if test-form then-form else-form) == (cond (test-form then-form) (t else-form)) */ -static Trampoline do_if(std::shared_ptr args, EnvPtr env) +static Trampoline do_if(std::shared_ptr form, EnvPtr env) { - if ( !(args->length() >= 3 && args->length() <= 4) ) + if ( !(form->length() >= 3 && form->length() <= 4) ) throw std::runtime_error("args error"); - bool isTrue = value_isTrue(EVAL(args->at(1), env)); - if (!isTrue && args->length() == 3) + bool isTrue = value_isTrue(EVAL(form->at(1), env)); + if (!isTrue && form->length() == 3) return Trampoline(nilValue); - return Trampoline(Trampoline::MORE, args->at(isTrue ? 2 : 3)); // TCO + return Trampoline(Trampoline::MORE, form->at(isTrue ? 2 : 3)); // TCO } // 順に評価 -static Trampoline do_progn(std::shared_ptr args, EnvPtr env) +static Trampoline do_progn(std::shared_ptr form, EnvPtr env) { - if (args->length() == 1) + if (form->length() == 1) return Trampoline(nilValue); int i; - for (i = 1; i < args->length() - 1; ++i) - EVAL(args->at(i), env); + for (i = 1; i < form->length() - 1; ++i) + EVAL(form->at(i), env); - return Trampoline(Trampoline::MORE, args->at(i)); // TCO + return Trampoline(Trampoline::MORE, form->at(i)); // TCO } -static Trampoline do_quote(std::shared_ptr args, EnvPtr env) +static Trampoline do_quote(std::shared_ptr form, EnvPtr env) { - if (args->length() != 2) + if (form->length() != 2) throw std::runtime_error("wrong number of args to QUOTE"); - return args->at(1); + return form->at(1); } static ListPtr make_progn(ListPtr list) @@ -155,15 +155,22 @@ static ListPtr make_progn(ListPtr list) } -// Special Operator LET, LET* -// 新しいスコープを導入する -static Trampoline do_let_star(std::shared_ptr args, EnvPtr env) +/** Special Operator LET, LET* +新しいスコープを導入する + (let ((if 10)) (+ if 10)) => これは通る! 逆にこれがマクロを難しくする +次は通らない: +* (defconstant hoge 10) +HOGE +* (let ((hoge 5)) (+ hoge 30)) #=> COMMON-LISP-USER::HOGE names a defined constant, and cannot be used in LET. +なので, 慣習として, 定数名は "+" で囲む +*/ +static Trampoline do_let_star(std::shared_ptr form, EnvPtr env) { - std::shared_ptr op = OBJECT_CAST(args->at(0)); + std::shared_ptr op = OBJECT_CAST(form->at(0)); bool is_star = op->name() == "LET*"; // (let () (+ 2 3)) 0個も可! - ListPtr bindings = VALUE_CAST_CHECKED(class list, args->at(1)); + ListPtr bindings = VALUE_CAST_CHECKED(class list, form->at(1)); EnvPtr inner = std::make_shared(env); for ( const auto& var : *bindings ) { std::shared_ptr sym; @@ -180,11 +187,12 @@ static Trampoline do_let_star(std::shared_ptr args, EnvPtr env) sym = VALUE_CAST_CHECKED(symbol, var); val = nilValue; } + // 定数の場合はここでエラー inner->set_value(sym->name(), val, false); } // an implicit progn. - return Trampoline(Trampoline::MORE, make_progn(args->sub(2)), inner); // TCO + return Trampoline(Trampoline::MORE, make_progn(form->sub(2)), inner); // TCO } @@ -224,30 +232,17 @@ static FuncPtr get_function(const value_t& func_name, EnvPtr env) // function name => function // name: function name // or lambda expression -static Trampoline do_function(std::shared_ptr args, EnvPtr env) +static Trampoline do_function(std::shared_ptr form, EnvPtr env) { - if (args->length() != 2) + if (form->length() != 2) throw std::runtime_error("wrong number of args to FUNCTION"); - return value_t(get_function(args->at(1), env)); + return value_t(get_function(form->at(1), env)); } -/* - if (special == "quasiquoteexpand") { - checkArgsIs("quasiquote", 1, argCount); - return quasiquote(list->item(1)); - } - - if (special == "quasiquote") { - checkArgsIs("quasiquote", 1, argCount); - ast = quasiquote(list->item(1)); - continue; // TCO - } -*/ - -// 仕様で決まっている。 -// See https://www.lispworks.com/documentation/HyperSpec/Body/03_ababa.htm +// Special operator の一覧は仕様で決まっている。後から追加できない。 +// -- 3.1.2.1.2.1 Special Forms struct SpecialForm { icu::UnicodeString name; std::function, EnvPtr )> func; diff --git a/s_expr.h b/s_expr.h index b01ed5d..0308bc6 100644 --- a/s_expr.h +++ b/s_expr.h @@ -170,11 +170,13 @@ class double_float : public number typedef std::variant< bool, int64_t, double, ObjectPtr > value_t; -bool value_isa(const value_t& , const icu::UnicodeString& klass); +extern bool value_isa(const value_t& , const icu::UnicodeString& klass); extern const std::shared_ptr nilValue; extern const std::shared_ptr trueValue; +extern value_t READ(std::istream& stream); + template inline std::shared_ptr<_T> OBJECT_CAST(const value_t& val) { @@ -373,7 +375,10 @@ class cons : public virtual list } // NIL を足してもよい. - void append(const value_t& ptr) { list_.push_back(ptr); } + list& append(const value_t& ptr) { + list_.push_back(ptr); + return *this; + } void pop_back() { list_.pop_back(); } diff --git a/test/Makefile b/test/Makefile index ca4a394..797ea61 100644 --- a/test/Makefile +++ b/test/Makefile @@ -4,8 +4,23 @@ TARGETS = ref_counted_test reader_test edit_line_test environment_test evaluation_test all: $(TARGETS) +# コンパイラオプション: +# https://best.openssf.org/Compiler-Hardening-Guides/Compiler-Options-Hardening-Guide-for-C-and-C++ +# 英語版のほうが更新されている。 + # GDB でデバグする場合, `-g` オプションよりも `-g3` のほうが便利. -CXXFLAGS = -Wall -Wextra -Wno-unused-parameter -Wno-format-extra-args -g3 +# _FORTIFY_SOURCE は副作用がありうる +CXXFLAGS = -Wall -Wextra -Wno-unused-parameter -Wno-format-extra-args -g3 \ + -O2 -Wformat -Wformat=2 -Wimplicit-fallthrough \ + -Werror=format-security \ + -U_FORTIFY_SOURCE -D_FORTIFY_SOURCE=3 \ + -D_GLIBCXX_ASSERTIONS \ + -fstrict-flex-arrays=3 \ + -fstack-clash-protection -fstack-protector-strong \ + -Wl,-z,nodlopen -Wl,-z,noexecstack \ + -Wl,-z,relro -Wl,-z,now \ + -Wl,--as-needed -Wl,--no-copy-dt-needed-entries \ + -fPIE -pie ref_counted_test: ref_counted_test.o $(CXX) $^ $(LDFLAGS) $(LDLIBS) -lstdc++ -licuuc -licuio -o $@ @@ -20,10 +35,10 @@ edit_line_test: edit_line_test.o ../edit_line.o $(CXX) $^ $(LDFLAGS) $(LDLIBS) -lstdc++ -licuuc -licuio -ledit -o $@ -environment_test: environment_test.o ../environment.o ../object_print.o +environment_test: environment_test.o ../environment.o ../object_print.o ../reader.o $(CXX) $^ $(LDFLAGS) $(LDLIBS) -lstdc++ -licuuc -licuio -ledit -o $@ -evaluation_test: evaluation_test.o ../evaluation.o ../environment.o ../object_print.o +evaluation_test: evaluation_test.o ../evaluation.o ../environment.o ../object_print.o ../reader.o $(CXX) $^ $(LDFLAGS) $(LDLIBS) -lstdc++ -licuuc -licuio -ledit -o $@ diff --git a/test/environment_test.cpp b/test/environment_test.cpp index b9846e2..e8b894e 100644 --- a/test/environment_test.cpp +++ b/test/environment_test.cpp @@ -7,10 +7,10 @@ namespace my { extern void PRINT(const value_t& value, std::ostream& out); } -my::value_t fun(my::EnvPtr env) +my::value_t hoge(my::EnvPtr args) { - my::value_t x = env->find_value("X"); - my::value_t y = env->find_value("Y"); + my::value_t x = args->find_value("X"); + my::value_t y = args->find_value("Y"); printf("callback!\n"); @@ -21,11 +21,7 @@ int main() { my::Environment env; - std::shared_ptr params = std::make_shared(); - params->append(std::make_shared("X")); - params->append(std::make_shared("Y")); - my::FuncPtr fn = std::make_shared("HOGE", params, fun); - env.set_function("HOGE", fn); + define_function("HOGE", "(x y)", hoge); // 呼び出し my::FuncPtr p = env.find_function("HOGE"); diff --git a/test/evaluation_test.cpp b/test/evaluation_test.cpp index b3309d7..6d0fca7 100644 --- a/test/evaluation_test.cpp +++ b/test/evaluation_test.cpp @@ -1,11 +1,65 @@ #include "../environment.h" +#include namespace my { - extern value_t EVAL(value_t ast, EnvPtr env); + extern value_t EVAL(value_t ast, EnvPtr env); + extern bool value_isTrue(const value_t& value) ; } +my::value_t func1(my::EnvPtr args) { + my::value_t x = args->find_value("X"); + int64_t v = std::get(x); + printf("func1: %ld\n", v); + + return x; +} + +my::value_t func2(my::EnvPtr args) { + my::value_t x = args->find_value("X"); + int64_t v = std::get(x); + printf("func2: %ld\n", v); + + return x; +} + +// ビルトイン関数 +// Function NOT +my::value_t do_not(my::EnvPtr args) { + my::value_t x = args->find_value("X"); + return value_isTrue(x) ? my::nilValue : my::trueValue; +} + +// ビルトイン関数 +// 標準出力に出力 +// Function WRITE, PRIN1, PRINT, PPRINT, PRINC +my::value_t do_print(my::EnvPtr args) { + my::value_t x = args->find_value("X"); + int64_t v = std::get(x); + printf("%ld\n", v); + + return my::nilValue; +} + + int main() { + define_function("FUNC1", "(x)", func1); + define_function("FUNC2", "(x)", func2); + define_function("NOT", "(x)", do_not); + define_function("PRINT", "(x)", do_print); + + icu::UnicodeString ast = + "(progn " + " (setq x 5) " + " (if (not x) (func1 x) (let ((x 30)) (func2 x))) " + " (print x))"; + + std::string u; + std::stringstream ast_ss(ast.toUTF8String(u)); + my::value_t astv = my::READ(ast_ss); + + my::EVAL(astv, my::globalEnv); + return 0; }