(load "prekode2b.scm") ;;;;;;; ;; 1 ;; ;;;;;;; ;; A (define (make-counter) (define count 0) (lambda () (set! count (+ count 1)) count)) ;; B ;; Se 1.b.pdf ;;;;;;; ;; 2 ;; ;;;;;;; ;; A (define (make-stack items) (define (push-item! item) (set! items (cons item items))) (define (push! items) (if (null? items) '() (begin (push-item! (car items)) (push! (cdr items))))) (define (pop!) (if (null? items) '() (let ((item (car items))) (set! items (cdr items)) item))) (lambda (symbol . args) (cond ((eq? symbol 'push!) (push! args)) ((eq? symbol 'pop!) (pop!)) ((eq? symbol 'stack) items) (else (error "Invalid symbol"))))) ;; B (define (push! s . args) (apply s 'push! args)) (define (pop! s) (s 'pop!)) (define (stack s) (s 'stack)) ;;;;;;; ;; 3 ;; ;;;;;;; ;; A ;; Etter define: 3.a-befor.pdf ;; Etter set-cdr!: 3.a-after.pdf ;; bar er en sirkulær liste etter kallet på set-cdr!. Cons-celle 4 peker på ;; cons-celle 2, så (cdr (cdddr bar)) gir celle 2 og (cddr (cdddr bar)) ;; gir celle 3. ;; B ;; Etter define: 3.b-before.pdf ;; Etter den første set-car!: 3.b-after.pdf ;; Først setter vi car av bar til cdr av bar, så bar er en cons-celle ;; hvor både car og cdr peker på en liste. ((a towel) a towel) er måten ;; scheme viser det. Etter den andre set-car! erstatter vi a med 42, og siden ;; car og cdr peker på samme cons-celle, endrer det på begge. Resultatet blir ;; dermed ((42 towel) 42 towel). ;; C ;; (list? bar) returnerer #f fordi bar er sirkulær. ;; (list? bah) returnerer #t, fordi den er en gyldig liste, terminert med ;; en tom liste, hvor det første elementet av listen bare tilfeldigvis er en ;; annen liste. Predikatet list? bryr seg ikke om at det første elementet ;; er samme cons-celle som resten av listen. ;;;;;;; ;; 4 ;; ;;;;;;; ;; A/B (define (mem symbol proc) (define (memoize proc) (define tbl (make-table)) ;; Run the procedure and store the result in the table (define (run args) (let ((val (apply proc args))) (insert! args val tbl) val)) ;; Run the procedure if the arguments aren't in the table yet, ;; otherwise just return the table entry (define (run-memoized args) (let ((val (lookup args tbl))) (if (eq? val #f) (run args) val))) ;; If the first argument is _get-proc, return the original procedure. ;; Otherwise, run the procedure memoized (define (fn . args) (if (and (not (null? args)) (eq? (car args) '_get-proc)) proc (run-memoized args))) fn) ;; Calling the procedure with the argument `_get-proc will return the ;; original procedure. (define (unmemoize proc) (proc '_get-proc)) (cond ((eq? symbol 'memoize) (memoize proc)) ((eq? symbol 'unmemoize) (unmemoize proc)) (else (error "Invalid symbol")))) ;; C ;; Fib-funksjonen kaller seg selv. Hvis vi lager en ny funksjon ;; mem-fib, som er memoisert, hvil ikke de rekursive kallene på fib ;; i fib-prosedyren være memoisert. Den eneste måten å få de rekursive ;; kallene til å også bli memoisert er å endre variabelen, slik at `fib` ;; refererer til den memoiserte funksjonen selv når den kalles rekursivt.