lambda expr fix.

README.md

@@ -33,8 +33,8 @@ C++17
  - Eval  -- `EVAL()` が AST を評価.
    + ✅ 関数呼び出し. Function `FUNCALL`
    + ✅ atom の評価
-   + `lambda` 式からクロージャをつくる
-   + ユーザ関数の定義 `DEFUN`
+   + ✅ `lambda` 式からクロージャをつくる
+   + ✅ ユーザ関数の定義 `DEFUN`
    + ✅ Special operator `IF`
    + macro `DO`
    + ✅ Tail Call Optimization (TCO)

builtin-functions.cpp

@@ -0,0 +1,126 @@
+
+#include "environment.h"
+#include <unicode/unistr.h>
+#include <iostream>
+using namespace icu;
+
+namespace my {
+
+extern bool value_isTrue(const value_t& value) ;
+
+// Function MACROEXPAND, MACROEXPAND-1
+extern value_t macroExpand1(EnvPtr args);
+
+/* https://hyotang666.github.io/archives/structure-vs-class.html
+
+  DEFSTRUCT で自動生成される名前とビルトイン関数の名前が、チグハグ
+    predicate named name-p,
+       -- (typep subclass 'my-class) があれば足りる
+    constructor function named make-constructor-name
+       -- MAKE-INSTANCE があれば不要では?
+    copier function named copy-constructor-name
+       -- COPY-STRUCTURE があれば不要
+    STRUCT名-SLOT名というアクセサ. 総称関数ではない。slot名だけのほうがいい?
+       (slot-value c 'slot) これでアクセサがなくても値を取れる
+ */
+
+//////////////////////////////////////////////////////////////////////////
+// <object>
+
+// ビルトイン関数
+// Function NOT
+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
+value_t do_print(my::EnvPtr args) {
+    my::value_t x = args->find_value("X");
+    PRINT(x, std::cout);
+    std::cout << "\n";
+
+    return my::nilValue;
+}
+
+// (setq a 1) =>  1
+// (list a 2) =>  (1 2)
+value_t do_list(EnvPtr args) {
+    // 呼び出し時に評価済み
+    return args->find_value("OBJECTS");
+}
+
+
+//////////////////////////////////////////////////////////////////////////
+// <number>
+
+// ビルトイン関数
+value_t do_add(EnvPtr args)
+{
+    value_t x = args->find_value("X");  double xv = std::get<double>(x);
+    value_t y = args->find_value("Y");  double yv = std::get<double>(y);
+
+    return xv + yv;
+}
+
+value_t do_multiply(EnvPtr args)
+{
+    value_t x = args->find_value("X"); double xv = std::get<double>(x);
+    value_t y = args->find_value("Y"); double yv = std::get<double>(y);
+
+    return xv * yv;
+}
+
+
+//////////////////////////////////////////////////////////////////////////
+// <function>
+
+value_t do_mapcar(EnvPtr args)
+{
+    FuncPtr func = VALUE_CAST_CHECKED(function, args->find_value("FUNC"));
+    ListPtr list = VALUE_CAST_CHECKED(class list, args->find_value("LIST"));
+
+    std::shared_ptr<cons> ret = std::make_shared<cons>();
+    for (const auto& v : *list) {
+        // ここは eval しなおさない
+        std::shared_ptr<cons> args = std::make_shared<cons>();
+        args->append(v);
+        ret->append( func->apply(args) );
+    }
+
+    if (ret->empty())
+        return nilValue;
+    else
+        return ret;
+}
+
+
+struct BuiltinFunc {
+    const UnicodeString& name;
+    const UnicodeString& params;
+    std::function<my::value_t(my::EnvPtr)> func;
+};
+
+static const BuiltinFunc funcs[] = {
+    {"MACROEXPAND-1", "(form)", my::macroExpand1 },
+    // <object>
+    {"NOT", "(x)", my::do_not },
+    {"PRINT", "(x)", my::do_print },
+    {"LIST", "(&rest objects)", do_list },
+    // <number>
+    {"+", "(x y)", my::do_add },
+    {"*", "(x y)", my::do_multiply },
+    // <function>
+    {"MAPCAR", "(func list)", do_mapcar },
+};
+
+void setup_functions()
+{
+    for (const auto& f : funcs)
+        define_function(f.name, f.params, f.func);
+}
+
+
+} // namespace my

