Skip to content

Commit

Permalink
macro [wip.] テストが通らない
Browse files Browse the repository at this point in the history
  • Loading branch information
@hhorikawa
hhorikawa committed Sep 13, 2024
1 parent aeb3621 commit afbe43e
Show file tree
Hide file tree
Showing 12 changed files with 350 additions and 130 deletions.
3 changes: 1 addition & 2 deletions edit_line.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,8 +6,7 @@
#include "my_debug.h"
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>

//#include <unistd.h>
#include <editline/readline.h>
#include <unicode/unistr.h>
using namespace icu;
Expand Down
5 changes: 1 addition & 4 deletions environment.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -91,7 +91,6 @@ FuncPtr Environment::find_function(const UnicodeString& symbol)
throw std::invalid_argument(symbol.toUTF8String(u) );
}

extern void PRINT(const value_t& value, std::ostream& out);

void Environment::set_value(const UnicodeString& symbol, const value_t& value,
bool constant)
Expand All @@ -114,9 +113,7 @@ void define_function(const icu::UnicodeString& name,
const icu::UnicodeString& params,
std::function<my::value_t(my::EnvPtr)> func)
{
std::string u;
std::stringstream ss(params.toUTF8String(u) );
value_t paramv = READ(ss);
value_t paramv = read_from_string(params);
ListPtr param_list = VALUE_CAST_CHECKED(list, paramv);
my::FuncPtr func_ptr = std::make_shared<my::function>(name, param_list, func);
my::globalEnv->set_function(name, func_ptr);
Expand Down
49 changes: 41 additions & 8 deletions environment.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,8 +20,10 @@ class function : public object
function() { }

// 関数またはクロージャをつくって返す
function(const icu::UnicodeString& name, ListPtr params, ListPtr body,
EnvPtr outer) : m_name(name), m_params(params), m_body(body), m_outer_env(outer) { }
function(const icu::UnicodeString& name, ListPtr params,
ListPtr body, // (defun ff () 1) も通る
EnvPtr outer, bool isMacro = false) :
m_name(name), m_params(params), m_body(body), m_outer_env(outer), m_isMacro(isMacro) { }

function(const icu::UnicodeString& name, ListPtr params,
const std::function<value_t(EnvPtr)>& handler) :
Expand All @@ -32,15 +34,18 @@ class function : public object

icu::UnicodeString name() const { return m_name; }

bool is_builtin() const { return m_handler != nullptr; }
bool is_builtin() const noexcept { return m_handler != nullptr; }
bool is_macro() const noexcept { return m_isMacro ; }

ListPtr getBody() const { return m_body; }
ListPtr getBody() const noexcept { return m_body; }

// 実引数の bind だけをおこなう
EnvPtr bind_arguments(ListPtr evaled_args);

// 関数を実行. bind_arguments() を含む
value_t apply(ListPtr evaled_args);
virtual value_t apply(ListPtr evaled_args);

value_t expand_macro(ListPtr args);

private:
// クロージャは "<lambda>"
Expand All @@ -52,16 +57,44 @@ class function : public object
// ビルトイン
std::function<value_t(EnvPtr)> m_handler;

// implicit progn. nil がありえる
// implicit progn. nil がありえる.
ListPtr m_body;

EnvPtr m_outer_env; // lexical environment. function では NULL.
EnvPtr m_outer_env; // lexical environment. function, macro では NULL.

bool m_isMacro;
};

typedef std::shared_ptr<function> FuncPtr;

class GenericFunction : public function
{
public:
// 実引数の型によって, 実際に呼び出すメソッドが変わる
value_t apply(ListPtr evaled_args);
};


////////////////////////////////////////////////////////////////////////
// class Environment

/*
定数への再代入が禁止されるのであって、オブジェクトの変更は可能
-> 環境のほうで対応する
(defconstant const '(1 2 3))
(push 'x const)
; ==>
; (SETQ CONST (CONS 'X CONST))
error: CONST is a constant and thus can't be set.
* (defconstant const '(1 2 3))
CONST
* (nconc const 'x)
(1 2 3 . X)
* const
(1 2 3 . X)
*/


struct BoundValue {
value_t val;
Expand All @@ -81,7 +114,7 @@ class Environment //: public RefCounted

// value を設定する
// (setq if 10) => これはエラー: PACKAGE-LOCK-VIOLATION. シンボルの束縛時にエラー.
// (let ((if 10)) (+ if 10)) => これは通る! 逆にこれがマクロを難しくする
// (let ((if 10)) (+ if 10)) => これは通る! special op は function のほう.
// 定数への(再)代入はエラー.
void set_value(const icu::UnicodeString& symbol,
const value_t& value, bool constant);
Expand Down
154 changes: 116 additions & 38 deletions evaluation.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ namespace my {

value_t EVAL(value_t ast, EnvPtr env);

static value_t eval_atom(const value_t& atom, EnvPtr env)
value_t eval_atom(const value_t& atom, EnvPtr env)
{
std::shared_ptr<symbol> sym = OBJECT_CAST<symbol>(atom);
if (sym != nullptr) {
Expand Down Expand Up @@ -82,23 +82,13 @@ static Trampoline do_setq(std::shared_ptr<cons> form, EnvPtr env)
}


/*
(defun) はマクロで、次のように展開される
* (macroexpand '(defun dbl (n) (* 2 n)))
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL) (SB-C:%COMPILER-DEFUN 'DBL T NIL NIL))
(SB-IMPL::%DEFUN 'DBL
(SB-INT:NAMED-LAMBDA DBL
(N)
(BLOCK DBL (* 2 N)))))
T
/**
CL: (defun) はマクロ. 手抜きで, special op にする
defun function-name lambda-list [[declaration* | documentation]] form*
*/
/*
static ret_t do_flet()
static Trampoline do_defun(std::shared_ptr<cons> form, EnvPtr env)
{
if (special == "fn*") {
checkArgsIs("fn*", 2, argCount);
/*
const malSequence* bindings =
VALUE_CAST(malSequence, list->item(1));
StringVec params;
Expand All @@ -107,11 +97,26 @@ static ret_t do_flet()
VALUE_CAST(malSymbol, bindings->item(i));
params.push_back(sym->value());
}
*/

return mal::lambda(params, list->item(2), env);
}
return Trampoline(nilValue);
}

/**
CL: DO, DO* はマクロ。手抜きで, special op にする
do ({var | (var [init-form [step-form]])}*) (end-test-form result-form*) declaration* {tag | statement}*
*/
static Trampoline do_do(std::shared_ptr<cons> form, EnvPtr env)
{
/*
for (int i = 1; i < argCount; i++) {
EVAL(list->item(i), env);
}
ast = list->item(argCount);
continue; // TCO
*/
return Trampoline(nilValue);
}


/** then-form, else-form は 1文だけ.
Expand Down Expand Up @@ -201,7 +206,22 @@ static Trampoline do_let_star(std::shared_ptr<cons> form, EnvPtr env)
return Trampoline(Trampoline::MORE, make_progn(form->sub(2)), inner); // TCO
}

extern void PRINT(const value_t& value, std::ostream& out);
// val がリストで，かつ op シンボルか
// @return 違った場合 nullptr
std::shared_ptr<cons> starts_with(const value_t& val,
const icu::UnicodeString& op)
{
std::shared_ptr<cons> form = OBJECT_CAST<cons>(val);
if (form == nullptr)
return nullptr;

std::shared_ptr<symbol> sym = OBJECT_CAST<symbol>(form->at(0));
if ( sym == nullptr || sym->name() != op )
return nullptr;

return form;
}


// lambda form と (function ...) と共用
static FuncPtr get_function(const value_t& func_name, EnvPtr env)
Expand All @@ -219,16 +239,12 @@ static FuncPtr get_function(const value_t& func_name, EnvPtr env)
}
else {
// lambda expression
std::shared_ptr<cons> lambda_expr = OBJECT_CAST<cons>(func_name);
std::shared_ptr<cons> lambda_expr = starts_with(func_name, "LAMBDA");
if (lambda_expr == nullptr)
throw std::runtime_error("not symbol nor cons");
throw std::runtime_error("not symbol nor lambda expression");
if (lambda_expr->length() < 2)
throw std::runtime_error("args needed");

sym = VALUE_CAST_CHECKED(symbol, lambda_expr->at(0));
if ( sym == nullptr || sym->name() != "LAMBDA" )
throw std::runtime_error("not lambda");

// クロージャを作って返す
FuncPtr func = std::make_shared<function>("<lambda>",
OBJECT_CAST<list>(lambda_expr->at(1)),
Expand All @@ -250,6 +266,61 @@ static Trampoline do_function(std::shared_ptr<cons> form, EnvPtr env)
}


// マクロの外側でも使える
Trampoline do_quasiquote(std::shared_ptr<cons> form, EnvPtr env)
{
ListPtr tmpl = OBJECT_CAST<class list>(form->at(1));
if (!tmpl || tmpl->empty() )
return form->at(1); // シンボルもそのまま返せばよい

// `,x の形 tmpl = (unquote x)
std::shared_ptr<cons> unq = starts_with(tmpl->at(0), "UNQUOTE"); // ","
if (unq != nullptr) {
// `,1 => 1
// `,x => 変数 X を評価
// `,(+ 2 3) => 5 リストを評価
return EVAL(tmpl->at(1), env);
}
else {
// `,@s はエラー: `,@S is not a well-formed backquote expression
unq = starts_with(tmpl->at(0), "UNQUOTE-SPLICING"); // ",@"
if (unq != nullptr)
throw std::runtime_error("not a well-formed backquote expression");
}

// `(1 2) => (1 2)
// `(1 ,x 3) => x を評価して埋め込む
// `(1 ,@s 5) => s は LIST でなければならない。展開して埋め込む
std::shared_ptr<cons> ret = std::make_shared<class cons>();

for (const auto& v : *tmpl) {
std::shared_ptr<cons> sub = OBJECT_CAST<cons>(v);
if (sub != nullptr) {
std::shared_ptr<symbol> op = OBJECT_CAST<symbol>(sub->at(0));
if (op != nullptr && op->name() == "UNQUOTE") // ","
ret->append(EVAL(sub->at(1), env));
else if (op != nullptr && op->name() == "UNQUOTE-SPLICING") {// ",@"
ListPtr lst = VALUE_CAST_CHECKED(class list, EVAL(sub->at(1), env));
if ( !lst->empty()) // NIL のときは要素削除
ret->append_range(lst);
}
else {
Trampoline r = do_quasiquote(sub, env); // 再帰
ret->append(r.value);
}
}
else
ret->append(v); // 評価しない
}

// `() => NIL
if (ret->empty())
return Trampoline(nilValue);
else
return Trampoline(ret);
}


// Special operator の一覧は仕様で決まっている。後から追加できない。
// -- <a href="https://www.lispworks.com/documentation/HyperSpec/Body/03_ababa.htm">3.1.2.1.2.1 Special Forms</a>
struct SpecialForm {
Expand Down Expand Up @@ -288,6 +359,12 @@ static const SpecialForm specialForms[] = {
//{"multiple-value-call", },
//{"multiple-value-prog1", },
{"PROGN", do_progn},

// とりあえず special operator として追加する:
{"QUASIQUOTE", do_quasiquote},
{"DEFUN", do_defun},
{"DO", do_do},
{"DO*", do_do},
};


Expand All @@ -301,18 +378,6 @@ value_t macroExpand(const value_t& ast, EnvPtr env) {
}


/** 関数の実行
1. lambda form だけ特別扱いされる
((lambda lambda-list . body) . arguments)
is semantically equivalent to the function form
(funcall #'(lambda lambda-list . body) . arguments)
2. どのメソッドを呼び出すか、実引数を評価した後に決める
1. compute the list of applicable methods
2. if no method is applicable then signal an error
3. sort the applicable methods in order of specificity
4. invoke the most specific method.
*/
static ListPtr eval_args(ListPtr args, EnvPtr env)
{
std::cout << __func__ << ": "; PRINT(args, std::cout); std::cout << "\n"; // DEBUG
Expand All @@ -328,6 +393,19 @@ static ListPtr eval_args(ListPtr args, EnvPtr env)
}


/* 関数の実行
1. lambda form だけ特別扱いされる
((lambda lambda-list . body) . arguments)
is semantically equivalent to the function form
(funcall #'(lambda lambda-list . body) . arguments)
2. どのメソッドを呼び出すか、実引数を評価した後に決める
1. compute the list of applicable methods
2. if no method is applicable then signal an error
3. sort the applicable methods in order of specificity
4. invoke the most specific method.
*/

value_t EVAL(value_t ast, EnvPtr env)
{
while (true) {
Expand Down Expand Up @@ -372,7 +450,7 @@ value_t EVAL(value_t ast, EnvPtr env)
// だいぶ手抜きでいく
evaled = eval_args(list->sub(1), env);
// lambda form だけ特別扱いされる
func = get_function(list->at(0), env); // TODO: メソッド選定
func = get_function(list->at(0), env);
// ここではもう, 元の env は不要
if ( func->is_builtin() ) {
env = nullptr;
Expand Down
Loading

0 comments on commit afbe43e

Please sign in to comment.