קצת על המדריך

;; list-length : List -> Int
;; usage: (list-length l) = the length of l
;; Page: 14
(define list-length
  (lambda (lst)
    (if (null? lst)
      0
      (+ 1 (list-length (cdr lst))))))

;; occurs-free? : Sym * Lcexp -> Bool
;; usage:
;; returns #t if the symbol var occurs free in exp,
;; otherwise returns #f.
;; Page: 19
(define occurs-free?
  (lambda (var exp)
    (cond
      ((symbol? exp) (eqv? var exp))
      ((eqv? (car exp) ’lambda)
        (and
          (not (eqv? var (car (cadr exp))))
          (occurs-free? var (caddr exp))))
      (else
        (or
          (occurs-free? var (car exp))
          (occurs-free? var (cadr exp)))))))

;; plus : N * N -> N
;; usage: (plus x y) = the sum of x and y
(define (plus x y)
  (if (is-zero? x)
    y
    (successor (plus (predecessor x) y))))

;; plus : N * N -> N
;; Unary Representation
;; page 33 10.
(define zero (lambda () ’()))
(define is-zero? (lambda (n) (null? n)))
(define successor (lambda (n) (cons #t n)))
(define predecessor (lambda (n) (cdr n)))

(define zero ’())
(define is-zero? null?)
(define successor (lambda (n) (cons #t n)))
(define predecessor cdr)

;; plus : N * N -> N
;; Scheme number representation
;; page 33
(define zero (lambda () 0))
(define is-zero? (lambda (n) (zero? n)))
(define successor (lambda (n) (+ n 1)))
(define predecessor (lambda (n) (- n 1)))

;; Could not extract snippet starting with: ;; (zero) =
;; from page 56

(define one (successor (zero)))
(define two (successor one))
(is-zero? (zero)) ;returns #t
(is-zero? one) ;returns #f
(is-zero? two) ;returns #f
;; testing
(define (f n) (+ n 2)) ;f(n)=n+2
(= 2 (((zero) f) 2)) ;returns #t
(= 4 ((one f) 2)) ;returns #t
(= 6 ((two f) 2)) ;returns #t
(define (g n) (* n n)) ;g(n)=n*n
(= 2 (((zero) g) 2)) ;returns #t
(= 4 ((one g) 2)) ;returns #t
(= 16 ((two g) 2)) ;returns #t

;; expressions that return #t
(is-zero? (predecessor one))
(is-zero? (predecessor (predecessor two)))
(is-zero? (predecessor (plus (zero) one)))
(is-zero? (predecessor (predecessor (plus one one))))
;; expressions that return #f
(is-zero? (predecessor (plus one one)))

(define e
  (extend-env ’d 6
    (extend-env ’y 8
      (extend-env ’x 7
        (extend-env ’y 14
          (empty-env))))))

;; data definition:
;; Env ::= (empty-env) | (extend-env Var Schemeval Env)
;; empty-env : () -> Env
(define empty-env
  (lambda () (list ’empty-env)))
;; extend-env : Var * Schemeval * Env -> Env
(define extend-env
  (lambda (var val env)
    (list ’extend-env var val env)))
;; apply-env : Env * Var -> Schemeval
(define apply-env
  (lambda (env search-var)
    (cond
      ((equal? (car env) ’empty-env)
        (report-no-binding-found search-var))
      ((equal? (car env) ’extend-env)
        (let ((saved-var (cadr env))
            (saved-val (caddr env))
            (saved-env (cadddr env)))
          (if (eqv? search-var saved-var)
            saved-val
            (apply-env saved-env search-var))))
      (else
        (report-invalid-env env)))))

(define report-no-binding-found
  (lambda (search-var)
    (eopl:error ’apply-env "No binding for ~s" search-var)))
(define report-invalid-env
  (lambda (env)
    (eopl:error ’apply-env "Bad environment: ~s" env)))

;; data definition:
;; Env = Var -> Schemeval
;; empty-env : () -> Env
(define empty-env
  (lambda ()
    (lambda (search-var)
      (report-no-binding-found search-var))))
;; extend-env : Var * Schemeval * Env -> Env
(define extend-env
  (lambda (saved-var saved-val saved-env)
    (lambda (search-var)
      (if (eqv? search-var saved-var)
        saved-val
        (apply-env saved-env search-var)))))
;; apply-env : Env * Var -> Schemeval
(define apply-env
  (lambda (env search-var)
    (env search-var)))

;; data definition:
;; Env = Var -> Schemeval
;; empty-env : () -> Env
(define empty-env
  (lambda ()
    (lambda (search-var)
      (report-no-binding-found search-var))))
;; extend-env : Var * Schemeval * Env -> Env
(define extend-env
  (lambda (saved-var saved-val saved-env)
    (lambda (search-var)
      (if (eqv? search-var saved-var)
        saved-val
        (saved-env search-var)))))

;; var-exp : Var -> Lc-exp
(define var-exp
  (lambda (var)
    ‘(var-exp ,var)))
;; lambda-exp : Var * Lc-exp -> Lc-exp
(define lambda-exp
  (lambda (var lc-exp)
    ‘(lambda-exp ,var ,lc-exp)))
;; app-exp : Lc-exp * Lc-exp -> Lc-exp
(define app-exp
  (lambda (lc-exp1 lc-exp2)
    ‘(app-exp ,lc-exp1 ,lc-exp2)))

;; var-exp? : Lc-exp -> Bool
(define var-exp?
  (lambda (x)
    (and (pair? x) (eq? (car x) ’var-exp))))
;; lambda-exp? : Lc-exp -> Bool
(define lambda-exp?
  (lambda (x)
    (and (pair? x) (eq? (car x) ’lambda-exp))))
;; app-exp? : Lc-exp -> Bool
(define app-exp?
  (lambda (x)
    (and (pair? x) (eq? (car x) ’app-exp))))

;; var-exp->var : Lc-exp -> Var
(define var-exp->var
  (lambda (x)
    (cadr x)))
;; lambda-exp->bound-var : Lc-exp -> Var
(define lambda-exp->bound-var
  (lambda (x)
    (cadr x)))
;; lambda-exp->body : Lc-exp -> Lc-exp
(define lambda-exp->body
  (lambda (x)
    (caddr x)))
;; app-exp->rator : Lc-exp -> Lc-exp
(define app-exp->rator
  (lambda (x)
    (cadr x)))
;; app-exp->rand : Lc-exp -> Lc-exp
(define app-exp->rand
  (lambda (x)
    (caddr x)))

;; occurs-free? : Sym * Lcexp -> Bool
(define occurs-free?
  (lambda (search-var exp)
    (cond
      ((var-exp? exp) (eqv? search-var (var-exp->var exp)))
            ((lambda-exp? exp)
              (and
                (not (eqv? search-var (lambda-exp->bound-var exp)))
                      (occurs-free? search-var (lambda-exp->body exp))))
                          (else
                            (or
                              (occurs-free? search-var (app-exp->rator exp))
                                  (occurs-free? search-var (app-exp->rand exp)))))))

(define-datatype lc-exp lc-exp?
  (var-exp
    (var symbol?))
  (lambda-exp
    (bound-var symbol?)
    (body lc-exp?))
  (app-exp
    (rator lc-exp?)
    (rand lc-exp?)))

;; occurs-free? : Sym * Lcexp -> Bool
(define occurs-free?
  (lambda (search-var exp)
    (cases lc-exp exp
      (var-exp (var)
        (eqv? var search-var))
      (lambda-exp (bound-var body)
        (and
          (not (eqv? search-var bound-var))
          (occurs-free? search-var body)))
      (app-exp (rator rand)
        (or
          (occurs-free? search-var rator)
          (occurs-free? search-var rand))))))

;; parse-expression: SchemeVal -> LcExp
(define parse-expression
  (lambda (datum)
    (cond
      ((symbol? datum) (var-exp datum))
      ((pair? datum)
        (if (eqv? (car datum) ’lambda)
          (lambda-exp (caadr datum)
            (parse-expression (caddr datum)))
          (app-exp
            (parse-expression (car datum))
            (parse-expression (cadr datum)))))
      (else (eopl:error ’parse-expression
          "Invalid concrete syntax ~s" datum)))))

;; unparse-expression: LcExp -> SchemeVal
(define unparse-expression
  (lambda (exp)
    (cases lc-exp exp
      (var-exp (id) id)
      (lambda-exp (id body)
        (list ’lambda (list id)
          (unparse-expression body)))
      (app-exp (rator rand)
        (list (unparse-expression rator)
          (unparse-expression rand))))))
(eopl:error ’apply-env "No binding for ~s" search-var)))

(a-program
  (let-exp ’x
    (const-exp 4)
    (diff-exp (var-exp ’x)
      (diff-exp (const-exp 1)
        (var-exp ’x)))))

(define-datatype expval expval?
  (num-val
    (calue number?))
  (bool-val
    (boolean boolean?)))

(define expval->num
  (lambda (v)
    (cases expval v
      (num-val (num) num)
      (else (expval-extractor-error ’num v)))))

(define expval->bool
  (lambda (v)
    (cases expval v
      (bool-val (bool) bool)
      (else (expval-extractor-error ’bool v)))))

(define expval-extractor-error
  (lambda (variant value)
    (eopl:error ’expval-extractors "Looking for a ~s, found ~s "
      variant value)))

(value-of-expression <<-(-(x,3),-(v,i)>> ρ) =
  = (-
    (value-of-expression <<-(x,3)>> ρ)
      (value-of-expression <<-(v,i)>> ρ)) =

;;; an expressed value is either a number, a boolean or a procv al.
(define-datatype expval expval?
  (num-val
    (value number?))
  (bool-val
    (boolean boolean?)))
;;; extractors:
(define expval->num
  (lambda (v)
    (cases expval v
      (num-val (num) num)
      (else (expval-extractor-error ’num v)))))
(define expval->bool
  (lambda (v)
    (cases expval v
      (bool-val (bool) bool)
      (else (expval-extractor-error ’bool v)))))
(define expval-extractor-error
  (lambda (variant value)
    (eopl:error ’expval-extractors "Looking for a ~s, found ~s "
      variant value)))

;; init-env : -> Env
;; (init-env) builds an environment in which i is bound to the
;; expressed value 1, v is bound to the expressed value 5, and x is
;; bound to the expressed value 10.
(define init-env
  (lambda ()
    (extend-env
      ’i (num-val 1)
      (extend-env
        ’v (num-val 5)
        (extend-env
          ’x (num-val 10)
          (empty-env))))))

;; run : String -> ExpVal
(define run
  (lambda (string)
    (value-of-program (scan>parse string))))

;; value-of-program : Program -> ExpVal
(define value-of-program
  (lambda (pgm)
    (cases program pgm
      (a-program (body)
        (value-of body (init-env))))))

;; value-of : Exp * Env -> ExpVal
(define value-of
  (lambda (exp env)
    (cases expression exp
      (const-exp (num) (num-val num))
      (var-exp (id) (apply-env env id))
      (diff-exp (exp1 exp2)
        (let ((val1
              (expval->num
                (value-of exp1 env)))
            (val2
              (expval->num
                (value-of exp2 env))))
          (num-val
            (- val1 val2))))
      (zero?-exp (exp1)
        (let ((val1 (expval->num (value-of exp1 env))))
                (if (zero? val1)
                  (bool-val #t)
                  (bool-val #f))))
            (if-exp (exp0 exp1 exp2)
              (if (expval->bool (value-of exp0 env))
                  (value-of exp1 env)
                  (value-of exp2 env)))
              (let-exp (id rhs body)
                (let ((val (value-of rhs env)))
                  (value-of body
                    (extend-env id val env))))
        )))

(define test-list
  ’(
    ;; simple arithmetic
    (positive-const "11" 11)
    (negative-const "-33" -33)
    (simple-arith-1 "-(44,33)" 11)
    ;; nested arithmetic
    (nested-arith-left "-(-(44,33),22)" -11)
    (nested-arith-right "-(55, -(22,11))" 44)
    ;; simple variables
    (test-var-1 "x" 10)
    (test-var-2 "-(x,1)" 9)
    (test-var-3 "-(1,x)" -9)

;; simple unbound variables
(test-unbound-var-1 "foo" error)
(test-unbound-var-2 "-(x,foo)" error)
;; simple conditionals
(if-true "if zero?(0) then 3 else 4" 3)
(if-false "if zero?(1) then 3 else 4" 4)
;; test dynamic typechecking
(no-bool-to-diff-1 "-(zero?(0),1)" error)
(no-bool-to-diff-2 "-(1,zero?(0))" error)
(no-int-to-if "if 1 then 2 else 3" error)
;; make sure that the test and both arms get evaluated
;; properly.
(if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
(if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
;; and make sure the other arm doesn’t get evaluated.
(if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
(if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4 " 4)
;; simple let
(simple-let-1 "let x = 3 in x" 3)
;; make sure the body and rhs get evaluated
(eval-let-body "let x = 3 in -(x,1)" 2)
(eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
;; check nested let and shadowing
(simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
(check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
(check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
))

(define value-of
  (lambda (exp env)
    (cases expression exp
      ...
      (proc-exp (bvar body)
        (proc-val
          (procedure bvar body env)))
      (call-exp (rator rand)
        (let ((proc (expval->proc (value-of rator env)))
                (arg (value-of rand env)))
              (apply-procedure proc arg)
    )))))

(value-of <<let x = 200
  in let f = proc (z) -(z,x)
  in let x = 100
  in let g = proc (z) -(z,x)
  in -((f 1), (g 1))>>
  ρ) =
= (value-of <<let f = proc (z) -(z,x)
  in let x = 100
  in let g = proc (z) -(z,x)
  in -((f 1), (g 1))>>
  [x=(num-val 200)] ρ) =
= (value-of <<let x = 100
  in let g = proc (z) -(z,x)
  in -((f 1), (g 1))>>
  [f=(proc-val (procedure z <<-(z,x)>> [x=(num-val 200)] ρ))]
      [x=(num-val 200)] ρ) =
    = (value-of <<let g = proc (z) -(z,x)
      in -((f 1), (g 1))>>
      [x=(num-val 100)]
      [f=(proc-val (procedure z <<-(z,x)>> [x=(num-val 200)] ρ))]
          [x=(num-val 200)] ρ) =
        = (value-of <<-((f 1), (g 1))>>
          [g=(proc-val (procedure z
              <<-(z,x)>>
              [x=(num-val 100)]
              [f=(proc-val (procedure z <<-(z,x)>> [x=(num-val 200)] ρ))]
                  [x=(num-val 200)] ρ))]
              [x=(num-val 100)]
              [f=(proc-val (procedure z <<-(z,x)>> [x=(num-val 200)] ρ))]
                  [x=(num-val 200)] ρ)

;; procedure : Symbol * Exp * Env -> Proc
(define procedure
  (lambda (bvar body env)
    (lambda (arg)
      (value-of body (extend-env bvar arg env)))))
;; apply-procedure : Proc * ExpVal -> ExpVal
(define apply-procedure
  (lambda (proc arg)
    (proc arg)))

(define-datatype proc proc?
  (procedure
    (bvar symbol?)
    (body expression?)
    (env environment?)))
(define apply-procedure
  (lambda (proc1 arg)
    (cases proc proc1
      (procedure (bvar body saved-env)
        (value-of body (extend-env bvar arg saved-env))))))

;;; an expressed value is either a number, a boolean or a procv al.
(define-datatype expval expval?
  (num-val
    (value number?))
  (bool-val
    (boolean boolean?))
  (proc-val
    (proc proc?)))

;; value-of : Exp * Env -> ExpVal
(define value-of
  (lambda (exp env)
    (cases expression exp
      ...
      (proc-exp (var body)
        (proc-val (procedure var body env)))
      (call-exp (rator rand)
        ; (let ((proc (expval->proc (value-of rator env)))
        ; (arg (value-of rand env)))
        (let ((val (value-of rator env))
            (arg (value-of rand env)))
          (let ((proc (expval->proc val)))
                  (apply-procedure proc arg)))
        )))

let
x=30
in
let*
x= -(x,1)
y= -(x,2)
in
-(x,y)
Expression ::= cond{Expression ==> Expression}∗end
cond-exp (exps1 exps2)

let
x=5
in
cond
zero? (x) ==> 7
zero? (-(x,5)) ==> 12
zero? (-(x,2)) ==>70
end
Expression ::= foldExpressionExpression [{Expression}∗(,)]
fold-exp (proc1

let
p1 = proc (x) -(x, -(0,3))
in
let
p2 = proc (x) -(x, 7)
in
compose [p1 ; p2; proc (x) {(10,x)] 5

let x = newref(0)
in letrec even(dummy)
= if zero?(deref(x))
then zero?(0)
else begin
setref(x, -(deref(x),1));
(odd 888)
end
odd(dummy)
= if zero?(deref(x))
then zero?(1)
else begin
setref(x, -(deref(x),1));
(even 888)
end
in begin setref(x,13); (odd 888) end

let g = let counter = newref(0)
in proc (dummy)
begin
setref(counter, -(deref(counter), -1)) ;
deref(counter)
end
in let a = (g 11)
in let b = (g 11)
in let c = (g 11)
in c
let x = newref(newref(0))
in begin
setref(deref(x), 321) ;
deref(deref(x))
end

let x = newref(newref(0))
in begin
setref(deref(x), 321) ;
deref(deref(x))
end

;; value-of-program : Program -> ExpVal
(define value-of-program
  (lambda (pgm)
    (initialize-store!) ; new for explicit refs.
    (cases program pgm
      (a-program (exp1)
        (value-of exp1 (init-env))))))

;;; World’s dumbest implementation of stores:
;;; a store is a list and
;;; a reference is an integer index into the list.
;;; the-store : Store
;;; the-store is the current store
(define the-store (empty-store))
;;; reference? : SchemeVal -> Boolean
;;; (reference? x) is true iff x represents a location
(define reference? integer?)
;;; initialize-store! : -> Unspecified
;;; (initialize-store!) sets the store to the empty store
(define initialize-store!
  (lambda ()
    (set! the-store (empty-store))))
;;; empty-store : -> Store
;;; (empty-store) returns an empty store
(define empty-store
  (lambda () ’()))

;;; newref : ExpVal -> Ref
;;; (newref v) returns a newly allocated reference
;;; initialized to v
(define newref
  (lambda (val)
    (let ((next-ref (length the-store)))
      (set! the-store
        (append the-store (list val)))
      (if (instrument-newref)
        (eopl:printf
          "newref: allocating location ~s~%"
          next-ref))
      next-ref)))

;;; deref : Ref -> ExpVal
;;; (deref ref) returns the value currently contained in ref
(define deref
  (lambda (ref) (list-ref the-store ref)))

;;; setref! : Ref * ExpVal -> Unspecified
;;; (setref! ref val) changes the current store
;;; by storing val into ref
(define setref!
  (lambda (ref0 val)
    (set! the-store
      ;; setref-inner : Store * Ref -> Store
      ;; (setref-inner sigma l) returns a store
      ;; that is like sigma except that,
      ;; in the store returned by setref-inner,
      ;; the location l contains val.
      (letrec ((setref-inner (lambda (store ref)
              (cond
                ((null? store)
                  (eopl:error ’setref
                    "illegal reference"))
                ((zero? ref)
                  (cons val (cdr store)))
                (else
                  (cons
                    (car store)
                    (setref-inner (cdr store)
                      (- ref 1)))))))))
      (setref-inner the-store ref0)))))

(newref-exp (exp1)
  (let ((v1 (value-of exp1 env)))
    (ref-val (newref v1))))
(deref-exp (exp1)
  (let ((v1 (value-of exp1 env)))
    (let ((ref1 (expval->ref v1)))
            (deref ref1))))
      (setref-exp (exp1 exp2)
        (let ((ref (expval->ref (value-of exp1 env))))
                (let ((v2 (value-of exp2 env)))
                  (begin
                    (setref! ref v2)
                    (num-val 23)))))

;;; an expressed value is either a number, a boolean, a procva l, or a
;;; reference.
(define-datatype expval expval?
  (num-val
    (value number?))
  (bool-val
    (boolean boolean?))
  (proc-val
    (proc proc?))
  (ref-val
    (ref reference?))
)

(define expval->ref
  (lambda (v)
    (cases expval v
      (ref-val (ref) ref)
      (else (expval-extractor-error ’reference v)))))

(define-datatype environment environment?
  (empty-env)
  (extend-env
    (bvar symbol?)
    (bval reference?) ; new for implicit-refs
    (saved-env environment?))
  (extend-env-rec*
    (proc-names (list-of symbol?))
    (b-vars (list-of symbol?))
    (proc-bodies (list-of expression?))
    (saved-env environment?)))

;; env->list : Env -> List
;; used for pretty-printing and debugging
(define env->list
  (lambda (env)
    (cases environment env
      (empty-env () ’())
      (extend-env (sym val saved-env)
        (cons
          (list sym val) ; val is a denoted value-- a
          ; reference.
          (env->list saved-env)))
            (extend-env-rec* (p-names b-vars p-bodies saved-env)
              (cons
                (list ’letrec p-names ’...)
                (env->list saved-env))))))

;; expval->printable : ExpVal -> List
;; returns a value like its argument, except procedures get c leaned
;; up with env->list
(define expval->printable
  (lambda (val)
    (cases expval val
      (proc-val (p)
        (cases proc p
          (procedure (var body saved-env)
            (list ’procedure var ’... (env->list saved-env)))))
                (else val))))

;; the-store: a Scheme variable containing the current stat e of the
;; store. Initially set to a dummy variable.
(define the-store ’uninitialized)
;; empty-store : () -> Sto
;; Page: 111
(define empty-store
  (lambda () ’()))
;; initialize-store! : () -> Sto
;; usage: (initialize-store!) sets the-store to the empty- store
;; Page 111
(define initialize-store!
  (lambda ()
    (set! the-store (empty-store))))

;; get-store : () -> Sto
;; Page: 111
;; This is obsolete. Replaced by get-store-as-list below
(define get-store
  (lambda () the-store))

;; reference? : SchemeVal -> Bool
;; Page: 111
(define reference?
  (lambda (v)
    (integer? v)))

;; newref : ExpVal -> Ref
;; Page: 111
(define newref
  (lambda (val)
    (let ((next-ref (length the-store)))
      (set! the-store
        (append the-store (list val)))
      (if (instrument-newref)
        (eopl:printf
          "newref: allocating location ~s with initial contents ~s~% "
          next-ref val))
      next-ref)))

;; deref : Ref -> ExpVal
;; Page 111
(define deref
  (lambda (ref)
    (list-ref the-store ref)))

;; setref! : Ref * ExpVal -> Unspecified
;; Page: 112
(define setref!
  (lambda (ref val)
    (set! the-store
      (letrec
        ((setref-inner
            ;; returns a list like store1, except that position ref1
            ;; contains val.
            (lambda (store1 ref1)
              (cond
                ((null? store1)
                  (report-invalid-reference ref the-store))
                ((zero? ref1)
                  (cons val (cdr store1)))
                (else
                  (cons
                    (car store1)
                    (setref-inner
                      (cdr store1) (- ref1 1))))))))
        (setref-inner the-store ref)))))

;; get-store-as-list : () -> Listof(List(Ref,Expval))
;; Exports the current state of the store as a scheme list.
;; (get-store-as-list ’(foo bar baz)) = ((0 foo)(1 bar) (2 ba z))
;; where foo, bar, and baz are expvals.
;; If the store were represented in a different way, this woul d be
;; replaced by something cleverer.
;; Replaces get-store (p. 111)
(define get-store-as-list
  (lambda ()
    (letrec
      ((inner-loop
          ;; convert sto to list as if its car was location n
          (lambda (sto n)
            (if (null? sto)
              ’()
              (cons
                (list n (car sto))
                (inner-loop (cdr sto) (+ n 1)))))))
      (inner-loop the-store 0))))
)

#include <stdio.h>
#include <stdlib.h>
doublef (double* p) {
*p = 3.14159;
return*p;
}
intmain (intargc,char* argv[]) {
intn = 12345;
double* p = (void*) &n;
doublex = f(p);
doubley = f(p+1);
doublez = f(p+2);
printf ( "n = %d\n" , n);
printf ( "x = %lf\n" , x);
}

proc (x : int) -(x,1)
letrec
int double (x : int) = if zero?(x)

let a = proc (i) proc (j) -(i, -(0,j))
in letrec m (x) = proc (y) if zero?(x)
then 0
else ((a ((m -(x,1) y)) y)
  in ((m 11) 12)
  .(7.2 הנהמשתניהטיפוסשנשייךלכלמשתנהקשור)

> (+ 2 3)
5
> +
#<Procedure>
> (define x 3)
> x
3
> (+ (* x x) (* 9 9)) 90)
180

(define list-length
  (lambda (lst)
    (if (null? lst)
      0
      (+ 1 (list-length (cdr lst))))))
((> lambda (x) 0) ’a)
    0

(cond (<test> <expression>)
    (<test> <expression>)
      ...
      (else <expression>) )

(define member?
  (lambda (a lst)
    (cond ((null? lst) #f)
      ((equal? (car lst) a) #t)
      (else (member? a (cdr lst))))))

(define times
  (lambda (x y)
    (if (is-zero? x) (zero)
      (plus y (times (predecessor x) y)))))

;; parse-expression: SchemeVal -> LcExp
(define parse-expression
  (lambda (datum)
    (cond
      ((symbol? datum) (var-exp datum))
      ((pair? datum)
        (if (eqv? (car datum) ’lambda)
          (lambda-exp (caadr datum)
            (parse-expression (caddr datum)))
          (app-exp
            (parse-expression (car datum))
            (parse-expression (cadr datum)))))
      (else (eopl:error ’parse-expression
          "Invalid concrete syntax ~s" datum)))))

;; unparse-expression: LcExp -> SchemeVal
(define unparse-expression
  (lambda (exp)
    (cases lc-exp exp
      (var-exp (id) id)
      (lambda-exp (id body)
        (list ’lambda (list id)
          (unparse-expression body)))
      (app-exp (rator rand)
        (list (unparse-expression rator)
          (unparse-expression rand))))))
(eopl:error ’apply-env "No binding for ~s" search-var)))

(value-of <<let f = proc(z) -(z,x) in (f 21)>> ρ) =
  = (value-of <<(f 21)>>
    [f=(value-of <<proc(z) -(z,x)>> ρ)]ρ) =
      = (value-of <<(f 21)>>
        [f=(value-of (procedure z <<-(z,x)>> ρ)]ρ) =
            = (apply-procedure
              (value-of <<f>> [f=(procedure z <<-(z,x)>> ρ)]ρ)
                (value-of <<21>> [f=(procedure z <<-(z,x)>> ρ)]ρ))=
                  = (apply-procedure
                    (procedure z <<-(z,x)>> ρ)
                      21)=
                    = (value-of <<-(z,x)>> [z=21] ρ)
                      = (- (value-of <<z>> [z=21] ρ)
                          (value-of <<x>> [z=21] ρ))
                            = (- 21 10)
                            = 11
                            /square

(value-of <<let x = proc(z) -(z,x) in (f 21)>> ρ) =
  = (value-of <<(x 21)>>
    [f=(value-of <<proc(z) -(z,x)>> ρ)]ρ) =
      = (value-of <<(x 21)>>
        [x=(value-of (procedure z <<-(z,x)>> ρ)]ρ) =
            = (apply-procedure
              (value-of <<x>> [x=(procedure z <<-(z,x)>> ρ)]ρ)
                (value-of <<21>> [x=(procedure z <<-(z,x)>> ρ)]ρ))=
                  = (apply-procedure
                    (procedure z <<-(z,x)>> ρ)
                      21)=
                    = (value-of <<-(z,x)>> [z=21] ρ)
                      = (- (value-of <<z>> [z=21] ρ)
                          (value-of <<x>> [z=21] ρ))
                            = (- 21 10)
                            = 11
                            /square

("let*" (arbno identifier "=" expression) "in" expression )
let*-exp)

(let*-exp (vars exps body)
  (if (null? vars)
    (value-of body env)
    (let* ((v1 (value-of (car exps) env))
        (e1 (extend-env (car vars) v1 env)))
      (value-of (let*-exp (cdr vars) (cdr exps) body) e1))))

("cond" (arbno expression "==>" expression) "end")
    cond-exp)

(cond-exp (exps1 exps2)
  (if (null? exps1)
    (display "error: cond error")
    (if (expval->bool (value-of (car exps1) env))
        (value-of (car exps2) env)
        (value-of (cond-exp (cdr exps1) (cdr exps2)) env))))

("fold" expression
  expression
  "[" (separated-list expression ",") "]" )
fold-exp)

(fold-exp (exp1 exp2 exps )
  (letrec
    ((proc (expval->proc (value-of exp1 env)))
          (acc (expval->num (value-of exp2 env)))
              (lst (map (lambda (exp)
                    (expval->num (apply-procedure proc (value-of exp env))))
                      exps))
                  (sum-all (lambda (l)
                      (if (null? l) 0 (+ (car l) (sum-all (cdr l)))))))
                (num-val (sum-all lst))))
      )))

("check" expression (arbno "and" expression) "end" )
check-exp)

(check-exp (exp1 exps )
  (if (expval->bool (value-of exp1 env))
      (if (null? exps)
        (bool-val #t)
        (value-of (check-exp (car exps) (cdr exps)) env))
      (bool-val #f)))

("count" expression
  "[" (separated-list expression ",") "]")
count-exp)

(count-exp (prc exps)
  (letrec ((p (lambda (prc exps cnt)
          (if (null? exps)
            cnt
            (if (expval->bool (value-of (call-exp prc (car exps)) env) )
                (p prc (cdr exps) (+ 1 cnt))
                (p prc (cdr exps) cnt))))))
      (num-val (p prc exps 0))))

("compose" "[" expression (arbno " ;" expression) "]" expression)
    compose-exp)

(compose-exp (firstexp exps val)
  (let* ((res (value-of (call-exp firstexp val) env))
      (resexp (var-exp ’res)))
    (if (null? exps)
      res
      (value-of (compose-exp (car exps) (cdr exps) resexp)

("setdynamic" identifier "=" expression "during" express ion)
setdynamic-exp)

(setdynamic-exp (var exp1 body)
  (let*
    ((varref (apply-env env var))
      (oldval (deref varref))
      (tempval (value-of exp1 env)))
    (begin
      (setref! varref tempval)
      (let ((result (value-of body env)))
        (begin
          (setref! varref oldval)
          result)))))

("proc" "(" identifier ")"
  (arbno "static" identifier "=" expression)
  expression)
proc-exp)

(proc-exp (var statvars statvals body)
  (letrec
    ((vals (map (lambda (exp)
            (value-of exp env))
          statvals))
      (expand-env (lambda (vars vals env1)
          (if (null? vars)
            env1
            (expand-env
              (cdr vars)
              (cdr vals)
              (extend-env
                (car vars)
                (newref (car vals))
                env1)))))
      (env-with-static (expand-env statvars vals env)))
    (proc-val (procedure var body env-with-static))))

("callref" expression "(" "ref" identifier ")")
callref-exp)

(callref-exp (rator rand)
  (let
    ((proc (expval->proc (value-of rator env)))
          (arg (apply-env env rand)))
        (apply-procedure2 proc arg)))

(define apply-procedure2
  (lambda (proc1 arg)
    (cases proc proc1
      (procedure (var body saved-env)
        (let ((new-env (extend-env var arg saved-env)))
          (value-of body new-env))))))

("while" expression "do" expression)
while-exp)

(while-exp (bl body)
  (letrec
    ((do-body (lambda (c)
          (if (expval->bool (value-of bl env))
              (begin
                (value-of body env)
                (do-body (+ c 1)))
              c))))
      (num-val (do-body 0))))