Nelze vybrat více než 25 témat Téma musí začínat písmenem nebo číslem, může obsahovat pomlčky („-“) a může být dlouhé až 35 znaků.
 
 
 
 
 
 

1272 řádky
48 KiB

  1. namespace Slime {
  2. proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
  3. if (n1 == n2)
  4. return true;
  5. if (n1->type != n2->type)
  6. return false;
  7. switch (n1->type) {
  8. case Lisp_Object_Type::T:
  9. case Lisp_Object_Type::Nil:
  10. case Lisp_Object_Type::Symbol:
  11. case Lisp_Object_Type::Keyword:
  12. case Lisp_Object_Type::Function:
  13. // TODO(Felix): should a pointer
  14. // object compare the pointer?
  15. case Lisp_Object_Type::Pointer:
  16. case Lisp_Object_Type::Continuation: return false;
  17. case Lisp_Object_Type::Number: return n1->value.number == n2->value.number;
  18. case Lisp_Object_Type::String: return string_equal(n1->value.string, n2->value.string);
  19. case Lisp_Object_Type::Pair: {
  20. return lisp_object_equal(n1->value.pair.first, n2->value.pair.first) &&
  21. lisp_object_equal(n1->value.pair.rest, n2->value.pair.rest);
  22. } break;
  23. case Lisp_Object_Type::HashMap: {
  24. auto n1_keys = n1->value.hashMap->get_all_keys();
  25. auto n2_keys = n2->value.hashMap->get_all_keys();
  26. defer {
  27. n1_keys.dealloc();
  28. n2_keys.dealloc();
  29. };
  30. if (n1_keys.next_index != n2_keys.next_index)
  31. return false;
  32. n1_keys.sort();
  33. n2_keys.sort();
  34. for (int i = 0; i < n1_keys.next_index; ++i) {
  35. if (!lisp_object_equal(n1_keys[i], n2_keys[i]))
  36. return false;
  37. if (!lisp_object_equal(n1->value.hashMap->get_object(n1_keys[i]),
  38. n2->value.hashMap->get_object(n2_keys[i])))
  39. return false;
  40. }
  41. return true;
  42. }
  43. case Lisp_Object_Type::Vector: {
  44. if (n1->value.vector.length != n2->value.vector.length )
  45. return false;
  46. for (int i = 0; i < n1->value.vector.length; ++i) {
  47. if (!lisp_object_equal(n1->value.vector.data+i, n2->value.vector.data+i))
  48. return false;
  49. }
  50. return true;
  51. } break;
  52. default: create_not_yet_implemented_error();
  53. }
  54. // we should never reach here
  55. return false;
  56. }
  57. proc add_to_load_path(const char* path) -> void {
  58. using Globals::load_path;
  59. load_path.append((void*)path);
  60. }
  61. proc built_in_load(String file_name) -> Lisp_Object* {
  62. profile_with_comment(file_name.data);
  63. char* file_content;
  64. char fullpath[4096];
  65. sprintf(fullpath, "%s", Memory::get_c_str(file_name));
  66. file_content = read_entire_file(Memory::get_c_str(file_name));
  67. if (!file_content) {
  68. for (auto it: Globals::load_path) {
  69. fullpath[0] = '\0';
  70. sprintf(fullpath, "%s%s", (char*)it, Memory::get_c_str(file_name));
  71. file_content = read_entire_file(fullpath);
  72. if (file_content)
  73. break;
  74. }
  75. if (!file_content) {
  76. printf("Load path:\n");
  77. for (auto it : Globals::load_path) {
  78. printf(" - %s\n", (char*) it);
  79. }
  80. create_generic_error("The file to load '%s' was not found in the load path.",
  81. Memory::get_c_str(file_name));
  82. return nullptr;
  83. }
  84. }
  85. Lisp_Object* result = Memory::nil;
  86. Array_List<Lisp_Object*>* program;
  87. String spath = Memory::create_string(fullpath);
  88. defer {
  89. free(spath.data);
  90. };
  91. try program = Parser::parse_program(spath, file_content);
  92. // NOTE(Felix): deferred so even if the eval failes, it will
  93. // run
  94. defer {
  95. program->dealloc();
  96. free(program);
  97. free(file_content);
  98. };
  99. for (auto expr : *program) {
  100. try result = eval_expr(expr);
  101. }
  102. return result;
  103. }
  104. proc built_in_import(String file_name) -> Lisp_Object* {
  105. profile_this();
  106. Environment* new_env;
  107. new_env = Memory::file_to_env_map.get_object(Memory::get_c_str(file_name));
  108. if (!new_env) {
  109. // create new empty environment
  110. try new_env = Memory::create_child_environment(get_root_environment());
  111. // TODO(Felix): check absoulute paths in the map, not just
  112. // relative ones
  113. Memory::file_to_env_map.set_object(Memory::get_c_str(file_name), new_env);
  114. push_environment(new_env);
  115. defer {
  116. pop_environment();
  117. };
  118. Lisp_Object* res;
  119. try res = built_in_load(file_name);
  120. }
  121. get_current_environment()->parents.append(new_env);
  122. return Memory::nil;
  123. }
  124. proc load_built_ins_into_environment() -> void* {
  125. profile_this();
  126. String file_name_built_ins = Memory::create_string(__FILE__);
  127. defer {
  128. free(file_name_built_ins.data);
  129. };
  130. define((remove_when_double_free_is_fixed (:k1 ()) (:k2 ()) . rest), "") {
  131. return Memory::nil;
  132. };
  133. define((remove_when_double_free_is_fixed_2 (:k1 ()) (:k2 ()) . rest), "") {
  134. return Memory::nil;
  135. };
  136. define_macro((apply fun fun_args), "TODO") {
  137. // NOTE(Felix): is has to be a macro because apply by
  138. // itself cannot return the result, we have to invoke eval
  139. // and to prevent recursion, apply is a macro
  140. profile_with_name("(apply)");
  141. using namespace Globals::Current_Execution;
  142. --cs.next_index;
  143. --ams.next_index;
  144. Lisp_Object* args = pcs[--pcs.next_index];
  145. try_void assert_list_length(args, 2);
  146. Lisp_Object* fun = args->value.pair.first;
  147. Lisp_Object* fun_args = args->value.pair.rest->value.pair.first;
  148. // 3. push args on the stack and apply
  149. ats.append([] {
  150. Lisp_Object* args_as_list = cs[--cs.next_index];
  151. for_lisp_list (args_as_list) {
  152. cs.append(it);
  153. }
  154. pcs.append(Memory::nil);
  155. (nass.end()-1)->append(NasAction::Step);
  156. });
  157. (nass.end()-1)->append(NasAction::And_Then_Action);
  158. // 2. Eval fun_args and keep them on the stack
  159. ats.append([] {
  160. // NOTE(Felix): Flip the top 2 elements on cs because
  161. // top is now the evaluated function, and below is the unevaluated args
  162. Lisp_Object* tmp = cs[cs.next_index-1];
  163. cs[cs.next_index-1] = cs[cs.next_index-2];
  164. cs[cs.next_index-2] = tmp;
  165. (nass.end()-1)->append(NasAction::Eval);
  166. });
  167. (nass.end()-1)->append(NasAction::And_Then_Action);
  168. // 1. Eval function and keep it on the stack, below it
  169. // store the unevaluated argument list
  170. ams.append(cs.next_index);
  171. cs.append(fun_args);
  172. cs.append(fun);
  173. (nass.end()-1)->append(NasAction::Eval);
  174. };
  175. define((get-counter),
  176. "When called returns a procedure that represents\n"
  177. "a counter. Each time it is called it returns the\n"
  178. "next whole number.")
  179. {
  180. define_symbol(
  181. Memory::get_symbol("c"),
  182. Memory::create_lisp_object((double)0));
  183. String file_name_built_ins = Memory::create_string(__FILE__);
  184. define((lambda), "") {
  185. fetch(c);
  186. c->value.number++;
  187. return c;
  188. };
  189. fetch(lambda);
  190. return lambda;
  191. };
  192. define_macro((eval expr),
  193. "Takes one argument, and evaluates it two times.")
  194. {
  195. profile_with_name("(eval)");
  196. using namespace Globals::Current_Execution;
  197. cs.data[cs.next_index-1] = pcs[--pcs.next_index]->value.pair.first;
  198. (nass.end()-1)->append(NasAction::Eval);
  199. (nass.end()-1)->append(NasAction::Eval);
  200. };
  201. define_macro((begin . rest),
  202. "Takes any number of forms. Evaluates them in order, "
  203. "and returns the last result.")
  204. {
  205. profile_with_name("(begin)");
  206. using namespace Globals::Current_Execution;
  207. --cs.next_index;
  208. --ams.next_index;
  209. Lisp_Object* args = pcs[--pcs.next_index];
  210. int length = list_length(args);
  211. cs.reserve(length);
  212. for_lisp_list(args) {
  213. cs.data[cs.next_index - 1 + (length - it_index)] = it;
  214. (nass.end()-1)->append(NasAction::Eval);
  215. (nass.end()-1)->append(NasAction::Pop);
  216. }
  217. --(nass.end()-1)->next_index;
  218. cs.next_index += length;
  219. };
  220. define_macro((if test then_part else_part),
  221. "Takes 3 arguments. If the first arguments evaluates to a truthy "
  222. "value, the if expression evaluates the second argument, else "
  223. "it will evaluete the third one and return them respectively.")
  224. {
  225. profile_with_name("(if)");
  226. using namespace Globals::Current_Execution;
  227. /* | | | <test> |
  228. | | -> | <then> |
  229. | <if> | | <else> |
  230. | .... | | ...... | */
  231. --ams.next_index;
  232. Lisp_Object* args = pcs.data[--pcs.next_index];
  233. Lisp_Object* test = args->value.pair.first;
  234. args = args->value.pair.rest;
  235. try_void assert_type(args, Lisp_Object_Type::Pair);
  236. Lisp_Object* consequence = args->value.pair.first;
  237. args = args->value.pair.rest;
  238. try_void assert_type(args, Lisp_Object_Type::Pair);
  239. Lisp_Object* alternative = args->value.pair.first;
  240. args = args->value.pair.rest;
  241. try_void assert_type(args, Lisp_Object_Type::Nil);
  242. --cs.next_index;
  243. cs.append(alternative);
  244. cs.append(consequence);
  245. cs.append(test);
  246. (nass.end()-1)->append(NasAction::Eval);
  247. (nass.end()-1)->append(NasAction::If);
  248. (nass.end()-1)->append(NasAction::Eval);
  249. };
  250. define_macro((define definee . args), "") {
  251. // NOTE(Felix): define has to be a macro, because we need
  252. // to evaluate the value for definee in case it is a
  253. // simple variable (not a function). So ebcause we don't
  254. // want to recursivly evaluate the value, we use a macro
  255. // and a NasAction.
  256. profile_with_name("(define)");
  257. using namespace Globals::Current_Execution;
  258. --cs.next_index;
  259. --ams.next_index;
  260. Lisp_Object* form = pcs.data[--pcs.next_index];
  261. Lisp_Object* definee = form->value.pair.first;
  262. form = form->value.pair.rest;
  263. try_void assert_type(form, Lisp_Object_Type::Pair);
  264. Lisp_Object* thing = form->value.pair.first;
  265. Lisp_Object* thing_cons = form;
  266. form = form->value.pair.rest;
  267. Lisp_Object_Type type = definee->type;
  268. switch (type) {
  269. case Lisp_Object_Type::Symbol: {
  270. if (form != Memory::nil) {
  271. Lisp_Object* doc = thing;
  272. try_void assert_type(doc, Lisp_Object_Type::String);
  273. try_void assert_type(form, Lisp_Object_Type::Pair);
  274. thing = form->value.pair.first;
  275. try_void assert("list must end here.", form->value.pair.rest == Memory::nil);
  276. // TODO docs (maybe with hooks) we have to attach
  277. // the docs to the result of evaluating
  278. }
  279. cs.append(definee);
  280. cs.append(thing);
  281. (nass.end()-1)->append(NasAction::Define_Var);
  282. (nass.end()-1)->append(NasAction::Eval);
  283. } break;
  284. case Lisp_Object_Type::Pair: {
  285. try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol);
  286. Lisp_Object* func;
  287. try_void func = Memory::create_lisp_object_function(Lisp_Function_Type::Lambda);
  288. func->value.function->parent_environment = get_current_environment();
  289. create_arguments_from_lambda_list_and_inject(definee->value.pair.rest, func);
  290. if (thing_cons->value.pair.first->type == Lisp_Object_Type::String &&
  291. thing_cons->value.pair.rest != Memory::nil)
  292. {
  293. // extract docs
  294. Globals::docs.set_object(
  295. func,
  296. Memory::duplicate_string(
  297. thing_cons->value.pair.first->value.string).data);
  298. thing_cons = thing_cons->value.pair.rest;
  299. }
  300. func->value.function->body.lisp_body = maybe_wrap_body_in_begin(thing_cons);
  301. define_symbol(definee->value.pair.first, func);
  302. cs.append(Memory::t);
  303. } break;
  304. default: {
  305. create_generic_error("you can only define symbols");
  306. return;
  307. }
  308. }
  309. };
  310. define((helper), "") {
  311. profile_with_name("(helper)");
  312. return Memory::create_lisp_object(101.0);
  313. };
  314. define((enable-debug-log), "") {
  315. profile_with_name("(enable-debug-log)");
  316. Globals::debug_log = true;
  317. return Memory::t;
  318. };
  319. define((disable-debug-log), "") {
  320. profile_with_name("(disable-debug-log)");
  321. Globals::debug_log = false;
  322. return Memory::t;
  323. };
  324. define_special((with-debug-log . rest), "") {
  325. profile_with_name("(enable-debug-log)");
  326. fetch(rest);
  327. Lisp_Object* result;
  328. Globals::debug_log = true;
  329. in_caller_env {
  330. for_lisp_list(rest) {
  331. // TODO(Felix): hooky would be really nice to
  332. // have. Then this would be a macro and we would
  333. // reset the debug log
  334. try result = eval_expr(it);
  335. }
  336. }
  337. Globals::debug_log = false;
  338. return result;
  339. };
  340. define((test (:k (helper))), "") {
  341. profile_with_name("(test)");
  342. fetch(k);
  343. return k;
  344. };
  345. define((= . args),
  346. "Takes 0 or more arguments and returns =t= if all arguments are equal "
  347. "and =()= otherwise.")
  348. {
  349. profile_with_name("(=)");
  350. fetch(args);
  351. if (args == Memory::nil)
  352. return Memory::t;
  353. Lisp_Object* first = args->value.pair.first;
  354. for_lisp_list (args) {
  355. if (!lisp_object_equal(it, first))
  356. return Memory::nil;
  357. }
  358. return Memory::t;
  359. };
  360. define((> . args), "TODO") {
  361. profile_with_name("(>)");
  362. fetch(args);
  363. double last_number = strtod("Inf", NULL);
  364. for_lisp_list (args) {
  365. try assert_type(it, Lisp_Object_Type::Number);
  366. if (it->value.number >= last_number)
  367. return Memory::nil;
  368. last_number = it->value.number;
  369. }
  370. return Memory::t;
  371. };
  372. define((>= . args), "TODO")
  373. {
  374. profile_with_name("(>=)");
  375. fetch(args);
  376. double last_number = strtod("Inf", NULL);
  377. for_lisp_list (args) {
  378. try assert_type(it, Lisp_Object_Type::Number);
  379. if (it->value.number > last_number)
  380. return Memory::nil;
  381. last_number = it->value.number;
  382. }
  383. return Memory::t;
  384. };
  385. define((< . args), "TODO")
  386. {
  387. profile_with_name("(<)");
  388. fetch(args);
  389. double last_number = strtod("-Inf", NULL);
  390. for_lisp_list (args) {
  391. try assert_type(it, Lisp_Object_Type::Number);
  392. if (it->value.number <= last_number)
  393. return Memory::nil;
  394. last_number = it->value.number;
  395. }
  396. return Memory::t;
  397. };
  398. define((<= . args), "TODO")
  399. {
  400. profile_with_name("(<=)");
  401. fetch(args);
  402. double last_number = strtod("-Inf", NULL);
  403. for_lisp_list (args) {
  404. try assert_type(it, Lisp_Object_Type::Number);
  405. if (it->value.number < last_number)
  406. return Memory::nil;
  407. last_number = it->value.number;
  408. }
  409. return Memory::t;
  410. };
  411. define((+ . args), "TODO")
  412. {
  413. profile_with_name("(+)");
  414. fetch(args);
  415. double sum = 0;
  416. for_lisp_list (args) {
  417. try assert_type(it, Lisp_Object_Type::Number);
  418. sum += it->value.number;
  419. }
  420. return Memory::create_lisp_object(sum);
  421. };
  422. define((- . args), "TODO")
  423. {
  424. profile_with_name("(-)");
  425. fetch(args);
  426. if (args == Memory::nil)
  427. return Memory::create_lisp_object(0.0);
  428. try assert_type(args->value.pair.first, Lisp_Object_Type::Number);
  429. double difference = args->value.pair.first->value.number;
  430. if (args->value.pair.rest == Memory::nil) {
  431. return Memory::create_lisp_object(-difference);
  432. }
  433. for_lisp_list (args->value.pair.rest) {
  434. try assert_type(it, Lisp_Object_Type::Number);
  435. difference -= it->value.number;
  436. }
  437. return Memory::create_lisp_object(difference);
  438. };
  439. define((* . args), "TODO")
  440. {
  441. profile_with_name("(*)");
  442. fetch(args);
  443. if (args == Memory::nil) {
  444. return Memory::create_lisp_object(1);
  445. }
  446. double product = 1;
  447. for_lisp_list (args) {
  448. try assert_type(it, Lisp_Object_Type::Number);
  449. product *= it->value.number;
  450. }
  451. return Memory::create_lisp_object(product);
  452. };
  453. define((/ . args), "TODO")
  454. {
  455. profile_with_name("(/)");
  456. fetch(args);
  457. if (args == Memory::nil) {
  458. return Memory::create_lisp_object(1);
  459. }
  460. try assert_type(args->value.pair.first, Lisp_Object_Type::Number);
  461. double quotient = args->value.pair.first->value.number;
  462. for_lisp_list (args->value.pair.rest) {
  463. try assert_type(it, Lisp_Object_Type::Number);
  464. quotient /= it->value.number;
  465. }
  466. return Memory::create_lisp_object(quotient);
  467. };
  468. define((** a b), "TODO") {
  469. profile_with_name("(**)");
  470. fetch(a, b);
  471. try assert_type(a, Lisp_Object_Type::Number);
  472. try assert_type(b, Lisp_Object_Type::Number);
  473. return Memory::create_lisp_object(pow(a->value.number,
  474. b->value.number));
  475. };
  476. define((% a b), "TODO") {
  477. profile_with_name("(%)");
  478. fetch(a, b);
  479. try assert_type(a, Lisp_Object_Type::Number);
  480. try assert_type(b, Lisp_Object_Type::Number);
  481. return Memory::create_lisp_object((int)a->value.number %
  482. (int)b->value.number);
  483. };
  484. define((get-random-between a b), "TODO") {
  485. profile_with_name("(get-random-between)");
  486. fetch(a, b);
  487. try assert_type(a, Lisp_Object_Type::Number);
  488. try assert_type(b, Lisp_Object_Type::Number);
  489. double fa = a->value.number;
  490. double fb = b->value.number;
  491. double x = (double)rand()/(double)(RAND_MAX);
  492. x *= (fb - fa);
  493. x += fa;
  494. return Memory::create_lisp_object(x);
  495. };
  496. define((gensym), "TODO") {
  497. profile_with_name("(gensym)");
  498. Lisp_Object* node;
  499. try node = Memory::create_lisp_object();
  500. node->type = Lisp_Object_Type::Symbol;
  501. node->value.symbol = Memory::create_string("gensym");
  502. return node;
  503. };
  504. define_special((bound? var), "TODO") {
  505. profile_with_name("(bound?)");
  506. fetch(var);
  507. try assert_type(var, Lisp_Object_Type::Symbol);
  508. Lisp_Object* res;
  509. in_caller_env {
  510. res = try_lookup_symbol(var, get_current_environment());
  511. }
  512. if (res)
  513. return Memory::t;
  514. return Memory::nil;
  515. };
  516. define_special((assert test), "TODO") {
  517. profile_with_name("(assert)");
  518. fetch(test);
  519. in_caller_env {
  520. Lisp_Object* res;
  521. try res = eval_expr(test);
  522. if (is_truthy(res))
  523. return Memory::t;
  524. }
  525. char* string = lisp_object_to_string(test, true);
  526. create_generic_error("Userland assertion. (%s)", string);
  527. free(string);
  528. return nullptr;
  529. };
  530. define_special((define-syntax form . body), "TODO") {
  531. profile_with_name("(define-syntax)");
  532. fetch(form, body);
  533. // TODO(Felix): Macros cannot have docs now
  534. if (form->type != Lisp_Object_Type::Pair) {
  535. create_parsing_error("You can only create function macros.");
  536. return nullptr;
  537. }
  538. Lisp_Object* symbol = form->value.pair.first;
  539. Lisp_Object* lambdalist = form->value.pair.rest;
  540. // creating new lisp object and setting type
  541. Lisp_Object* func;
  542. try func = Memory::create_lisp_object_function(Lisp_Function_Type::Macro);
  543. in_caller_env {
  544. // setting parent env
  545. func->value.function->parent_environment = get_current_environment();
  546. create_arguments_from_lambda_list_and_inject(lambdalist, func);
  547. func->value.function->body.lisp_body = maybe_wrap_body_in_begin(body);
  548. define_symbol(symbol, func);
  549. }
  550. return Memory::nil;
  551. };
  552. define((mutate target source), "TODO") {
  553. profile_with_name("(mutate)");
  554. fetch(target, source);
  555. if (target == Memory::nil ||
  556. target == Memory::t ||
  557. target->type == Lisp_Object_Type::Keyword ||
  558. target->type == Lisp_Object_Type::Symbol)
  559. {
  560. create_generic_error("You cannot mutate to nil, t, keywords or symbols because they have to be unique");
  561. }
  562. if (source == Memory::nil ||
  563. source == Memory::t ||
  564. source->type == Lisp_Object_Type::Keyword ||
  565. source->type == Lisp_Object_Type::Symbol)
  566. {
  567. create_generic_error("You cannot mutate nil, t, keywords or symbols");
  568. }
  569. *target = *source;
  570. return target;
  571. };
  572. define((vector-length v), "TODO") {
  573. profile_with_name("(vector-length)");
  574. fetch(v);
  575. try assert_type(v, Lisp_Object_Type::Vector);
  576. return Memory::create_lisp_object((double)v->value.vector.length);
  577. };
  578. define((vector-ref vec idx), "TODO") {
  579. profile_with_name("(vector-ref)");
  580. fetch(vec, idx);
  581. try assert_type(vec, Lisp_Object_Type::Vector);
  582. try assert_type(idx, Lisp_Object_Type::Number);
  583. int int_idx = ((int)idx->value.number);
  584. try assert("vector access index must be >= 0", int_idx >= 0);
  585. try assert("vector access index must be < length", int_idx < vec->value.vector.length);
  586. return vec->value.vector.data+int_idx;
  587. };
  588. define((vector-set! vec idx val), "TODO") {
  589. profile_with_name("(vector-set!)");
  590. fetch(vec, idx, val);
  591. try assert_type(vec, Lisp_Object_Type::Vector);
  592. try assert_type(idx, Lisp_Object_Type::Number);
  593. int int_idx = ((int)idx->value.number);
  594. try assert("vector access index must be >= 0", int_idx >= 0);
  595. try assert("vector access index must be < length", int_idx < vec->value.vector.length);
  596. vec->value.vector.data[int_idx] = *val;
  597. return val;
  598. };
  599. define_special((set! sym val), "TODO") {
  600. profile_with_name("(set!)");
  601. fetch(sym, val);
  602. try assert_type(sym, Lisp_Object_Type::Symbol);
  603. Environment* target_env;
  604. in_caller_env {
  605. val = eval_expr(val);
  606. target_env = find_binding_environment(sym, get_current_environment());
  607. if (!target_env)
  608. target_env = get_root_environment();
  609. }
  610. push_environment(target_env);
  611. define_symbol(sym, val);
  612. pop_environment();
  613. return val;
  614. };
  615. define((set-car! target source), "TODO") {
  616. profile_with_name("(set-car!)");
  617. fetch(target, source);
  618. try assert_type(target, Lisp_Object_Type::Pair);
  619. *target->value.pair.first = *source;
  620. return source;
  621. };
  622. define((set-cdr! target source), "TODO") {
  623. profile_with_name("(set-cdr!)");
  624. fetch(target, source);
  625. try assert_type(target, Lisp_Object_Type::Pair);
  626. *target->value.pair.rest = *source;
  627. return source;
  628. };
  629. define_special((quote datum), "TODO") {
  630. profile_with_name("(quote)");
  631. fetch(datum);
  632. return datum;
  633. };
  634. define_special((quasiquote expr), "TODO") {
  635. profile_with_name("(quasiquote)");
  636. fetch(expr);
  637. Lisp_Object* quasiquote_sym = Memory::get_symbol("quasiquote");
  638. Lisp_Object* unquote_sym = Memory::get_symbol("unquote");
  639. Lisp_Object* unquote_splicing_sym = Memory::get_symbol("unquote-splicing");
  640. // NOTE(Felix): first we have to initialize the variable
  641. // with a garbage lambda, so that we can then overwrite it
  642. // a recursive lambda
  643. const auto unquoteSomeExpressions = [&] (const auto & self, Lisp_Object* expr) -> Lisp_Object* {
  644. // if it is an atom, return it
  645. if (expr->type != Lisp_Object_Type::Pair)
  646. return Memory::copy_lisp_object(expr);
  647. // it is a pair!
  648. Lisp_Object* originalPair = expr->value.pair.first;
  649. // if we find quasiquote, uhu
  650. if (originalPair == quasiquote_sym)
  651. return expr;
  652. if (originalPair == unquote_sym || originalPair == unquote_splicing_sym)
  653. {
  654. // eval replace the stuff
  655. Lisp_Object* ret;
  656. in_caller_env {
  657. try ret = eval_expr(expr->value.pair.rest->value.pair.first);
  658. }
  659. return ret;
  660. }
  661. // it is a list but not starting with the symbol
  662. // unquote, so search in there for stuff to unquote.
  663. // While copying the list
  664. //NOTE(Felix): Of fucking course we have to copy the
  665. // list. The quasiquote will be part of the body of a
  666. // funciton, we can't just modify it because otherwise
  667. // we modify the body of the function and would bake
  668. // in the result...
  669. Lisp_Object* newPair = Memory::nil;
  670. Lisp_Object* newPairHead = newPair;
  671. Lisp_Object* head = expr;
  672. while (head->type == Lisp_Object_Type::Pair) {
  673. // if it is ,@ we have to actually do more work
  674. // and inline the result
  675. if (head->value.pair.first->type == Lisp_Object_Type::Pair &&
  676. head->value.pair.first->value.pair.first == unquote_splicing_sym)
  677. {
  678. Lisp_Object* spliced = self(self, head->value.pair.first);
  679. if (spliced == Memory::nil) {
  680. head = head->value.pair.rest;
  681. continue;
  682. }
  683. try assert_type(spliced, Lisp_Object_Type::Pair);
  684. if (newPair == Memory::nil) {
  685. try newPair = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
  686. newPairHead = newPair;
  687. } else {
  688. try newPairHead->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
  689. newPairHead = newPairHead->value.pair.rest;
  690. newPairHead->value.pair.first = spliced->value.pair.first;
  691. newPairHead->value.pair.rest = spliced->value.pair.rest;
  692. // now skip to the end
  693. while (newPairHead->value.pair.rest != Memory::nil) {
  694. newPairHead = newPairHead->value.pair.rest;
  695. }
  696. }
  697. } else {
  698. if (newPair == Memory::nil) {
  699. try newPair = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
  700. newPairHead = newPair;
  701. } else {
  702. try newPairHead->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
  703. newPairHead = newPairHead->value.pair.rest;
  704. }
  705. newPairHead->value.pair.first = self(self, head->value.pair.first);
  706. }
  707. // if (Memory::get_type(head->value.pair.rest) != Lisp_Object_Type::Pair) {
  708. // break;
  709. // }
  710. head = head->value.pair.rest;
  711. }
  712. newPairHead->value.pair.rest = Memory::nil;
  713. return newPair;
  714. };
  715. expr = unquoteSomeExpressions(unquoteSomeExpressions, expr);
  716. return expr;
  717. };
  718. define((not test), "TODO") {
  719. profile_with_name("(not)");
  720. fetch(test);
  721. return is_truthy(test) ? Memory::nil : Memory::t;
  722. };
  723. // // // defun("while", "TODO", __LINE__, cLambda {
  724. // // // try arguments_length = list_length(arguments);
  725. // // // try assert(arguments_length >= 2);
  726. // // // Lisp_Object* condition_part = arguments->value.pair.first;
  727. // // // Lisp_Object* condition;
  728. // // // Lisp_Object* then_part = arguments->value.pair.rest;
  729. // // // Lisp_Object* wrapped_then_part;
  730. // // // try wrapped_then_part = Memory::create_lisp_object_pair(
  731. // // // Memory::get_symbol("begin"),
  732. // // // then_part);
  733. // // // Lisp_Object* result = Memory::nil;
  734. // // // while (true) {
  735. // // // try condition = eval_expr(condition_part);
  736. // // // if (condition == Memory::nil)
  737. // // // break;
  738. // // // try result = eval_expr(wrapped_then_part);
  739. // // // }
  740. // // // return result;
  741. // // // });
  742. define_special((lambda args . body), "TODO") {
  743. profile_with_name("(lambda)");
  744. fetch(args, body);
  745. // creating new lisp object and setting type
  746. Lisp_Object* func;
  747. try func = Memory::create_lisp_object_function(Lisp_Function_Type::Lambda);
  748. in_caller_env {
  749. func->value.function->parent_environment = get_current_environment();
  750. }
  751. try create_arguments_from_lambda_list_and_inject(args, func);
  752. func->value.function->body.lisp_body = maybe_wrap_body_in_begin(body);
  753. return func;
  754. };
  755. define((list . args), "TODO") {
  756. profile_with_name("(list)");
  757. fetch(args);
  758. return args;
  759. };
  760. define((hash-map . args), "TODO") {
  761. profile_with_name("(hash-map)");
  762. fetch(args);
  763. Lisp_Object* ret;
  764. try ret = Memory::create_lisp_object_hash_map();
  765. for_lisp_list (args) {
  766. try assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
  767. head = head->value.pair.rest;
  768. ret->value.hashMap->set_object(it, head->value.pair.first);
  769. }
  770. return ret;
  771. };
  772. define((hash-map-get hm key), "TODO") {
  773. profile_with_name("(hash-map-get)");
  774. fetch(hm, key);
  775. try assert_type(hm, Lisp_Object_Type::HashMap);
  776. Lisp_Object* ret = (Lisp_Object*)hm->value.hashMap->get_object(key);
  777. if (!ret)
  778. create_symbol_undefined_error("The key was not set in the hashmap");
  779. return ret;
  780. };
  781. define((hash-map-set! hm key value), "TODO") {
  782. profile_with_name("(hash-map-set!)");
  783. fetch(hm, key, value);
  784. try assert_type(hm, Lisp_Object_Type::HashMap);
  785. hm->value.hashMap->set_object(key, value);
  786. return Memory::nil;
  787. };
  788. define((hash-map-delete! hm key), "TODO") {
  789. profile_with_name("(hash-map-delete!)");
  790. fetch(hm, key);
  791. try assert_type(hm, Lisp_Object_Type::HashMap);
  792. hm->value.hashMap->delete_object(key);
  793. return Memory::nil;
  794. };
  795. define((vector . args), "TODO") {
  796. profile_with_name("(vector)");
  797. fetch(args);
  798. Lisp_Object* ret;
  799. int length = list_length(args);
  800. try ret = Memory::create_lisp_object_vector(length, args);
  801. return ret;
  802. };
  803. define((pair car cdr), "TODO") {
  804. profile_with_name("(pair)");
  805. fetch(car, cdr);
  806. Lisp_Object* ret;
  807. try ret = Memory::create_lisp_object_pair(car, cdr);
  808. return ret;
  809. };
  810. define((first seq), "TODO") {
  811. profile_with_name("(first)");
  812. fetch(seq);
  813. if (seq == Memory::nil)
  814. return Memory::nil;
  815. try assert_type(seq, Lisp_Object_Type::Pair);
  816. return seq->value.pair.first;
  817. };
  818. define((rest seq), "TODO") {
  819. profile_with_name("(rest)");
  820. fetch(seq);
  821. if (seq == Memory::nil)
  822. return Memory::nil;
  823. try assert_type(seq, Lisp_Object_Type::Pair);
  824. return seq->value.pair.rest;
  825. };
  826. define((set-type! node new_type), "TODO") {
  827. profile_with_name("(set-type!)");
  828. fetch(node, new_type);
  829. try assert_type(new_type, Lisp_Object_Type::Keyword);
  830. // TODO(Felix): Enable again when we have user types again:
  831. // node->userType = new_type;
  832. return node;
  833. };
  834. define((delete-type! n), "TODO") {
  835. profile_with_name("(delete-type!)");
  836. fetch(n);
  837. // TODO(Felix): Enable again when we have user types again:
  838. // n->userType = nullptr;
  839. return Memory::t;
  840. };
  841. define((type n), "TODO") {
  842. profile_with_name("(type)");
  843. fetch(n);
  844. // TODO(Felix): Enable again when we have user types again:
  845. // if (n->userType) {
  846. // return n->userType;
  847. // }
  848. Lisp_Object_Type type = n->type;
  849. switch (type) {
  850. case Lisp_Object_Type::Continuation: return Memory::get_keyword("continuation");
  851. case Lisp_Object_Type::Function: {
  852. Function* fun = n->value.function;
  853. if (fun->is_c) {
  854. switch (fun->type.c_function_type) {
  855. case C_Function_Type::cMacro: return Memory::get_keyword("cMacro");
  856. case C_Function_Type::cFunction: return Memory::get_keyword("cFunction");
  857. case C_Function_Type::cSpecial: return Memory::get_keyword("cSpecial");
  858. default: return Memory::get_keyword("c??");
  859. }
  860. } else {
  861. switch (fun->type.lisp_function_type) {
  862. case Lisp_Function_Type::Lambda: return Memory::get_keyword("lambda");
  863. case Lisp_Function_Type::Macro: return Memory::get_keyword("macro");
  864. default: return Memory::get_keyword("??");
  865. }
  866. }
  867. }
  868. case Lisp_Object_Type::HashMap: return Memory::get_keyword("hashmap");
  869. case Lisp_Object_Type::Keyword: return Memory::get_keyword("keyword");
  870. case Lisp_Object_Type::Nil: return Memory::get_keyword("nil");
  871. case Lisp_Object_Type::Number: return Memory::get_keyword("number");
  872. case Lisp_Object_Type::Pair: return Memory::get_keyword("pair");
  873. case Lisp_Object_Type::Pointer: return Memory::get_keyword("pointer");
  874. case Lisp_Object_Type::String: return Memory::get_keyword("string");
  875. case Lisp_Object_Type::Symbol: return Memory::get_keyword("symbol");
  876. case Lisp_Object_Type::T: return Memory::get_keyword("t");
  877. case Lisp_Object_Type::Vector: return Memory::get_keyword("vector");
  878. case(Lisp_Object_Type::Invalid_Garbage_Collected): return Memory::get_keyword("Invalid: Garbage Collected");
  879. case(Lisp_Object_Type::Invalid_Under_Construction): return Memory::get_keyword("Invalid: Under Construction");
  880. }
  881. return Memory::get_keyword("unknown");
  882. };
  883. // define((mem-reset), "TODO") {
  884. // profile_with_name("(mem-reset)");
  885. // Memory::reset();
  886. // return Memory::nil;
  887. // };
  888. define_special((info n), "TODO")
  889. {
  890. // NOTE(Felix): we need to define_special because the docstring is
  891. // attached to the symbol. Because some object are singletons
  892. // (symbols, keyowrds, nil, t) we dont want to store docs on the
  893. // object. Otherwise (define k :doc "hallo" :keyword) would modify
  894. // // the global keyword
  895. profile_with_name("(info)");
  896. fetch(n);
  897. print(n);
  898. Lisp_Object* type;
  899. Lisp_Object* val;
  900. in_caller_env {
  901. try type = eval_expr(Memory::create_list(Memory::get_symbol("type"), n));
  902. try val = eval_expr(n);
  903. }
  904. printf(" is of type ");
  905. print(type);
  906. printf(" (internal: %s)", lisp_object_type_to_string(val->type));
  907. printf("\nand is printed as: ");
  908. print(val);
  909. printf("\n\ndocs:\n=====\n %s\n\n",
  910. (Globals::docs.get_object(val))
  911. ? Globals::docs.get_object(val)
  912. : "No docs avaliable");
  913. if (val->type == Lisp_Object_Type::Function)
  914. {
  915. Arguments* args = &val->value.function->args;
  916. printf("Arguments:\n==========\n");
  917. printf("Postitional: {");
  918. if (args->positional.symbols.next_index != 0) {
  919. printf("%s",
  920. Memory::get_c_str(args->positional.symbols.data[0]->value.symbol));
  921. for (int i = 1; i < args->positional.symbols.next_index; ++i) {
  922. printf(", %s",
  923. Memory::get_c_str(args->positional.symbols.data[i]->value.symbol));
  924. }
  925. }
  926. printf("}\n");
  927. printf("Keyword: {");
  928. if (args->keyword.values.next_index != 0) {
  929. printf("%s",
  930. Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol));
  931. if (args->keyword.values.data[0]) {
  932. printf(" (");
  933. print(args->keyword.values.data[0], true);
  934. printf(")");
  935. }
  936. for (int i = 1; i < args->keyword.values.next_index; ++i) {
  937. printf(", %s",
  938. Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol));
  939. if (args->keyword.values.data[i]) {
  940. printf(" (");
  941. print(args->keyword.values.data[i], true);
  942. printf(")");
  943. }
  944. }
  945. }
  946. printf("}\n");
  947. printf("Rest: {");
  948. if (args->rest)
  949. printf("%s",
  950. Memory::get_c_str(args->rest->value.symbol));
  951. printf("}\n");
  952. }
  953. return Memory::nil;
  954. };
  955. define((show n), "TODO") {
  956. profile_with_name("(show)");
  957. fetch(n);
  958. try assert_type(n, Lisp_Object_Type::Function);
  959. try assert("c-functoins cannot be shown", !n->value.function->is_c);
  960. puts("body:\n");
  961. print(n->value.function->body.lisp_body);
  962. puts("\n");
  963. printf("parent_env: %p\n",
  964. n->value.function->parent_environment);
  965. return Memory::nil;
  966. };
  967. define((addr-of var), "TODO") {
  968. profile_with_name("(addr-of-var)");
  969. fetch(var);
  970. return Memory::create_lisp_object(&var);
  971. };
  972. define((generate-docs file_name), "TODO") {
  973. profile_with_name("(generate-docs)");
  974. fetch(file_name);
  975. try assert_type(file_name, Lisp_Object_Type::String);
  976. in_caller_env {
  977. try generate_docs(file_name->value.string);
  978. }
  979. return Memory::t;
  980. };
  981. define((print (:sep " ") (:end "\n") (:repr ()) . things), "TODO") {
  982. profile_with_name("(print)");
  983. fetch(sep, end, repr, things);
  984. if (things != Memory::nil) {
  985. bool print_repr = repr != Memory::nil;
  986. print(things->value.pair.first, repr);
  987. for_lisp_list(things->value.pair.rest) {
  988. print(sep);
  989. print(it, repr);
  990. }
  991. }
  992. print(end);
  993. return Memory::nil;
  994. };
  995. define((read (:prompt ">")), "TODO") {
  996. profile_with_name("(read)");
  997. fetch(prompt);
  998. print(prompt);
  999. // TODO(Felix): make read_line return a String*
  1000. char* line = read_line();
  1001. defer {
  1002. free(line);
  1003. };
  1004. String strLine = Memory::create_string(line);
  1005. return Memory::create_lisp_object(strLine);
  1006. };
  1007. define((exit (:code 0)), "TODO") {
  1008. profile_with_name("(exit)");
  1009. fetch(code);
  1010. try assert_type(code, Lisp_Object_Type::Number);
  1011. exit((int)code->value.number);
  1012. };
  1013. define((break), "TODO") {
  1014. profile_with_name("(break)");
  1015. in_caller_env {
  1016. print_environment(get_current_environment());
  1017. }
  1018. return Memory::nil;
  1019. };
  1020. define((memstat), "TODO") {
  1021. profile_with_name("(memstat)");
  1022. Memory::print_status();
  1023. return Memory::nil;
  1024. };
  1025. define_special((mytry try_part catch_part), "TODO") {
  1026. profile_with_name("(mytry)");
  1027. fetch(try_part, catch_part);
  1028. Lisp_Object* result;
  1029. in_caller_env {
  1030. ignore_logging {
  1031. dont_break_on_errors {
  1032. result = eval_expr(try_part);
  1033. if (Globals::error) {
  1034. delete_error();
  1035. try result = eval_expr(catch_part);
  1036. }
  1037. }
  1038. }
  1039. }
  1040. return result;
  1041. };
  1042. define((load file), "TODO") {
  1043. profile_with_name("(load)");
  1044. fetch(file);
  1045. try assert_type(file, Lisp_Object_Type::String);
  1046. Lisp_Object* result;
  1047. in_caller_env {
  1048. try result = built_in_load(file->value.string);
  1049. }
  1050. return result;
  1051. };
  1052. define((import f), "TODO") {
  1053. profile_with_name("(import)");
  1054. fetch(f);
  1055. try assert_type(f, Lisp_Object_Type::String);
  1056. Lisp_Object *result;
  1057. in_caller_env {
  1058. try result = built_in_import(f->value.string);
  1059. }
  1060. return Memory::t;
  1061. };
  1062. define((copy obj), "TODO") {
  1063. profile_with_name("(copy)");
  1064. fetch(obj);
  1065. // TODO(Felix): if we are copying string nodes, then
  1066. // shouldn't the string itself also get copied??
  1067. return Memory::copy_lisp_object(obj);
  1068. };
  1069. define((error type message), "TODO") {
  1070. profile_with_name("(error)");
  1071. fetch(type, message);
  1072. // TODO(Felix): make the error function useful
  1073. try assert_type(type, Lisp_Object_Type::Keyword);
  1074. try assert_type(message, Lisp_Object_Type::String);
  1075. using Globals::error;
  1076. error = new(Error);
  1077. error->type = type;
  1078. error->message = message->value.string;
  1079. create_generic_error("Userlanderror");
  1080. return nullptr;
  1081. };
  1082. define((symbol->keyword sym), "TODO") {
  1083. profile_with_name("(symbol->keyword)");
  1084. fetch(sym);
  1085. try assert_type(sym, Lisp_Object_Type::Symbol);
  1086. return Memory::get_keyword(sym->value.symbol);
  1087. };
  1088. define((string->symbol str), "TODO") {
  1089. profile_with_name("(string->symbol)");
  1090. fetch(str);
  1091. // TODO(Felix): do some sanity checks on the string. For
  1092. // example, numbers are not valid symbols.
  1093. try assert_type(str, Lisp_Object_Type::String);
  1094. return Memory::get_symbol(Memory::duplicate_string(str->value.string));
  1095. };
  1096. define((symbol->string sym), "TODO") {
  1097. profile_with_name("(symbol->string)");
  1098. fetch(sym);
  1099. try assert_type(sym, Lisp_Object_Type::Symbol);
  1100. return Memory::create_lisp_object(
  1101. Memory::duplicate_string(sym->value.symbol));
  1102. };
  1103. define((concat-strings . strings), "TODO") {
  1104. profile_with_name("(concat-strings)");
  1105. fetch(strings);
  1106. int resulting_string_len = 0;
  1107. for_lisp_list (strings) {
  1108. try assert_type(it, Lisp_Object_Type::String);
  1109. resulting_string_len += it->value.string.length;
  1110. }
  1111. String resulting_string = Memory::create_string("", resulting_string_len);
  1112. int index_in_string = 0;
  1113. for_lisp_list (strings) {
  1114. strcpy(resulting_string.data+index_in_string,
  1115. Memory::get_c_str(it->value.string));
  1116. index_in_string += it->value.string.length;
  1117. }
  1118. return Memory::create_lisp_object(resulting_string);
  1119. };
  1120. return nullptr;
  1121. }
  1122. }