String literals, better error reporting and some R5RS mechanics implemented.
This commit is contained in:
parent
edadfea781
commit
344746cc64
112
example.scm
112
example.scm
|
@ -1,4 +1,52 @@
|
||||||
|
|
||||||
|
;;; Standard lib, in scheme
|
||||||
|
|
||||||
|
; Lists
|
||||||
|
|
||||||
|
;
|
||||||
|
(define (foldl f i l)
|
||||||
|
(if (null? l)
|
||||||
|
i
|
||||||
|
(foldl f (f (car l) i) (cdr l))))
|
||||||
|
|
||||||
|
(define (foldr f i l)
|
||||||
|
(if (null? l)
|
||||||
|
i
|
||||||
|
(f (car l) (foldr f i (cdr l)))))
|
||||||
|
|
||||||
|
(define (map f l)
|
||||||
|
(if (null? l)
|
||||||
|
'()
|
||||||
|
(foldr (lambda (e a) (cons (f e) a)) '() l)))
|
||||||
|
|
||||||
|
(define (length l)
|
||||||
|
(foldl + 0 (map (lambda (x) 1) l)))
|
||||||
|
|
||||||
|
(define (reverse l)
|
||||||
|
(foldl cons '() l))
|
||||||
|
|
||||||
|
|
||||||
|
(define list-tail; Taken from https://people.csail.mit.edu/jaffer/r5rs/Pairs-and-lists.html
|
||||||
|
(lambda (x k)
|
||||||
|
(if (zero? k)
|
||||||
|
x
|
||||||
|
(list-tail (cdr x) (- k 1)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
; Math
|
||||||
|
|
||||||
|
(define (zero? x) (= x 0))
|
||||||
|
(define (positive? x) (> x 0))
|
||||||
|
(define (negative? x) (< x 0))
|
||||||
|
(define (odd? x) (= (mod x 2) 1))
|
||||||
|
(define (even? x) (= (mod x 2) 0))
|
||||||
|
|
||||||
|
|
||||||
|
; Test string
|
||||||
|
|
||||||
|
(display "Hello World") (newline)
|
||||||
|
|
||||||
; Test functions
|
; Test functions
|
||||||
|
|
||||||
(define add-three (lambda (x y z) (+ (+ x z) y)))
|
(define add-three (lambda (x y z) (+ (+ x z) y)))
|
||||||
|
@ -31,6 +79,70 @@
|
||||||
(set! x 10)
|
(set! x 10)
|
||||||
(display x) (newline)
|
(display x) (newline)
|
||||||
|
|
||||||
|
(newline)
|
||||||
|
(display "* R5RS: Testing numerical operators *")
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
(display "Testing number?\n\tExpect: #t #f #f #f\n\tGotten: ")
|
||||||
|
(display (number? 5))
|
||||||
|
(display " ")
|
||||||
|
(display (number? #f))
|
||||||
|
(display " ")
|
||||||
|
(display (number? "hello"))
|
||||||
|
(display " ")
|
||||||
|
(display (number? '(1 2)))
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
(newline)
|
||||||
|
(display "* R5RS: Testing fold and map *")
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
(display "Testing sum over foldl!\n\tExpect: 28\n\tGotten: ")
|
||||||
|
(display (foldl + 0 '(1 2 3 4 5 6 7)))
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
(display "Testing sum over foldr!\n\tExpect: 28\n\tGotten: ")
|
||||||
|
(display (foldr + 0 '(1 2 3 4 5 6 7)))
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
(display "Testing map!\n\tExpect: (21 22 23)\n\tGotten: ")
|
||||||
|
(display (map (lambda (a) (+ 20 a)) '(1 2 3)))
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
(display "Testing length!\n\tExpect: 13\n\tGotten: ")
|
||||||
|
(display (length '(1 2 3 1 2 3 1 2 3 1 2 3 1)))
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
(display "Testing length!\n\tExpect: (5 4 3 2 1)\n\tGotten: ")
|
||||||
|
(display (reverse '(1 2 3 4 5)))
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
; Test environment set
|
||||||
|
|
||||||
|
(newline)
|
||||||
|
(display "* Testing custom library *")
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
(display "Testing set-env! Expect 32: ")
|
||||||
|
(display ((set-env! (lambda () x) '((x . 32)) )))
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
(display "Testing string->datum! Expect (2): ")
|
||||||
|
(display (cdr (string->datum "(display 2)")))
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
(newline)
|
||||||
|
(display "* Testing Eval system *")
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
(display "Eval expression. Expect 6: ")
|
||||||
|
(display (eval '(* 2 (cdr '(2 . 3))) (scheme-report-environment 5)))
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
(newline)
|
||||||
|
(display "* Testing Macro system *")
|
||||||
|
(newline)
|
||||||
|
|
||||||
; Test syntax-rules
|
; Test syntax-rules
|
||||||
|
|
||||||
(define-syntax and
|
(define-syntax and
|
||||||
|
|
717
tigerscheme.tig
717
tigerscheme.tig
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user