project9.scm

;; The first three lines of this file were inserted by DrScheme.
;; They record information about the language level.
#reader(lib "plai-pretty-big-reader.ss" "plai")((modname pro9) (read-case-sensitive #t) (teachpacks ()))
(define (AEfoldin op nv list)  
  (cond
    ((null? list) nv)
    ((null? (rest list)) (AEfoldin op (op (first list) (op nv)) (rest list))) ;(op nv) => -3 vb icin 
    (else (AEfoldin op (op nv (first list)) (rest list)))))

(define (AEfold op nv list) (AEfoldin op nv (reverse list)))

(define-type F1OAI
  [fnum (n number?)]
  [fadd (operands (listof F1OAI?))]
  [fsub (operands (listof F1OAI?))]
  [fmul (operands (listof F1OAI?))]
  [fdiv (operands (listof F1OAI?))]
 ; [fif-exp (lhs F1OAI?) (mid F1OAI?) (rhs F1OAI?)]
  [fwith (name symbol?) (named-expr F1OAI?) (body F1OAI?)]
  [fid (name symbol?)]
  [fapp (fun-name symbol?) (arg F1OAI?)]
)

;<fundef> ::= {<symbol> <symbol>  <LF1OAI>}
(define-type FunDef
  [fundef (fun-name symbol?) (arg-name symbol?) (body F1OAI?)])

(define-type Env 
  [mtSub]
  [aSub (name symbol?) (value number?) (ds Env?)])

;;lookup-fundef : symbol listof(FunDef) -> FunDef
;;consumes a function-name and a function-definition list and returns the function-definition of that function-name
(define (lookup-fundef fun-name fundefs)
  (cond
    [(empty? fundefs) (error fun-name "function not found")]
    [else (if(symbol=? fun-name (fundef-fun-name (first fundefs)))
             (first fundefs)
             (lookup-fundef fun-name (rest fundefs)))]
    ))

;;lookup : symbol Env -> F1OAI
(define (lookup name ds)
  (type-case Env ds
             [mtSub () (error 'look-up "no binding for an identifier")]
             [aSub (bound-name bound-value rest-ds)
                   (if(symbol=? bound-name name)
                      bound-value (lookup name rest-ds))]))

;;interp : F1OAI listof(fundef) Env -> number
(define (interp expr fun-defs ds)
  (type-case F1OAI expr
             [fnum (n) n]
             [fadd (operands)(AEfold + 0 (map (lambda (x) (interp x fun-defs ds)) operands))]
             [fsub (operands)(AEfold - 0 (map (lambda (x) (interp x fun-defs ds)) operands))]
             [fmul (operands)(AEfold * 1 (map (lambda (x) (interp x fun-defs ds)) operands))]
             [fdiv (operands)(AEfold / 1 (map (lambda (x) (interp x fun-defs ds)) operands))]
             [fwith (bound-id named-expr bound-body)
                    (interp bound-body 
                            fun-defs
                            (aSub bound-id (interp named-expr
                                                   fun-defs
                                                   ds) ds))]
             [fid (v) (lookup v ds)]
             [fapp (fun-name arg-expr)
                   (local([define the-fun-def (lookup-fundef fun-name fun-defs)])
                     (interp (fundef-body the-fun-def)
                             fun-defs
                             (aSub (fundef-arg-name the-fun-def)
                                   (interp arg-expr fun-defs ds)
                                   (mtSub))))]))

(test (interp (fapp 'toto (fnum 4)) (list (fundef 'toto 's (fdiv (list (fnum 4) (fid 's))))) (list (fid 's) (fnum 5) )) 1)

;differentiation:

(define er-rate 0.0001)
(define (d/dx f) (lambda (x) (/ (- (f (+ x er-rate)) (f x)) er-rate)))

;(define diff-sq (d/dx (lambda (x) (* x x))))
;> (diff-sq 10)
;20.000099999890608