From 1bafa2271c808b064d2ccf76f9272d4d71961ef1 Mon Sep 17 00:00:00 2001 From: Vincent Ollivier Date: Thu, 15 Sep 2022 20:50:23 +0200 Subject: [PATCH] Add apply to Lisp (#410) * Replace mapcar by apply * Add map and reduce to core lib * Add pi.lsp example * Fix tests * Refactor pi-digits * Move builtin join to core lib as string-join * Rename decode-* and encode-* to *-decode and *-encode * Update doc --- doc/lisp.md | 11 +++++---- dsk/lib/lisp/core.lsp | 29 +++++++++++++++++------ dsk/tmp/lisp/pi.lsp | 16 +++++++++++++ src/usr/install.rs | 1 + src/usr/lisp.rs | 53 ++++++++++++++++--------------------------- 5 files changed, 64 insertions(+), 46 deletions(-) create mode 100644 dsk/tmp/lisp/pi.lsp diff --git a/doc/lisp.md b/doc/lisp.md index 4daae47..02cbea1 100644 --- a/doc/lisp.md +++ b/doc/lisp.md @@ -29,11 +29,11 @@ of strings to the language and reading from the filesystem. ## Additional Builtins - `defun` (aliased to `defn`) -- `mapcar` (aliased to `map`) +- `apply` - `type` - `string` -- `encode-string` and `decode-string` -- `encode-number` and `decode-number` +- `string-encode` and `string-decode` +- `number-encode` and `number-decode` - `regex-find` - `parse` - `system` @@ -43,14 +43,15 @@ of strings to the language and reading from the filesystem. - Trigonometric functions: `acos`, `asin`, `atan`, `cos`, `sin`, `tan` - Comparisons: `>`, `<`, `>=`, `<=`, `=` - Boolean operations: `not`, `and`, `or` -- String operations: `lines`, `join` +- String operations: `lines` - File IO: `read-file`, `read-file-bytes`, `write-file-bytes`, `append-file-bytes` ## Core Library - `null`, `null?`, `eq?` - `atom?`, `string?`, `boolean?`, `symbol?`, `number?`, `list?`, `function?`, `lambda?` - `first`, `second`, `third`, `rest` -- `append`, `reverse` +- `map`, `reduce`, `append`, `reverse` +- `string-join` - `read-line`, `read-char` - `print`, `println` - `write-file`, `append-file` diff --git a/dsk/lib/lisp/core.lsp b/dsk/lib/lisp/core.lsp index b3034c1..d96f386 100644 --- a/dsk/lib/lisp/core.lsp +++ b/dsk/lib/lisp/core.lsp @@ -53,6 +53,21 @@ (defn third (x) (second (rest x))) +(defn reduce (f ls) + (cond + ((null? (rest ls)) (first ls)) + (true (f (first ls) (reduce f (rest ls)))))) + +(defn string-join (ls s) + (reduce (fn (x y) (string x s y)) ls)) + +(defn map (f ls) + (cond + ((null? ls) null) + (true (cons + (f (first ls)) + (map f (rest ls)))))) + (defn append (x y) (cond ((null? x) y) @@ -69,13 +84,13 @@ (true (append (list i) (range (+ i 1) n))))) (defn read-line () - (decode-string (reverse (rest (reverse (read-file-bytes "/dev/console" 256)))))) + (string-decode (reverse (rest (reverse (read-file-bytes "/dev/console" 256)))))) (defn read-char () - (decode-string (read-file-bytes "/dev/console" 4))) + (string-decode (read-file-bytes "/dev/console" 4))) (defn print (exp) - (do (append-file-bytes "/dev/console" (encode-string (string exp))) '())) + (do (append-file-bytes "/dev/console" (string-encode (string exp))) '())) (defn println (exp) (do (print exp) (print "\n"))) @@ -84,16 +99,16 @@ (def prn println) (defn uptime () - (decode-number (read-file-bytes "/dev/clk/uptime" 8))) + (number-decode (read-file-bytes "/dev/clk/uptime" 8))) (defn realtime () - (decode-number (read-file-bytes "realtime" 8))) + (number-decode (read-file-bytes "realtime" 8))) (defn write-file (path str) - (write-file-bytes path (encode-string str))) + (write-file-bytes path (string-encode str))) (defn append-file (path str) - (append-file-bytes path (encode-string str))) + (append-file-bytes path (string-encode str))) (defn regex-match? (pattern str) (not (null? (regex-find pattern str)))) diff --git a/dsk/tmp/lisp/pi.lsp b/dsk/tmp/lisp/pi.lsp new file mode 100644 index 0000000..aa9a5d4 --- /dev/null +++ b/dsk/tmp/lisp/pi.lsp @@ -0,0 +1,16 @@ +(load "/lib/lisp/core.lsp") + +(defn pi-nth (n) + (* (^ 16 (- n)) (- + (/ 4 (+ 1 (* 8 n))) + (/ 2 (+ 4 (* 8 n))) + (/ 1 (+ 5 (* 8 n))) + (/ 1 (+ 6 (* 8 n)))))) + +(defn pi-digits (n) + (apply + (map pi-nth (range 0 n)))) + +(println + (cond + ((null? args) "Usage: pi ") + (true (pi-digits (parse (car args)))))) diff --git a/src/usr/install.rs b/src/usr/install.rs index a600d1c..4c42dea 100644 --- a/src/usr/install.rs +++ b/src/usr/install.rs @@ -55,6 +55,7 @@ pub fn copy_files(verbose: bool) { create_dir("/tmp/lisp", verbose); copy_file("/tmp/lisp/factorial.lsp", include_bytes!("../../dsk/tmp/lisp/factorial.lsp"), verbose); copy_file("/tmp/lisp/fibonacci.lsp", include_bytes!("../../dsk/tmp/lisp/fibonacci.lsp"), verbose); + copy_file("/tmp/lisp/pi.lsp", include_bytes!("../../dsk/tmp/lisp/pi.lsp"), verbose); create_dir("/tmp/life", verbose); copy_file("/tmp/life/centinal.cells", include_bytes!("../../dsk/tmp/life/centinal.cells"), verbose); diff --git a/src/usr/lisp.rs b/src/usr/lisp.rs index 55bfd05..0410f47 100644 --- a/src/usr/lisp.rs +++ b/src/usr/lisp.rs @@ -366,13 +366,13 @@ fn default_env() -> Rc> { }).collect(); Ok(Exp::Str(args.join(""))) })); - data.insert("encode-string".to_string(), Exp::Func(|args: &[Exp]| -> Result { + data.insert("string-encode".to_string(), Exp::Func(|args: &[Exp]| -> Result { ensure_length_eq!(args, 1); let s = string(&args[0])?; let buf = s.as_bytes(); Ok(Exp::List(buf.iter().map(|b| Exp::Num(*b as f64)).collect())) })); - data.insert("decode-string".to_string(), Exp::Func(|args: &[Exp]| -> Result { + data.insert("string-decode".to_string(), Exp::Func(|args: &[Exp]| -> Result { ensure_length_eq!(args, 1); match &args[0] { Exp::List(list) => { @@ -383,7 +383,7 @@ fn default_env() -> Rc> { _ => Err(Err::Reason("Expected arg to be a list".to_string())) } })); - data.insert("decode-number".to_string(), Exp::Func(|args: &[Exp]| -> Result { + data.insert("number-decode".to_string(), Exp::Func(|args: &[Exp]| -> Result { ensure_length_eq!(args, 1); match &args[0] { Exp::List(list) => { @@ -394,7 +394,7 @@ fn default_env() -> Rc> { _ => Err(Err::Reason("Expected arg to be a list".to_string())) } })); - data.insert("encode-number".to_string(), Exp::Func(|args: &[Exp]| -> Result { + data.insert("number-encode".to_string(), Exp::Func(|args: &[Exp]| -> Result { ensure_length_eq!(args, 1); let f = float(&args[0])?; Ok(Exp::List(f.to_be_bytes().iter().map(|b| Exp::Num(*b as f64)).collect())) @@ -411,13 +411,6 @@ fn default_env() -> Rc> { _ => Err(Err::Reason("Expected args to be a regex and a string".to_string())) } })); - data.insert("join".to_string(), Exp::Func(|args: &[Exp]| -> Result { - ensure_length_eq!(args, 2); - match (&args[0], &args[1]) { - (Exp::List(list), Exp::Str(s)) => Ok(Exp::Str(list_of_strings(list)?.join(s))), - _ => Err(Err::Reason("Expected args to be a list and a string".to_string())) - } - })); data.insert("lines".to_string(), Exp::Func(|args: &[Exp]| -> Result { ensure_length_eq!(args, 1); let s = string(&args[0])?; @@ -451,7 +444,7 @@ fn default_env() -> Rc> { let mut forms: Vec = data.keys().map(|k| k.to_string()).collect(); let builtins = vec![ "quote", "atom", "eq", "car", "cdr", "cons", "cond", "label", "def", "lambda", "fn", - "defun", "defn", "mapcar", "map", "progn", "do", "load", "quit" + "defun", "defn", "apply", "progn", "do", "load", "quit" ]; for builtin in builtins { forms.push(builtin.to_string()); @@ -614,16 +607,14 @@ fn eval_defun_args(args: &[Exp], env: &mut Rc>) -> Result eval_label_args(&label_args, env) } -fn eval_mapcar_args(args: &[Exp], env: &mut Rc>) -> Result { - ensure_length_eq!(args, 2); - match eval(&args[1], env) { - Ok(Exp::List(list)) => { - Ok(Exp::List(list.iter().map(|exp| { - eval(&Exp::List(vec!(args[0].clone(), exp.clone())), env) - }).collect::, Err>>()?)) - } - _ => Err(Err::Reason("Expected second argument to be a list".to_string())), +fn eval_apply_args(args: &[Exp], env: &mut Rc>) -> Result { + ensure_length_gt!(args, 1); + let mut args = args.to_vec(); + match eval(&args.pop().unwrap(), env) { + Ok(Exp::List(rest)) => args.extend(rest), + _ => return Err(Err::Reason("Expected last argument to be a list".to_string())), } + eval(&Exp::List(args.to_vec()), env) } fn eval_progn_args(args: &[Exp], env: &mut Rc>) -> Result { @@ -667,7 +658,7 @@ fn eval_built_in_form(exp: &Exp, args: &[Exp], env: &mut Rc>) -> Op "lambda" | "fn" => Some(eval_lambda_args(args)), "defun" | "defn" => Some(eval_defun_args(args, env)), - "mapcar" | "map" => Some(eval_mapcar_args(args, env)), + "apply" => Some(eval_apply_args(args, env)), "progn" | "do" => Some(eval_progn_args(args, env)), "load" => Some(eval_load_args(args, env)), _ => None, @@ -961,7 +952,7 @@ fn test_lisp() { assert_eq!(eval!("(= (+ 0.15 0.15) (+ 0.1 0.2))"), "true"); // number - assert_eq!(eval!("(decode-number (encode-number 42))"), "42"); + assert_eq!(eval!("(number-decode (number-encode 42))"), "42"); // string assert_eq!(eval!("(parse \"9.75\")"), "9.75"); @@ -972,14 +963,11 @@ fn test_lisp() { assert_eq!(eval!("(eq \"foo\" \"bar\")"), "false"); assert_eq!(eval!("(lines \"a\nb\nc\")"), "(\"a\" \"b\" \"c\")"); - // map - eval!("(defun inc (a) (+ a 1))"); - assert_eq!(eval!("(map inc '(1 2))"), "(2 3)"); - assert_eq!(eval!("(map parse '(\"1\" \"2\" \"3\"))"), "(1 2 3)"); - assert_eq!(eval!("(map (fn (n) (* n 2)) '(1 2 3))"), "(2 4 6)"); - - // join - assert_eq!(eval!("(join '(\"a\" \"b\" \"c\") \" \")"), "\"a b c\""); + // apply + assert_eq!(eval!("(apply + '(1 2 3))"), "6"); + assert_eq!(eval!("(apply + 1 '(2 3))"), "6"); + assert_eq!(eval!("(apply + 1 2 '(3))"), "6"); + assert_eq!(eval!("(apply + 1 2 3 '())"), "6"); // trigo assert_eq!(eval!("(acos (cos pi))"), PI.to_string()); @@ -990,9 +978,6 @@ fn test_lisp() { assert_eq!(eval!("(sin (/ pi 2))"), "1"); assert_eq!(eval!("(tan 0)"), "0"); - eval!("(defn apply2 (f arg1 arg2) (f arg1 arg2))"); - assert_eq!(eval!("(apply2 + 1 2)"), "3"); - // list assert_eq!(eval!("(list)"), "()"); assert_eq!(eval!("(list 1)"), "(1)");