environment.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 proje) (read-case-sensitive #t) (teachpacks ()))
;; Comp 314 - Project 9
;; Anıl Özselgin (10276040) - Ahmet Sevimli (10276043)

(define p3->p1
  (lambda (f)
    (lambda (p1)
      (lambda (p2)
        (lambda (p3)
          (f p3 p1 p2))))))


(define p2->p1
  (lambda (f)
    (lambda (p1)
      (lambda (p2)
        (f p2 p1)))))


(define my-fold-inner
  (lambda (op x liste)
    (cond
      ((null? (cdr liste))x)
      (else 
       (my-fold-inner op (op x (car(cdr liste))) (cdr liste))))))

(define my-fold
  (lambda (op liste)
    (my-fold-inner op (car liste) liste)))

;;OAİ  definition
(define-type OAİ
  [sayi (n number?)]
  [id (name symbol?)]
  [topla (operant OAİlist?)]
  [çıkart (operant OAİlist?)]
  [çarp (operant OAİlist?)]
  [böl (operant OAİlist?)]
  [üs (operant OAİlist?)]
  [eğer (expr1 OAİ?)(expr2 OAİ?)(expr3 OAİ?)]
  [olsun (name symbol?) (named-expr OAİ?) (body OAİ?)]
  [app (fun-name symbol?) (arg OAİ?)])

;list of OAİ --> boolean 
(define (OAİlist? ae) 
  (and (<= 1 (length ae)) (OAİ? (car ae)) (OAİlistinner? (cdr ae))))

;inner function for OAİlist function
(define (OAİlistinner? ae)
  (or
   (null? ae)
   (and(OAİ? (car ae))(OAİlistinner? (cdr ae)))))

(define-type FunDef
  [fundef (fun-name symbol?)
          (arg-name symbol?)
          (body OAİ?)])


(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)))]))


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


;; lookup : symbol DefrdSub --> OAİ
(define (lookup name ds)
  (type-case DefrdSub ds
             [mtSub () (error 'lookup "no binding for identifier")]
             [aSub (bound-name bound-value rest-ds)
                   (if (symbol=? bound-name name)
                       bound-value
                       (lookup name rest-ds))]))



;;parser for OAİ 
;;example:
;;>(parse '(topla 4 5))
;;(topla (list (sayi 4) (sayi 5)))
;> (parse '(olsun x 1 (eğer (çıkart x 5) (üs 5 x) (üs x x))))
;;(olsun
;; (id 'x)
;; (sayi 1)
;; (eğer (çıkart (list (id 'x) (sayi 5))) (üs (list (sayi 5) (id 'x))) (üs (list (id 'x) (id 'x)))))
;;;

(define (parse OAİ)
  (cond
    [(and (list? OAİ) (eq? (first OAİ) 'üs) (not (= (length OAİ) 3))) (error "invalid input")]
    [(and (list? OAİ) (eq? (first OAİ) 'eğer) (not (= (length OAİ) 4))) (error "invalid input")]
    [(number? OAİ)(sayi OAİ)]
    [(symbol? OAİ)(id OAİ)]
    [(and (= (length OAİ) 2) (symbol? (first OAİ)))
     (app (first OAİ) (parse (second OAİ)))]
    [(list? OAİ)
     (case (car OAİ)
       [(topla) (topla (parseOperants (cdr OAİ)))]
       [(çıkart) (çıkart (parseOperants (cdr OAİ)))]
       [(çarp) (çarp (parseOperants (cdr OAİ)))]
       [(böl) (böl (parseOperants (cdr OAİ)))]
       [(üs) (üs (parseOperants (cdr OAİ)))]
       [(eğer)(eğer (parse(cadr OAİ))(parse(caddr OAİ))(parse(cadddr OAİ)))]
       [(olsun) (olsun  (cadr OAİ) (parse(caddr OAİ)) (parse(cadddr OAİ)) )]
       [else (error "unknown expression type")])]
    [else (error "unknown expression type")]
    ))

;;inner function for parser function
;;it creates a list of operant in defined data-type
(define (parseOperants operant)
  (if (null? operant) null
      (cons (parse (car operant)) (parseOperants (cdr operant)))))


;;//bundan sonrası calculation için
;;OAİlistsubst  listenin tüm elemanlarını  subst fonksiyonuna teker teker sokup  consla bağlıyor.  liste geri döndürüyor.
;;calc fonksiyonu hesaplamaların yapıldığı yer
;;example:
;;>(calc(parse '(topla 4 5)))
;;9
;;>(calc(parse '(olsun x 1 (eğer (çıkart x 5) (üs 5 x) (üs x x)))))
;;5
;;>> (calc(parse '(olsun y 4(topla 4 (olsun x 3 10) 8))))
;;22
;;> (calc(parse '(olsun x 5(topla x (olsun x 3 x)))))
;;8

(define (calc expr fun-defs env)
  (type-case OAİ expr
             [sayi (n) n]
             [topla (operant) (my-fold +  (map (((p3->p1 calc)fun-defs)env) operant))]
             [çıkart (operant) (my-fold - (map (((p3->p1 calc)fun-defs)env) operant))]
             [çarp (operant) (my-fold * (map (((p3->p1 calc)fun-defs)env) operant ))]
             [böl (operant) (my-fold / (map (((p3->p1 calc)fun-defs)env) operant ))]
             [üs (operant) (my-fold expt (map (((p3->p1 calc)fun-defs)env) operant ))]
             [eğer (expr1 expr2 expr3) (if (not(eqv? 0 (calc expr1 fun-defs env))) (calc expr2 fun-defs env) (calc expr3 fun-defs env))]
             [olsun (bound-id named-expr bound-body)
                    (calc bound-body
                          fun-defs
                          (aSub bound-id
                                (calc named-expr
                                      fun-defs
                                      env)
                                env))]
             [app (fun-name arg-expr)
                  (local ([define the-fun-def (lookup-fundef fun-name fun-defs)])
                    (calc (fundef-body the-fun-def )
                            fun-defs
                            (aSub (fundef-arg-name the-fun-def )
                                  (calc arg-expr fun-defs env)
                                  (mtSub))))]
             [id (v) (lookup v env)]))


;;> (calc(parse '(olsun x 5 (olsun y x (olsun x 7 (topla y x))))) () (mtSub))
;;12

;;> (calc (parse '{fibonacci 20}) (list (fundef 'fibonacci 'n (parse '{eğer n (eğer (çıkart n 1) (topla (fibonacci(çıkart n 1))(fibonacci (çıkart n 2))) 1) 0}))) (mtSub))
;;6765

;;> (calc (parse '{fac 5}) (list (fundef 'fac 'n (parse '{eğer n {çarp n {fac {çıkart n 1}}} 1}))) (mtSub))
;;120