From 66864ff8a9bfb66179bb6f03a85691bb8f6044b5 Mon Sep 17 00:00:00 2001 From: Nicolas Janin Date: Wed, 6 Nov 2024 18:05:22 +0100 Subject: [PATCH 01/10] Add new tests --- test.sh | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/test.sh b/test.sh index deff59d..099c497 100755 --- a/test.sh +++ b/test.sh @@ -164,6 +164,14 @@ run args 15 '(defun f (x y z) (+ x y z)) (f 3 5 7)' run restargs '(3 5 7)' '(defun f (x . y) (cons x y)) (f 3 5 7)' run restargs '(3)' '(defun f (x . y) (cons x y)) (f 3)' +# strings +run string= '()' '(string= "hello" "Hello")' +run string= t '(string= "hello" "hello")' +run 'symbol->string' 'twelve' " + (define twelve 12) + (symbol->string 'twelve)" +run 'string->symbol' 'twelve' '(string->symbol "twelve")' + # Lexical closures run closure 3 '(defun call (f) ((lambda (var) (f)) 5)) ((lambda (var) (call (lambda () var))) 3)' From 1efacb7db5275cd6d94a35e96a8f6cdc7cfa279e Mon Sep 17 00:00:00 2001 From: Nicolas Janin Date: Thu, 7 Nov 2024 07:48:25 +0100 Subject: [PATCH 02/10] Fix crash in comment Refactor arithmetic operations --- src/minilisp.c | 97 +++++++++++++++----------------------------------- 1 file changed, 28 insertions(+), 69 deletions(-) diff --git a/src/minilisp.c b/src/minilisp.c index 2dac0eb..5a0ab39 100644 --- a/src/minilisp.c +++ b/src/minilisp.c @@ -174,13 +174,13 @@ static Obj *read_list(void *root) { for (;;) { *obj = read_expr(root); if (!*obj) - error("Unclosed parenthesis", (*obj)->line_num); + error("Unclosed parenthesis", filepos.line_num); if (*obj == Cparen) return reverse(*head); if (*obj == Dot) { *last = read_expr(root); if (read_expr(root) != Cparen) - error("Closed parenthesis expected after dot", (*obj)->line_num); + error("Closed parenthesis expected after dot", filepos.line_num); Obj *ret = reverse(*head); (*head)->cdr = *last; return ret; @@ -660,77 +660,36 @@ static Obj *prim_reverse(void *root, Obj **env, Obj **list) { } } -// (+ ...) -static Obj *prim_plus(void *root, Obj **env, Obj **list) { - long long sum = 0; - for (Obj *args = eval_list(root, env, list); args != Nil; args = args->cdr) { - if (args->car->type != TINT) - error("+ takes only numbers", (*list)->line_num); - sum += args->car->value; - } - return make_int(root, sum); -} - -// (* ...) -static Obj *prim_mult(void *root, Obj **env, Obj **list) { - long long prod = 1; - for (Obj *args = eval_list(root, env, list); args != Nil; args = args->cdr) { - if (args->car->type != TINT) - error("* takes only numbers", (*list)->line_num); - prod *= args->car->value; - } - return make_int(root, prod); -} - -// (/ ...) -static Obj *prim_div(void *root, Obj **env, Obj **list) { - Obj *args = eval_list(root, env, list); - long long r = args->car->value; - for (Obj *p = args->cdr; p != Nil; p = p->cdr){ - if (p->car->type != TINT) - error("/ takes only numbers", (*list)->line_num); - r /= p->car->value; - } - return make_int(root, r); +#define PRIM_ARITHMETIC_OP(PRIM_OP, OP, OPEQ) \ +static Obj *PRIM_OP(void *root, Obj **env, Obj **list) { \ + Obj *args = eval_list(root, env, list); \ + long long r = args->car->value; \ + for (Obj *p = args->cdr; p != Nil; p = p->cdr) { \ + if (p->car->type != TINT) \ + error(#OP " takes only numbers", (*list)->line_num); \ + r OPEQ p->car->value; \ + } \ + return make_int(root, r); \ } -// (% ...) -static Obj *prim_modulo(void *root, Obj **env, Obj **list) { - Obj *args = eval_list(root, env, list); - long long r = args->car->value; - for (Obj *p = args->cdr; p != Nil; p = p->cdr){ - if (p->car->type != TINT) - error("mod takes only numbers", (*list)->line_num); - r %= p->car->value; - } - return make_int(root, r); -} - -// (- ...) -static Obj *prim_minus(void *root, Obj **env, Obj **list) { - Obj *args = eval_list(root, env, list); - for (Obj *p = args; p != Nil; p = p->cdr) - if (p->car->type != TINT) - error("- takes only numbers", (*list)->line_num); - if (args->cdr == Nil) - return make_int(root, -args->car->value); - long long r = args->car->value; - for (Obj *p = args->cdr; p != Nil; p = p->cdr) - r -= p->car->value; - return make_int(root, r); -} +// (+ ...) +PRIM_ARITHMETIC_OP(prim_plus, +, += ) +PRIM_ARITHMETIC_OP(prim_minus, -, -= ) +PRIM_ARITHMETIC_OP(prim_mult, *, *= ) +PRIM_ARITHMETIC_OP(prim_div , /, /= ) +PRIM_ARITHMETIC_OP(prim_modulo, %, %= ) // (op ) -#define PRIM_COMPARISON_OP(PRIM_OP, OP) \ -static Obj *PRIM_OP(void *root, Obj **env, Obj **list) { \ - Obj *args = eval_list(root, env, list); \ - if (length(args) != 2) \ - error(#OP " takes only 2 number", (*list)->line_num);\ - Obj *x = args->car; \ - Obj *y = args->cdr->car; \ - if (x->type != TINT || y->type != TINT) \ - error(#OP " takes only 2 numbers", (*list)->line_num); \ - return x->value OP y->value ? True : Nil; \ +#define PRIM_COMPARISON_OP(PRIM_OP, OP) \ +static Obj *PRIM_OP(void *root, Obj **env, Obj **list) { \ + Obj *args = eval_list(root, env, list); \ + if (length(args) != 2) \ + error(#OP " takes only 2 number", (*list)->line_num); \ + Obj *x = args->car; \ + Obj *y = args->cdr->car; \ + if (x->type != TINT || y->type != TINT) \ + error(#OP " takes only 2 numbers", (*list)->line_num); \ + return x->value OP y->value ? True : Nil; \ } PRIM_COMPARISON_OP(prim_num_eq, ==) From e2a4784a4611238ec2a280dd57e72c23dadfcf33 Mon Sep 17 00:00:00 2001 From: Nicolas Janin Date: Wed, 30 Oct 2024 14:09:43 +0100 Subject: [PATCH 03/10] Rebase --- examples/hanoi.lisp | 2 +- examples/nqueens.lisp | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/examples/hanoi.lisp b/examples/hanoi.lisp index 0e1c680..12e0196 100644 --- a/examples/hanoi.lisp +++ b/examples/hanoi.lisp @@ -16,4 +16,4 @@ (defun hanoi (n) (hanoi-move n 'L 'M 'R)) -(hanoi 5) \ No newline at end of file +(hanoi 5) diff --git a/examples/nqueens.lisp b/examples/nqueens.lisp index 3795e87..6c595d9 100644 --- a/examples/nqueens.lisp +++ b/examples/nqueens.lisp @@ -136,17 +136,17 @@ (defun get (board x y) (nth (nth board x) y)) -;; Set symbol "@" to location (x, y). +;; Set symbol "Q" to location (x, y). (defun set (board x y) - (setcar (nth-tail (nth board x) y) '@)) + (setcar (nth-tail (nth board x) y) 'Q)) ;; Set symbol "x" to location (x, y). (defun clear (board x y) (setcar (nth-tail (nth board x) y) 'x)) -;; Returns true if location (x, y)'s value is "@". +;; Returns true if location (x, y)'s value is "Q". (defun set? (board x y) - (eq (get board x y) '@)) + (eq (get board x y) 'Q)) ;; Print out the given board. (defun print (board) From d64c0740f44a87fcb8ce231020f2d29117df8d6d Mon Sep 17 00:00:00 2001 From: Nicolas Janin Date: Wed, 30 Oct 2024 14:10:43 +0100 Subject: [PATCH 04/10] Update README --- .vscode/c_cpp_properties.json | 18 ++++++ .vscode/launch.json | 25 ++++++++ .vscode/settings.json | 59 +++++++++++++++++++ README.md | 12 ++++ examples/library.lisp | 108 ++++++++++++++++++++++++++++++++++ examples/test.lisp | 17 ++++++ history.txt | 88 +++++++++++++++++++++++++++ ketopt_test.c | 89 ++++++++++++++++++++++++++++ output.txt | 46 +++++++++++++++ test.sh | 0 10 files changed, 462 insertions(+) create mode 100644 .vscode/c_cpp_properties.json create mode 100644 .vscode/launch.json create mode 100644 .vscode/settings.json create mode 100644 examples/library.lisp create mode 100644 examples/test.lisp create mode 100644 history.txt create mode 100644 ketopt_test.c create mode 100644 output.txt mode change 100755 => 100644 test.sh diff --git a/.vscode/c_cpp_properties.json b/.vscode/c_cpp_properties.json new file mode 100644 index 0000000..cea4d3f --- /dev/null +++ b/.vscode/c_cpp_properties.json @@ -0,0 +1,18 @@ +{ + "configurations": [ + { + "name": "windows-gcc-x64", + "includePath": [ + "${workspaceFolder}/**" + ], + "compilerPath": "gcc", + "cStandard": "${default}", + "cppStandard": "${default}", + "intelliSenseMode": "windows-gcc-x64", + "compilerArgs": [ + "" + ] + } + ], + "version": 4 +} \ No newline at end of file diff --git a/.vscode/launch.json b/.vscode/launch.json new file mode 100644 index 0000000..00c410b --- /dev/null +++ b/.vscode/launch.json @@ -0,0 +1,25 @@ +{ + "name": "C++ Launch", + "type": "cppdbg", + "request": "launch", + "program": "${workspaceFolder}/minilisp", + "stopAtEntry": false, + "customLaunchSetupCommands": [ + { "text": "target-run", "description": "run target", "ignoreFailures": false } + ], + "launchCompleteCommand": "exec-run", + "linux": { + "MIMode": "gdb", + "miDebuggerPath": "/usr/bin/gdb" + }, + "osx": { + "MIMode": "lldb" + }, + "windows": { + "MIMode": "gdb", + "miDebuggerPath": "C:\\MinGw\\bin\\gdb.exe" + }, + "configurations": [ + + ] + } \ No newline at end of file diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 0000000..ca83374 --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,59 @@ +{ + "C_Cpp_Runner.cCompilerPath": "/usr/bin/gcc", + "C_Cpp_Runner.cppCompilerPath": "/usr/bing++", + "C_Cpp_Runner.debuggerPath": "/usr/bingdb", + "C_Cpp_Runner.cStandard": "", + "C_Cpp_Runner.cppStandard": "", + "C_Cpp_Runner.msvcBatchPath": "C:/Program Files/Microsoft Visual Studio/VR_NR/Community/VC/Auxiliary/Build/vcvarsall.bat", + "C_Cpp_Runner.useMsvc": false, + "C_Cpp_Runner.warnings": [ + "-Wall", + "-Wextra", + "-Wpedantic", + "-Wshadow", + "-Wformat=2", + "-Wcast-align", + "-Wconversion", + "-Wsign-conversion", + "-Wnull-dereference" + ], + "C_Cpp_Runner.msvcWarnings": [ + "/W4", + "/permissive-", + "/w14242", + "/w14287", + "/w14296", + "/w14311", + "/w14826", + "/w44062", + "/w44242", + "/w14905", + "/w14906", + "/w14263", + "/w44265", + "/w14928" + ], + "C_Cpp_Runner.enableWarnings": true, + "C_Cpp_Runner.warningsAsError": false, + "C_Cpp_Runner.compilerArgs": [], + "C_Cpp_Runner.linkerArgs": [], + "C_Cpp_Runner.includePaths": [], + "C_Cpp_Runner.includeSearch": [ + "*", + "**/*" + ], + "C_Cpp_Runner.excludeSearch": [ + "**/build", + "**/build/**", + "**/.*", + "**/.*/**", + "**/.vscode", + "**/.vscode/**" + ], + "C_Cpp_Runner.useAddressSanitizer": false, + "C_Cpp_Runner.useUndefinedSanitizer": false, + "C_Cpp_Runner.useLeakSanitizer": false, + "C_Cpp_Runner.showCompilationTime": false, + "C_Cpp_Runner.useLinkTimeOptimization": false, + "C_Cpp_Runner.msvcSecureNoWarnings": false +} \ No newline at end of file diff --git a/README.md b/README.md index f727edc..89a9ad1 100644 --- a/README.md +++ b/README.md @@ -78,6 +78,18 @@ CTRL-Z SUSPEND PROCESS ``` The REPL also saves the history of commands in the file history.txt +<<<<<<< HEAD +======= + +Known bugs: +* Operators "and" and "or" do not work like their typical Lisp counterpart +because they evaluate all their operands at the same time instead of one +by one. + + +Original README +======= +>>>>>>> 0822c20 (Update README) This file is loaded at startup, so one can recall previous commands. Future improvements: diff --git a/examples/library.lisp b/examples/library.lisp new file mode 100644 index 0000000..a35975c --- /dev/null +++ b/examples/library.lisp @@ -0,0 +1,108 @@ +(defun list (x . y) (cons x y)) + +;; (let1 var val body ...) +;; => ((lambda (var) body ...) val) +(defmacro let1 (var val . body) + (cons (cons 'lambda (cons (list var) body)) + (list val))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Control structures +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defmacro cond (rest) + (if (= () rest) + () + (if (= (car (car rest)) t) + (car (cdr (car rest))) + (list 'if + (car (car rest)) + (car (cdr (car rest))) + (cond (cdr rest)))))) + +;; (and e1 e2 ...) +;; => (if e1 (and e2 ...)) +;; (and e1) +;; => e1 +(defmacro and (expr . rest) + (if rest + (list 'if expr (cons 'and rest)) + expr)) + +;; (or e1 e2 ...) +;; => (let1 e1 +;; (if (or e2 ...))) +;; (or e1) +;; => e1 +;; +;; The reason to use the temporary variables is to avoid evaluating the +;; arguments more than once. +(defmacro or (expr . rest) + (if rest + (let1 var (gensym) + (list 'let1 var expr + (list 'if var var (cons 'or rest)))) + expr)) + +;; (when expr body ...) +;; => (if expr (progn body ...)) +(defmacro when (expr . body) + (cons 'if (cons expr (list (cons 'progn body))))) + +;; (unless expr body ...) +;; => (if expr () body ...) +(defmacro unless (expr . body) + (cons 'if (cons expr (cons () body)))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; List operators +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Applies each element of lis to pred. If pred returns a true value, terminate +;; the evaluation and returns pred's return value. If all of them return (), +;; returns (). +(defun any (lis pred) + (when lis + (or (pred (car lis)) + (any (cdr lis) pred)))) + +;;; Applies each element of lis to fn, and returns their return values as a list. +(defun map (lis fn) + (when lis + (cons (fn (car lis)) + (map (cdr lis) fn)))) + +;; Returns nth element of lis. +(defun nth (lis n) + (if (= n 0) + (car lis) + (nth (cdr lis) (- n 1)))) + +;; Returns the nth tail of lis. +(defun nth-tail (lis n) + (if (= n 0) + lis + (nth-tail (cdr lis) (- n 1)))) + +;; Returns a list consists of m .. n-1 integers. +(defun %iota (m n) + (unless (<= n m) + (cons m (%iota (+ m 1) n)))) + +;; Returns a list consists of 0 ... n-1 integers. +(defun iota (n) + (%iota 0 n)) + +;; Returns a new list whose length is len and all members are init. +(defun make-list (len init) + (unless (= len 0) + (cons init (make-list (- len 1) init)))) + +;; Applies fn to each element of lis. +(defun for-each (lis fn) + (or (not lis) + (progn (fn (car lis)) + (for-each (cdr lis) fn)))) + diff --git a/examples/test.lisp b/examples/test.lisp new file mode 100644 index 0000000..9c99024 --- /dev/null +++ b/examples/test.lisp @@ -0,0 +1,17 @@ +(defun list (x . y) (cons x y)) + +(defun count-down (n) + (if (= n 0) + 0 + (progn (println n) + (count-down (- n 1))))) + +(count-down 20) + +(defun fact (n) + (if (= n 0) + 1 + (* n (fact (- n 1))))) + +(fact 10) + diff --git a/history.txt b/history.txt new file mode 100644 index 0000000..c1852e6 --- /dev/null +++ b/history.txt @@ -0,0 +1,88 @@ + (defmacro unless (condition expr) + (list 'if condition () expr)) + (macroexpand (unless (= x 1) '(x is not 1))) + (defmacro unless (condition expr)(list ('if condition () expr))) +(defun list (x . y)(cons x y)) + (defmacro unless (condition expr)(list ('if condition () expr))) +(defun list (x . y)(cons x y)) + (defmacro unless (condition expr)(list ('if condition () expr))) +(list 1 2 3) +(list '(1 2) 3) +(list (list 1 2) 3) + (defmacro unless (condition expr)(list ('if condition () expr))) +(list (list 1 2) 3) +(list 3) +'(3) +(cons 1 2) +(+ (length '('hello 'world)) 44) +(if (> 3 2) (progn (println 'hello) (println 'yo)) (+ 2 3)) +(if (> 3 2) (progn (println 'hello) (println 'yo) (println 'titi)) (+ 2 3)) +(quote (hello world 1 2 3)) +(quote (what is (going on) here?)) +(define my-variable (quote hello)) +(println my-variable) +(setq my-variable 43) +(println my-variable) +(defun sq(n) (* n n)) +(sq 4) +sq +(defun list (x . y)(cons x y)) +'(1 2 3 4) +(list 1 2 3 4) +(defun sq(n) (* n n)) +(and () t) +(and t ()) +(and t t t t t) +(and t t t ()) +(and () ()) +(or t t) +(or) +(or t ()) +(or () ()) +(or () () t) +(defun sq (n) (* n n)) +(sq 5) +(defun sq (n) (* n n)) +(sq 5) +(+ 1 1) +(reverse '( 1 2 3)) +(reverse (1 2 3)) +(reverse 1 2 3) +(reverse (list 1 2 3)) +(reverse 1 2 3 4 5 6 7) +(reverse (1 2 3)) +(reverse '(1 2 3)) +(+ 1 1) +(list 1 2 3) +(iota 10) +(iota 100) +(+ 1 2) +(+ 1 1) +(hanoi 7) +(hanoi 9) +(hanoi 8) +(load "examples/test") +(load "examples/test.lisp") +(+ 1 1) +(load "examples/library.lisp") +(iota 1000) +(load "examples/library.lisp") +(iota 1000) +(iota 100) +(+ 1 1) +(iota 100) +(+ 1 1) +(+ 2 (+ 3 4)) +(defun sq(n) (* n n)) +(sq 5) +(* 5 (sq 5)) +(* 3 4 5) +(* 3 4 (* 4 6)) +(* 12 24) +(defun factorial (n) (if (= n 0) 1 (* n (factorial (- n 1))) ) ) +(factorial 5) +(fact 12) +(fact 13) +(fact 14) +(fact 12) +q diff --git a/ketopt_test.c b/ketopt_test.c new file mode 100644 index 0000000..4009e24 --- /dev/null +++ b/ketopt_test.c @@ -0,0 +1,89 @@ +#include +#include +#include +#include "ketopt.h" + +static void test_opt(int c, int opt, const char *arg) +{ + if (c == 'x') fprintf(stderr, "-x\n"); + else if (c == 'y') fprintf(stderr, "-y %s\n", arg); + else if (c == 301) fprintf(stderr, "--foo\n"); + else if (c == 302) fprintf(stderr, "--bar %s\n", arg? arg : "(null)"); + else if (c == 303) fprintf(stderr, "--opt %s\n", arg? arg : "(null)"); + else if (c == '?') fprintf(stderr, "unknown option -%c\n", opt? opt : ':'); + else if (c == ':') fprintf(stderr, "missing option argument: -%c\n", opt? opt : ':'); +} + +static void print_cmd(int argc, char *argv[], int ind) +{ + int i; + fprintf(stderr, "CMD: %s", argv[0]); + if (ind > 1) { + fputs(" [", stderr); + for (i = 1; i < ind; ++i) { + if (i != 1) fputc(' ', stderr); + fputs(argv[i], stderr); + } + fputc(']', stderr); + } + for (i = ind; i < argc; ++i) + fprintf(stderr, " %s", argv[i]); + fputc('\n', stderr); +} + +static void test_ketopt(int argc, char *argv[]) +{ + static ko_longopt_t longopts[] = { + { "foo", ko_no_argument, 301 }, + { "bar", ko_required_argument, 302 }, + { "opt", ko_optional_argument, 303 }, + { NULL, 0, 0 } + }; + ketopt_t opt = KETOPT_INIT; + int c; + fprintf(stderr, "===> ketopt() <===\n"); + while ((c = ketopt(&opt, argc, argv, 1, "xy:", longopts)) >= 0) + test_opt(c, opt.opt, opt.arg); + print_cmd(argc, argv, opt.ind); +} + +static void test_getopt(int argc, char *argv[]) +{ + static struct option long_options[] = { + { "foo", no_argument, 0, 301 }, + { "bar", required_argument, 0, 302 }, + { "opt", optional_argument, 0, 303 }, + {0, 0, 0, 0} + }; + int c, option_index; + fprintf(stderr, "===> getopt() <===\n"); + while ((c = getopt_long(argc, argv, ":xy:", long_options, &option_index)) >= 0) + test_opt(c, optopt, optarg); + print_cmd(argc, argv, optind); +} + +int main(int argc, char *argv[]) +{ + int i; + char **argv2; + if (argc == 1) { + fprintf(stderr, "Usage: ketopt_test [options] [...]\n"); + fprintf(stderr, "Options:\n"); + fprintf(stderr, " -x no argument\n"); + fprintf(stderr, " -y STR required argument\n"); + fprintf(stderr, " --foo no argument\n"); + fprintf(stderr, " --bar=STR required argument\n"); + fprintf(stderr, " --opt[=STR] optional argument\n"); + fprintf(stderr, "\nExamples:\n"); + fprintf(stderr, " ketopt_test -xy1 -x arg1 -y -x -- arg2 -x\n"); + fprintf(stderr, " ketopt_test --foo --bar=1 --bar 2 --opt arg1 --opt=3\n"); + fprintf(stderr, " ketopt_test arg1 -y\n"); + return 1; + } + argv2 = (char**)malloc(sizeof(char*) * argc); + for (i = 0; i < argc; ++i) argv2[i] = argv[i]; + test_ketopt(argc, argv); + test_getopt(argc, argv2); + free(argv2); + return 0; +} diff --git a/output.txt b/output.txt new file mode 100644 index 0000000..c2f5033 --- /dev/null +++ b/output.txt @@ -0,0 +1,46 @@ +Loading examples/nqueens.lisp +DEBUG: Checking function call: (defun list (x . y) (cons x y)) +DEBUG: Checking function call: (defmacro let1 (var val . body) (cons (cons (quote lambda) (cons (list var) body)) (list val))) +DEBUG: Checking function call: (defmacro and (expr . rest) (if rest (list (quote if) expr (cons (quote and) rest)) expr)) +DEBUG: Checking function call: (defmacro or (expr . rest) (if rest (let1 var (gensym) (list (quote let1) var expr (list (quote if) var var (cons (quote or) rest)))) expr)) +DEBUG: Checking function call: (defmacro when (expr . body) (cons (quote if) (cons expr (list (cons (quote progn) body))))) +DEBUG: Checking function call: (defmacro unless (expr . body) (cons (quote if) (cons expr (cons () body)))) +DEBUG: Checking function call: (defun any (lis pred) (when lis (or (pred (car lis)) (any (cdr lis) pred)))) +DEBUG: Checking function call: (defun map (lis fn) (when lis (cons (fn (car lis)) (map (cdr lis) fn)))) +DEBUG: Checking function call: (defun nth (lis n) (if (= n 0) (car lis) (nth (cdr lis) (- n 1)))) +DEBUG: Checking function call: (defun nth-tail (lis n) (if (= n 0) lis (nth-tail (cdr lis) (- n 1)))) +DEBUG: Checking function call: (defun %iota (m n) (unless (<= n m) (cons m (%iota (+ m 1) n)))) +DEBUG: Checking function call: (defun iota (n) (%iota 0 n)) +DEBUG: Checking function call: (defun make-list (len init) (unless (= len 0) (cons init (make-list (- len 1) init)))) +DEBUG: Checking function call: (defun for-each (lis fn) (or (not lis) (progn (fn (car lis)) (for-each (cdr lis) fn)))) +DEBUG: Checking function call: (defun make-board (size) (map (iota size) (lambda (_) (make-list size (quote x))))) +DEBUG: Checking function call: (defun get (board x y) (nth (nth board x) y)) +DEBUG: Checking function call: (defun set (board x y) (setcar (nth-tail (nth board x) y) (quote Q))) +DEBUG: Checking function call: (defun clear (board x y) (setcar (nth-tail (nth board x) y) (quote x))) +DEBUG: Checking function call: (defun set? (board x y) (eq (get board x y) (quote Q))) +DEBUG: Checking function call: (defun print (board) (if (not board) (quote $) (println (car board)) (print (cdr board)))) +DEBUG: Checking function call: (defun conflict? (board x y) (any (iota x) (lambda (n) (or (set? board n y) (let1 z (+ y (- n x)) (and (<= 0 z) (set? board n z))) (let1 z (+ y (- x n)) (and (< z board-size) (set? board n z))))))) +DEBUG: Checking function call: (defun %solve (board x) (if (= x board-size) (progn (print board) (println (quote $))) (for-each (iota board-size) (lambda (y) (unless (conflict? board x y) (set board x y) (%solve board (+ x 1)) (clear board x y)))))) +DEBUG: Checking function call: (defun solve (board) (println (quote start)) (%solve board 0) (println (quote done))) +DEBUG: Checking function call: (define board-size 4) +DEBUG: Checking function call: (define board (make-board board-size)) +DEBUG: Checking function call: (make-board board-size) +DEBUG: Checking tail position for: (make-board board-size) in context: null +DEBUG: apply_func called with tail_call = 0 +DEBUG: Checking function call: (map (iota size) (lambda (_) (make-list size (quote x)))) +DEBUG: Checking tail position for: (map (iota size) (lambda (_) (make-list size (quote x)))) in context: ((map (iota size) (lambda (_) (make-list size (quote x))))) +DEBUG: Tail call optimization for: (map (iota size) (lambda (_) (make-list size (quote x)))) +DEBUG: Checking function call: (iota size) +DEBUG: Checking tail position for: (iota size) in context: null +DEBUG: apply_func called with tail_call = 0 +DEBUG: Checking function call: (%iota 0 n) +DEBUG: Checking tail position for: (%iota 0 n) in context: ((%iota 0 n)) +DEBUG: Tail call optimization for: (%iota 0 n) +DEBUG: apply_func called with tail_call = 1 +DEBUG: apply_func called with tail_call = 0 +DEBUG: Checking function call: (cons (quote if) (cons expr (cons () body))) +DEBUG: Checking function call: (quote if) +DEBUG: Checking function call: (cons expr (cons () body)) +DEBUG: Checking function call: (cons () body) +DEBUG: Checking function call: (<= n m) +DEBUG: Checking function call: (con \ No newline at end of file diff --git a/test.sh b/test.sh old mode 100755 new mode 100644 From 51547cbcb3e9f89b5233139570a4afa3d7e1a872 Mon Sep 17 00:00:00 2001 From: Nicolas Janin Date: Thu, 7 Nov 2024 14:00:42 +0100 Subject: [PATCH 05/10] Examples now load library.lisp --- examples/hanoi.lisp | 2 +- examples/life.lisp | 95 +----------------------------------- examples/nqueens.lisp | 111 ++---------------------------------------- 3 files changed, 5 insertions(+), 203 deletions(-) diff --git a/examples/hanoi.lisp b/examples/hanoi.lisp index 12e0196..cc37abe 100644 --- a/examples/hanoi.lisp +++ b/examples/hanoi.lisp @@ -1,4 +1,4 @@ -(defun list (x . y) (cons x y)) +(load "examples/library.lisp") (defun hanoi-print (disk from to) (println (string-concat "Move disk " disk diff --git a/examples/life.lisp b/examples/life.lisp index f6f2968..72b2b03 100644 --- a/examples/life.lisp +++ b/examples/life.lisp @@ -2,100 +2,7 @@ ;;; Conway's game of life ;;; -;; (progn expr ...) -;; => ((lambda () expr ...)) -;(defmacro progn (expr . rest) -; (list (cons 'lambda (cons () (cons expr rest))))) - -(defun list (x . y) - (cons x y)) - - -;(defun not (x) -; (if x () t)) - -;; (let var val body ...) -;; => ((lambda (var) body ...) val) -(defmacro let (var val . body) - (cons (cons 'lambda (cons (list var) body)) - (list val))) - -;; (and e1 e2 ...) -;; => (if e1 (and e2 ...)) -;; (and e1) -;; => e1 -(defmacro and (expr . rest) - (if rest - (list 'if expr (cons 'and rest)) - expr)) - -;; (or e1 e2 ...) -;; => (let e1 -;; (if (or e2 ...))) -;; (or e1) -;; => e1 -;; -;; The reason to use the temporary variables is to avoid evaluating the -;; arguments more than once. -(defmacro or (expr . rest) - (if rest - (let var (gensym) - (list 'let var expr - (list 'if var var (cons 'or rest)))) - expr)) - -;; (when expr body ...) -;; => (if expr (progn body ...)) -(defmacro when (expr . body) - (cons 'if (cons expr (list (cons 'progn body))))) - -;; (unless expr body ...) -;; => (if expr () body ...) -(defmacro unless (expr . body) - (cons 'if (cons expr (cons () body)))) - -;;; -;;; Numeric operators -;;; - -;(defun <= (e1 e2) -; (or (< e1 e2) -; (= e1 e2))) - -;;; -;;; List operators -;;; - -;;; Applies each element of lis to fn, and returns their return values as a list. -(defun map (lis fn) - (when lis - (cons (fn (car lis)) - (map (cdr lis) fn)))) - -;; Returns nth element of lis. -(defun nth (lis n) - (if (= n 0) - (car lis) - (nth (cdr lis) (- n 1)))) - -;; Returns the nth tail of lis. -(defun nth-tail (lis n) - (if (= n 0) - lis - (nth-tail (cdr lis) (- n 1)))) - -;; Returns a list consists of m .. n-1 integers. -(defun %iota (m n) - (unless (<= n m) - (cons m (%iota (+ m 1) n)))) - -;; Returns a list consists of 0 ... n-1 integers. -(defun iota (n) - (%iota 0 n)) - -;;; -;;; Main -;;; +(load "examples/library.lisp") (define width 10) (define height 10) diff --git a/examples/nqueens.lisp b/examples/nqueens.lisp index 6c595d9..de2af76 100644 --- a/examples/nqueens.lisp +++ b/examples/nqueens.lisp @@ -15,112 +15,7 @@ ;;; expanded form using cons and list. ;;; -;; (progn expr ...) -;; => ((lambda () expr ...)) -;(defmacro progn (expr . rest) -; (list (cons 'lambda (cons () (cons expr rest))))) - -(defun list (x . y) (cons x y)) - -;(defun not (x) (if x () t)) - -;; (let1 var val body ...) -;; => ((lambda (var) body ...) val) -(defmacro let1 (var val . body) - (cons (cons 'lambda (cons (list var) body)) - (list val))) - -;; (and e1 e2 ...) -;; => (if e1 (and e2 ...)) -;; (and e1) -;; => e1 -(defmacro and (expr . rest) - (if rest - (list 'if expr (cons 'and rest)) - expr)) - -;; (or e1 e2 ...) -;; => (let1 e1 -;; (if (or e2 ...))) -;; (or e1) -;; => e1 -;; -;; The reason to use the temporary variables is to avoid evaluating the -;; arguments more than once. -(defmacro or (expr . rest) - (if rest - (let1 var (gensym) - (list 'let1 var expr - (list 'if var var (cons 'or rest)))) - expr)) - -;; (when expr body ...) -;; => (if expr (progn body ...)) -(defmacro when (expr . body) - (cons 'if (cons expr (list (cons 'progn body))))) - -;; (unless expr body ...) -;; => (if expr () body ...) -(defmacro unless (expr . body) - (cons 'if (cons expr (cons () body)))) - -;;; -;;; Numeric operators -;;; - -;(defun <= (e1 e2) -; (or (< e1 e2) -; (= e1 e2))) - -;;; -;;; List operators -;;; - -;; Applies each element of lis to pred. If pred returns a true value, terminate -;; the evaluation and returns pred's return value. If all of them return (), -;; returns (). -(defun any (lis pred) - (when lis - (or (pred (car lis)) - (any (cdr lis) pred)))) - -;;; Applies each element of lis to fn, and returns their return values as a list. -(defun map (lis fn) - (when lis - (cons (fn (car lis)) - (map (cdr lis) fn)))) - -;; Returns nth element of lis. -(defun nth (lis n) - (if (= n 0) - (car lis) - (nth (cdr lis) (- n 1)))) - -;; Returns the nth tail of lis. -(defun nth-tail (lis n) - (if (= n 0) - lis - (nth-tail (cdr lis) (- n 1)))) - -;; Returns a list consists of m .. n-1 integers. -(defun %iota (m n) - (unless (<= n m) - (cons m (%iota (+ m 1) n)))) - -;; Returns a list consists of 0 ... n-1 integers. -(defun iota (n) - (%iota 0 n)) - -;; Returns a new list whose length is len and all members are init. -(defun make-list (len init) - (unless (= len 0) - (cons init (make-list (- len 1) init)))) - -;; Applies fn to each element of lis. -(defun for-each (lis fn) - (or (not lis) - (progn (fn (car lis)) - (for-each (cdr lis) fn)))) +(load "examples/library.lisp") ;;; ;;; N-queens solver @@ -164,11 +59,11 @@ ;; Check if there's no conflicting queen upward (set? board n y) ;; Upper left - (let1 z (+ y (- n x)) + (let z (+ y (- n x)) (and (<= 0 z) (set? board n z))) ;; Upper right - (let1 z (+ y (- x n)) + (let z (+ y (- x n)) (and (< z board-size) (set? board n z))))))) From 909263bec5c52e6e340354fb791d010c4c9992a4 Mon Sep 17 00:00:00 2001 From: Nicolas Janin Date: Thu, 7 Nov 2024 14:14:41 +0100 Subject: [PATCH 06/10] Remove files that shouldn't be tracked --- .vscode/launch.json | 25 ----- examples/library.lisp | 216 +++++++++++++++++++++--------------------- examples/test.lisp | 17 ---- history.txt | 88 ----------------- ketopt_test.c | 89 ----------------- output.txt | 46 --------- test.sh | 0 7 files changed, 108 insertions(+), 373 deletions(-) delete mode 100644 .vscode/launch.json delete mode 100644 examples/test.lisp delete mode 100644 history.txt delete mode 100644 ketopt_test.c delete mode 100644 output.txt mode change 100644 => 100755 test.sh diff --git a/.vscode/launch.json b/.vscode/launch.json deleted file mode 100644 index 00c410b..0000000 --- a/.vscode/launch.json +++ /dev/null @@ -1,25 +0,0 @@ -{ - "name": "C++ Launch", - "type": "cppdbg", - "request": "launch", - "program": "${workspaceFolder}/minilisp", - "stopAtEntry": false, - "customLaunchSetupCommands": [ - { "text": "target-run", "description": "run target", "ignoreFailures": false } - ], - "launchCompleteCommand": "exec-run", - "linux": { - "MIMode": "gdb", - "miDebuggerPath": "/usr/bin/gdb" - }, - "osx": { - "MIMode": "lldb" - }, - "windows": { - "MIMode": "gdb", - "miDebuggerPath": "C:\\MinGw\\bin\\gdb.exe" - }, - "configurations": [ - - ] - } \ No newline at end of file diff --git a/examples/library.lisp b/examples/library.lisp index a35975c..2a69869 100644 --- a/examples/library.lisp +++ b/examples/library.lisp @@ -1,108 +1,108 @@ -(defun list (x . y) (cons x y)) - -;; (let1 var val body ...) -;; => ((lambda (var) body ...) val) -(defmacro let1 (var val . body) - (cons (cons 'lambda (cons (list var) body)) - (list val))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Control structures -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro cond (rest) - (if (= () rest) - () - (if (= (car (car rest)) t) - (car (cdr (car rest))) - (list 'if - (car (car rest)) - (car (cdr (car rest))) - (cond (cdr rest)))))) - -;; (and e1 e2 ...) -;; => (if e1 (and e2 ...)) -;; (and e1) -;; => e1 -(defmacro and (expr . rest) - (if rest - (list 'if expr (cons 'and rest)) - expr)) - -;; (or e1 e2 ...) -;; => (let1 e1 -;; (if (or e2 ...))) -;; (or e1) -;; => e1 -;; -;; The reason to use the temporary variables is to avoid evaluating the -;; arguments more than once. -(defmacro or (expr . rest) - (if rest - (let1 var (gensym) - (list 'let1 var expr - (list 'if var var (cons 'or rest)))) - expr)) - -;; (when expr body ...) -;; => (if expr (progn body ...)) -(defmacro when (expr . body) - (cons 'if (cons expr (list (cons 'progn body))))) - -;; (unless expr body ...) -;; => (if expr () body ...) -(defmacro unless (expr . body) - (cons 'if (cons expr (cons () body)))) - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; List operators -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Applies each element of lis to pred. If pred returns a true value, terminate -;; the evaluation and returns pred's return value. If all of them return (), -;; returns (). -(defun any (lis pred) - (when lis - (or (pred (car lis)) - (any (cdr lis) pred)))) - -;;; Applies each element of lis to fn, and returns their return values as a list. -(defun map (lis fn) - (when lis - (cons (fn (car lis)) - (map (cdr lis) fn)))) - -;; Returns nth element of lis. -(defun nth (lis n) - (if (= n 0) - (car lis) - (nth (cdr lis) (- n 1)))) - -;; Returns the nth tail of lis. -(defun nth-tail (lis n) - (if (= n 0) - lis - (nth-tail (cdr lis) (- n 1)))) - -;; Returns a list consists of m .. n-1 integers. -(defun %iota (m n) - (unless (<= n m) - (cons m (%iota (+ m 1) n)))) - -;; Returns a list consists of 0 ... n-1 integers. -(defun iota (n) - (%iota 0 n)) - -;; Returns a new list whose length is len and all members are init. -(defun make-list (len init) - (unless (= len 0) - (cons init (make-list (- len 1) init)))) - -;; Applies fn to each element of lis. -(defun for-each (lis fn) - (or (not lis) - (progn (fn (car lis)) - (for-each (cdr lis) fn)))) - +(defun list (x . y) (cons x y)) + +;; (let var val body ...) +;; => ((lambda (var) body ...) val) +(defmacro let (var val . body) + (cons (cons 'lambda (cons (list var) body)) + (list val))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Control structures +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defmacro cond (rest) + (if (= () rest) + () + (if (= (car (car rest)) t) + (car (cdr (car rest))) + (list 'if + (car (car rest)) + (car (cdr (car rest))) + (cond (cdr rest)))))) + +;; (and e1 e2 ...) +;; => (if e1 (and e2 ...)) +;; (and e1) +;; => e1 +(defmacro and (expr . rest) + (if rest + (list 'if expr (cons 'and rest)) + expr)) + +;; (or e1 e2 ...) +;; => (let e1 +;; (if (or e2 ...))) +;; (or e1) +;; => e1 +;; +;; The reason to use the temporary variables is to avoid evaluating the +;; arguments more than once. +(defmacro or (expr . rest) + (if rest + (let var (gensym) + (list 'let var expr + (list 'if var var (cons 'or rest)))) + expr)) + +;; (when expr body ...) +;; => (if expr (progn body ...)) +(defmacro when (expr . body) + (cons 'if (cons expr (list (cons 'progn body))))) + +;; (unless expr body ...) +;; => (if expr () body ...) +(defmacro unless (expr . body) + (cons 'if (cons expr (cons () body)))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; List operators +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Applies each element of lis to pred. If pred returns a true value, terminate +;; the evaluation and returns pred's return value. If all of them return (), +;; returns (). +(defun any (lis pred) + (when lis + (or (pred (car lis)) + (any (cdr lis) pred)))) + +;;; Applies each element of lis to fn, and returns their return values as a list. +(defun map (lis fn) + (when lis + (cons (fn (car lis)) + (map (cdr lis) fn)))) + +;; Returns nth element of lis. +(defun nth (lis n) + (if (= n 0) + (car lis) + (nth (cdr lis) (- n 1)))) + +;; Returns the nth tail of lis. +(defun nth-tail (lis n) + (if (= n 0) + lis + (nth-tail (cdr lis) (- n 1)))) + +;; Returns a list consists of m .. n-1 integers. +(defun %iota (m n) + (unless (<= n m) + (cons m (%iota (+ m 1) n)))) + +;; Returns a list consists of 0 ... n-1 integers. +(defun iota (n) + (%iota 0 n)) + +;; Returns a new list whose length is len and all members are init. +(defun make-list (len init) + (unless (= len 0) + (cons init (make-list (- len 1) init)))) + +;; Applies fn to each element of lis. +(defun for-each (lis fn) + (or (not lis) + (progn (fn (car lis)) + (for-each (cdr lis) fn)))) + diff --git a/examples/test.lisp b/examples/test.lisp deleted file mode 100644 index 9c99024..0000000 --- a/examples/test.lisp +++ /dev/null @@ -1,17 +0,0 @@ -(defun list (x . y) (cons x y)) - -(defun count-down (n) - (if (= n 0) - 0 - (progn (println n) - (count-down (- n 1))))) - -(count-down 20) - -(defun fact (n) - (if (= n 0) - 1 - (* n (fact (- n 1))))) - -(fact 10) - diff --git a/history.txt b/history.txt deleted file mode 100644 index c1852e6..0000000 --- a/history.txt +++ /dev/null @@ -1,88 +0,0 @@ - (defmacro unless (condition expr) - (list 'if condition () expr)) - (macroexpand (unless (= x 1) '(x is not 1))) - (defmacro unless (condition expr)(list ('if condition () expr))) -(defun list (x . y)(cons x y)) - (defmacro unless (condition expr)(list ('if condition () expr))) -(defun list (x . y)(cons x y)) - (defmacro unless (condition expr)(list ('if condition () expr))) -(list 1 2 3) -(list '(1 2) 3) -(list (list 1 2) 3) - (defmacro unless (condition expr)(list ('if condition () expr))) -(list (list 1 2) 3) -(list 3) -'(3) -(cons 1 2) -(+ (length '('hello 'world)) 44) -(if (> 3 2) (progn (println 'hello) (println 'yo)) (+ 2 3)) -(if (> 3 2) (progn (println 'hello) (println 'yo) (println 'titi)) (+ 2 3)) -(quote (hello world 1 2 3)) -(quote (what is (going on) here?)) -(define my-variable (quote hello)) -(println my-variable) -(setq my-variable 43) -(println my-variable) -(defun sq(n) (* n n)) -(sq 4) -sq -(defun list (x . y)(cons x y)) -'(1 2 3 4) -(list 1 2 3 4) -(defun sq(n) (* n n)) -(and () t) -(and t ()) -(and t t t t t) -(and t t t ()) -(and () ()) -(or t t) -(or) -(or t ()) -(or () ()) -(or () () t) -(defun sq (n) (* n n)) -(sq 5) -(defun sq (n) (* n n)) -(sq 5) -(+ 1 1) -(reverse '( 1 2 3)) -(reverse (1 2 3)) -(reverse 1 2 3) -(reverse (list 1 2 3)) -(reverse 1 2 3 4 5 6 7) -(reverse (1 2 3)) -(reverse '(1 2 3)) -(+ 1 1) -(list 1 2 3) -(iota 10) -(iota 100) -(+ 1 2) -(+ 1 1) -(hanoi 7) -(hanoi 9) -(hanoi 8) -(load "examples/test") -(load "examples/test.lisp") -(+ 1 1) -(load "examples/library.lisp") -(iota 1000) -(load "examples/library.lisp") -(iota 1000) -(iota 100) -(+ 1 1) -(iota 100) -(+ 1 1) -(+ 2 (+ 3 4)) -(defun sq(n) (* n n)) -(sq 5) -(* 5 (sq 5)) -(* 3 4 5) -(* 3 4 (* 4 6)) -(* 12 24) -(defun factorial (n) (if (= n 0) 1 (* n (factorial (- n 1))) ) ) -(factorial 5) -(fact 12) -(fact 13) -(fact 14) -(fact 12) -q diff --git a/ketopt_test.c b/ketopt_test.c deleted file mode 100644 index 4009e24..0000000 --- a/ketopt_test.c +++ /dev/null @@ -1,89 +0,0 @@ -#include -#include -#include -#include "ketopt.h" - -static void test_opt(int c, int opt, const char *arg) -{ - if (c == 'x') fprintf(stderr, "-x\n"); - else if (c == 'y') fprintf(stderr, "-y %s\n", arg); - else if (c == 301) fprintf(stderr, "--foo\n"); - else if (c == 302) fprintf(stderr, "--bar %s\n", arg? arg : "(null)"); - else if (c == 303) fprintf(stderr, "--opt %s\n", arg? arg : "(null)"); - else if (c == '?') fprintf(stderr, "unknown option -%c\n", opt? opt : ':'); - else if (c == ':') fprintf(stderr, "missing option argument: -%c\n", opt? opt : ':'); -} - -static void print_cmd(int argc, char *argv[], int ind) -{ - int i; - fprintf(stderr, "CMD: %s", argv[0]); - if (ind > 1) { - fputs(" [", stderr); - for (i = 1; i < ind; ++i) { - if (i != 1) fputc(' ', stderr); - fputs(argv[i], stderr); - } - fputc(']', stderr); - } - for (i = ind; i < argc; ++i) - fprintf(stderr, " %s", argv[i]); - fputc('\n', stderr); -} - -static void test_ketopt(int argc, char *argv[]) -{ - static ko_longopt_t longopts[] = { - { "foo", ko_no_argument, 301 }, - { "bar", ko_required_argument, 302 }, - { "opt", ko_optional_argument, 303 }, - { NULL, 0, 0 } - }; - ketopt_t opt = KETOPT_INIT; - int c; - fprintf(stderr, "===> ketopt() <===\n"); - while ((c = ketopt(&opt, argc, argv, 1, "xy:", longopts)) >= 0) - test_opt(c, opt.opt, opt.arg); - print_cmd(argc, argv, opt.ind); -} - -static void test_getopt(int argc, char *argv[]) -{ - static struct option long_options[] = { - { "foo", no_argument, 0, 301 }, - { "bar", required_argument, 0, 302 }, - { "opt", optional_argument, 0, 303 }, - {0, 0, 0, 0} - }; - int c, option_index; - fprintf(stderr, "===> getopt() <===\n"); - while ((c = getopt_long(argc, argv, ":xy:", long_options, &option_index)) >= 0) - test_opt(c, optopt, optarg); - print_cmd(argc, argv, optind); -} - -int main(int argc, char *argv[]) -{ - int i; - char **argv2; - if (argc == 1) { - fprintf(stderr, "Usage: ketopt_test [options] [...]\n"); - fprintf(stderr, "Options:\n"); - fprintf(stderr, " -x no argument\n"); - fprintf(stderr, " -y STR required argument\n"); - fprintf(stderr, " --foo no argument\n"); - fprintf(stderr, " --bar=STR required argument\n"); - fprintf(stderr, " --opt[=STR] optional argument\n"); - fprintf(stderr, "\nExamples:\n"); - fprintf(stderr, " ketopt_test -xy1 -x arg1 -y -x -- arg2 -x\n"); - fprintf(stderr, " ketopt_test --foo --bar=1 --bar 2 --opt arg1 --opt=3\n"); - fprintf(stderr, " ketopt_test arg1 -y\n"); - return 1; - } - argv2 = (char**)malloc(sizeof(char*) * argc); - for (i = 0; i < argc; ++i) argv2[i] = argv[i]; - test_ketopt(argc, argv); - test_getopt(argc, argv2); - free(argv2); - return 0; -} diff --git a/output.txt b/output.txt deleted file mode 100644 index c2f5033..0000000 --- a/output.txt +++ /dev/null @@ -1,46 +0,0 @@ -Loading examples/nqueens.lisp -DEBUG: Checking function call: (defun list (x . y) (cons x y)) -DEBUG: Checking function call: (defmacro let1 (var val . body) (cons (cons (quote lambda) (cons (list var) body)) (list val))) -DEBUG: Checking function call: (defmacro and (expr . rest) (if rest (list (quote if) expr (cons (quote and) rest)) expr)) -DEBUG: Checking function call: (defmacro or (expr . rest) (if rest (let1 var (gensym) (list (quote let1) var expr (list (quote if) var var (cons (quote or) rest)))) expr)) -DEBUG: Checking function call: (defmacro when (expr . body) (cons (quote if) (cons expr (list (cons (quote progn) body))))) -DEBUG: Checking function call: (defmacro unless (expr . body) (cons (quote if) (cons expr (cons () body)))) -DEBUG: Checking function call: (defun any (lis pred) (when lis (or (pred (car lis)) (any (cdr lis) pred)))) -DEBUG: Checking function call: (defun map (lis fn) (when lis (cons (fn (car lis)) (map (cdr lis) fn)))) -DEBUG: Checking function call: (defun nth (lis n) (if (= n 0) (car lis) (nth (cdr lis) (- n 1)))) -DEBUG: Checking function call: (defun nth-tail (lis n) (if (= n 0) lis (nth-tail (cdr lis) (- n 1)))) -DEBUG: Checking function call: (defun %iota (m n) (unless (<= n m) (cons m (%iota (+ m 1) n)))) -DEBUG: Checking function call: (defun iota (n) (%iota 0 n)) -DEBUG: Checking function call: (defun make-list (len init) (unless (= len 0) (cons init (make-list (- len 1) init)))) -DEBUG: Checking function call: (defun for-each (lis fn) (or (not lis) (progn (fn (car lis)) (for-each (cdr lis) fn)))) -DEBUG: Checking function call: (defun make-board (size) (map (iota size) (lambda (_) (make-list size (quote x))))) -DEBUG: Checking function call: (defun get (board x y) (nth (nth board x) y)) -DEBUG: Checking function call: (defun set (board x y) (setcar (nth-tail (nth board x) y) (quote Q))) -DEBUG: Checking function call: (defun clear (board x y) (setcar (nth-tail (nth board x) y) (quote x))) -DEBUG: Checking function call: (defun set? (board x y) (eq (get board x y) (quote Q))) -DEBUG: Checking function call: (defun print (board) (if (not board) (quote $) (println (car board)) (print (cdr board)))) -DEBUG: Checking function call: (defun conflict? (board x y) (any (iota x) (lambda (n) (or (set? board n y) (let1 z (+ y (- n x)) (and (<= 0 z) (set? board n z))) (let1 z (+ y (- x n)) (and (< z board-size) (set? board n z))))))) -DEBUG: Checking function call: (defun %solve (board x) (if (= x board-size) (progn (print board) (println (quote $))) (for-each (iota board-size) (lambda (y) (unless (conflict? board x y) (set board x y) (%solve board (+ x 1)) (clear board x y)))))) -DEBUG: Checking function call: (defun solve (board) (println (quote start)) (%solve board 0) (println (quote done))) -DEBUG: Checking function call: (define board-size 4) -DEBUG: Checking function call: (define board (make-board board-size)) -DEBUG: Checking function call: (make-board board-size) -DEBUG: Checking tail position for: (make-board board-size) in context: null -DEBUG: apply_func called with tail_call = 0 -DEBUG: Checking function call: (map (iota size) (lambda (_) (make-list size (quote x)))) -DEBUG: Checking tail position for: (map (iota size) (lambda (_) (make-list size (quote x)))) in context: ((map (iota size) (lambda (_) (make-list size (quote x))))) -DEBUG: Tail call optimization for: (map (iota size) (lambda (_) (make-list size (quote x)))) -DEBUG: Checking function call: (iota size) -DEBUG: Checking tail position for: (iota size) in context: null -DEBUG: apply_func called with tail_call = 0 -DEBUG: Checking function call: (%iota 0 n) -DEBUG: Checking tail position for: (%iota 0 n) in context: ((%iota 0 n)) -DEBUG: Tail call optimization for: (%iota 0 n) -DEBUG: apply_func called with tail_call = 1 -DEBUG: apply_func called with tail_call = 0 -DEBUG: Checking function call: (cons (quote if) (cons expr (cons () body))) -DEBUG: Checking function call: (quote if) -DEBUG: Checking function call: (cons expr (cons () body)) -DEBUG: Checking function call: (cons () body) -DEBUG: Checking function call: (<= n m) -DEBUG: Checking function call: (con \ No newline at end of file diff --git a/test.sh b/test.sh old mode 100644 new mode 100755 From 3b305e81c862af2d202a929a3168eaa7e3c57997 Mon Sep 17 00:00:00 2001 From: Nicolas Janin <30365898+NJdevPro@users.noreply.github.com> Date: Thu, 7 Nov 2024 20:50:41 +0100 Subject: [PATCH 07/10] Delete .vscode directory --- .vscode/c_cpp_properties.json | 18 ----------- .vscode/settings.json | 59 ----------------------------------- 2 files changed, 77 deletions(-) delete mode 100644 .vscode/c_cpp_properties.json delete mode 100644 .vscode/settings.json diff --git a/.vscode/c_cpp_properties.json b/.vscode/c_cpp_properties.json deleted file mode 100644 index cea4d3f..0000000 --- a/.vscode/c_cpp_properties.json +++ /dev/null @@ -1,18 +0,0 @@ -{ - "configurations": [ - { - "name": "windows-gcc-x64", - "includePath": [ - "${workspaceFolder}/**" - ], - "compilerPath": "gcc", - "cStandard": "${default}", - "cppStandard": "${default}", - "intelliSenseMode": "windows-gcc-x64", - "compilerArgs": [ - "" - ] - } - ], - "version": 4 -} \ No newline at end of file diff --git a/.vscode/settings.json b/.vscode/settings.json deleted file mode 100644 index ca83374..0000000 --- a/.vscode/settings.json +++ /dev/null @@ -1,59 +0,0 @@ -{ - "C_Cpp_Runner.cCompilerPath": "/usr/bin/gcc", - "C_Cpp_Runner.cppCompilerPath": "/usr/bing++", - "C_Cpp_Runner.debuggerPath": "/usr/bingdb", - "C_Cpp_Runner.cStandard": "", - "C_Cpp_Runner.cppStandard": "", - "C_Cpp_Runner.msvcBatchPath": "C:/Program Files/Microsoft Visual Studio/VR_NR/Community/VC/Auxiliary/Build/vcvarsall.bat", - "C_Cpp_Runner.useMsvc": false, - "C_Cpp_Runner.warnings": [ - "-Wall", - "-Wextra", - "-Wpedantic", - "-Wshadow", - "-Wformat=2", - "-Wcast-align", - "-Wconversion", - "-Wsign-conversion", - "-Wnull-dereference" - ], - "C_Cpp_Runner.msvcWarnings": [ - "/W4", - "/permissive-", - "/w14242", - "/w14287", - "/w14296", - "/w14311", - "/w14826", - "/w44062", - "/w44242", - "/w14905", - "/w14906", - "/w14263", - "/w44265", - "/w14928" - ], - "C_Cpp_Runner.enableWarnings": true, - "C_Cpp_Runner.warningsAsError": false, - "C_Cpp_Runner.compilerArgs": [], - "C_Cpp_Runner.linkerArgs": [], - "C_Cpp_Runner.includePaths": [], - "C_Cpp_Runner.includeSearch": [ - "*", - "**/*" - ], - "C_Cpp_Runner.excludeSearch": [ - "**/build", - "**/build/**", - "**/.*", - "**/.*/**", - "**/.vscode", - "**/.vscode/**" - ], - "C_Cpp_Runner.useAddressSanitizer": false, - "C_Cpp_Runner.useUndefinedSanitizer": false, - "C_Cpp_Runner.useLeakSanitizer": false, - "C_Cpp_Runner.showCompilationTime": false, - "C_Cpp_Runner.useLinkTimeOptimization": false, - "C_Cpp_Runner.msvcSecureNoWarnings": false -} \ No newline at end of file From ace8ad34d982d85c3cb35e931e26c511a67944a8 Mon Sep 17 00:00:00 2001 From: Nicolas Janin Date: Fri, 8 Nov 2024 01:29:59 +0100 Subject: [PATCH 08/10] Coerce eq and string=. Fix regression in prim_minus --- src/minilisp.c | 40 ++++++++++++++++++++++++---------------- test.sh | 4 ++-- 2 files changed, 26 insertions(+), 18 deletions(-) diff --git a/src/minilisp.c b/src/minilisp.c index 5a0ab39..6d8e3ac 100644 --- a/src/minilisp.c +++ b/src/minilisp.c @@ -674,11 +674,24 @@ static Obj *PRIM_OP(void *root, Obj **env, Obj **list) { \ // (+ ...) PRIM_ARITHMETIC_OP(prim_plus, +, += ) -PRIM_ARITHMETIC_OP(prim_minus, -, -= ) PRIM_ARITHMETIC_OP(prim_mult, *, *= ) PRIM_ARITHMETIC_OP(prim_div , /, /= ) PRIM_ARITHMETIC_OP(prim_modulo, %, %= ) +// (- ...) +static Obj *prim_minus(void *root, Obj **env, Obj **list) { + Obj *args = eval_list(root, env, list); + for (Obj *p = args; p != Nil; p = p->cdr) + if (p->car->type != TINT) + error("- takes only numbers", (*list)->line_num); + if (args->cdr == Nil) + return make_int(root, -args->car->value); + long long r = args->car->value; + for (Obj *p = args->cdr; p != Nil; p = p->cdr) + r -= p->car->value; + return make_int(root, r); +} + // (op ) #define PRIM_COMPARISON_OP(PRIM_OP, OP) \ static Obj *PRIM_OP(void *root, Obj **env, Obj **list) { \ @@ -860,9 +873,17 @@ static Obj *prim_if(void *root, Obj **env, Obj **list) { // (eq expr expr) static Obj *prim_eq(void *root, Obj **env, Obj **list) { if (length(*list) != 2) - error("Malformed eq", (*list)->line_num); + error("eq takes 2 arguments only", (*list)->line_num); Obj *values = eval_list(root, env, list); - return values->car == values->cdr->car ? True : Nil; + Obj *first = values->car; + Obj *second = values->cdr->car; + if (first->type == TSTRING){ + if (second->type == TSTRING) + return strcmp(first->name, second->name) == 0 ? True : Nil; + else + error("The 2 arguments of eq must be of the same type", (*list)->line_num); + } + return first == second ? True : Nil; } // String primitives @@ -931,18 +952,6 @@ static Obj *prim_string_to_symbol(void *root, Obj **env, Obj **list) { return intern(root, args->car->name); } -// String comparison -static Obj *prim_string_eq(void *root, Obj **env, Obj **list) { - Obj *args = eval_list(root, env, list); - if (length(args) != 2) - error("string= requires 2 arguments", (*list)->line_num); - - if (args->car->type != TSTRING || args->cdr->car->type != TSTRING) - error("string= arguments must be strings", (*list)->line_num); - - return strcmp(args->car->name, args->cdr->car->name) == 0 ? True : Nil; -} - static void add_primitive(void *root, Obj **env, char *name, Primitive *fn) { DEFINE2(sym, prim); *sym = intern(root, name); @@ -994,7 +1003,6 @@ static void define_primitives(void *root, Obj **env) { add_primitive(root, env, "string-concat", prim_string_concat); add_primitive(root, env, "symbol->string", prim_symbol_to_string); add_primitive(root, env, "string->symbol", prim_string_to_symbol); - add_primitive(root, env, "string=", prim_string_eq); add_primitive(root, env, "load", prim_load); add_primitive(root, env, "exit", prim_exit); } diff --git a/test.sh b/test.sh index 099c497..f4c2991 100755 --- a/test.sh +++ b/test.sh @@ -146,6 +146,8 @@ run eq t "(eq 'foo 'foo)" run eq t "(eq + +)" run eq '()' "(eq 'foo 'bar)" run eq '()' "(eq + 'bar)" +run eq '()' '(eq "hello" "Hello")' +run eq t '(eq "hello" "hello")' # gensym run gensym G__0 '(gensym)' @@ -165,8 +167,6 @@ run restargs '(3 5 7)' '(defun f (x . y) (cons x y)) (f 3 5 7)' run restargs '(3)' '(defun f (x . y) (cons x y)) (f 3)' # strings -run string= '()' '(string= "hello" "Hello")' -run string= t '(string= "hello" "hello")' run 'symbol->string' 'twelve' " (define twelve 12) (symbol->string 'twelve)" From 201366b50804df00ca10f46773d08404fdc61da6 Mon Sep 17 00:00:00 2001 From: Nicolas Janin Date: Fri, 8 Nov 2024 15:35:32 +0100 Subject: [PATCH 09/10] Fix error messages. Add more functions in library.lisp --- README.md | 13 ++- examples/library.lisp | 247 ++++++++++++++++++++++++------------------ examples/nqueens.lisp | 9 +- src/minilisp.c | 2 +- src/repl.c | 8 +- 5 files changed, 152 insertions(+), 127 deletions(-) diff --git a/README.md b/README.md index 89a9ad1..14de649 100644 --- a/README.md +++ b/README.md @@ -272,22 +272,23 @@ exhaustion error. `(progn expr expr ...)` executes several expressions in sequence. - (progn (print "I own ") - (defun add(x y)(+ x y)) - (println (add 3 7) " cents")) ; -> prints "I own 10 cents" + ( progn (print "I own ") + (defun add(x y)(+ x y)) + (println (add 3 7) " cents") ) ; -> prints "I own 10 cents" ### Equivalence test operators `eq` takes two arguments and returns `t` if the objects are the same. What `eq` really does is a pointer comparison, so two objects happened to have the same contents but actually different are considered to not be the same by `eq`. +`eq` can also compare two strings. ### String functions -`string=` compares two strings. +`eq` compares two strings. - (string= "Hello" "Hello") ; -> t - (string= "Hello" "World") ; -> () + (eq "Hello" "Hello") ; -> t + (eq "Hello" "hello") ; -> () `string-concat` concatenates strings. diff --git a/examples/library.lisp b/examples/library.lisp index 2a69869..cbbcff7 100644 --- a/examples/library.lisp +++ b/examples/library.lisp @@ -1,108 +1,139 @@ -(defun list (x . y) (cons x y)) - -;; (let var val body ...) -;; => ((lambda (var) body ...) val) -(defmacro let (var val . body) - (cons (cons 'lambda (cons (list var) body)) - (list val))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Control structures -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro cond (rest) - (if (= () rest) - () - (if (= (car (car rest)) t) - (car (cdr (car rest))) - (list 'if - (car (car rest)) - (car (cdr (car rest))) - (cond (cdr rest)))))) - -;; (and e1 e2 ...) -;; => (if e1 (and e2 ...)) -;; (and e1) -;; => e1 -(defmacro and (expr . rest) - (if rest - (list 'if expr (cons 'and rest)) - expr)) - -;; (or e1 e2 ...) -;; => (let e1 -;; (if (or e2 ...))) -;; (or e1) -;; => e1 -;; -;; The reason to use the temporary variables is to avoid evaluating the -;; arguments more than once. -(defmacro or (expr . rest) - (if rest - (let var (gensym) - (list 'let var expr - (list 'if var var (cons 'or rest)))) - expr)) - -;; (when expr body ...) -;; => (if expr (progn body ...)) -(defmacro when (expr . body) - (cons 'if (cons expr (list (cons 'progn body))))) - -;; (unless expr body ...) -;; => (if expr () body ...) -(defmacro unless (expr . body) - (cons 'if (cons expr (cons () body)))) - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; List operators -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Applies each element of lis to pred. If pred returns a true value, terminate -;; the evaluation and returns pred's return value. If all of them return (), -;; returns (). -(defun any (lis pred) - (when lis - (or (pred (car lis)) - (any (cdr lis) pred)))) - -;;; Applies each element of lis to fn, and returns their return values as a list. -(defun map (lis fn) - (when lis - (cons (fn (car lis)) - (map (cdr lis) fn)))) - -;; Returns nth element of lis. -(defun nth (lis n) - (if (= n 0) - (car lis) - (nth (cdr lis) (- n 1)))) - -;; Returns the nth tail of lis. -(defun nth-tail (lis n) - (if (= n 0) - lis - (nth-tail (cdr lis) (- n 1)))) - -;; Returns a list consists of m .. n-1 integers. -(defun %iota (m n) - (unless (<= n m) - (cons m (%iota (+ m 1) n)))) - -;; Returns a list consists of 0 ... n-1 integers. -(defun iota (n) - (%iota 0 n)) - -;; Returns a new list whose length is len and all members are init. -(defun make-list (len init) - (unless (= len 0) - (cons init (make-list (- len 1) init)))) - -;; Applies fn to each element of lis. -(defun for-each (lis fn) - (or (not lis) - (progn (fn (car lis)) - (for-each (cdr lis) fn)))) - +;; +;; Simple library of useful functions and macros +;; + +(defun list (x . y) + (cons x y)) + + +;; (and e1 e2 ...) +;; => (if e1 (and e2 ...)) +;; (and e1) +;; => e1 +(defmacro and (expr . rest) + (if rest + (list 'if expr (cons 'and rest)) + expr)) + +;; (or e1 e2 ...) +;; => (let e1 +;; (if (or e2 ...))) +;; (or e1) +;; => e1 +;; +;; The reason to use the temporary variables is to avoid evaluating the +;; arguments more than once. +(defmacro or (expr . rest) + (if rest + (let var (gensym) + (list 'let var expr + (list 'if var var (cons 'or rest)))) + expr)) + +;; (let var val body ...) +;; => ((lambda (var) body ...) val) +(defmacro let (var val . body) + (cons (cons 'lambda (cons (list var) body)) + (list val))) + +;; (when expr body ...) +;; => (if expr (progn body ...)) +(defmacro when (expr . body) + (cons 'if (cons expr (list (cons 'progn body))))) + +;; (unless expr body ...) +;; => (if expr () body ...) +(defmacro unless (expr . body) + (cons 'if (cons expr (cons () body)))) + +;;; +;;; List operators +;;; + +;;; Applies each element of lis to fn, and returns their return values as a list. +(defun map (lis fn) + (when lis + (cons (fn (car lis)) + (map (cdr lis) fn)))) + +;; Applies each element of lis to pred. If pred returns a true value, terminate +;; the evaluation and returns pred's return value. If all of them return (), +;; returns (). +(defun any (lis pred) + (when lis + (or (pred (car lis)) + (any (cdr lis) pred)))) + +;; returns t if elem exists in list l +(defun member (l elem) + (any l (lambda (x) (or (eq x elem) (= x elem))))) + +;; Returns nth element of lis. +(defun nth (lis n) + (if (= n 0) + (car lis) + (nth (cdr lis) (- n 1)))) + +;; Returns the nth tail of lis. +(defun nth-tail (lis n) + (if (= n 0) + lis + (nth-tail (cdr lis) (- n 1)))) + +;; Returns a list consists of m .. n-1 integers. +(defun %iota (m n) + (unless (<= n m) + (cons m (%iota (+ m 1) n)))) + +;; Returns a list consists of 0 ... n-1 integers. +(defun iota (n) (%iota 0 n)) + +;; Returns a new list whose length is len and all members are init. +(defun make-list (len init) + (unless (= len 0) + (cons init (make-list (- len 1) init)))) + +;; Applies fn to each element of lis. +(defun for-each (lis fn) + (or (not lis) + (progn (fn (car lis)) + (for-each (cdr lis) fn)))) + +; Concatenates and flattens lists into a single list +(defun append (first . rest) + (if (eq () rest) + first + (append2 first + (append-reduce rest)))) + +(defun append2 (x y) + (if (eq () x) + y + (cons (car x) + (append2 (cdr x) y)))) + +(defun append-reduce (lists) + (if (eq () (cdr lists)) + (car lists) + (append2 (car lists) + (append-reduce (cdr lists))))) + +(defun filter (pred lst) + (if (eq () lst) + () + (if (pred (car lst)) + (cons (car lst) + (filter pred (cdr lst))) + (filter pred (cdr lst))))) + +(defun quicksort (lst) + (if (eq () lst) + () + (if (eq () (cdr lst)) + lst + (let pivot (car lst) + (append + (quicksort (filter (lambda(x) (< x pivot)) (cdr lst))) + (cons pivot ()) + (quicksort (filter (lambda(x) (>= x pivot)) (cdr lst)))) )))) + \ No newline at end of file diff --git a/examples/nqueens.lisp b/examples/nqueens.lisp index de2af76..c1d6220 100644 --- a/examples/nqueens.lisp +++ b/examples/nqueens.lisp @@ -8,13 +8,6 @@ ;;; This program solves N-queens puzzle by depth-first backtracking. ;;; -;;; -;;; Basic macros -;;; -;;; Because the language does not have quasiquote, we need to construct an -;;; expanded form using cons and list. -;;; - (load "examples/library.lisp") ;;; @@ -74,7 +67,7 @@ ;; Problem solved (progn (print board) (println '$)) - (for-each (iota board-size) + (map (iota board-size) (lambda (y) (unless (conflict? board x y) (set board x y) diff --git a/src/minilisp.c b/src/minilisp.c index 6d8e3ac..f769aea 100644 --- a/src/minilisp.c +++ b/src/minilisp.c @@ -377,7 +377,7 @@ static Obj *push_env(void *root, Obj **env, Obj **vars, Obj **vals) { for (; (*vars)->type == TCELL; *vars = (*vars)->cdr, *vals = (*vals)->cdr) { if ((*vals)->type != TCELL) error("Cannot apply function: number of argument does not match", - (*vals)->line_num); + (*vars)->line_num); *sym = (*vars)->car; *val = (*vals)->car; *map = acons(root, sym, val, map); diff --git a/src/repl.c b/src/repl.c index 14ea0e8..437142b 100644 --- a/src/repl.c +++ b/src/repl.c @@ -108,7 +108,7 @@ static size_t read_file(char *fname, char **text) { size_t length = 0; FILE *f = fopen(fname, "r"); if (!f) { - error("Failed to load file %s", fname); + error("Failed to load file %s", filepos.line_num, fname); return 0; } @@ -118,14 +118,14 @@ static size_t read_file(char *fname, char **text) { *text = malloc(length + 1); if (!*text) { - error("Out of memory."); + error("Out of memory.", filepos.line_num); fclose(f); return 0; } size_t read = fread(*text, 1, length, f); if (read != length) { - error("Failed to read entire file"); + error("Failed to read entire file", filepos.line_num); free(*text); *text = NULL; fclose(f); @@ -152,7 +152,7 @@ void process_file(char *fname, Obj **env, Obj **expr) { FILE *stream = fmemopen(text, len, "r"); if (!stream) { free(text); - error("Failed to create memory stream"); + error("Failed to create memory stream for %s", filepos.line_num, fname); return; } From e66fa6796a5cd504d0147d5b9e05f2ac35b67512 Mon Sep 17 00:00:00 2001 From: Nicolas Janin Date: Fri, 8 Nov 2024 17:10:00 +0100 Subject: [PATCH 10/10] Add reduce --- examples/library.lisp | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/examples/library.lisp b/examples/library.lisp index cbbcff7..454a642 100644 --- a/examples/library.lisp +++ b/examples/library.lisp @@ -56,6 +56,13 @@ (cons (fn (car lis)) (map (cdr lis) fn)))) +(defun reduce (fn lst init) + (if (eq () lst) + init + (reduce fn + (cdr lst) + (fn init (car lst))))) + ;; Applies each element of lis to pred. If pred returns a true value, terminate ;; the evaluation and returns pred's return value. If all of them return (), ;; returns (). @@ -98,7 +105,7 @@ (or (not lis) (progn (fn (car lis)) (for-each (cdr lis) fn)))) - + ; Concatenates and flattens lists into a single list (defun append (first . rest) (if (eq () rest)