WIP: macro

src/builtin.cpp

@@ -90,14 +90,6 @@ void registerFunction2(std::unordered_map<Symbol, Value>* variables, Allocator*
 }
 
 
-bool isPair(Value obj)
-{
-    if (!obj.isPointer())
-        return false;
-    return dynamic_cast<PairObject*>(obj.asPointer()) != nullptr;
-}
-
-
 } // namespace
 
 

src/object.cpp

@@ -143,4 +143,12 @@ void ContinuationObject::mark()
 }
 
 
+bool isPair(Value value)
+{
+    if (!value.isPointer())
+        return false;
+    return dynamic_cast<PairObject*>(value.asPointer());
+}
+
+
 } // namespace nscheme

src/object.hpp

@@ -247,4 +247,8 @@ class ContinuationObject : public Object {
 };
 
 
+// utility functions
+bool isPair(Value v);
+
+
 } // namespace nscheme

src/parser.cpp

@@ -32,14 +32,6 @@ bool isSelfEvaluating(Value value)
 }
 
 
-inline bool isPair(Value value)
-{
-    if (!value.isPointer())
-        return false;
-    return dynamic_cast<PairObject*>(value.asPointer());
-}
-
-
 template <typename T, typename... Args> std::unique_ptr<T> make_unique(Args&&... args)
 {
     return std::unique_ptr<T>(new T(std::forward<Args>(args)...));
@@ -52,6 +44,22 @@ template <typename T, typename... Args> std::unique_ptr<T> make_unique(Args&&...
 namespace nscheme {
 
 
+bool LocalNames::lookupSymbol(Symbol symbol, std::pair<size_t, size_t>* out) const
+{
+    size_t frame_index = 0;
+    for (const LocalNames* p = this; p != nullptr; p = p->parent) {
+        auto it = p->name2index.find(symbol);
+        if (it != p->name2index.end()) {
+            out->first = frame_index;
+            out->second = it->second;
+            return true;
+        }
+        ++frame_index;
+    }
+    return false;
+}
+
+
 std::unique_ptr<Node> Parser::parse(Value datum)
 {
     Position dummy(symbol_table_->intern(""), 1, 1);
@@ -79,23 +87,6 @@ std::unique_ptr<Node> Parser::parse(Value datum)
 }
 
 
-bool Parser::lookupSymbol(Symbol symbol, const LocalNames& names,
-                          std::pair<size_t, size_t>* out) const
-{
-    size_t frame_index = 0;
-    for (const LocalNames* p = &names; p != nullptr; p = p->parent) {
-        auto it = p->name2index.find(symbol);
-        if (it != p->name2index.end()) {
-            out->first = frame_index;
-            out->second = it->second;
-            return true;
-        }
-        ++frame_index;
-    }
-    return false;
-}
-
-
 std::unique_ptr<Node> Parser::parseExprOrDefine(Value value, const Position& position,
                                                 LocalNames& names)
 {
@@ -146,7 +137,7 @@ std::unique_ptr<ExprNode> Parser::parseVariable(Symbol symbol, const Position& p
                                                 LocalNames& names)
 {
     std::pair<size_t, size_t> index;
-    if (lookupSymbol(symbol, names, &index))
+    if (names.lookupSymbol(symbol, &index))
         return make_unique<IndexedVariableNode>(position, index.first, index.second);
     else
         return make_unique<NamedVariableNode>(position, symbol);
@@ -281,7 +272,7 @@ std::unique_ptr<ExprNode> Parser::parseAssignment(Value value, const Position& p
     Symbol symbol = p1->getCar().asSymbol();
     auto expr = parseExpr(p2->getCar(), source_map_->at(p2), names);
     std::pair<size_t, size_t> index;
-    if (lookupSymbol(symbol, names, &index))
+    if (names.lookupSymbol(symbol, &index))
         return make_unique<IndexedAssignmentNode>(position, index.first, index.second,
                                                   std::move(expr));
     else

src/parser.hpp

@@ -11,6 +11,19 @@
 namespace nscheme {
 
 
+struct LocalNames {
+    explicit LocalNames(LocalNames* parent)
+        : parent(parent)
+    {
+    }
+
+    bool lookupSymbol(Symbol symbol, std::pair<size_t, size_t>* out) const;
+
+    LocalNames* parent;
+    std::unordered_map<Symbol, size_t> name2index;
+};
+
+
 class Parser {
 public:
     Parser(SymbolTable* symbol_table, SourceMap* source_map,
@@ -29,16 +42,6 @@ class Parser {
     std::unique_ptr<Node> parse(Value datum);
 
 private:
-    struct LocalNames {
-        explicit LocalNames(LocalNames* parent)
-            : parent(parent)
-        {
-        }
-        LocalNames* parent;
-        std::unordered_map<Symbol, size_t> name2index;
-    };
-
-    bool lookupSymbol(Symbol symbol, const LocalNames& names, std::pair<size_t, size_t>* out) const;
     std::unique_ptr<Node> parseExprOrDefine(Value value, const Position& position,
                                             LocalNames& names);
     std::unique_ptr<ExprNode> parseExpr(Value value, const Position& position, LocalNames& names);

src/translator.cpp

@@ -0,0 +1,101 @@
+#include "translator.hpp"
+#include <algorithm>
+
+
+namespace nscheme {
+
+
+bool SyntaxRule::match(Value pattern, Value expr, std::unordered_map<Symbol, Value>& mapping) const
+{
+    if (pattern.isSymbol()) {
+        Symbol symbol = pattern.asSymbol();
+        if (symbol == kwd_underscore_)
+            return true;
+        auto it = std::find(literals_.begin(), literals_.end(), symbol);
+        if (it != literals_.end()) {
+            // symbol is literal
+            return expr.isSymbol() && symbol == expr.asSymbol();
+        }
+        // symbol is not literal
+        mapping.insert(std::make_pair(symbol, expr));
+        return true;
+    }
+
+    if (isPair(pattern)) {
+        if (!isPair(expr))
+            return false;
+
+        ssize_t ellipsis_index = -1;
+        ssize_t pattern_len = -1;
+        bool is_proper = false;
+
+        auto p = static_cast<PairObject*>(pattern.asPointer());
+        for (size_t i = 0;; ++i) {
+            Value car = p->getCar();
+            if (car.isSymbol() && car.asSymbol() == kwd_ellipsis_) {
+                if (ellipsis_index != -1)
+                    throw std::runtime_error("multiple ellipsis in pattern");
+                ellipsis_index = i;
+            }
+
+            Value cdr = p->getCdr();
+            if (!isPair(cdr)) {
+                pattern_len = i + 1;
+                if (cdr == Value::Nil)
+                    is_proper = true;
+                break;
+            }
+            p = static_cast<PairObject*>(cdr.asPointer());
+        }
+
+        ssize_t expr_len = -1;
+        auto q = static_cast<PairObject*>(expr.asPointer());
+        for (size_t i = 0;; ++i) {
+            Value cdr = q->getCdr();
+            if (!isPair(cdr)) {
+                expr_len = i + 1;
+                if (is_proper != (cdr == Value::Nil))
+                    return false;
+                break;
+            }
+            q = static_cast<PairObject*>(cdr.asPointer());
+        }
+
+        if (expr_len < pattern_len)
+            return false;
+
+        ssize_t e = (ellipsis_index != -1) ? (ellipsis_index - 1) : (expr_len + 1);
+        ssize_t m = (ellipsis_index != -1) ? (expr_len - pattern_len + ellipsis_index) : -1;
+
+        p = static_cast<PairObject*>(pattern.asPointer());
+        q = static_cast<PairObject*>(expr.asPointer());
+        for (ssize_t i = 0;; ++i) {
+            if (!match(p->getCar(), q->getCar(), mapping))
+                return false;
+
+            if (e <= i && i < m) {
+                Value q_cdr = q->getCdr();
+                q = static_cast<PairObject*>(q_cdr.asPointer());
+            }
+            else {
+                Value p_cdr = (i == m) ? static_cast<PairObject*>(p->getCdr().asPointer())->getCdr()
+                                       : p->getCdr();
+                Value q_cdr = q->getCdr();
+                if (!isPair(p_cdr) && !isPair(q_cdr)) {
+                    if (is_proper)
+                        return true;
+                    return match(p_cdr, q_cdr, mapping);
+                }
+                if (!isPair(p_cdr) || !isPair(q_cdr))
+                    return false;
+                p = static_cast<PairObject*>(p_cdr.asPointer());
+                q = static_cast<PairObject*>(q_cdr.asPointer());
+            }
+        }
+    }
+
+    return pattern == expr;
+}
+
+
+} // namespace nscheme

src/translator.hpp

@@ -0,0 +1,47 @@
+#pragma once
+
+#include <vector>
+#include "parser.hpp"
+#include "value.hpp"
+
+
+namespace nscheme {
+
+class Allocator;
+class SymbolTable;
+
+
+class SyntaxRule {
+public:
+    SyntaxRule(Value pattern, Value tmpl, std::vector<Symbol>& literals, LocalNames& names,
+               Allocator* allocator, SymbolTable* symbol_table)
+        : pattern_(pattern)
+        , template_(tmpl)
+        , literals_(literals)
+        , names_(names)
+        , allocator_(allocator)
+        , symbol_table_(symbol_table)
+        , kwd_underscore_(symbol_table->intern("-"))
+        , kwd_ellipsis_(symbol_table->intern("..."))
+    {
+    }
+
+    bool verifyPattern() const;
+
+    Value replace(Value expr);
+
+    bool match(Value pattern, Value expr, std::unordered_map<Symbol, Value>& mapping) const;
+
+private:
+    Value pattern_;
+    Value template_;
+    std::vector<Symbol>& literals_;
+    LocalNames& names_;
+    Allocator* allocator_;
+    SymbolTable* symbol_table_;
+    Symbol kwd_underscore_;
+    Symbol kwd_ellipsis_;
+};
+
+
+} // namespace nscheme

src/value.hpp

@@ -84,7 +84,7 @@ class Value {
 
     union {
         uint64_t value_;
-        Object *ptr_;
+        Object* ptr_;
     };
 };