diff options
| -rw-r--r-- | TODO | 20 | ||||
| -rw-r--r-- | minimal.scm | 2 | ||||
| -rw-r--r-- | prelude.scm | 3 | ||||
| -rw-r--r-- | rust/TODO | 10 | ||||
| -rw-r--r-- | rust/notes.txt | 3 | ||||
| -rw-r--r-- | rust/spectrum.rs | 35 | ||||
| -rw-r--r-- | test/r5rs_pitfall.scm | 332 | ||||
| -rw-r--r-- | test/simple.scm | 48 | ||||
| -rw-r--r-- | test/unicode.scm | 3 | ||||
| -rw-r--r-- | test/unicode_lambda.scm | 6 |
10 files changed, 431 insertions, 31 deletions
@@ -1,22 +1,16 @@ -- rust: - - define/set! support (at the REPL?) - - refactor out lifetime specifiers - - add file input support (eg, comments in parser, multi-line, tty detect) - - multi-part lambdas - - begin (?) - - map, filter - - add numerical comparisons (>, >=) - - basic testing - - pseudo unittest; makefile? + => good tests at: + http://swiss.csail.mit.edu/~jaffer/Scheme - find r7rs-small; try a full/compliant implementation in scheme/python? eg, macros -- define a larger sub-set with let, letrc, etc - - include a parser - - should be able to run minimal.scm - of interest: julia c javascript haskell go + +links: +http://www.defmacro.org/ramblings/lisp-in-haskell.html +https://github.com/mbutterick/mal +http://norvig.com/lispy2.html diff --git a/minimal.scm b/minimal.scm index 5c953e6..218eb5b 100644 --- a/minimal.scm +++ b/minimal.scm @@ -1,4 +1,3 @@ - ; cyclic dependency graph (sigh) ; ; meaning @@ -248,3 +247,4 @@ (lambda (e) (meaning e (quote ())))) ;(value '((lambda (a b) (a (add1 b))) (lambda (c) (add1 c)) 4)) ; 6 +;(value (quote (lambda (a b) (a (add1 b))) (lambda (c) (add1 c)) 4)) ; 6 diff --git a/prelude.scm b/prelude.scm index a7469b5..9721c33 100644 --- a/prelude.scm +++ b/prelude.scm @@ -27,5 +27,8 @@ (cond ((null? l) ()) (else (cons (f (car l)) (map f (cdr l))))))) +(define true #t) +(define false #f) + (define for-each map) ;(define compose (lambda (f g) (lambda args (f (apply g args))))) diff --git a/rust/TODO b/rust/TODO new file mode 100644 index 0000000..6198755 --- /dev/null +++ b/rust/TODO @@ -0,0 +1,10 @@ +- basic tests +- fold in norvig's "lispy2" additions http://norvig.com/lispy2.html +- fix quote (should take an expr, not a list?) +- fix cond/cdr behavior working right; also empty tuple +- get minimal.scm to run +- if let +- use getopt +? multi-part lambdas +? apply +? re-write runge kutta with lists, not vectors diff --git a/rust/notes.txt b/rust/notes.txt new file mode 100644 index 0000000..cc35cdf --- /dev/null +++ b/rust/notes.txt @@ -0,0 +1,3 @@ +https://mgattozzi.github.io/2016/11/08/scheme-input.html + +see also: tail recursion notes impl notes from norvig diff --git a/rust/spectrum.rs b/rust/spectrum.rs index 8325798..73ba59d 100644 --- a/rust/spectrum.rs +++ b/rust/spectrum.rs @@ -562,7 +562,7 @@ fn apply_action(list: &Vec<SchemeExpr>, } }, _ => Err(format!("cdr only takes lists and quotes (got {})", - scheme_repr(&args[0]):unwrap())) + scheme_repr(&args[0]).unwrap())) } }, "cons" => { @@ -757,8 +757,9 @@ fn repl(verbose: bool, top_env: &mut HashMap<String, SchemeExpr>) { } } -/* This loads and evals the hard-coded prelude file (which is just scheme expressions compiled into - * the executable), saving the resulting defines in top_env. +/* Loads and evals the hard-coded prelude file (which is just scheme + * expressions compiled into the executable), saving the resulting defines in + # top_env. */ fn import_prelude(top_env: &mut HashMap<String, SchemeExpr>) -> Result<(), String> { @@ -778,8 +779,10 @@ fn import_file(fpath: &Path, top_env: &mut HashMap<String, SchemeExpr>) -> Resul let mut f = File::open(fpath) .expect(&format!("couldn't open file: {}", &fpath.to_str().unwrap())); + f.read_to_end(&mut raw_bytes) .expect(&format!("couldn't read file: {}", &fpath.to_str().unwrap())); + let contents = String::from_utf8(raw_bytes) .expect(&format!("UTF-8 decode error reading file: {}", &fpath.to_str().unwrap())); @@ -792,13 +795,13 @@ fn import_file(fpath: &Path, top_env: &mut HashMap<String, SchemeExpr>) -> Resul } fn usage() { - println!("usage:\tspectrum [-h] [-v] [--no-repl] [--no-prelude] [<files>]"); - println!(""); - println!("Files will be loaded in order, then drop to REPL (unless \"--no-repl\" is passed)."); - println!("Verbose flag (\"-v\") will result in lexed tokens and parsed AST \ - being dumped to stdout (when on REPL)."); - println!("A \"prelude\" of common Scheme/LISP functions (eg, cdaddr) will \ - be loaded before any files (unless \"--no-prelude\" is passed)."); + println!( +r#"usage:\tspectrum [-h] [-v] [--no-repl] [--no-prelude] [<files>] + +Files will be loaded in order, then drop to REPL (unless "--no-repl" is passed). +Verbose flag ("-v") will result in lexed tokens and parsed AST being dumped to stdout (when on REPL). +A "prelude" of common Scheme/LISP functions (eg, cdaddr) will be loaded before any files (unless "--no-prelude" is passed). +"#); } fn main() { @@ -806,7 +809,6 @@ fn main() { let mut verbose: bool = false; let mut no_repl: bool = false; let mut no_prelude: bool = false; - let mut top_env = HashMap::<String, SchemeExpr>::new(); let mut file_list = Vec::<String>::new(); @@ -828,6 +830,8 @@ fn main() { } } + let mut top_env = HashMap::<String, SchemeExpr>::new(); + if !no_prelude { import_prelude(&mut top_env).unwrap(); } @@ -839,12 +843,9 @@ fn main() { return; } println!("Loading {}...", fname); - match import_file(&fpath, &mut top_env) { - Err(e) => { - println!("Error loading file: {}\n {}", fname, e); - return; - }, - Ok(_) => () + if let Err(e) = import_file(&fpath, &mut top_env) { + println!("Error loading file: {}\n {}", fname, e); + return; } } diff --git a/test/r5rs_pitfall.scm b/test/r5rs_pitfall.scm new file mode 100644 index 0000000..87ca3cf --- /dev/null +++ b/test/r5rs_pitfall.scm @@ -0,0 +1,332 @@ +;; From: http://sisc-scheme.org/r5rs_pitfall.scm +;; +;; r5rs_pitfalls.scm +;; +;; This program attempts to test a Scheme implementation's conformance +;; to various subtle edge-cases and consequences of the R5RS Scheme standard. +;; Code was collected from public forums, and is hereby placed in the public domain. +;; +;; +(define-syntax should-be + (syntax-rules () + ((_ test-id value expression) + (let ((return-value expression)) + (if (not (equal? return-value value)) + (for-each (lambda (v) (display v)) + `("Failure: " test-id ", expected '" + value "', got '" ,return-value "'." #\newline)) + (for-each (lambda (v) (display v)) + '("Passed: " test-id #\newline))))))) + +(define call/cc call-with-current-continuation) + +;; Section 1: Proper letrec implementation + +;;Credits to Al Petrofsky +;; In thread: +;; defines in letrec body +;; http://groups.google.com/groups?selm=87bsoq0wfk.fsf%40app.dial.idiom.com +(should-be 1.1 0 + (let ((cont #f)) + (letrec ((x (call-with-current-continuation (lambda (c) (set! cont c) 0))) + (y (call-with-current-continuation (lambda (c) (set! cont c) 0)))) + (if cont + (let ((c cont)) + (set! cont #f) + (set! x 1) + (set! y 1) + (c 0)) + (+ x y))))) + +;;Credits to Al Petrofsky +;; In thread: +;; Widespread bug (arguably) in letrec when an initializer returns twice +;; http://groups.google.com/groups?selm=87d793aacz.fsf_-_%40app.dial.idiom.com +(should-be 1.2 #t + (letrec ((x (call/cc list)) (y (call/cc list))) + (cond ((procedure? x) (x (pair? y))) + ((procedure? y) (y (pair? x)))) + (let ((x (car x)) (y (car y))) + (and (call/cc x) (call/cc y) (call/cc x))))) + +;;Credits to Alan Bawden +;; In thread: +;; LETREC + CALL/CC = SET! even in a limited setting +;; http://groups.google.com/groups?selm=19890302162742.4.ALAN%40PIGPEN.AI.MIT.EDU +(should-be 1.3 #t + (letrec ((x (call-with-current-continuation + (lambda (c) + (list #T c))))) + (if (car x) + ((cadr x) (list #F (lambda () x))) + (eq? x ((cadr x)))))) + +;; Section 2: Proper call/cc and procedure application + +;;Credits to Al Petrofsky, (and a wink to Matthias Blume) +;; In thread: +;; Widespread bug in handling (call/cc (lambda (c) (0 (c 1)))) => 1 +;; http://groups.google.com/groups?selm=87g00y4b6l.fsf%40radish.petrofsky.org +(should-be 2.1 1 + (call/cc (lambda (c) (0 (c 1))))) + +;; Section 3: Hygienic macros + +;; Eli Barzilay +;; In thread: +;; R5RS macros... +;; http://groups.google.com/groups?selm=skitsdqjq3.fsf%40tulare.cs.cornell.edu +(should-be 3.1 4 + (let-syntax ((foo + (syntax-rules () + ((_ expr) (+ expr 1))))) + (let ((+ *)) + (foo 3)))) + + +;; Al Petrofsky again +;; In thread: +;; Buggy use of begin in r5rs cond and case macros. +;; http://groups.google.com/groups?selm=87bse3bznr.fsf%40radish.petrofsky.org +(should-be 3.2 2 + (let-syntax ((foo (syntax-rules () + ((_ var) (define var 1))))) + (let ((x 2)) + (begin (define foo +)) + (cond (else (foo x))) + x))) + +;;Al Petrofsky +;; In thread: +;; An Advanced syntax-rules Primer for the Mildly Insane +;; http://groups.google.com/groups?selm=87it8db0um.fsf@radish.petrofsky.org + +(should-be 3.3 1 + (let ((x 1)) + (let-syntax + ((foo (syntax-rules () + ((_ y) (let-syntax + ((bar (syntax-rules () + ((_) (let ((x 2)) y))))) + (bar)))))) + (foo x)))) + +;; Al Petrofsky +;; Contributed directly +(should-be 3.4 1 + (let-syntax ((x (syntax-rules ()))) 1)) + +;; Setion 4: No identifiers are reserved + +;;(Brian M. Moore) +;; In thread: +;; shadowing syntatic keywords, bug in MIT Scheme? +;; http://groups.google.com/groups?selm=6e6n88%248qf%241%40news.cc.ukans.edu +(should-be 4.1 '(x) + ((lambda lambda lambda) 'x)) + +(should-be 4.2 '(1 2 3) + ((lambda (begin) (begin 1 2 3)) (lambda lambda lambda))) + +(should-be 4.3 #f + (let ((quote -)) (eqv? '1 1))) +;; Section 5: #f/() distinctness + +;; Scott Miller +(should-be 5.1 #f + (eq? #f '())) +(should-be 5.2 #f + (eqv? #f '())) +(should-be 5.3 #f + (equal? #f '())) + +;; Section 6: string->symbol case sensitivity + +;; Jens Axel S?gaard +;; In thread: +;; Symbols in DrScheme - bug? +;; http://groups.google.com/groups?selm=3be55b4f%240%24358%24edfadb0f%40dspool01.news.tele.dk +(should-be 6.1 #f + (eq? (string->symbol "f") (string->symbol "F"))) + +;; Section 7: First class continuations + +;; Scott Miller +;; No newsgroup posting associated. The gist of this test and 7.2 +;; is that once captured, a continuation should be unmodified by the +;; invocation of other continuations. This test determines that this is +;; the case by capturing a continuation and setting it aside in a temporary +;; variable while it invokes that and another continuation, trying to +;; side effect the first continuation. This test case was developed when +;; testing SISC 1.7's lazy CallFrame unzipping code. +(define r #f) +(define a #f) +(define b #f) +(define c #f) +(define i 0) +(should-be 7.1 28 + (let () + (set! r (+ 1 (+ 2 (+ 3 (call/cc (lambda (k) (set! a k) 4)))) + (+ 5 (+ 6 (call/cc (lambda (k) (set! b k) 7)))))) + (if (not c) + (set! c a)) + (set! i (+ i 1)) + (case i + ((1) (a 5)) + ((2) (b 8)) + ((3) (a 6)) + ((4) (c 4))) + r)) + +;; Same test, but in reverse order +(define r #f) +(define a #f) +(define b #f) +(define c #f) +(define i 0) +(should-be 7.2 28 + (let () + (set! r (+ 1 (+ 2 (+ 3 (call/cc (lambda (k) (set! a k) 4)))) + (+ 5 (+ 6 (call/cc (lambda (k) (set! b k) 7)))))) + (if (not c) + (set! c a)) + (set! i (+ i 1)) + (case i + ((1) (b 8)) + ((2) (a 5)) + ((3) (b 7)) + ((4) (c 4))) + r)) + +;; Credits to Matthias Radestock +;; Another test case used to test SISC's lazy CallFrame routines. +(should-be 7.3 '((-1 4 5 3) + (4 -1 5 3) + (-1 5 4 3) + (5 -1 4 3) + (4 5 -1 3) + (5 4 -1 3)) + (let ((k1 #f) + (k2 #f) + (k3 #f) + (state 0)) + (define (identity x) x) + (define (fn) + ((identity (if (= state 0) + (call/cc (lambda (k) (set! k1 k) +)) + +)) + (identity (if (= state 0) + (call/cc (lambda (k) (set! k2 k) 1)) + 1)) + (identity (if (= state 0) + (call/cc (lambda (k) (set! k3 k) 2)) + 2)))) + (define (check states) + (set! state 0) + (let* ((res '()) + (r (fn))) + (set! res (cons r res)) + (if (null? states) + res + (begin (set! state (car states)) + (set! states (cdr states)) + (case state + ((1) (k3 4)) + ((2) (k2 2)) + ((3) (k1 -))))))) + (map check '((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))))) + +;; Modification of the yin-yang puzzle so that it terminates and produces +;; a value as a result. (Scott G. Miller) +(should-be 7.4 '(10 9 8 7 6 5 4 3 2 1 0) + (let ((x '()) + (y 0)) + (call/cc + (lambda (escape) + (let* ((yin ((lambda (foo) + (set! x (cons y x)) + (if (= y 10) + (escape x) + (begin + (set! y 0) + foo))) + (call/cc (lambda (bar) bar)))) + (yang ((lambda (foo) + (set! y (+ y 1)) + foo) + (call/cc (lambda (baz) baz))))) + (yin yang)))))) + +;; Miscellaneous + +;;Al Petrofsky +;; In thread: +;; R5RS Implementors Pitfalls +;; http://groups.google.com/groups?selm=871zemtmd4.fsf@app.dial.idiom.com +(should-be 8.1 -1 + (let - ((n (- 1))) n)) + +(should-be 8.2 '(1 2 3 4 1 2 3 4 5) + (let ((ls (list 1 2 3 4))) + (append ls ls '(5)))) + +;; This example actually illustrates a bug in R5RS. If a Scheme system +;; follows the letter of the standard, 1 should be returned, but +;; the general agreement is that 2 should instead be returned. +;; The reason is that in R5RS, let-syntax always introduces new scope, thus +;; in the following test, the let-syntax breaks the definition section +;; and begins the expression section of the let. +;; +;; The general agreement by the implementors in 1998 was that the following +;; should be possible, but isn't: +;; +;; (define ---) +;; (let-syntax (---) +;; (define ---) +;; (define ---)) +;; (define ---) +;; +;; Scheme systems based on the Portable syntax-case expander by Dybvig +;; and Waddell do allow the above, and thus often violate the letter of +;; R5RS. In such systems, the following will produce a local scope: +;; +;; (define ---) +;; (let-syntax ((a ---)) +;; (let () +;; (define ---) +;; (define ---))) +;; (define ---) +;; +;; Credits to Matthias Radestock and thanks to R. Kent Dybvig for the +;; explanation and background +(should-be 8.3 1 + (let ((x 1)) + (let-syntax ((foo (syntax-rules () ((_) 2)))) + (define x (foo)) + 3) + x)) + +;;Not really an error to fail this (Matthias Radestock) +;;If this returns (0 1 0), your map isn't call/cc safe, but is probably +;;tail-recursive. If its (0 0 0), the opposite is true. +(let ((result + (let () + (define executed-k #f) + (define cont #f) + (define res1 #f) + (define res2 #f) + (set! res1 (map (lambda (x) + (if (= x 0) + (call/cc (lambda (k) (set! cont k) 0)) + 0)) + '(1 0 2))) + (if (not executed-k) + (begin (set! executed-k #t) + (set! res2 res1) + (cont 1))) + res2))) + (if (equal? result '(0 0 0)) + (display "Map is call/cc safe, but probably not tail recursive or inefficient.") + (display "Map is not call/cc safe, but probably tail recursive and efficient.")) + (newline)) + diff --git a/test/simple.scm b/test/simple.scm new file mode 100644 index 0000000..41babb5 --- /dev/null +++ b/test/simple.scm @@ -0,0 +1,48 @@ + +; This comment should be skipped + +(begin + (display #t) + (newline)) + +; anonymous lambda +(define add1 (lambda (x) (+ 1 x))) +(display (eq? (add1 4) 5)) +(newline) + +; named/defined lambda, spread over multiple lines +(define + add1 + (lambda + (x) + (+ 1 x))) +(display (eq? (add1 4) 5)) +(newline) + +; this checks that cond is a special form +(define fact (lambda (n) (if (<= n 1) 1 (* n (fact (- n 1)))))) +(display (eq? 479001600 (fact 12))) +(newline) + +(display (eq? (add1 (car (cons 4 (cons 0 ())))) 5)) +(newline) + +(car (car (quote (lambda (x) (+ 1 x))))) + +(define dummy-var 5) +(set! dummy-var 6) +(display (eq? dummy-var 6)) +(newline) + +(display (string? "short string with spaces")) +(newline) + +(display (pair? (cons 1 (cons 2 ())))) +(newline) + +(display (symbol? 'lambda)) +(newline) + +(display (procedure? add1)) +(newline) + diff --git a/test/unicode.scm b/test/unicode.scm new file mode 100644 index 0000000..9ea74eb --- /dev/null +++ b/test/unicode.scm @@ -0,0 +1,3 @@ + +(display (eq? "αβγ" "αβγ")) +(newline) diff --git a/test/unicode_lambda.scm b/test/unicode_lambda.scm new file mode 100644 index 0000000..6c8b17f --- /dev/null +++ b/test/unicode_lambda.scm @@ -0,0 +1,6 @@ + +(display (eq? (quote λ) 'λ)) +(newline) + +(display (eq? 5 ((λ (x) (+ x 4)) 1))) +(newline) |