substitution.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 ()))
(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İ?)])

(define-type FunDef
  [fundef (fun-name symbol?)
          (arg-name symbol?)
          (body 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 (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)))]))

;;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)
  (type-case OAİ expr
             [sayi (n) n]
             [topla (operant) (my-fold +  (map ((p2->p1 calc)fun-defs) operant))]
             [çıkart (operant) (my-fold - (map ((p2->p1 calc)fun-defs) operant))]
             [çarp (operant) (my-fold * (map ((p2->p1 calc)fun-defs) operant ))]
             [böl (operant) (my-fold / (map ((p2->p1 calc)fun-defs) operant ))]
             [üs (operant) (my-fold expt (map ((p2->p1 calc)fun-defs) operant ))]
             [eğer (expr1 expr2 expr3) (if (not(eqv? 0 (calc expr1 fun-defs))) (calc expr2 fun-defs) (calc expr3 fun-defs))]
             [olsun (bound-id named-expr bound-body)
                    (calc (subst bound-body
                                 bound-id
                                 (sayi (calc named-expr fun-defs)))fun-defs)]
             [app (fun-name arg-expr)
                  (local ([define the-fun-def (lookup-fundef fun-name fun-defs)])
                                (calc (subst (fundef-body the-fun-def)
                                                     (fundef-arg-name the-fun-def)
                                                     (sayi (calc arg-expr fun-defs)))
                                      fun-defs))]
             [id (v) (error "calc free identifier")]
             ))

;;olsun kısmı kitaptaki subsititution fonksiyonun aynısı
(define (subst expr sub-id val)
  (type-case OAİ expr
             [sayi (n) expr]
             [topla (operant) (topla (OAİlistsubst operant sub-id val))]
             [çıkart (operant) (çıkart (OAİlistsubst operant sub-id val))]
             [çarp (operant) (çarp (OAİlistsubst operant sub-id val))]
             [böl (operant) (böl (OAİlistsubst operant sub-id val))]
             [üs (operant) (üs (OAİlistsubst operant sub-id val))]
             [eğer (expr1 expr2 expr3)
                   (eğer (subst expr1 sub-id val) (subst expr2 sub-id val) (subst expr3 sub-id val))]
             [olsun (bound-id named-expr bound-body)
                    (if (symbol=? bound-id sub-id)
                        (olsun bound-id
                               (subst named-expr sub-id val)
                               bound-body)
                        (olsun bound-id
                               (subst named-expr sub-id val)
                               (subst bound-body sub-id val)))]
             [app (name arg) (app name (subst arg sub-id val))]
             [id (v) (if (symbol=? v sub-id) val expr)]))

;;inner function for subst  function
(define (OAİlistsubst operant sub-id val)
  (if (null? operant) null
      (cons (subst (car operant) sub-id val) (OAİlistsubst (cdr operant) sub-id val))))


;;> (calc (parse '{fac 5}) (list (fundef 'fac 'n (parse '{eğer n {çarp n {fac {çıkart n 1}}} 1}))))
;;120
;;> (calc (parse '{fibonacci 6}) (list (fundef 'fibonacci 'n (parse '{eğer n (eğer (çıkart n 1) (topla (fibonacci(çıkart n 1))(fibonacci (çıkart n 2))) 1) 0}))))
;;8