From 178b9241cddfcb353a366aa67a475f14a2555a06 Mon Sep 17 00:00:00 2001 From: Meisterlala <6453306+Meisterlala@users.noreply.github.com> Date: Tue, 18 Aug 2020 14:05:46 +0200 Subject: [PATCH] completed homework 5 from script v1.2 --- Programming Languages/Part B/Week 2/hw5.rkt | 167 ++++++++++++++++++ .../Part B/Week 2/hw5test.rkt | 60 +++++++ .../Week 3/120_static_vs_dynamic_one.rkt | 35 ++++ .../Week 3/120_static_vs_dynamic_one.sml | 40 +++++ .../Part B/Week 3/122_eval.rkt | 18 ++ 5 files changed, 320 insertions(+) create mode 100644 Programming Languages/Part B/Week 2/hw5.rkt create mode 100644 Programming Languages/Part B/Week 2/hw5test.rkt create mode 100644 Programming Languages/Part B/Week 3/120_static_vs_dynamic_one.rkt create mode 100644 Programming Languages/Part B/Week 3/120_static_vs_dynamic_one.sml create mode 100644 Programming Languages/Part B/Week 3/122_eval.rkt diff --git a/Programming Languages/Part B/Week 2/hw5.rkt b/Programming Languages/Part B/Week 2/hw5.rkt new file mode 100644 index 0000000..d5a3165 --- /dev/null +++ b/Programming Languages/Part B/Week 2/hw5.rkt @@ -0,0 +1,167 @@ +;; Programming Languages, Homework 5 + +#lang racket +(provide (all-defined-out)) ;; so we can put tests in a second file + +;; definition of structures for MUPL programs - Do NOT change +(struct var (string) #:transparent) ;; a variable, e.g., (var "foo") +(struct int (num) #:transparent) ;; a constant number, e.g., (int 17) +(struct add (e1 e2) #:transparent) ;; add two expressions +(struct ifgreater (e1 e2 e3 e4) #:transparent) ;; if e1 > e2 then e3 else e4 +(struct fun (nameopt formal body) #:transparent) ;; a recursive(?) 1-argument function +(struct call (funexp actual) #:transparent) ;; function call +(struct mlet (var e body) #:transparent) ;; a local binding (let var = e in body) +(struct apair (e1 e2) #:transparent) ;; make a new pair +(struct fst (e) #:transparent) ;; get first part of a pair +(struct snd (e) #:transparent) ;; get second part of a pair +(struct aunit () #:transparent) ;; unit value -- good for ending a list +(struct isaunit (e) #:transparent) ;; evaluate to 1 if e is unit else 0 + +;; a closure is not in "source" programs but /is/ a MUPL value; it is what functions evaluate to +(struct closure (env fun) #:transparent) + +;; Problem 1 + +(define (racketlist->mupllist rl) + (if (empty? rl) + (aunit) + (apair (car rl) (racketlist->mupllist (cdr rl))))) + +(define (mupllist->racketlist ml) + (if (aunit? ml) + empty + (cons (apair-e1 ml) (mupllist->racketlist (apair-e2 ml))))) + +;; Problem 2 + +;; lookup a variable in an environment +;; Do NOT change this function +(define (envlookup env str) + (cond [(null? env) (error "unbound variable during evaluation" str)] + [(equal? (car (car env)) str) (cdr (car env))] + [#t (envlookup (cdr env) str)])) + +;; Do NOT change the two cases given to you. +;; DO add more cases for other kinds of MUPL expressions. +;; We will test eval-under-env by calling it directly even though +;; "in real life" it would be a helper function of eval-exp. +(define (eval-under-env e env) + (cond [(var? e) + (envlookup env (var-string e))] + [(add? e) + (let ([v1 (eval-under-env (add-e1 e) env)] + [v2 (eval-under-env (add-e2 e) env)]) + (if (and (int? v1) + (int? v2)) + (int (+ (int-num v1) + (int-num v2))) + (error "MUPL addition applied to non-number")))] + [(int? e) + e] + [(closure? e) + e] + [(aunit? e) + e] + [(fun? e) + (closure env e)] + [(ifgreater? e) + (let ([v1 (eval-under-env (ifgreater-e1 e) env)] + [v2 (eval-under-env (ifgreater-e2 e) env)]) + (if (and (int? v1) (int? v2)) + (if (> (int-num v1) (int-num v2)) + (eval-under-env (ifgreater-e3 e) env) + (eval-under-env (ifgreater-e4 e) env)) + (error "Must compare Integers")))] + [(mlet? e) + (if (string? (mlet-var e)) + (eval-under-env (mlet-body e) + (cons (cons (mlet-var e) (eval-under-env (mlet-e e) env)) env)) + (error "Variable name has to be a String"))] + [(call? e) + (let* ([f (eval-under-env (call-funexp e) env)] + [argv (eval-under-env (call-actual e) env)]) + (if (closure? f) + (let* ([fname (fun-nameopt (closure-fun f))] + [farg (fun-formal (closure-fun f))] + [fbody (fun-body (closure-fun f))] + [bind (if (equal? fname #f) + (list (cons farg argv)) + (append (list (cons farg argv)) (list (cons fname f))))]) + (eval-under-env fbody (append bind (closure-env f)))) + (error "no function")))] + [(apair? e) + (apair (eval-under-env (apair-e1 e) env) + (eval-under-env (apair-e2 e) env))] + [(fst? e) + (let ([sub (eval-under-env (fst-e e) env)]) + (if (apair? sub) + (apair-e1 sub) + (error "no Pair")))] + [(snd? e) + (let ([sub (eval-under-env (snd-e e) env)]) + (if (apair? sub) + (apair-e2 sub) + (error "no Pair")))] + [(isaunit? e) + (if (aunit? (eval-under-env (isaunit-e e) env)) + (int 1) + (int 0))] + + [#t (error (format "bad MUPL expression: ~v" e))])) + +;; Do NOT change +(define (eval-exp e) + (eval-under-env e null)) + +;; Problem 3 + +(define (ifaunit e1 e2 e3) (if (equal? (isaunit e1) (int 1)) + e2 + e3)) + +(define (mlet* lstlst e2) (if (empty? lstlst) + e2 + (mlet (car (car lstlst)) + (cdr (car lstlst)) + (mlet* (cdr lstlst) e2)))) + +(define (ifeq e1 e2 e3 e4) + (mlet* (list (cons "_x" e1) (cons "_y" e2)) + (ifgreater (var "_x") (var "_y") e4 + (ifgreater (var "_y") (var "_x") e4 e3)))) + +;; Problem 4 + +(define mupl-map + (fun "map" "f" + (fun "helper" "mupls" + (ifaunit (var "mupls") + (aunit) + ; Recursively apply f on all list members + ; Recall that mupls is a list (pair when evaluated), e.g. (cons m (cons mupls') ...) + (apair (call (var "f") (fst (var "mupls"))) + (call (var "helper") (snd (var "mupls")))))))) + +; Part b +(define mupl-mapAddN + (mlet "map" mupl-map + ; Double currying going on here, mupl-mapAddN needs the integer i + ; in order to complete the (already curried) map function + (fun "helper" "i" + (call (var "map") (fun "f" "x" (add (var "x") (var "i"))))))) +;; Challenge Problem + +(struct fun-challenge (nameopt formal body freevars) #:transparent) ;; a recursive(?) 1-argument function + +;; We will test this function directly, so it must do +;; as described in the assignment +(define (compute-free-vars e) "CHANGE") + +;; Do NOT share code with eval-under-env because that will make +;; auto-grading and peer assessment more difficult, so +;; copy most of your interpreter here and make minor changes +(define (eval-under-env-c e env) "CHANGE") + +;; Do NOT change this +(define (eval-exp-c e) + (eval-under-env-c (compute-free-vars e) null)) diff --git a/Programming Languages/Part B/Week 2/hw5test.rkt b/Programming Languages/Part B/Week 2/hw5test.rkt new file mode 100644 index 0000000..64f36a8 --- /dev/null +++ b/Programming Languages/Part B/Week 2/hw5test.rkt @@ -0,0 +1,60 @@ +#lang racket +;; Programming Languages Homework 5 Simple Test +;; Save this file to the same directory as your homework file +;; These are basic tests. Passing these tests does not guarantee that your code will pass the actual homework grader + +;; Be sure to put your homework file in the same folder as this test file. +;; Uncomment the line below and, if necessary, change the filename +(require "hw5.rkt") + +(require rackunit) + +(define tests + (test-suite + "Sample tests for Assignment 5" + + ;; check racketlist to mupllist with normal list + (check-equal? (racketlist->mupllist (list (int 3) (int 4))) (apair (int 3) (apair (int 4) (aunit))) "racketlist->mupllist test") + + ;; check mupllist to racketlist with normal list + (check-equal? (mupllist->racketlist (apair (int 3) (apair (int 4) (aunit)))) (list (int 3) (int 4)) "racketlist->mupllist test") + + ;; tests if ifgreater returns (int 2) + (check-equal? (eval-exp (ifgreater (int 3) (int 4) (int 3) (int 2))) (int 2) "ifgreater test") + + ;; mlet test + (check-equal? (eval-exp (mlet "x" (int 1) (add (int 5) (var "x")))) (int 6) "mlet test") + + ;; call test + (check-equal? (eval-exp (call (closure '() (fun #f "x" (add (var "x") (int 7)))) (int 1))) (int 8) "call test") + + ;;snd test + (check-equal? (eval-exp (snd (apair (int 1) (int 2)))) (int 2) "snd test") + + ;; isaunit test + (check-equal? (eval-exp (isaunit (closure '() (fun #f "x" (aunit))))) (int 0) "isaunit test") + + ;; ifaunit test + (check-equal? (eval-exp (ifaunit (int 1) (int 2) (int 3))) (int 3) "ifaunit test") + + ;; mlet* test + (check-equal? (eval-exp (mlet* (list (cons "x" (int 10))) (var "x"))) (int 10) "mlet* test") + + ;; ifeq test + (check-equal? (eval-exp (ifeq (int 1) (int 2) (int 3) (int 4))) (int 4) "ifeq test") + + ;; mupl-map test + (check-equal? (eval-exp (call (call mupl-map (fun #f "x" (add (var "x") (int 7)))) (apair (int 1) (aunit)))) + (apair (int 8) (aunit)) "mupl-map test") + + ;; problems 1, 2, and 4 combined test + (check-equal? (mupllist->racketlist + (eval-exp (call (call mupl-mapAddN (int 7)) + (racketlist->mupllist + (list (int 3) (int 4) (int 9)))))) (list (int 10) (int 11) (int 16)) "combined test") + + )) + +(require rackunit/text-ui) +;; runs the test +(run-tests tests) diff --git a/Programming Languages/Part B/Week 3/120_static_vs_dynamic_one.rkt b/Programming Languages/Part B/Week 3/120_static_vs_dynamic_one.rkt new file mode 100644 index 0000000..7365278 --- /dev/null +++ b/Programming Languages/Part B/Week 3/120_static_vs_dynamic_one.rkt @@ -0,0 +1,35 @@ +; Programming Languages, Dan Grossman +; Section 6: Static Versus Dyanamic Typing, Part 1 + +#lang racket + +(define (f y) + (if (> y 0) (+ y y) "hi")) + +(define a (let ([ans (f 7)]) + (if (number? ans) (number->string ans) ans))) + +(define (cube x) + (if (not (number? x)) + (error "bad arguments") + (* x x x))) + +(define b (cube 7)) + +(define (f2 g) + (cons (g 7) (g #t))) + +(define pair_of_pairs + (f2 (lambda (x) (cons x x)))) + +(define (pow-bad-type x) ; curried + (lambda (y) + (if (= y 0) + 1 + (* x (pow-bad-type x (- y 1)))))) ; oops + +(define (pow-bad-algorithm x) ; curried + (lambda (y) + (if (= y 0) + 1 + (+ x ((pow-bad-algorithm x) (- y 1)))))) ; oops diff --git a/Programming Languages/Part B/Week 3/120_static_vs_dynamic_one.sml b/Programming Languages/Part B/Week 3/120_static_vs_dynamic_one.sml new file mode 100644 index 0000000..2e20dd9 --- /dev/null +++ b/Programming Languages/Part B/Week 3/120_static_vs_dynamic_one.sml @@ -0,0 +1,40 @@ +(* Programming Languages, Dan Grossman *) +(* Section 6: Static Versus Dyanamic Typing, Part 1 *) + +datatype t = Int of int | String of string +fun f y = if y > 0 then Int(y+y) else String "hi" + +fun foo x = case f x of + Int i => Int.toString i + | String s => s + +fun cube x = x * x * x + +val z = cube 7 + +(* fun f g = (g 7, g true) *) (* does not type-check *) +(* val pair_of_pairs = f (fn x => (x,x)) *) + +datatype tort = Int of int + | String of string + | Cons of tort * tort + | Fun of tort -> tort + (* would have more constructors *) + +val _ = if true + then Fun (fn x => case x of Int i => Int (i*i*i)) + else Cons (Int 7, String "hi") + +(* does not type-check *) +(* +fun pow x y = + if y = 0 + then 1 + else x * pow (x,y-1) +*) + +(* wrong algorithm *) +fun pow x y = (* curried *) + if y = 0 + then 1 + else x + pow x (y-1) (* oops *) diff --git a/Programming Languages/Part B/Week 3/122_eval.rkt b/Programming Languages/Part B/Week 3/122_eval.rkt new file mode 100644 index 0000000..0994fca --- /dev/null +++ b/Programming Languages/Part B/Week 3/122_eval.rkt @@ -0,0 +1,18 @@ +; Programming Languages, Dan Grossman +; Section 6: Optional: eval and quote + +#lang racket + +(define (make-some-code1 y) ; just returns a list + (if y + (list 'begin (list 'print "hi") (list '+ 4 2)) + (list '+ 5 3))) + +(define (make-some-code2 y) ; same as make-some-code1 + (if y + (quote (begin (print "hi") (+ 4 2))) + (quote (+ 5 3)))) + +(define (test1) (eval (make-some-code1 #t))) ; prints "hi", result 6 +(define (test2) (eval (make-some-code1 #t))) ; prints "hi", result 6 + -- 2.51.2