No puede seleccionar más de 25 temas Los temas deben comenzar con una letra o número, pueden incluir guiones ('-') y pueden tener hasta 35 caracteres de largo.
 
 
 
 
 
 

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