Recursivitate in limbajul PROC (EOPL 3) | Simulating recursivity in PROC language, Eopl3

PROC nu suportă recursivitatea.
Pentru a o simula, se folosește artificiul numit y-combinator și se creează un caz de test  în  tests.scm  pentru fiecare operație dorită.


1) Suma nr. 1 ... N

    (sum-1-to-N
"let p = proc(f) proc(x)
    if zero?(x) then 0 else -(((f f) -(x,1)), -(0,x))
in ((p p) 10)" 55)


2) Numerele Fibonacci:  fibo (N) = fibo (N-1) + fibo(N-2)

    (fibonacci "
let p = proc(f) proc(x)
    if zero?(x) then 0 else if zero?(-(x,1)) then 1 else -( ((f  f) -(x,1)), -(0, ((f f) -(x, 2))))
in ((p p) 10)
    " 55)


3) Înmulțirea a două numere

    (x*y
"let p = proc(f) proc(x) proc(y) proc(z)
    if zero?(z) then x else ((((f f) -(x, -(0,y))) y) -(z, 1))
in ((((p p) 0) 6) 7)" 42)


4) Factorial: N! = 1 * 2 * ... * N

    (factorial
"let multipl = proc(a) proc(b)
    let p = proc(f) proc(x) proc(y) proc(z)
        if zero?(z) then x else ((((f f) -(x, -(0,y))) y) -(z, 1))
    in ((((p p) 0) a) b)
in
    let fun = proc (f) proc(x)
        if zero?(-(x,1)) then 1 else ((multipl x) ((f f) -(x,1)))
    in ((fun fun) 5)" 120)

Extensii pentru limbajul LET | EOPL3 Let language extensions - Stack operations

Constructori:
* stack -> list
* push : expVal x list -> list

Observatori:
* top : list -> expVal
* pop : list -> list
* size : list -> num-val


> lang.scm_________________________________________________
;; the grammar
        (expression    ("stack") stack-exp)
        (expression ("push" expression expression) push-exp)
        (expression ("top" expression) top-exp)
        (expression ("pop" expression) pop-exp)
        (expression ("size" "(" expression ")") size-exp)


> interp.scm_______________________________________________ 
 ;; value-of
        (stack-exp ()
            '())
        (push-exp (exp1 exp2)
            (cons (value-of exp1 env) (value-of exp2 env)))
        (top-exp (exp1)
            (car (value-of exp1 env))   
        )
        (pop-exp (exp1)
            (cdr (value-of exp1 env))
        )
        (size-exp (exp1)
            (num-val (length (value-of exp1 env)))
        )


> tests.scm__________________________________________________

        (stack-1 "top stack" error)
        (stack-2 "top push 3 push 4 stack" 3)
        (stack-3 "pop stack" error)
        (stack-4 "pop push 1 push 2 push zero?(0) stack" (2 #t))
        (stack-5 "size(stack)" 0)
        (stack-6 "size(push 100 stack)" 1)
        (stack-7 "let x=1 in let y=2 in top pop push x push -(x,y) push y stack" -1)

_____________________________________________________________

Extensii pentru limbajul LET | EOPL3 Let language extensions for list: cons, car, cdr, ...

Constructori:
* listagoala -> ListofExpval
* adauga : expVal x ListofExpval -> ListofExpval

Observatori:
* primul : ListofExpval -> expVal
* restul : ListofExpval -> ListofExpval
* e_goala : ListofExpval -> Bool

> lang.scm___________________________________________________
;;; in the grammar
        (expression
            ("lista-goala")
        gol-exp)

        (expression 
            ("adauga" expression "la" expression)
        add-exp)

        (expression
            ("primul" "din" expression)
        car-exp)

        (expression
            ("restul" "din" expression)
        cdr-exp)

        (expression
            ("e-goala" "(" expression ")")
        isempty-exp)

> interp.scm__________________________________________________
;; in value-of 
        (gol-exp ()
            '()
        )

        (add-exp (exp1 exp2)
            (cons (value-of exp1 env) (value-of exp2 env)))

        (car-exp (exp1)
            (car (value-of exp1 env)))

        (cdr-exp (exp1)
            (cdr (value-of exp1 env)))

        (isempty-exp (exp1)
            (bool-val (null? (value-of exp1 env))))

> tests.scm____________________________________________________
        (lista-test1 "adauga 5 la adauga 6 la lista-goala" (5 6))
        (lista-test2 "lista-goala" ())
        (lista-test3 "let x=1 in adauga x la lista-goala" (1))
        (lista-test4 "adauga zero?(1) la adauga 5 la adauga let x = 2 in -(x,1) la lista-goala" (#f 5 1))
        (lista-test5 "e-goala(lista-goala)" #t)
        (lista-test6 "e-goala(adauga 3 la lista-goala)" #f)
        (lista-test7 "primul din let x=1 in adauga x la lista-goala" 1)
        (lista-test8 "restul din adauga zero?(1) la adauga 5 la adauga let x = 2 in -(x,1) la lista-goala" (5 1))

> top.scm______________________________________________________
;;; in sloppy->expval  (for tests.scm)
((list? sloppy-val) (map sloppy->expval sloppy-val))

Extensii pentru limbajul LET | EOPL3 Let language extensions: RECORD

RECORD
> data-structures.scm
;; in define-datatype
    ; Record
    (record-val
        (record (list-of (list-of symbol?) (list-of expval?)))
    )

;; independent function
    ; record
    (define expval->record (lambda (v)
        (cases expval v
            (record-val (record) record)
            (else (expval-extractor-error 'set v)))))


> lang.scm
; constructor for record
        (expression
            ("record" "{" (separated-list identifier ":" expression ";") "}")
        record-exp)
        ; end Record

;; observer: accessing a record
        (expression
            ("(" identifier "." identifier ")")
        access-exp)


> interp.scm
        ; record
        ; ((id1 id2 id3...) (val1 val2 val3...))
        ; returns the same thing but the members "val" are evaluated
        (record-exp (myids myvals)
              (record-val
                (list myids (map (lambda (myval) (value-of myval env)) myvals))
            )
          )

        ;; access record
        (access-exp (id id_inside)
            (letrec ((myrecord (expval->record (value-of (var-exp id) env)))
                    (myfun (lambda (ids vals)
                        (if (null? ids) "Error"
                            (if (eq? (car ids) id_inside) (car vals)
                            ;else
                            (myfun (cdr ids) (cdr vals)))))))
                    ; in
                    (myfun (car myrecord) (cadr myrecord)))
        )


> top.scm
;; in sloppy->expval
    ; for record ((id1 id2 id3...) (val1 val2 val3...))
    ((and (list? sloppy-val) (not (null? sloppy-val))
        (eq? (length sloppy-val) 2))   
        (record-val (list (car sloppy-val)
            (map (lambda (myelem) (sloppy->expval myelem)) (cadr sloppy-val)))))   
    ; end record


> tests.scm
;; test record
        (rec-test "let x=record{y:10; z:20} in x" ((y z) (10 20)))
        (rec-test2 "let x=record{y:10; z:20} in (x.z)" 20)
        (rec-test3 "zero?(record{y:10; z:20})" error)
        (rec-test4 "let y = record {ab:5; cd:30} in if zero?(2) then (y.ab) else (y.cd)" 30) ; 30 is the sloppy-value!!!

(run "let x=record{y:10; z:20} in (x.a)") ----> gives "Error"

Extensii pentru limbajul LET | EOPL3 Let language extensions: SET

SET
> data-structures.scm
;;; inside define-datatype
    (set-val
        (set (list-of expval?))
    )

;;; independent function
    (define expval->set (lambda (v)
        (cases expval v
            (set-val (set) set)
            (else (expval-extractor-error 'set v)))))

> lang.scm
;;; inside expression
        (expression
            ("set" "{" (separated-list expression ",") "}") 
        set-exp)

> interp.scm
;;; inside value-of
        (set-exp (exp1) ; exp1 is a list of expressions
            ;; the return type should be set-val
            (set-val
                (map (lambda (myexp) (value-of myexp env)) exp1)) ; don't make it concrete value inside the set!
        )

> top.scm
;;; inside sloppy->expval
((list? sloppy-val) (set-val (map sloppy->expval sloppy-val)))

> tests.scm
      (set-test-diff1 "-(set {1,2}, 3)" error)                ; can't extract from a set
      (set-test-diff2 "-(5, set {1,2})" error)
      (set-test-zero "zero?(set{1,2})" error)                ; can't test a set for zero
      (set-test-if1 "if set{1,2} then #t else 2" error)        ; can't test if set
      (set-test-if2 "if zero?(2) then 3 else set {1,2}" (1 2))
      (set-test-if3 "if zero?(0) then set{1,2} else 0" (1 2))
      (test-set-let1 "let id =set {1,2,3} in id" (1 2 3))
      (test-set-let2 "let x=1 in set {x, -(x,1), -(x,2)}" (1 0 -1))
      (test-set-set "set {set {1,2}, 5, zero?(3), if zero?(x) then x else 0, let y=1 in set{y,7}}" 
        ((1 2) 5 #f 0 (1 7))) 


Operații pe SET de numere: Union, Intersect, Membership, isEmpty ...

> lang.scm_______________________________________________________

        ;; member check
        (expression
            ("is" expression "member-of" expression)
        memb-exp)

        ;; is empty
        (expression
            ("empty-set?" "(" expression ")")
        empty-exp)
 
        ;; union
        (expression
            ("union" expression "with" expression)
        union-exp)

        ;; intersection
        (expression
            ("intersect" expression "with" expression)
        inter-exp)


> interp.scm___________________________________________________________

        ;; membership ---- works only for numbers inside of set
        (memb-exp (memb setList)
            (letrec ((mymember (expval->num (value-of memb env)))
                (myset (expval->set (value-of setList env)))
                (getMembership (lambda (memberName set)
                        (if (null? set) (bool-val #f)
                            (if (eq? (expval->num (car set)) memberName) (bool-val #t)
                                (getMembership memberName (cdr set)))))))
                (getMembership mymember myset)))


        ;; check if set is empty
        (empty-exp (setList)
            (if (null? (expval->set (value-of setList env))) (bool-val #t)
                (bool-val #f)))

        ;; union --- set of numbers
        (union-exp (set1 set2)
            (letrec ((s1 (expval->set (value-of set1 env)))
                    (s2 (expval->set (value-of set2 env)))
                    (isMember (lambda (mem mylist)
                        (if (null? mylist) #f (if (eq? (expval->num mem) (expval->num (car mylist))) #t (isMember mem (cdr mylist))))))
                    (getUnion (lambda (se1 se2)
                        (if (null? se2) se1
                            (if (not (isMember (car se2) se1)) (getUnion (cons (car se2) se1) (cdr se2))
                                (getUnion se1 (cdr se2)))))))
            (set-val (getUnion s1 s2))))

        ;; intersection --- works for numbers only
        (inter-exp (set1 set2)
            (letrec ((myset1 (expval->set (value-of set1 env)))
                    (myset2 (expval->set (value-of set2 env)))
                    (isMember (lambda (mem mylist)
                        (if (null? mylist) #f (if (eq? (expval->num mem) (expval->num (car mylist))) #t (isMember mem (cdr mylist))))))
                    (find-intersect (lambda (s1 s2 dummy)      
                        (if (null? s1) dummy    ; else
                            (if (isMember (car s1) s2) (find-intersect (cdr s1) s2 (cons (car s1) dummy))
                                (find-intersect (cdr s1) s2 dummy))))))
            (set-val (find-intersect myset1 myset2 '()))))
 
> tests.scm__________________________________________________________

    (test-member1 "is 2 member-of set {1,2,3}" #t)
    (test-member2 "is 4 member-of set {1,2,3}" #f)
    (test-empty1 "empty-set?(set{2,3,4, set{1,2}})" #f)
    (test-empty2 "empty-set?(set{})" #t)
    (test-union1 "union set{1,2} with set{2,3}" (3 1 2))
    (test-union2 "union set{} with set{2}" (2))
    (test-inter1 "intersect set{1,2} with set{2,3}" (2))
    (test-inter2 "intersect set{0,4,2,1,6,3} with set {9,0,2,10}" (2 0))