X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=src%2Fscheme-library.scm;h=cd2693231759f24143b192baa22b34d6d06f2f99;hb=5c256a740ae9bf1f774e202cbdaf66d8e33f37e7;hp=68debca48afbcd9d7b31c15e485338e1acbcbdfb;hpb=aa76b536aa3e1a90b31a64fd9147b2b16153ec8b;p=scheme.forth.jl.git diff --git a/src/scheme-library.scm b/src/scheme-library.scm index 68debca..cd26932 100644 --- a/src/scheme-library.scm +++ b/src/scheme-library.scm @@ -13,7 +13,27 @@ (define (cdar l) (cdr (car l))) (define (cddr l) (cdr (cdr l))) (define (cadar l) (car (cdr (car l)))) +(define (caddr l) (car (cdr (cdr l)))) +(define (cadddr l) (car (cdr (cdr (cdr l))))) +;; FUNCTIONAL PROGRAMMING + +(define (fold-left proc init l) + (if (null? l) + init + (fold-left proc (proc init (car l)) (cdr l)))) + +(define (reduce-left proc init l) + (if (null? l) + init + (if (null? (cdr l)) + (car l) + (fold-left proc (proc (car l) (car (cdr l))) (cdr (cdr l)))))) + +(define (map proc l) + (if (null? l) + '() + (cons (proc (car l)) (map proc (cdr l))))) ;; NUMBERS @@ -118,18 +138,6 @@ (define (null? arg) (eq? arg '())) -(define (fold-left proc init l) - (if (null? l) - init - (fold-left proc (proc init (car l)) (cdr l)))) - -(define (reduce-left proc init l) - (if (null? l) - init - (if (null? (cdr l)) - (car l) - (fold-left proc (proc (car l) (car (cdr l))) (cdr (cdr l)))))) - (define (+ . args) (fold-left pair+ 0 args)) @@ -203,7 +211,7 @@ (define (iter a count) (if (null? a) count - (iter (cdr a) (+ count 1)))) + (iter (cdr a) (fix:+ count 1)))) (iter l 0)) ; Join two lists together @@ -330,18 +338,18 @@ (define (sum n) (define (sum-iter total count maxcount) - (if (> count maxcount) + (if (fix:> count maxcount) total - (sum-iter (+ total count) (+ count 1) maxcount))) + (sum-iter (fix:+ total count) (fix:+ count 1) maxcount))) (sum-iter 0 1 n)) ; Recursive summation. Use this to compare with tail call ; optimized iterative algorithm. (define (sum-recurse n) - (if (= n 0) + (if (fix:= n 0) 0 - (+ n (sum-recurse (- n 1))))) + (fix:+ n (sum-recurse (fix:- n 1))))) ;; MISC