PureLisp/cons.cpp at master · pteetor/PureLisp · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
//
//  cons heap and functions
//

#include "doctest.h"
#include "consVM.h"

// const int N_CONS = 200;

void cons(Cell* car, Cell* cdr)
{
  push(car);
  push(cdr);
  cons();
}

void cons() {
  // Sanity checks
  validate_cell_ptr(down(1));   // car
  validate_cell_ptr(down(0));   // cdr

  Cons* p = alloc_cons();
  p->type = Tag::CONS_TAG;
  p->cdr = pop();
  p->car = pop();
  push(p);
  return;
}

Cons* as_cons(Cell* p)
{
  if (p->type != Tag::CONS_TAG) {
    LispError("as_cons: not a cons");
  }
  return (Cons*) p;
}

Cell* car(Cell* p)
{
  if (p->type != Tag::CONS_TAG)
  {
    throw LispError("car: not a cons", true);
  }

  return ((Cons*) p)->car;
}

Cell* cdr(Cell* p)
{
  if (p->type != Tag::CONS_TAG)
  {
    throw LispError("cdr: not a cons", true);
  }

  return ((Cons*) p)->cdr;
}

void print(Cons* p)
{
  std::cout << "(";
  print(p->car);

  Cell* q = p->cdr;
  Cons* r;

  while (q != nil) {
    std::cout << " ";
    switch (q->type)
    {
    case Tag::ATOM_TAG:
      std::cout << ". ";
      print((Atom*) q);
      std::cout << ")";
      return;
    case Tag::CONS_TAG:
      r = (Cons*) q;
      print(r->car);
      q = r->cdr;
      break;
    default:
      throw LispError("print: invalid cell type", true);
    }
  }
  std::cout << ")";
}

// -------------------------------------

void audit_cons()
{
    // TBD
}

// -------------------------------------

TEST_CASE("testing car()") {
  cons(nil, a_t);
  REQUIRE(car(top()) == nil);
}

TEST_CASE("testing cdr()") {
  cons(nil, a_t);
  REQUIRE(cdr(top()) == a_t);
}