environment.cpp

@@ -17,26 +17,30 @@ icu::UnicodeString function::print() const {
     return "#<FUNCTION " + name() + ">";
 }
 
-// ビルトイン関数の実行
-// @param env 実引数が評価された環境
-value_t function::apply(ListPtr eval_args)
-{
-    EnvPtr inner = bind_arguments(eval_args);
-    return m_handler(inner);
-}
-
 EnvPtr function::bind_arguments(ListPtr eval_args)
 {
-    if (m_params->length() != eval_args->length())
-        throw std::runtime_error("Argument length mismatch");
-
-    EnvPtr inner = std::make_shared<Environment>(m_outer_env); // クロージャの場合
+    // クロージャの場合, 外側の環境を使える
+    EnvPtr inner = std::make_shared<Environment>(m_outer_env);
 
     // 突き合わせしながら環境に登録
-    for (int i = 0; i < m_params->length(); ++i) {
-        std::shared_ptr<symbol> id = VALUE_CAST_CHECKED(symbol, m_params->at(i));
-        inner->set_value(id->name(), eval_args->at(i), false);
+    list::const_iterator p = m_params->begin();
+    list::const_iterator q = eval_args->begin();
+    for ( ; p != m_params->end(); ++p, ++q) {
+        std::shared_ptr<symbol> id = VALUE_CAST_CHECKED(symbol, *p);
+        if (id->name() == "&REST") {
+            if ( (++p) == m_params->end())
+                throw std::runtime_error("&rest param missing");
+            id = VALUE_CAST_CHECKED(symbol, *p);
+            inner->set_value(id->name(), eval_args->sub(q), false);
+            return inner;
+        }
+
+        if (q == eval_args->end())
+            throw std::runtime_error("Argument length short");
+        inner->set_value(id->name(), *q, false);
     }
+    if (q != eval_args->end())
+        throw std::runtime_error("Argument length long");
 
     return inner;
 }

evaluation.cpp

@@ -31,6 +31,26 @@ bool value_isTrue(const value_t& value) {
     return true;
 }
 
+static ListPtr make_progn(ListPtr list)
+{
+    std::shared_ptr<cons> progn = std::make_shared<cons>();
+    progn->append(std::make_shared<symbol>("PROGN"));
+    progn->append_range(list);
+    return progn;
+}
+
+
+// ビルトイン関数の実行
+// @param evaled_args 評価された後の実引数のリスト
+value_t function::apply(ListPtr evaled_args)
+{
+    EnvPtr inner = bind_arguments(evaled_args);
+    if (is_builtin())
+        return m_handler(inner);
+
+    return EVAL(make_progn(m_body), inner);
+}
+
 
 /////////////////////////////////////////////////////////////////////////
 // Special Forms
@@ -88,16 +108,13 @@ defun function-name lambda-list [[declaration* | documentation]] form*
 */
 static Trampoline do_defun(std::shared_ptr<cons> form, EnvPtr env)
 {
-    /*
-                const malSequence* bindings =
-                    VALUE_CAST(malSequence, list->item(1));
-                StringVec params;
-                for (int i = 0; i < bindings->count(); i++) {
-                    const malSymbol* sym =
-                        VALUE_CAST(malSymbol, bindings->item(i));
-                    params.push_back(sym->value());
-                }
-    */
+    std::shared_ptr<symbol> name = VALUE_CAST_CHECKED(symbol, form->at(1));
+    ListPtr params = VALUE_CAST_CHECKED(class list, form->at(2));
+    ListPtr body = form->sub(3); // an implicit progn.
+
+    FuncPtr func_ptr = std::make_shared<function>(
+                                        name->name(), params, body, nullptr);
+    globalEnv->set_function(name->name(), func_ptr);
 
     return Trampoline(nilValue);
 }
@@ -157,14 +174,6 @@ static Trampoline do_quote(std::shared_ptr<cons> form, EnvPtr env)
     return form->at(1);
 }
 
