Skip to content

Instantly share code, notes, and snippets.

@jbclements
Created March 6, 2013 00:14
Show Gist options
  • Save jbclements/5095637 to your computer and use it in GitHub Desktop.
Save jbclements/5095637 to your computer and use it in GitHub Desktop.
updated file with #lang racket and quoted ()s.
#lang racket
;; Rafael George Homework 5
;; definition of structures for MUPL programs
(define-struct var (string)) ;; a variable, e.g., (make-var "foo")
(define-struct int (num)) ;; a constant number, e.g., (make-int 17)
(define-struct add (e1 e2)) ;; add two expressions
(define-struct ifgreater (e1 e2 e3 e4));;if e1 > e2 then e3 else e4
(define-struct fun (nameopt formal body)) ;; a recursive(?) 1-argument function
(define-struct app (funexp actual)) ;; function application
(define-struct mlet (var e body)) ;; a mlet expression (let var = e in body)
(define-struct apair (e1 e2)) ;; make a new pair
(define-struct fst (e)) ;; get first part of an apair
(define-struct snd (e)) ;; get second part of an apair
(define-struct aunit ()) ;; unit value -- good for ending a list
(define-struct isaunit (e)) ;; evaluate to 1 if e is aunit else 0
;; a closure is not in "source" programs; it's what functions evaluate to
(define-struct closure (env fun))
;; These just make writing MUPL programs more convenient
(define V make-var)
(define I make-int)
;; lookup a variable in an environment
(define (envlookup env str)
(cond [(null? env) (error "unbound variable during evaluation" str)]
[(equal? (caar env) str) (cdar env)]
[#t (envlookup (cdr env) str)]))
;; The interpreter
(define (eval-prog p)
(letrec
([f (lambda (env p)
(cond [(add? p)
(let ([v1 (f env (add-e1 p))]
[v2 (f env (add-e2 p))])
(if (and (int? v1)
(int? v2))
(make-int (+ (int-num v1)
(int-num v2)))
(error "MUPL addition applied to non-number" )))]
;; 1 Ifgreater. I don't know why it's first but it is.
[(ifgreater? p)
(let ([v1 (f env (ifgreater-e1 p))]
[v2 (f env (ifgreater-e2 p))])
(if (and (int? v1) (int? v2))
(if (> (int-num v1)
(int-num v2))
(f env (ifgreater-e3 p))
(f env (ifgreater-e4 p)))
(error "MUPL IfGreater applied to non-numbers" )))]
;; 2 if it's an int return itself
[(int? p) p]
;; 3 if it's a var look it up in the environment
[(var? p)(f env (envlookup env (var-string p)))]
;; 4 apair just returns itself
[(apair? p) (make-apair (f env (apair-e1 p)) (f env (apair-e2 p)))]
;; 5 fst evaluate the argument and sees if it is an apair, then
;; returns the first one
[(fst? p) (let ([v (f env (fst-e p))])
(if (apair? v) (apair-e1 v)
(error "MUPL fst applied to non apair")))]
;; 6 snd evaluate the argument blah blah same as above but the
;; second one
[(snd? p) (let ([v (f env (snd-e p))])
(if (apair? v) (apair-e2 v)
(error "MUPL snd applied to non apair")))]
;; 7 aunit just returns an aunit
[(aunit? p) p]
;; 8 isaunit retuns 1 if it is an aunit and 0 if it isn't
[(isaunit? p) (let ([v (f env (isaunit-e p))])
(if (aunit? v) (make-int 1) (make-int 0)))]
;; 9 mlet takes a variable name, an expression, and a body
;; and executes the body in an environment in which the
;; expression is bound to the variable name
[(mlet? p) (let ([v1 (f env (mlet-e p))])
(f (cons(cons (mlet-var p) v1) env) (mlet-body p)))]
;; 10 fun a function evaluates to a closure containing
;; the environment and the function
[(fun? p) (make-closure env p)]
;; 11 app
[(app? p) (let* ([clos (f env (app-funexp p))]
[arg (f env (app-actual p))]
[func (closure-fun clos)]
[clos-env (closure-env clos)]
[arg-bind (cons (fun-formal func) arg)]
[final-env (append (cons arg-bind clos-env) env)]
[bod (fun-body func)])
(if (fun-nameopt func)
[f (cons (cons (fun-nameopt func) clos) final-env) bod]
[f final-env bod]))]
[(closure? p) p]
[#t (begin (print p)(error "bad MUPL expression"))]))])
(f '() p)))
(define (ifaunit e1 e2 e3)
(make-ifgreater (make-isaunit e1) (make-int 0) e2 e3))
(define (mlet* lstlst e2)
(if (null? lstlst) e2
(let ([tail (mlet*(cdr lstlst) e2)])
(make-mlet (caar lstlst) (cdar lstlst)
tail))))
(define (ifeq e1 e2 e3 e4)
(mlet*(list (cons "_x" e1) (cons "_y" e2))
(make-ifgreater (make-var "_x") (make-var "_y") e4
(make-ifgreater (make-var "_y") (make-var "_x") e4 e3))))
(define mupl-map
(make-fun #f "func"
(make-fun "inner" "lst"
(ifaunit [make-var "lst"]
[make-aunit]
[mlet* (cons
(cons "hd"
(make-app (make-var "func")(make-fst(make-var "lst"))))
(cons(cons "tl"
(make-app (make-var "inner") (make-snd(make-var "lst"))))'()))
(make-apair (make-var "hd") (make-var "tl"))]))))
(define mupl-mapAddN
(make-mlet "map" mupl-map
(make-fun #f "n" (make-app (make-var "map")
(make-fun #f "item" (make-add (make-var "n")
(make-var "item") ))))))
;; a simple test case and associated code -- no need to change it
;; (though you will likely want more tests of course)
(define (ifeqtest)(= 1 (int-num (eval-prog(ifeq (I 1) (I 1) (I 1) (I 3))))))
(define (curry-test) (if (= 5 (int-num (eval-prog (make-app(make-fun #f "s" (make-app(make-fun #f "t" (make-add (V "s") (V "t")))(I 2))) (I 3)))))
(print "currying works") (error "Currying doesn't work")))
(define (mfl) (eval-prog(make-mlet "map" mupl-map (make-app(make-var "map") (make-fun #f "item" (make-add (make-var "item") (make-int 1)))))))
(define (mapunit) (eval-prog(make-app (mfl) (make-aunit))))
(define (mapone) (eval-prog(make-app (mfl) (make-apair (I 1)(make-aunit)))))
(define (list-to-mupllist lst)
(if (null? lst)
(make-aunit)
(make-apair (car lst) (list-to-mupllist (cdr lst)))))
(define (muplintlist-to-list lst)
(cond [(aunit? lst) '()]
[(apair? lst)
(if (int? (apair-e1 lst))
(cons (int-num (apair-e1 lst)) (muplintlist-to-list (apair-e2 lst)))
(error "muplintlist-to-list"))]
[#t (error "muplintlist-to-list")]))
(define (test-addN)
(eval-prog (make-app (make-app mupl-mapAddN (I 7))
(list-to-mupllist (list (I 3) (I 4) (I 9))))))
@maxfriedrich42
Copy link

Dear jbclements, could you please delete this gist? You are giving away the solutions to graded assignments in the Coursera "Programming Languages" Course (which is currently offered again in self-paced mode). This makes it very easy to cheat and reduces the learning effect for other learners. Many thanks in advance for your collaboration in making the course more effective for everyone!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment