implementations/uvm-ncc/joy.c

   1 //    Copyright © 2023 Simon Forman
   2 //
   3 //    This file is part of Thun
   4 //
   5 //    Thun is free software: you can redistribute it and/or modify
   6 //    it under the terms of the GNU General Public License as published by
   7 //    the Free Software Foundation, either version 3 of the License, or
   8 //    (at your option) any later version.
   9 //
  10 //    Thun is distributed in the hope that it will be useful,
  11 //    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 //    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 //    GNU General Public License for more details.
  14 //
  15 //    You should have received a copy of the GNU General Public License
  16 //    along with Thun.  If not see <http://www.gnu.org/licenses/>.
  17 //
  18 #include <uvm/syscalls.h>
  19 #include <string.h>
  20 /*
  21 ███████╗██████╗ ██████╗  ██████╗ ██████╗
  22 ██╔════╝██╔══██╗██╔══██╗██╔═══██╗██╔══██╗
  23 █████╗  ██████╔╝██████╔╝██║   ██║██████╔╝
  24 ██╔══╝  ██╔══██╗██╔══██╗██║   ██║██╔══██╗
  25 ███████╗██║  ██║██║  ██║╚██████╔╝██║  ██║
  26 ╚══════╝╚═╝  ╚═╝╚═╝  ╚═╝ ╚═════╝ ╚═╝  ╚═╝
  27
  28 ██╗  ██╗ █████╗ ███╗   ██╗██████╗ ██╗     ██╗███╗   ██╗ ██████╗
  29 ██║  ██║██╔══██╗████╗  ██║██╔══██╗██║     ██║████╗  ██║██╔════╝
  30 ███████║███████║██╔██╗ ██║██║  ██║██║     ██║██╔██╗ ██║██║  ███╗
  31 ██╔══██║██╔══██║██║╚██╗██║██║  ██║██║     ██║██║╚██╗██║██║   ██║
  32 ██║  ██║██║  ██║██║ ╚████║██████╔╝███████╗██║██║ ╚████║╚██████╔╝
  33 ╚═╝  ╚═╝╚═╝  ╚═╝╚═╝  ╚═══╝╚═════╝ ╚══════╝╚═╝╚═╝  ╚═══╝ ╚═════╝
  34
  35 No setjmp/longjmp, so let's have a global error value and check it after ops.
  36 */
  37
  38 u64 error = 0;
  39
  40 #define NO_ERROR 0
  41 #define UNKNOWN_WORD_ERROR 1
  42 #define MISSING_CLOSING_BRACKET 2
  43 #define EXTRA_CLOSING_BRACKET 3
  44 #define CONS_HEAP_OOM 4
  45 #define STRING_HEAP_OOM 5
  46 #define NOT_ENOUGH_VALUES_ON_STACK 6
  47 #define NOT_A_LIST 7
  48 #define CANNOT_TAKE_FIRST_OF_EMPTY_LIST 8
  49 #define CANNOT_TAKE_REST_OF_EMPTY_LIST 9
  50
  51
  52 #define CHECK_ERROR if (error != NO_ERROR) return 0;
  53
  54
  55 /*
  56 char *error_messages[3] = {
  57         "",
  58         "Unknown word",
  59         "Missing closing bracket"
  60 };
  61 */
  62
  63 #define PRINT_I64(message, number) { print_str(message); print_i64(number); print_endl(); }
  64
  65
  66 /*
  67  ██████╗ ██████╗ ███╗   ██╗███████╗    ██╗  ██╗███████╗ █████╗ ██████╗
  68 ██╔════╝██╔═══██╗████╗  ██║██╔════╝    ██║  ██║██╔════╝██╔══██╗██╔══██╗
  69 ██║     ██║   ██║██╔██╗ ██║███████╗    ███████║█████╗  ███████║██████╔╝
  70 ██║     ██║   ██║██║╚██╗██║╚════██║    ██╔══██║██╔══╝  ██╔══██║██╔═══╝
  71 ╚██████╗╚██████╔╝██║ ╚████║███████║    ██║  ██║███████╗██║  ██║██║
  72  ╚═════╝ ╚═════╝ ╚═╝  ╚═══╝╚══════╝    ╚═╝  ╚═╝╚══════╝╚═╝  ╚═╝╚═╝
  73 Cons Heap
  74
  75 We don't have Unions, Enums, or Typedefs.  So how do we represent Joy types?
  76 In SICP they use a pair of arrays of pointers, one for heads and one
  77 for tails.
  78
  79 > A pointer to a pair is an index into the two vectors.
  80
  81 */
  82
  83 #define HEAP_SIZE 1024
  84
  85 u32 heads[HEAP_SIZE];
  86 u32 tails[HEAP_SIZE];
  87
  88
  89 // cell 0 is reserved so that 0 can be the empty list.
  90 u32 free = 1;
  91
  92 // > We also need a representation for objects other than pairs (such as
  93 // > numbers and symbols) and a way to distinguish one kind of data from
  94 // > another. There are many methods of accomplishing this, but they all
  95 // > reduce to using typed pointers, that is, to extending the notion of
  96 // > ``pointer'' to include information on data type.
  97
  98 // Let's use u32 with the two MSB's for the type tag.
  99
 100 #define TYPE_OF(pointer) (pointer >> 30)
 101 #define VALUE_OF(pointer) (pointer & 0x3fffffff)
 102 #define JOY_VALUE(type, value) ((type & 3) << 30) | (value & 0x3fffffff)
 103
 104 /*
 105 This means that our ints are restricted to 30 bits for now, until
 106 I implement bignums.
 107
 108
 109 In the Thun dialect of Joy we have four types of values:
 110
 111 Integers, Booleans, Symbols, and Lists.
 112 */
 113 u8 joyList = 0;
 114 u8 joyInt = 1;
 115 u8 joySymbol = 2;
 116 u8 joyBool = 3;
 117
 118 // Because the type tag for lists is 0 the empty list is just 0;
 119 u32 empty_list = 0;
 120
 121 u32
 122 cons(u32 head, u32 tail)
 123 {
 124         if (free >= HEAP_SIZE) {
 125                 error = CONS_HEAP_OOM;
 126                 return 0;
 127         }
 128         heads[free] = head;
 129         tails[free] = tail;
 130         u32 cell = JOY_VALUE(joyList, free);
 131         ++free;
 132         return cell;
 133 }
 134
 135 u32 head(u32 list) { return heads[VALUE_OF(list)]; }
 136 u32 tail(u32 list) { return tails[VALUE_OF(list)]; }
 137
 138
 139
 140 /*
 141 ███████╗████████╗██████╗ ██╗███╗   ██╗ ██████╗
 142 ██╔════╝╚══██╔══╝██╔══██╗██║████╗  ██║██╔════╝
 143 ███████╗   ██║   ██████╔╝██║██╔██╗ ██║██║  ███╗
 144 ╚════██║   ██║   ██╔══██╗██║██║╚██╗██║██║   ██║
 145 ███████║   ██║   ██║  ██║██║██║ ╚████║╚██████╔╝
 146 ╚══════╝   ╚═╝   ╚═╝  ╚═╝╚═╝╚═╝  ╚═══╝ ╚═════╝
 147
 148 ██╗  ██╗███████╗ █████╗ ██████╗
 149 ██║  ██║██╔════╝██╔══██╗██╔══██╗
 150 ███████║█████╗  ███████║██████╔╝
 151 ██╔══██║██╔══╝  ██╔══██║██╔═══╝
 152 ██║  ██║███████╗██║  ██║██║
 153 ╚═╝  ╚═╝╚══════╝╚═╝  ╚═╝╚═╝
 154 Simple string storage heap.
 155
 156 We need a place to keep symbol strings.
 157
 158 */
 159
 160 #define STRING_HEAP_SIZE 100000
 161
 162 char string_heap[STRING_HEAP_SIZE];
 163 u32 string_heap_top = 0;
 164
 165 char*
 166 allocate_string(char *buffer, u32 offset, u32 length)
 167 {
 168         u64 end = string_heap_top + length + 1;
 169         // I have already spent more time thinking about avoiding overflow
 170         // from the line above, going into the comparison below and goofing
 171         // up for "pathological" inputs (string_heap_top + length == MAX_INT_64
 172         // or whatever it's called.  In practice, this should never happen,
 173         // and we spell that with assert, eh?  I'm not going to add it now,
 174         // but it would be something like assert(string_heap_top + length < MAX_INT_64)
 175         if (end >= STRING_HEAP_SIZE) {
 176                 error = STRING_HEAP_OOM;
 177                 return 0;
 178         }
 179         memcpy(string_heap + string_heap_top, buffer + offset, length);
 180         string_heap[end] = '\0';
 181         u32 new_string = string_heap_top;
 182         string_heap_top = (u32)end + 1;
 183         //print_str("allocating ");print_str(string_heap + new_string);print_endl();
 184         return string_heap + new_string;
 185 }
 186
 187
 188 /*
 189 ██████╗ ██████╗ ██╗███╗   ██╗████████╗███████╗██████╗
 190 ██╔══██╗██╔══██╗██║████╗  ██║╚══██╔══╝██╔════╝██╔══██╗
 191 ██████╔╝██████╔╝██║██╔██╗ ██║   ██║   █████╗  ██████╔╝
 192 ██╔═══╝ ██╔══██╗██║██║╚██╗██║   ██║   ██╔══╝  ██╔══██╗
 193 ██║     ██║  ██║██║██║ ╚████║   ██║   ███████╗██║  ██║
 194 ╚═╝     ╚═╝  ╚═╝╚═╝╚═╝  ╚═══╝   ╚═╝   ╚══════╝╚═╝  ╚═╝
 195 Printer
 196 */
 197
 198 void
 199 print_joy_value(u32 jv)
 200 {
 201         u8 type = TYPE_OF(jv);
 202         if (type == joyInt) {
 203                 print_i64(VALUE_OF(jv));
 204         } else if (type == joyBool) {
 205                 print_str(VALUE_OF(jv) ? "true" : "false");
 206         } else if (type == joyList) {
 207                 print_str("[");
 208                 print_joy_list(jv);
 209                 print_str("]");
 210         } else if (type == joySymbol) {
 211                 char *str = ht_lookup(VALUE_OF(jv));
 212                 if (error != NO_ERROR)
 213                         return;
 214                 print_str(str);
 215         }
 216 }
 217
 218 void
 219 print_joy_list(u32 list)
 220 {
 221         while (list) {
 222                 print_joy_value(head(list));
 223                 if (error != NO_ERROR)
 224                         return;
 225                 list = tail(list);
 226                 if (list) {
 227                         print_str(" ");
 228                 }
 229         }
 230 }
 231
 232
 233 /*
 234 ██╗  ██╗ █████╗ ███████╗██╗  ██╗
 235 ██║  ██║██╔══██╗██╔════╝██║  ██║
 236 ███████║███████║███████╗███████║
 237 ██╔══██║██╔══██║╚════██║██╔══██║
 238 ██║  ██║██║  ██║███████║██║  ██║
 239 ╚═╝  ╚═╝╚═╝  ╚═╝╚══════╝╚═╝  ╚═╝
 240
 241 ████████╗ █████╗ ██████╗ ██╗     ███████╗
 242 ╚══██╔══╝██╔══██╗██╔══██╗██║     ██╔════╝
 243    ██║   ███████║██████╔╝██║     █████╗
 244    ██║   ██╔══██║██╔══██╗██║     ██╔══╝
 245    ██║   ██║  ██║██████╔╝███████╗███████╗
 246    ╚═╝   ╚═╝  ╚═╝╚═════╝ ╚══════╝╚══════╝
 247 And now for a hash table.
 248
 249 This table maps between hashes of symbol strings which are used in the
 250 tagged pointers in Joy values and strings which are stored in the string
 251 heap.
 252
 253 TODO: bool ht_has(char *str, u32 index, u32 length) to see if a fragment
 254           of a string buffer is a symbol in the hash table.
 255
 256 FNV hash function.
 257
 258 https://benhoyt.com/writings/hash-table-in-c/#hash-tables
 259 https://en.wikipedia.org/wiki/Fowler–Noll–Vo_hash_function
 260
 261 */
 262
 263 #define FNV_OFFSET 0xcbf29ce484222325
 264 #define FNV_PRIME 0x100000001b3
 265
 266 u64
 267 hash_key(char* key)
 268 {
 269         u64 hash = FNV_OFFSET;
 270         for (char* p = key; *p; ++p) {
 271                 hash = hash ^ (u64)(unsigned char)(*p);
 272                 hash = hash * FNV_PRIME;
 273         }
 274         return hash;
 275 }
 276
 277 u64
 278 hash_fragment(char *str, u32 index, u32 length)
 279 {
 280         u64 hash = FNV_OFFSET;
 281         for (char* p = (str + index); length; --length, ++p) {
 282                 hash = hash ^ (u64)(unsigned char)(*p);
 283                 hash = hash * FNV_PRIME;
 284         }
 285         return hash;
 286 }
 287
 288 // Capacity is a power of two (10 for now.)
 289 #define EXPONENT 10
 290 #define CAPACITY 1024
 291 #define HASH_MASK 1023
 292
 293 // Note that there's no checking for filling the table and expanding.
 294 // For now, I'm just going to use a "large enough" table and hope
 295 // for the best.  (We have thirty bits to work with so the obvious
 296 // thing to do is make the exponent fifteen, half for the hash key
 297 // and half for the increment.)
 298
 299 char* hash_table[CAPACITY];
 300
 301 u32
 302 ht_insert(char *symbol)
 303 {
 304         u64 hash = hash_key(symbol);
 305         u32 index = hash % CAPACITY;
 306
 307         char *candidate = hash_table[index];
 308         if (!candidate) {
 309                 hash_table[index] = symbol;
 310                 return JOY_VALUE(joySymbol, VALUE_OF(hash));
 311         }
 312
 313         // https://en.wikipedia.org/wiki/Double_hashing
 314         // Rather than use another hash function I'm going to try
 315         // using the extra bits of the same hash.
 316         u32 increment = ((VALUE_OF(hash) >> EXPONENT) | 1) % CAPACITY;
 317         // If I understand correctly, making the increment odd
 318         // means it will traverse the whole (even-sized) table.
 319         while (candidate) {
 320                 // Compare pointers then hashes (since we already have
 321                 // one hash I'm guessing that that's cheaper or at least
 322                 // no more expensive than string comparision.)
 323                 if (candidate == symbol || hash == hash_key(candidate))
 324                         break;
 325                 index = (index + increment) % CAPACITY;
 326                 candidate = hash_table[index];
 327         }
 328         if (!candidate) {
 329                 hash_table[index] = symbol;
 330         }
 331         return JOY_VALUE(joySymbol, VALUE_OF(hash));
 332 }
 333
 334 char*
 335 ht_lookup(u32 hash)
 336 {
 337         // Note that hash must be truncated to N (N=30 as it happens) bits
 338         // by VALUE_OF().
 339         u32 index = hash % CAPACITY;
 340         char *candidate = hash_table[index];
 341         u32 increment = ((hash >> EXPONENT) | 1) % CAPACITY;
 342         while (candidate) {
 343                 if (hash == VALUE_OF(hash_key(candidate)))
 344                         return candidate;
 345                 index = (index + increment) % CAPACITY;
 346                 candidate = hash_table[index];
 347         }
 348         error = UNKNOWN_WORD_ERROR;
 349         return 0;
 350 }
 351
 352
 353 u32
 354 ht_has(char *str, u32 index, u32 length)
 355 {
 356         u32 hash = VALUE_OF(hash_fragment(str, index, length));
 357         ht_lookup(hash);
 358         if (UNKNOWN_WORD_ERROR == error) {
 359                 error = NO_ERROR;
 360                 return 0;
 361         }
 362         return hash;
 363 }
 364
 365
 366
 367
 368
 369 /******************************************************************************/
 370
 371
 372
 373 u32
 374 pop_any(u32 stack)
 375 {
 376         if (!stack) {
 377                 error = NOT_ENOUGH_VALUES_ON_STACK;
 378                 return 0;
 379         }
 380         return head(stack);
 381 }
 382
 383
 384 u32
 385 pop_list(u32 stack)
 386 {
 387         u32 list = pop_any(stack);
 388         CHECK_ERROR
 389         if (TYPE_OF(list) != joyList) {
 390                 error = NOT_A_LIST;
 391                 return 0;
 392         }
 393         return list;
 394 }
 395
 396
 397 u32
 398 push_symbol(char *symbol, u32 stack)
 399 {
 400         return cons(JOY_VALUE(joySymbol, ht_insert(symbol)), stack);
 401 }
 402
 403
 404 u32
 405 push_int(u32 n, u32 stack)
 406 {
 407         return cons(JOY_VALUE(joyInt, n), stack);
 408 }
 409
 410
 411 /******************************************************************************/
 412
 413 bool
 414 is_integer(char *str, u32 index, u32 length)
 415 {
 416         for (;length; --length) {
 417                 char ch = *(str + index + length - 1);
 418                 if (!(ch == '0'
 419                         || ch == '1'
 420                         || ch == '2'
 421                         || ch == '3'
 422                         || ch == '4'
 423                         || ch == '5'
 424                         || ch == '6'
 425                         || ch == '7'
 426                         || ch == '8'
 427                         || ch == '9'))
 428                 {
 429                         return 0;
 430                 }
 431         }
 432         return 1;
 433 }
 434
 435 u32
 436 convert_integer(char *str, u32 index, u32 length)
 437 {
 438         u32 result = 0;
 439         length = length + index;
 440         for (; index < length; ++index) {
 441                 char ch = *(str + index);
 442                 u8 digit = (u8)ch - (u8)'0';
 443                 result = result * 10 + digit;
 444         }
 445         //print_str("converted integer ");print_i64(result);print_endl();
 446         return JOY_VALUE(joyInt, result);
 447 }
 448
 449 /******************************************************************************/
 450
 451
 452 /*
 453 ██████╗  █████╗ ██████╗ ███████╗███████╗██████╗
 454 ██╔══██╗██╔══██╗██╔══██╗██╔════╝██╔════╝██╔══██╗
 455 ██████╔╝███████║██████╔╝███████╗█████╗  ██████╔╝
 456 ██╔═══╝ ██╔══██║██╔══██╗╚════██║██╔══╝  ██╔══██╗
 457 ██║     ██║  ██║██║  ██║███████║███████╗██║  ██║
 458 ╚═╝     ╚═╝  ╚═╝╚═╝  ╚═╝╚══════╝╚══════╝╚═╝  ╚═╝
 459 Parser
 460
 461 */
 462
 463
 464 u32
 465 intern(char *str, u32 index, u32 length)
 466 {
 467         u32 symbol_hash = ht_has(str, index, length);
 468         if (!symbol_hash) {
 469                 char *token = allocate_string(str, index, length);
 470                 if (error != NO_ERROR) {
 471                         //print_str("a. Error code: ");print_i64(error);print_endl();
 472                         return 0;
 473                 }
 474                 symbol_hash = ht_insert(token);
 475         }
 476         return JOY_VALUE(joySymbol, symbol_hash);
 477 }
 478
 479
 480 u32
 481 tokenate(char *str, u32 index, u32 length)
 482 {
 483         if (4 == length
 484                 && *(str + index) == 't'
 485                 && *(str + index + 1) == 'r'
 486                 && *(str + index + 2) == 'u'
 487                 && *(str + index + 3) == 'e'
 488         ) {
 489                 //print_str("tokenate true");print_endl();
 490                 return JOY_VALUE(joyBool, 1);
 491         }
 492         if (5 == length
 493                 && *(str + index) == 'f'
 494                 && *(str + index + 1) == 'a'
 495                 && *(str + index + 2) == 'l'
 496                 && *(str + index + 3) == 's'
 497                 && *(str + index + 4) == 'e'
 498         ) {
 499                 //print_str("tokenate false");print_endl();
 500                 return JOY_VALUE(joyBool, 0);
 501         }
 502         if (is_integer(str, index, length)) {
 503                 //print_str("tokenate integer");print_endl();
 504                 return convert_integer(str, index, length);
 505         }
 506         return intern(str, index, length);
 507 }
 508
 509
 510 int
 511 is_delimiter(char ch)
 512 {
 513         return ch == '[' || ch == ']' || ch == ' ';
 514 }
 515
 516 // Store in-progress lists.  Here as in the hash table I'm not checking
 517 // for capacity overload or anything like that.  If you think you're going
 518 // to parse more than a five hundred '[' chars then increase the size of
 519 // this array.
 520 u32 t2e_stack[1000];
 521 u32 t2e_stack_top = 0;
 522
 523 #define T2E_PUSH(thing) t2e_stack[t2e_stack_top] = (thing); ++t2e_stack_top; (thing) = empty_list;
 524 #define T2E_POP(thing)  if (!t2e_stack_top) { error = EXTRA_CLOSING_BRACKET; return 0; }; --t2e_stack_top; (thing) = t2e_stack[t2e_stack_top];
 525
 526 u32
 527 text_to_expression(char *str)
 528 {
 529         u32 index = 0;
 530         u32 end = empty_list;
 531         u32 top = empty_list;
 532         u32 tok = empty_list;
 533         u64 str_length = strlen(str);  // TODO: rewrite so we don't iterate through the string twice.
 534         while (index < str_length) {
 535                 char ch = str[index];
 536                 if (' ' == ch) {
 537                         ++index;
 538                         continue;
 539                 }
 540                 if ('[' == ch) {  // start new list
 541                         ++index;
 542                         T2E_PUSH(end)
 543                         T2E_PUSH(top)
 544                         continue;
 545                 }
 546                 if (']' == ch) {  // finish last new list
 547                         ++index;
 548                         tok = top;
 549                         T2E_POP(top)
 550                         T2E_POP(end)
 551                 } else {
 552                         u32 i = index + 1;
 553                         for (; i < str_length && !is_delimiter(str[i]); ++i) {}
 554                         tok = tokenate(str, index, i - index);
 555                         index = i;
 556                 }
 557                 u32 cell = cons(tok, empty_list);
 558                 if (end) tails[end] = cell;
 559                 if (!top) top = cell;
 560                 end = cell;
 561         }
 562         if (t2e_stack_top) {
 563                 error = MISSING_CLOSING_BRACKET;
 564                 return empty_list;
 565         }
 566         return top;
 567 }
 568
 569
 570 /*
 571 In order to return two "pointers" I'm going to just OR them
 572 into one u64 value.  It might be conceptually cleaner to define
 573 an array of two u32 values, eh?
 574
 575         u32 joy_state[2];
 576
 577 I'll figure it out later, I just want to get something going for now.
 578 I also don't want to take the time at the moment to figure out if/how
 579 to call function pointers in NCC C, so a chain of if..else is the
 580 ticket.
 581 */
 582
 583 #define MATCH(name) if (!strcmp(symbol, (name)))
 584
 585 u64
 586 joy_eval(char *symbol, u32 stack, u32 expression)
 587 {
 588         MATCH("clear") return (u64)expression;
 589         MATCH("i")
 590         //return i_joy_combinator(stack, expression);
 591         {
 592                 u32 list = pop_list(stack); CHECK_ERROR
 593                 stack = tail(stack);
 594                 stack = joy(stack, list); CHECK_ERROR
 595         }
 596         else MATCH("concat") { stack = concat(stack); }
 597         else MATCH("cons") { stack = cons_joy_func(stack); }
 598         else MATCH("dup") { stack = dup(stack); }
 599         else MATCH("first") { stack = first(stack); }
 600         else MATCH("pop") { stack = pop(stack); }
 601         else MATCH("rest") { stack = rest(stack); }
 602         else MATCH("stack") { stack = cons(stack, stack); }
 603         else MATCH("swaack") { stack = swaack(stack); }
 604         else MATCH("swap") { stack = swap(stack); }
 605         // i, dip, branch, loop ...
 606         //else MATCH("") { stack = (stack); }
 607         CHECK_ERROR
 608         //print_str(symbol);print_endl();
 609         return (u64)stack << 32 | expression;
 610 }
 611
 612 /*
 613 u64
 614 i_joy_combinator(u32 stack, u32 expression)
 615 {
 616         u32 list = pop_list(stack); CHECK_ERROR
 617         stack = tail(stack);
 618         // And here we now have to implement expression-as-list-of-lists.
 619         expression = cons(list, expression); CHECK_ERROR
 620         return (u64)stack << 32 | expression;
 621 }
 622 */
 623
 624
 625
 626
 627 u32
 628 cons_joy_func(u32 stack)
 629 {
 630         u32 list = pop_list(stack); CHECK_ERROR
 631         stack = tail(stack);
 632         u32 tos = pop_any(stack);   CHECK_ERROR
 633         stack = tail(stack);
 634         list = cons(tos, list);     CHECK_ERROR
 635         stack = cons(list, stack);  CHECK_ERROR
 636         return stack;
 637 }
 638
 639
 640 u32
 641 concat(u32 stack)
 642 {
 643         u32 list_tail = pop_list(stack); CHECK_ERROR
 644         stack = tail(stack);
 645         u32 list_head = pop_list(stack); CHECK_ERROR
 646         stack = tail(stack);
 647         u32 result = empty_list;
 648         if (!list_tail) { result = list_head; } else
 649         if (!list_head) { result = list_tail; } else
 650         {
 651                 result = cons(head(list_head), empty_list); CHECK_ERROR
 652                 list_head = tail(list_head);
 653                 u32 current_cell = result;
 654                 while (list_head) {
 655                         u32 next_cell = cons(head(list_head), empty_list); CHECK_ERROR
 656                         list_head = tail(list_head);
 657                         current_cell = tails[current_cell] = next_cell;
 658                 }
 659                 tails[current_cell] = list_tail;
 660         }
 661         stack = cons(result, stack); CHECK_ERROR
 662         return stack;
 663 }
 664
 665
 666 u32
 667 swaack(u32 stack)
 668 {
 669         u32 list = pop_list(stack);      CHECK_ERROR
 670         stack = cons(tail(stack), list); CHECK_ERROR
 671         return stack;
 672 }
 673
 674
 675 u32
 676 first(u32 stack)
 677 {
 678         u32 list = pop_list(stack); CHECK_ERROR
 679         if (!list) {
 680                 error = CANNOT_TAKE_FIRST_OF_EMPTY_LIST;
 681                 return 0;
 682         }
 683         stack = cons(head(list), tail(stack)); CHECK_ERROR
 684         return stack;
 685 }
 686
 687
 688 u32
 689 rest(u32 stack)
 690 {
 691         u32 list = pop_list(stack); CHECK_ERROR
 692         if (!list) {
 693                 error = CANNOT_TAKE_REST_OF_EMPTY_LIST;
 694                 return 0;
 695         }
 696         stack = cons(tail(list), tail(stack)); CHECK_ERROR
 697         return stack;
 698 }
 699
 700
 701 u32
 702 pop(u32 stack)
 703 {
 704         if (!stack) {
 705                 error = NOT_ENOUGH_VALUES_ON_STACK;
 706                 return 0;
 707         }
 708         return tail(stack);
 709 }
 710
 711
 712 u32
 713 dup(u32 stack)
 714 {
 715         u32 tos = pop_any(stack); CHECK_ERROR
 716         stack = cons(tos, stack); CHECK_ERROR
 717         return stack;
 718 }
 719
 720
 721 u32
 722 swap(u32 stack)
 723 {
 724         u32 tos = pop_any(stack);    CHECK_ERROR
 725         stack = tail(stack);
 726         u32 second = pop_any(stack); CHECK_ERROR
 727         stack = tail(stack);
 728         stack = cons(tos, stack);    CHECK_ERROR
 729         stack = cons(second, stack); CHECK_ERROR
 730         return stack;
 731 }
 732
 733
 734 u32
 735 joy(u32 stack, u32 expression)
 736 {
 737         u32 term;
 738         while (expression) {
 739                 term = head(expression);
 740                 expression = tail(expression);
 741                 if (TYPE_OF(term) == joySymbol) {
 742                         char *symbol = ht_lookup(VALUE_OF(term)); CHECK_ERROR
 743                         u64 new_state = joy_eval(symbol, stack, expression); CHECK_ERROR
 744                         stack = new_state >> 32;
 745                         expression = new_state & 0xffffffff;
 746                 }
 747                 else { stack = cons(term, stack); CHECK_ERROR }
 748         }
 749         return stack;
 750 }
 751
 752
 753 void
 754 main()
 755 {
 756         memset(hash_table, 0, sizeof(hash_table));
 757         memset(string_heap, 0, sizeof(string_heap));
 758         memset(t2e_stack, 0, sizeof(t2e_stack));
 759         error = NO_ERROR;
 760
 761         // TODO: these should be global.
 762         u32 joy_true = JOY_VALUE(joyBool, 1);
 763         u32 joy_false = JOY_VALUE(joyBool, 0);
 764
 765         /*
 766         u32 stack = empty_list;
 767         stack = push_int(23, stack);
 768         stack = cons(joy_true, stack);
 769         stack = push_int(42, stack);
 770         stack = push_symbol("cats", stack);
 771         u32 el = empty_list;
 772         el = push_int(48, el);
 773         el = cons(el, el);
 774         stack = cons(el, stack);
 775         stack = cons(joy_false, stack);
 776         stack = push_int(273, stack);
 777         print_joy_list(stack);
 778         print_endl();
 779         */
 780
 781         u32 expression = text_to_expression("1 2 3 stack i 23 18");
 782         //u32 expression = text_to_expression("1 2 3 stack rest first [] cons cons [99 888 7] concat");
 783         //u32 expression = text_to_expression("1 2 3 clear 4 5 6");
 784         //u32 expression = text_to_expression(" 1[2[true 3][aa[aa bb] aa bb cc]bob]false[]bob 3[4] ga[]ry");
 785         print_joy_list(expression);
 786         print_endl();
 787         u32 stack = joy(empty_list, expression);
 788         if (error) PRINT_I64("error: ", error) else {
 789                 print_joy_list(stack);
 790                 print_endl();
 791         }
 792 }