-static ListPtr make_progn(ListPtr list)
-{
-    std::shared_ptr<cons> progn = std::make_shared<cons>();
-    progn->append(std::make_shared<symbol>("PROGN"));
-    progn->append_range(list);
-    return progn;
-}
-
 
 /** Special Operator LET, LET*
 新しいスコープを導入する

s_expr.h

@@ -278,13 +278,14 @@ class list : public virtual sequence
     // (car nil)         => NIL
     virtual value_t car() const noexcept = 0;
 
-    virtual ListPtr sub(int start) const = 0;
-
     // operator [] があるもの
     typedef std::vector<value_t> Container;
     typedef typename Container::const_iterator  const_iterator ;
     typedef typename Container::iterator        iterator ;
 
+    virtual ListPtr sub(int start) const = 0;
+    virtual ListPtr sub(const_iterator start) const = 0;
+
     virtual iterator begin() noexcept = 0;
     virtual iterator end() noexcept = 0;
     virtual const_iterator begin() const noexcept = 0;
@@ -348,6 +349,14 @@ class cons : public virtual list
             return std::make_shared<cons>(list_.begin() + start, list_.end());
     }
 
+    // @override
+    ListPtr sub(const_iterator start) const {
+        if (start == end())
+            return std::static_pointer_cast<list>(nilValue);
+        else
+            return std::make_shared<cons>(start, list_.end());
+    }
+
     // NIL を足してもよい.
     cons& append(const value_t& ptr) {
         list_.push_back(ptr);
@@ -406,6 +415,14 @@ class null : public virtual symbol, public virtual list
         return std::static_pointer_cast<list>(nilValue);
     }
 
+    // @override
+    ListPtr sub(const_iterator start) const {
+        if (start != begin())
+            throw std::out_of_range("start must eq begin()");
+
+        return std::static_pointer_cast<list>(nilValue);
+    }
+
     iterator begin() noexcept { return iterator(); }
     iterator end() noexcept { return iterator(); }
     const_iterator begin() const noexcept { return const_iterator(); }

test/Makefile

@@ -40,13 +40,13 @@ 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 ../reader.o
+environment_test: environment_test.o ../environment.o ../object_print.o ../reader.o ../evaluation.o ../macros.o
 	$(CXX) $^ $(LDFLAGS) $(LDLIBS) -lstdc++ -licuuc -licuio -ledit -o $@
 
-macro_test: macro_test.o ../macros.o ../environment.o ../object_print.o ../reader.o ../evaluation.o
+macro_test: macro_test.o ../macros.o ../environment.o ../object_print.o ../reader.o ../evaluation.o ../builtin-functions.o
 	$(CXX) $^ $(LDFLAGS) $(LDLIBS) -lstdc++ -licuuc -licuio -ledit -o $@
 
-evaluation_test: evaluation_test.o ../evaluation.o ../environment.o ../object_print.o ../reader.o ../macros.o
+evaluation_test: evaluation_test.o ../evaluation.o ../environment.o ../object_print.o ../reader.o ../macros.o ../builtin-functions.o
 	$(CXX) $^ $(LDFLAGS) $(LDLIBS) -lstdc++ -licuuc -licuio -ledit -o $@
 
 
@@ -55,7 +55,7 @@ evaluation_test: evaluation_test.o ../evaluation.o ../environment.o ../object_pr
 ../s_expr.h: ../my_debug.h
 ../environment.o: ../environment.cpp ../environment.h ../s_expr.h
 ../evaluation.o: ../evaluation.cpp ../environment.h ../s_expr.h
-
+../builtin-functions.o: ../builtin-functions.cpp ../environment.h ../s_expr.h
 
 clean:
 	rm -f ../*.o *.o $(TARGETS)

test/environment_test.cpp

@@ -1,5 +1,6 @@
 
 #include "../environment.h"
+#include "../my_debug.h"
 #include <stdio.h>
 #include <iostream>
 
@@ -22,11 +23,13 @@ int main()
     // 呼び出し
     // global env は outer とは無関係
     my::FuncPtr p = env.find_function("HOGE");
+    ASSERT( p != nullptr, "must not nullptr");
+/*
     std::shared_ptr<my::cons> args = std::make_shared<my::cons>();
     args->append(my::value_t(10))
          .append(std::make_shared<my::string>("fuga"));
     my::value_t result = p->apply(args);
     PRINT(result, std::cout);
-
+*/
     return 0;
 }