uni/inf2810/hw2.b/oppgave.scm

(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.