Programming language 解题报告

1. homework1
2. homework2
3. homework3
4. homework4
5. homework5
6. homework6
7. homework7

这里的七个 homework 是华盛顿大学的 programming lamguage 课程很重要的一个组成部分。题目不难，我花了大概两周的时间做完了习题和看完了全部的课程，下面的 homework 是自己做的，大家可以参考一下。

1 homework1

1.1 is_older

fun is_older (date1 : (int * int * int), date2 : (int * int * int)) =
  (*这个函数的要求是判断date1是否比date2更早，其实非常好判断，直接按照年月日判断即可*)
  if (#1 date1) <> (#1 date2) (* 年的值不同 *)
  then (#1 date1) < (#1 date2)
  else if (#2 date1) <> (#2 date2) (* 月的值不同 *)
  then (#2 date1) < (#2 date2)
  else if (#3 date1) <> (#3 date2) (* 天数不同 *)
  then (#3 date1) < (#3 date2)
  else false (* 到这里表示两个日期相同,返回false *)

1.2 number_in_month

fun number_in_month (dl : (int * int * int) list, month : int) =
  (* 参数是一个 list of dates 和一个 month,要返回的结果是在指定的这个月里，这个dates中月份等于该month的一共有多少个 *)
  if null dl
  then 0
  else if (#2 (hd dl)) = month
  then 1 + number_in_month(tl dl, month)
  else number_in_month(tl dl, month)

1.3 number_in_months

fun number_in_months(dl : (int * int * int) list, ml : int list) =
  if null ml
  then []
  else number_in_month(dl, hd ml)::number_in_months(dl, tl ml)

1.4 dates_in_month

fun dates_in_month(dl : (int * int * int) list, m : int) =
  if null dl
  then []
  else if (#2 (hd dl)) = m
  then (hd dl)::dates_in_month(tl dl, m)
  else dates_in_month(tl dl, m)

1.5 dates_in_months

fun dates_in_months(dl : (int * int * int) list, ml : int list) =
  if null ml
  then []
  else [dates_in_month(dl, hd ml)] @ dates_in_months(dl, tl ml)

1.6 get_nth

fun get_nth (sl : string list , nth : int) =
  (* 题目里的说明是不用担心sl太短，这样的话，函数就可以变得很简洁了*)
  if nth = 1
  then hd sl
  else get_nth(tl sl, nth - 1)

1.7 date_to_string

fun date_to_string (date : (int * int * int)) =
  let val ml = ["January", "February", "March",
	  "April", "May", "June", "July",
	  "August", "September", "October",
	  "November", "December"]
  in
     get_nth(ml, (#2 date)) ^ " " ^Int.toString((#3 date)) ^ ", " ^ Int.toString((#1 date))
  end

1.8 number_before_reaching_sum

fun number_before_reaching_sum (sum : int, il : int list) =
  (* 这玩意挺爽的一点是，里面可以做辅助函数 *)
  let
      fun helper (il : int list, sum_of_n_items : int, n_item : int) = (* sum_of_n_items是前面的n项的和，n_item是第n项*)
	if sum_of_n_items >= sum
	then n_item
	else helper(tl il, sum_of_n_items + hd il, n_item + 1)
  in
      helper(il, 0, 0)
  end

1.9 what_month

fun what_month (day : int) =
  (* 这是一个简化版的程序，忽略了闰年 *)
  let
      val day_of_each_month = [31, 28, 31, 30,
			       31, 30, 31, 31,
			       30, 31, 30, 31] (* 每个月的天数 *)
      fun count_days (rest_days : int, day_of_each_month : int list, nth : int) =
	if rest_days <=  hd day_of_each_month
	then nth
	else count_days(rest_days - hd day_of_each_month, tl day_of_each_month, nth + 1)
  in
      count_days(day, day_of_each_month, 1)
  end

1.10 month_range

fun month_range (day1 : int, day2 : int) =
  if day1 > day2
  then []
  else if day1 = day2
  then [what_month(day2)]
  else what_month(day1)::month_range(day1 + 1, day2)

1.11 oldest

fun oldest (dl : (int * int * int) list) =
  if null dl
  then NONE
  else let
      fun oldest_date(dl : (int * int * int) list) =
	if null (tl dl)
	then hd dl
	else let val dl_ans = oldest_date(tl dl)
	     in
		 if is_older(dl_ans, hd dl)
		 then hd dl
		 else dl_ans
	     end
  in
      SOME(oldest_date(dl))
  end

1.12 number_in_months_challenge

fun number_in_months_challenge (dl : (int * int * int) list, ml : int list) =
  (* 我们要做的是，去除重复的月份即可,使用local function *)
  let
      fun reverse_list(il : int list) =
      (* 这个函数用于反转list *)
	let
	    fun iter (remained_list : int list, result : int list) =
	      if null remained_list
	      then result
	      else iter(tl remained_list, hd remained_list :: result)
	in
	    iter(il, [])
	end

      fun filter_dup (il : int list, result : int list) =
	(* 关键的问题在于如何去除重复 *)
	if null il
	then result
	else if
	    let
		fun in_the_list (n : int , il : int list) = (* 这个函数主要用来判断n是否在il这个int list之中*)
		  if null il
		  then false
		  else if n = hd il
		  then true
		  else in_the_list(n, tl il) (* 这个函数的定义倒是没有什么错误 *)
	    in
		in_the_list(hd il, result) (* 判断 hd il 是否在result之中*)
	    end
	then filter_dup(tl il, result) (* 在result之中，则继续迭代*)
	else filter_dup(tl il, hd il::result) (* 不在result之中，则加入result*)
  in
      number_in_months(dl, reverse_list(filter_dup(ml, [])))
  end

1.13 reasonable_date

(* 最后一个函数了 *)
fun reasonable_date (date : (int * int * int)) =
  if (#1 date) <= 0
  then false
  else if (# 2 date) > 12 orelse (#2 date) < 1
  then false
  else
      let
	  fun is_leap_year(year : int) =
	    (* 判断某年是否为闰年 *)
	    if year mod 400 = 0 orelse (year mod 4 = 0 andalso year mod 100 <> 0)
	    then true
	    else false

	  fun get_nth(il : int list, n : int) = (* 取list表单的第n项 *)
	     if n = 1
	     then hd il
	     else get_nth(tl il, n - 1)

	  val day_of_each_month_in_leap_year = [31, 29, 31, 30,
						31, 30, 31, 31,
						30, 31, 30, 31]

	  val day_of_each_month_in_ord_year = [31, 28, 31, 30,
						31, 30, 31, 31,
						30, 31, 30, 31]
      in
	  let
	      fun is_day_right(d : int, m : int, day_of_each_month : int list) =
		if d > 0 andalso d <= get_nth(day_of_each_month, m)
		then true
		else false
	  in
	      if is_leap_year((#1 date))
	      then is_day_right((#3 date), (#2 date), day_of_each_month_in_leap_year) (* 如果是闰年 *)
	      else is_day_right((#3 date), (#2 date), day_of_each_month_in_ord_year) (* 如果不是闰年 *)
	  end

      end

2 homework2

2.1 all_except_iotion

fun same_string(s1 : string, s2 : string) =
    s1 = s2

(* 不允许使用函数null, hd, tl, isSome, valOf, or # *)
fun all_except_option (str, strl) =
  (* 我来分析一下匹配的结果，首先，如果strl为空，自然返回NONE
     然后，如果strl的首元素和str匹配，返回SOME，否则的话，继续递归 *)
  (* 这里有一个假设，那就是str至多在strl中出现一次 *)
  case strl of
      [] => NONE
    | x::xs' => if same_string(str, x)
		then SOME(xs') (* 去除了str后形成的新的SOME *)
		else
		    let val re = all_except_option(str, xs')
		    in
			case re of
			    NONE => NONE
			 | SOME px => SOME(x::px)
		    end

2.2 get_substitutions1

fun get_substitutions1 (sll, s) =
(* 这个函数显然要用到前面定义的辅助函数 *)
  case sll of
      [] => []
    | x::xs' => let val re = all_except_option(s, x)
		in case re of
		       NONE => get_substitutions1(xs', s)
		     | SOME v => v @ get_substitutions1(xs', s)
		end

2.3 get_substitutions2

fun get_substitutions2 (sll, s) =
(* 尾递归版本的替换 *)
  let fun sub(sll, acc) =
	case sll of
	    [] => acc
	  | x::xs' => let val re = all_except_option(s, x) (* 得到这个list的结果 *)
		      in case re of
			     NONE => sub(xs', acc) (* 继续往后面递归 *)
			   | SOME v => sub(xs', v @ acc) (* 累积一下，继续递归 *)
		      end
  in
      sub(sll, [])
  end

2.4 similar_names

fun similar_names (sll, full_name) =
(* 其实也是很简单的一道题目 *)
  let
      val {first = x, middle = y, last = z} = full_name
      val ans = [full_name] (* 事先将full_name装入 *)
  in
      let
	  val temp =  get_substitutions2(sll, x) (* 这样可以得到一个替换的结果,用first name x 去替换 *)
	  fun sub (sl, ans) =
	    case sl of
		[] => ans
	      | h::t  =>  sub(t, {first = h, middle = y, last = z} :: ans)

      in
	  sub(temp, ans) (* 替换 *)
      end
  end

2.5 card_color

datatype suit = Clubs | Diamonds | Hearts | Spades
datatype rank = Jack | Queen | King | Ace | Num of int 
type card = suit * rank

datatype color = Red | Black
datatype move = Discard of card | Draw 

exception IllegalMove

(* put your solutions for problem 2 here *)
fun card_color (c) =
  case c of
      (s, k) => k

2.6 card_value

fun card_value (c, k) =
  case k of
      Ace => 11
    | Num i => i
    | _ => 10

2.7 remove_card

fun remove_card (cs, c, exn) =
  case cs of
      ac :: rc => if ac = c
		  then rc
		  else ac :: remove_card(rc, c, exn)
    | [] => raise exn

2.8 all_same_color

fun all_same_color (cs) =
  case cs of
      (c1, v1) :: (c2, v2) :: rc => if c1 = c2
				    then all_same_color((c2, v2) :: rc)
				    else false
    | _  => true

2.9 sum_cards

fun sum_cards (cs) =
  (* 需要使用到尾递归 *)
  let
      fun helper_sum_cards(cards, acc) =
	case cards of
	    c :: rc => helper_sum_cards(rc, card_value(c) + acc)
	  | [] =>  acc
  in
      helper_sum_cards(cs, 0)
  end

2.10 score

fun score (cs, goal) =
  (* 计算成绩 *)
  let val sum = sum_cards(cs)
  in
      let
	  val  reliminary_score =      
	      if sum > goal
	      then 3 * (sum - goal)
	      else goal - sum
      in
	  if all_same_color(cs) (* 如果牌是相同的颜色，那么成绩就是preliminary score除2 *)
	  then reliminary_score
	  else reliminary_score div 2
      end
  end

2.11 officiate

fun officiate (card_list, move_list, goal) =
  let
      fun helper_officiate (card_list, herd_list, move_list, goal) =
	(* card_list是牌的列表，herd_list是现在手里有的牌的列表，而move_list表示每一步应该怎样走 *)
	case move_list of
	    [] => score(herd_list, goal) (* 移动列表中已经没有东西了，立即返回score *)
	  | Draw :: rest_moves => (* 这里的要求是，抓取一张牌 *) 
	    (case card_list of 
		 card :: rest_cards =>
		 let
		     val new_herd_list = card :: herd_list
		 in
		     if sum_cards(new_herd_list) > goal (* 抓牌后是的新的herd_list的分数sum超过了goal *)
		     then score(new_herd_list, goal)
		     else  helper_officiate(rest_cards, card :: herd_list, rest_moves, goal) 
		 end
	       | [] => score(herd_list, goal) (* 已经没有牌了，游戏结束，所以返回score *)
	    )
	 |  Discard card :: rest_moves =>  helper_officiate(card_list, remove_card(herd_list, card, IllegalMove), rest_moves, goal)
  in
      helper_officiate(card_list, [], move_list, goal)
  end

3 homework3

这次的东西确实有一点难度!

(* Dan Grossman, CSE341 Spring 2013, HW3 Provided Code *)
exception NoAnswer

datatype pattern = Wildcard
		 | Variable of string
		 | UnitP
		 | ConstP of int
		 | TupleP of pattern list
		 | ConstructorP of string * pattern

datatype valu = Const of int
	      | Unit
	      | Tuple of valu list
	      | Constructor of string * valu

fun g f1 f2 p =
    let 
	val r = g f1 f2 (* partial function *)
    in
	case p of (* p的类型是pattern *)
	    Wildcard          => f1 ()
	  | Variable x        => f2 x
	  | TupleP ps         => List.foldl (fn (p,i) => (r p) + i) 0 ps (* ps是一个list，r是一个函数，使用一个参数，返回int *)
	  | ConstructorP(_,p) => r p (* 只是要干什么呀 *)
	  | _                 => 0
    end

(* 题目要求是使用g来count_wildcards *)

3.1 count_wildcards

fun count_wildcards p =
  case p of
      ConstructorP (_, np) => count_wildcards np (* np也是一个pattern *)
    | Wildcard => 1
    | TupleP plist => (case plist of
			   x::(y::xs') => count_wildcards x + count_wildcards (TupleP (y::xs'))
			 | x::[] => count_wildcards x)
    | _ => 0
(*
    | ConstP _ => 0
    | UnitP => 0
    | Variable _ => 0 
*)

3.2 count_wildcards_e

fun count_wildcards_e p =
  g (fn x => 1) (fn x => 0) p

3.3 count_wild_and_variable_lengths

fun count_wild_and_variable_lengths p =
  g (fn x => 1) (fn x => String.size x) p

3.4 count_some_var

fun count_some_var s p =
  g (fn x => 0) (fn x => if x = s then 1 else 0) p

3.5 check_pat

fun check_pat p =
  let
      fun collect_string p =
	case p of
	    Variable s => [s]
	  | TupleP ps  => List.foldl (fn (p, i) => i @ (collect_string p)) [] ps
	  | _ => []
      fun is_dup sl =
	case sl of
	    [] => false
	  | x::xs' => (List.exists (fn s => if x = s then true else false) xs') orelse is_dup xs' 
  in
     is_dup((collect_string p))
  end

3.6 only_capitals

fun only_capitals (sl) =
  List.filter (fn x => Char.isUpper (String.sub(x, 0)))  sl

3.7 longest_string1

(* foldl函数从左边干到右边，foldr函数从右边干到左边 *)
fun longest_string1 sl =
  foldl (fn (x, y) => if String.size x  > String.size y then x else y) "" sl

3.8 longest_string2

fun longest_string2 sl =
  foldl (fn (x, y) => if String.size x >= String.size y then x  else y) "" sl

3.9 longest_string3

val longest_string3 = foldl (fn (x, y) => if String.size x  > String.size y then x else y) ""

3.10 longest_string4

val longest_string4 = foldl (fn (x, y) => if String.size x >= String.size y then x else y) ""

3.11 longest_string_helper

fun longest_string_helper f sl = f sl

3.12 longest_capitalized

val longest_capitalized = (longest_string1 o only_capitals)

3.13 rev_string

val rev_string  = implode o rev o explode

3.14 first_answer

fun first_answer f l =
  (* f作用在list之上，然后直到list返回一个SOME v*)
  case l of
      [] => raise NoAnswer
    | h::t => case f(h) of
		  SOME v => v
		| _ => first_answer f t

3.15 all_answers

(* list option和option list很值得注意 *)
(* ('a -> 'b list option) -> 'a list -> 'b list option *)
fun all_answers f l =
  (* 函数存在一些问题啊!l中的某个元素被f作用之后产生NONE，整个结果就是NONE，感觉不是很好递归的样子 *)
  case l of
      [] => SOME [] (*返回一个list option *)
    | h::t => case f(h) of
		  NONE => NONE
		| SOME r =>
		  let
		     val re = (all_answers f t) (* 需要说明一下，re是一个list option,也就是说，如果re为SOME v，那么v是一个list*)
		  in
		      case re of
			  NONE => NONE
			| SOME v => SOME(r @ v) 
		  end

3.16 match

fun match v_p =
   case v_p of
       (_ ,Wildcard) => SOME [] (* Wildcard 匹配一切 *)
     | (v, Variable s) => SOME [(s, v)] (*Variable s匹配任何的valu v*)
     | (Unit, UnitP) => SOME []
     | (Const v1, ConstP v2) => if v1 = v2 then SOME [] else NONE
     | ((Constructor (vs, vv)), (ConstructorP (ps, pp))) => if vs <> ps then NONE else match (vv, pp)
     | (Tuple v, TupleP p) => (all_answers match (ListPair.zip (v, p))) 
     | _ => NONE  (* 其余的都不匹配 *)

3.17 first_match

fun first_match v pl =
  SOME(first_answer (fn x => match (v, x)) pl) handle NoAnswer => NONE

4 homework4

#lang racket

(provide (all-defined-out)) ;; so we can put tests in a second file

;; put your code below

(define (sequence low high stride)
  (if (> low high)
      null
      (cons low (sequence (+ low stride) high stride))))

(define (string-append-map xs suffix)
  (map (lambda (x) (string-append x suffix)) xs))

(define (list-nth-mod xs n)
  (let ([i (remainder n (length xs))])
    (cond [(< n 0) (error "list-nth-mod: negative number")]
	  [(null? xs) (error "list-nth-mod: empty list")]
	  [else (begin (car (list-tail xs i)))])))

(define ones (lambda () (cons 1 ones)))
(define nat (letrec ([f (lambda (x) (cons x (lambda () (f (+ x 1)))))])
	      (lambda () (f 1))))

(define (stream-for-n-steps s n)
  (if (= n 0)
      null
      (cons (car (s)) (stream-for-n-steps (cdr (s))(- n 1)))))

(define funny-number-stream (letrec ([f (lambda (x)
					  (if (= (remainder x 5) 0)
					      (cons (- 0 x)
						    (lambda () (f (+ x 1))))
					      (cons x
						    (lambda () (f (+ x 1))))))])
			      (lambda () (f 1))))

(define dan-then-dog (letrec ([f (lambda (x)
				 (if (= (remainder x 2) 0)
				     (cons "dan.jpg"
					   (lambda () (f (+ x 1))))
				     (cons "dog.jpg"
					   (lambda () (f (+ x 1))))))])
		       (lambda () (f 0))))
(define (stream-add-zero s)
      (lambda () (cons (cons 0 (car (s))) (stream-add-zero (cdr (s))))))

;; 有了前面的玩意，后面就变得非常简单了
(define (cycle-lists xs ys)
  (letrec ([xl (length xs)] ;得到两个序列的长度
	   [yl (length ys)]
	   [f (lambda (ax ay) ;; 我们至少需要两个累积量，非常有趣的东西
		(cons (cons (list-nth-mod xs ax) (list-nth-mod ys ay))
		      (lambda () (f (remainder (+ 1 ax) xl) (remainder (+ 1 ay) yl)))))])
    (lambda () (f 0 0))))

(define (vector-assoc v vev)
  (letrec ([len (vector-length vev)]
	   [f (lambda (a)
		(if (= (- 1 len) a)
		    #f
		    (letrec ([vv (vector-ref vev a)])
		      (if (and (pair? vv) (equal? (car vv) v))
			      vv
			      (f (+ a 1))))))])
    (f 0)))


(define (cached-assoc xs n)
  (letrec
      ([cached-vector (make-vector n #f)]
       [index 0]
       [f (lambda (av ac) ;; 寻找某一个value,在vector之中
	    (cond
	      [(= ac n) #f]
	      [(letrec ([element-in-vector (vector-ref cached-vector ac)])
		 (and (pair? element-in-vector) (= (car element-in-vector) av) element-in-vector))]
	      [else (f av (+ ac 1))]))])
  (lambda (v)
    (letrec ([value-in-vector (f v 0)])
      (cond [(not value-in-vector)
	     (letrec ([value-in-list (assoc v xs)])
	       (begin (vector-set! cached-vector index value-in-list)
	       (set! index (remainder (+ 1 index) n)) value-in-list))] ;; 没有在vector中找到这个值
	    [else value-in-vector])))))
;; 定义一个宏 macro
(define-syntax  while-less
  (syntax-rules (do)
		[(while-less e1 do e2)
		 (letrec ([v1 e1]
		       [loop (lambda ()
				 (if (> e2 (- v1 1))
				     #t
				     (loop)))])
		   (loop))]))

5 homework5

;; 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; it is what functions evaluate to
(struct closure (env fun) #:transparent) 

;; Problem 1

;; CHANGE (put your solutions here)
;; 这种题目果然只是用来热身的呀！
(define (racketlist->mupllist rl)
  (if (null? rl) (aunit)
      (apair (car rl) (racketlist->mupllist (cdr rl)))))

(define (mupllist->racketlist ml)
  (if (aunit? ml) null
      (cons (apair-e1 ml) (mupllist->racketlist (apair-e2 ml)))))
;; Problem 2

;; Implementing the MUPL Language

;; lookup a variable in an environment
;; Do NOT change this function
(define (envlookup env str) ;; 在环境env中寻找某个变量
  (cond [(null? env) (error "unbound variable during evaluation" str)]
	[(equal? (car (car env)) str) (cdr (car env))] ;; 如果值相同，就返回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) ;; 如果e是变量
	 (envlookup env (var-string e))] ;; 在env中寻找对应的值
	[(add? e) ;; 如果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)))
	       (begin (print v1) (print v2)(
	       (error "MUPL addition applied to non-number")))))]
	;; CHANGE add more cases here
	[(fst? e) ;; 这里的要求是e的计算结果是apair
	 (let ([v (eval-under-env (fst-e e) env)])
	   (if (apair? v)
	       (apair-e1 v)
	       (error "e is not apair")))]
	[(snd? e) ;; 计算snd
	 (let ([v (eval-under-env (snd-e e) env)])
	   (if (apair? v)
	       (apair-e2 v)
	       (error "e is not apair")))]
	[(ifgreater? e) ;; 现在要解释ifgreater表达式了
	 (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 "ifgreater expression needs two number")))]

	[(int? e) ;; 现在要处理整数
	 (let ([v (int-num e)])
	   (if (number? v)
	       e
	       (error "int expression encounter a thing that is not a number!")))]

	[(apair? e) ;; 处理apair表达式
	 (let ([v1 (eval-under-env (apair-e1 e) env)]
	       [v2 (eval-under-env (apair-e2 e) env)])
	   (apair v1 v2))]

	[(fun? e) ;; 现在处理函数，要求可以实现递归哦，是在是太他妈神奇了!
	 (let ([fun-name (fun-nameopt e)])
	   (if fun-name
	       (closure (append (list (cons fun-name e)) env) e)
	       (closure env e)))]

	[(mlet? e) ;; 处理mlet表达式
	 (letrec ([s (mlet-var e)] ;; 获得变量名
		  [v (eval-under-env (mlet-e e) env)]) ;; 获得值
	   (eval-under-env (mlet-body e) (append (list (cons s v)) env)))]

	[(call? e) ;; 这个东西是最重要的啦，我要实现闭包啦。
	 (letrec ([v1 (eval-under-env (call-funexp e) env)]
		  [v2 (eval-under-env (call-actual e) env)])
	   (if (closure? v1) ;; 要求v1是一个闭包
	       (letrec ([fn (closure-fun v1)] ;; 函数本体
			[fe (closure-env v1)]) ;; 原来的环境
		 (eval-under-env (fun-body fn)
				 (append (list (cons (fun-formal fn) v2))
					 fe)))
	       (if (fun? v1)
		   (eval-under-env (call v1 v2) env)
		   (error "She is not a closure!"))))]
	[(isaunit? e) ;; 现在开始处理isaunit表达式
	 (if (aunit? (eval-under-env (isaunit-e e) env)) (int 1) (int 0))]
	[(aunit? e) e]

	[#t (error (format "bad MUPL expression: ~v" e))]))

;; Do NOT change
(define (eval-exp e)
  (eval-under-env e null))

;(define 1fun (fun "x" "y" (mlet "z" (int 3) (add (var "y") (var "z")))))
;(define 2fun (fun "x" "y" (add (var "y") (int 1))))
;(define 3fun (fun "x" "y" (ifgreater (var "y") (int 5) (int 0) (add (var "y") (call (var "x") (add (var "y") (int 1)))))))
;(eval-exp (call 3fun (int 2)))

;; Problem 3

(define (ifaunit e1 e2 e3)
  (ifgreater (isaunit e1) (int 0) e2 e3)) ;; 这玩意才是正确的解决办法

(define (mlet* lstlst e2) ;; 递归形式的宏展开
  (if (null? lstlst)
      e2
      (let ([s (car (car lstlst))]
	    [v (cdr (car lstlst))])
	(mlet s v (mlet* (cdr lstlst) e2)))))

;(define (ifeq e1 e2 e3 e4)
;  )
(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 ;; 函数的名称是map，然后f是一个MUPL list
  (fun "map" "fn"
       (fun "mupl-map" "mlist"
	    (ifaunit (var "mlist")
		     (aunit)
		     (apair (call (var "fn")
				   (fst (var "mlist"))) 
			    (call (var "mupl-map") (snd (var "mlist"))))))))

(define mupl-mapAddN 
  (mlet "map" mupl-map
	(fun "mupl-mapAddN" "x" (call (var "map")
				      (fun #f "y" (add (var "x") (var "y")))))))

;; 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 grading
;; 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))

6 homework6

这玩意比较麻烦！

# University of Washington, Programming Languages, Homework 6, hw6runner.rb

# This is the only file you turn in, so do not modify the other files as
# part of your solution.

class MyPiece < Piece
  # The constant All_My_Pieces should be declared here
  # class array holding all the pieces and their rotations
  # array，其中包含了所有的pieces和他们的旋转方式
  All_My_Pieces = Piece::All_Pieces.concat(
  [
    rotations([[0, 0], [1, 0], [0, 1], [1, 1], [-1, 0]]),
   [[[-1, 0], [-2, 0], [0, 0], [1, 0], [2, 0]],
     [[0, -1], [0, -2], [0, 0], [0, 1], [0, 2]]],
     rotations([[0, 0], [0, 1], [1, 0]])
  ])
  Cheat_Piece = [[[0, 0]]]

  # your enhancements here
  def self.next_piece (board) # 这个貌似是静态方法
	# puts "大家好，天气真晴朗啊！"
    Piece.new(All_My_Pieces.sample, board) # 随机挑选一个图形来做
  end

  def self.cheat_piece(board)
    MyPiece.new(Cheat_piece, board)
    # 开启欺骗模式
  end
end

class MyBoard < Board
  # your enhancements here
  def initialize (game) # 初始化游戏，是吧！
   super # 所谓的super，就是将父类的代码放在前面，这个东西和C++里面有所不同啊！
   @current_block = MyPiece.next_piece(self) # piece 就是所谓的块结构
    @cheat_cost = 100
    @cheat_queued = false
  end

  # gets the next piece
  def next_piece # 我现在才发现，原来board也有next_piece方法，非常棒的东西啊！
    @current_block = MyPiece.next_piece(self) # 下一个块，是吧！
    @current_pos = nil
    if @cheat_queued
      @current_block = MyPiece.cheat_piece(self)
      @cheat_queued = false
    end
  end

  def store_current
	locations = @current_block.current_rotation
	displacement = @current_block.position
	(0..(locations.size-1)).each{
		|index| 
		current = locations[index];
		@grid[current[1]+displacement[1]][current[0]+displacement[0]] = 
		@current_pos[index]
	}
	remove_filled
	@delay = [@delay - 2, 80].max
  end

  def rotate_180_degree
    if !game_over? and @game.is_running?
      @current_block.move(0, 0, 2) # 旋转180°
    end
    draw # draw 这玩意，你理解为重绘吧！
  end

  def new_game
    super
    @cheat_queued = false
  end

  def cheat
    return if @cheat_queued || @score < @cheat_cost
    @cheat_queued = true
    @score -= @cheat_cost
  end
end

class MyTetris < Tetris

  def set_board
    @canvas = TetrisCanvas.new
    @board = MyBoard.new(self)
    @canvas.place(@board.block_size * @board.num_rows + 3,
		  @board.block_size * @board.num_columns + 6, 24, 80)
    @board.draw
  end

  def key_bindings  # 这里终于看到键盘的绑定了！
   super
   @root.bind('u', proc{@board.rotate_180_degree})
    @root.bind('c', proc{@board.cheat})
  end
end

7 homework7

首先是 hw7.sml 文件。

(* CSE341 Spring 2013, Homework 7, hw7.sml (see also Ruby code) *)

(* Do not make changes to this code except where you see comments containing
   the word CHANGE. *)

(* expressions in a little language for 2D geometry objects
   values: points, lines, vertical lines, line segments
   other expressions: intersection of two expressions, lets, variables, 
		      (shifts added by you)
*)
datatype geom_exp =  (* 几何表达式 *)
	   NoPoints
	 | Point of real * real (* represents point (x,y) *)
	 | Line of real * real (* represents line (slope, intercept) *)
	 | VerticalLine of real (* x value *)
	 | LineSegment of real * real * real * real (* x1,y1 to x2,y2 *)
	 | Intersect of geom_exp * geom_exp (* intersection expression *)
	 | Let of string * geom_exp * geom_exp (* let s = e1 in e2 *)
	 | Var of string
(* CHANGE add shifts for expressions of the form Shift(deltaX, deltaY, exp *)
	 | Shift of real * real * geom_exp

exception BadProgram of string
exception Impossible of string

(* helper functions for comparing real numbers since rounding means
   we should never compare for equality *)

val epsilon = 0.00001

fun real_close (r1,r2) = (* 这里用来判断两个浮点数是否相等，这里的判断方法是看接近的程度 *)
    (Real.abs (r1 - r2)) < epsilon

(* notice curried *)
fun real_close_point (x1,y1) (x2,y2) = 
    real_close(x1,x2) andalso real_close(y1,y2)

(* helper function to return the Line or VerticalLine containing 
   points (x1,y1) and (x2,y2). Actually used only when intersecting 
   line segments, but might be generally useful *)
fun two_points_to_line (x1,y1,x2,y2) = 
    if real_close(x1,x2)
    then VerticalLine x1 (* 如果两个x的值太接近了，将会形成一个垂直的线段 *)
    else
	let 
	    val m = (y2 - y1) / (x2 - x1) (* 计算斜率 *)
	    val b = y1 - m * x1
	in
	    Line(m,b) (* 形成一条直线 *)
	end

(* helper function for interpreter: return value that is the intersection
   of the arguments: 25 cases because there are 5 kinds of values, but
   many cases can be combined, especially because intersection is commutative.
   Do *not* call this function with non-values (e.g., shifts or lets)
 *)
fun intersect (v1,v2) =
    case (v1,v2) of

       (NoPoints, _) => NoPoints (* 5 cases *)
     | (_, NoPoints) => NoPoints (* 4 additional cases *)

     |  (Point p1, Point p2) => if real_close_point p1 p2
				then v1 (* 两个点过度接近，那么就形成一个点 *)
				else NoPoints

      | (Point (x,y), Line (m,b)) => if real_close(y, m * x + b)
				     then v1 (* 只有一种情况呗，那就是点在线上 *)
				     else NoPoints

      | (Point (x1,_), VerticalLine x2) => if real_close(x1,x2)
					   then v1
					   else NoPoints

      | (Point _, LineSegment seg) => intersect(v2,v1) (* 点和线段的情况,转换为线段和点的情况 *)

      | (Line _, Point _) => intersect(v2,v1) (* 线和点的情况，转换为点和线的情况 *)

      | (Line (m1,b1), Line (m2,b2)) => (* 两条线的情况 *)
	if real_close(m1,m2)  (* 斜率是否相同呢 *)
	then (if real_close(b1,b2) (* b值是否相同呢 *)
	      then v1 (* same line *)
	      else  NoPoints) (* parallel lines do not intersect *)
	else  (* 斜率不同，因此必定有交点 *)
	    let (* one-point intersection *)
		val x = (b2 - b1) / (m1 - m2)
		val y = m1 * x + b1
	    in
		Point (x,y)
	    end

      | (Line (m1,b1), VerticalLine x2) => Point(x2, m1 * x2 + b1) (* 线和垂直线的情况 *)

      | (Line _, LineSegment _) => intersect(v2,v1) (* 线和线段的情况,转换为线段和线的情况 *)

      | (VerticalLine _, Point _) => intersect(v2,v1)
      | (VerticalLine _, Line _)  => intersect(v2,v1)

      | (VerticalLine x1, VerticalLine x2) =>
	if real_close(x1,x2)
	then v1 (* same line *)
	else NoPoints (* parallel *)

      | (VerticalLine _, LineSegment seg) => intersect(v2,v1)

      | (LineSegment seg, _) => (* 线段和其他的东西的组合 *)
	(* the hard case, actually 4 cases because v2 could be a point,
	   line, vertical line, or line segment *)
	(* First compute the intersection of (1) the line containing the segment 
	   and (2) v2. Then use that result to compute what we need. *)

	(* two_points_to_line表示的是由两个点构成的一条线 *)
	(* 在这里，我有一个疑问，那就是如果v2是线段，调用intersect就变成了线和线段的情况，而该情况会转换一下，继续调用intersect,变成了线段和线的情况
也就是说，这里变成了死循环! *)
	(* 然而事实证明，这并不会形成死循环
我们以例子 
val a = LineSegment (0.0, 0.0, 1.0, 1.0);
val b = LineSegment (0.0, 1.0, 1.0, 0.0);
val c = intersect(a, b);
来分析一下
调用
 intersect(two_points_to_line a, b);
令 val d = two_points_to_line (0.0, 0.0, 1.0, 1.0);
此时 d = Line (1.0, 0.0)
现在求 intersect(d, b);的值
现在变成了线和线段的情况
即现在调用 intersect(b, d)
好吧，到了这里，我的疑问也就解决了，因为线段b继续调用下去的话，会变成求线和线的交点，而这个问题已经解决了，所以能够得到正确的结果！
 *)
	(case intersect(two_points_to_line seg, v2) of (* 转变成为了线和v2的关系 *)
	    NoPoints => NoPoints
	  | Point(x0,y0) => (* 判断这个点是否在线段的范围之内 *)
	    (* assumes v1 was properly preprocessed *)
	    let 
		fun inbetween(v,end1,end2) = (* inbetween是一个函数 *)
		    (end1 - epsilon <= v andalso v <= end2 + epsilon) (* epsilon是间距的最小值 *)
		    orelse (end2 - epsilon <= v andalso v <= end1 + epsilon)
		val (x1,y1,x2,y2) = seg (* seg是一个线段 *)
	    in
		if inbetween(x0,x1,x2) andalso inbetween(y0,y1,y2) (* 这玩意无非就是要判断，x0在x1和x2之中，y0在y1和y2之中 *)
		then Point(x0,y0) (* 返回这个点的值 *)
		else NoPoints
	    end
	  | Line _ => v1 (* so segment seg is on line v2 *)
	  | VerticalLine _ => v1 (* so segment seg is on vertical-line v2 *)
	  | LineSegment seg2 => (* 这是个嘛玩意，线和v2的交点是一条线段，也就是v2也是一条线段，很有意思，这里无非是取交集罢了 *)
	    (* the hard case in the hard case: seg and seg2 are on the same
	       line (or vertical line), but they could be (1) disjoint or 
	       (2) overlapping or (3) one inside the other or (4) just touching.
	       And we treat vertical segments differently, so there are 4*2 cases.
	     *)
	    let
		val (x1start,y1start,x1end,y1end) = seg (* 两条线段 *)
		val (x2start,y2start,x2end,y2end) = seg2
	    in
		if real_close(x1start,x1end) (* 两个x相聚太近了 *)
		then (* 线段成为了垂线 *)
		    (* let segment a start at or below start of segment b *)
		    let 
			val ((aXstart,aYstart,aXend,aYend),
			     (bXstart,bYstart,bXend,bYend)) = if y1start < y2start (*  *)
							      then (seg,seg2)
							      else (seg2,seg)
		    in
			if real_close(aYend,bYstart) (* 两个点相距很近啊 *)
			then Point (aXend,aYend) (* 构成了一个点*)
			else if aYend < bYstart 
			then NoPoints (* 两个线段相离 *)
			else if aYend > bYend
			then LineSegment(bXstart,bYstart,bXend,bYend) (* b inside a *)
			else LineSegment(bXstart,bYstart,aXend,aYend) (* overlapping *)
		    end
		else (* the segments are on a (non-vertical) line *) (* 线段不是垂直的线 *)
		    (* let segment a start at or to the left of start of segment b *)
		    let 
			val ((aXstart,aYstart,aXend,aYend),
			     (bXstart,bYstart,bXend,bYend)) = if x1start < x2start
							      then (seg,seg2)
							      else (seg2,seg)
		    in
			if real_close(aXend,bXstart) (* 判断a线段的终点的x坐标和b线段的起点的x坐标的关系 *)
			then Point (aXend,aYend) (* just touching *)
			else if aXend < bXstart 
			then NoPoints (* disjoint *)
			else if aXend > bXend
			then LineSegment(bXstart,bYstart,bXend,bYend) (* b inside a *)
			else LineSegment(bXstart,bYstart,aXend,aYend) (* overlapping *)
		    end 
	    end                                         
	  | _ => raise Impossible "bad result from intersecting with a line")
      | _ => raise Impossible "bad call to intersect: only for shape values"

(* interpreter for our language: 
   * takes a geometry expression and returns a geometry value
   * for simplicity we have the top-level function take an environment,
     (which should be [] for the whole program
   * we assume the expression e has already been "preprocessed" as described
     in the homework assignment: 
	 * line segments are not actually points (endpoints not real close)
	 * lines segment have left (or, if vertical, bottom) coordinate first
*)

(* 下面的是解释器的部分 *)
fun eval_prog (e,env) =
    case e of
	NoPoints => e (* first 5 cases are all values, so no computation *)
      | Point _  => e
      | Line _   => e
      | VerticalLine _ => e
      | LineSegment _  => e
      | Var s => (* 如果进来的是一个变量，则寻找该变量，否则抛出异常 *)
	(case List.find (fn (s2,v) => s=s2) env of
	     NONE => raise BadProgram("var not found: " ^ s)
	   | SOME (_,v) => v)
      | Let(s,e1,e2) => eval_prog (e2, ((s, eval_prog(e1,env)) :: env))
      | Intersect(e1,e2) => intersect(eval_prog(e1,env), eval_prog(e2, env)) (* 这里是计算两个东西的交点 *)
(* CHANGE: Add a case for Shift expressions *)
      | Shift (dx, dy, e1) =>
	(case eval_prog(e1, env) of
	     NoPoints => NoPoints
	   | Point (x, y) => Point (x + dx, y + dy)
	   | Line (m, b) => Line (m, b + dy - m * dx)
	   | VerticalLine x => VerticalLine (x + dx)
	   | LineSegment (x1, y1, x2, y2) => LineSegment (x1 + dx, y1 + dy, x2 + dx, y2 + dy)) 
(* CHANGE: Add function preprocess_prog of type geom_exp -> geom_exp *)
(* 非常有意思的东西 *)
fun preprocess_prog geom_exp =
  case geom_exp of
      LineSegment (x1, y1, x2, y2) => (if real_close(x1, x2) andalso real_close(y1, y2)
				       then Point (x1, y1)
				       else geom_exp)
    (* | Line (m, b) =>  (if m = 0.0
		       then VerticalLine b
		       else geom_exp)
     *)
    | _ => geom_exp

最后是一个 hw7.rb 文件！

class GeometryExpression
  # do *not* change this class definition
  Epsilon = 0.00001
end
yy
class GeometryValue 
  # do *not* change methods in this class definition
  # you can add methods if you wish

  private
  # some helper methods that may be generally useful
  def real_close(r1,r2) 
      (r1 - r2).abs < GeometryExpression::Epsilon # 非常爽，是吧！
  end
  def real_close_point(x1,y1,x2,y2)  # 主要判断这两个坐标是不是非常靠近
      real_close(x1,x2) && real_close(y1,y2)
  end
  # two_points_to_line could return a Line or a VerticalLine
  def two_points_to_line(x1,y1,x2,y2) # 两个点构成线
      if real_close(x1,x2)
	VerticalLine.new x1
      else
	m = (y2 - y1).to_f / (x2 - x1)
	b = y1 - m * x1
	Line.new(m,b)
      end
  end

  public
  # we put this in this class so all subclasses can inherit it:
  # the intersection of self with a NoPoints is a NoPoints object
  def intersectNoPoints np # 求和Nopoint的交点
    np # could also have NoPoints.new here instead
  end

  # we put this in this class so all subclasses can inhert it:
  # the intersection of self with a LineSegment is computed by
  # first intersecting with the line containing the segment and then
  # calling the result's intersectWithSegmentAsLineResult with the segment

  def intersectLineSegment seg # 其实思路和SML文件中展现的是一样的，主要的思想是转化
    # 我们主要要求的是LineSegment和其他的东西的交点,根据转化的思想：
    # 线段和其他东西相交的结果，可以转化为线和其他东西相交的结果
    # 两者是等价的，正如你在SML文件中所看到的
    # 首先将线段转化为线，然后求这个线和别的东西的相交结果
    line_result = intersect(two_points_to_line(seg.x1,seg.y1,seg.x2,seg.y2))
    # 仔细看上面的函数，其实可以转换为self.intersect(two_points_to_line(seg.x1,seg.y1,seg.x2,seg.y2))
    # 这里的self就相当于sml文件里面的v2
    # 去掉一层包裹之后，我们取a = two_points_to_line(seg.x1,seg.y1,seg.x2,seg.y2),然后会继续调用
    # a类中相应的函数来处理a类和self的关系(都会有结果),会得到相对应的结果line_result
    line_result.intersectWithSegmentAsLineResult seg
    # 然后调用line_result.intersectWithSegmentAsLineResult函数，这里值得注意的是，并没有调用intersect函数
    # 非常有意思
  end
end

class NoPoints < GeometryValue
  # do *not* change this class definition: everything is done for you
  # (although this is the easiest class, it shows what methods every subclass
  # of geometry values needs)

  # Note: no initialize method only because there is nothing it needs to do
  def eval_prog env 
    self # all values evaluate to self
  end
  def preprocess_prog
    self # no pre-processing to do here
  end
  def shift(dx,dy)
    self # shifting no-points is no-points
  end
  def intersect other
    other.intersectNoPoints self # will be NoPoints but follow double-dispatch
  end
  def intersectPoint p # 求和点的交点
    self # intersection with point and no-points is no-points
  end
  def intersectLine line # 求和线的交点
    self # intersection with line and no-points is no-points
  end
  def intersectVerticalLine vline # 求和竖线的交点
    self # intersection with line and no-points is no-points
  end
  # if self is the intersection of (1) some shape s and (2) 
  # the line containing seg, then we return the intersection of the 
  # shape s and the seg.  seg is an instance of LineSegment
  def intersectWithSegmentAsLineResult seg
    self
  end
end

class Point < GeometryValue # 点
  # *add* methods to this class -- do *not* change given code and do not
  # override any methods

  # Note: You may want a private helper method like the local
  # helper function inbetween in the ML code
  attr_reader :x, :y
  def initialize(x,y)
    @x = x
    @y = y
  end

  def preprocess_prog # 提前处理一个点
    self # 事实上，并没有什么好处理的啦！
  end

  def eval_prog env
    self
  end

  def shift (dx, dy)
    Point.new(x + dx, y + dy) # 新建一个对象
  end

  def intersectPoint p
    if real_close_point(self.x, self.y, p.x, p.y)
      then self
    else
      NoPoints.new
    end
  end

  def intersectLine line # 点和线的交点
    if real_close(y, line.m * x + line.b)
      then self
    else NoPoints.new
    end
  end

  def intersectVerticalLine vline # 求点和竖线的交点
    if real_close(x, vline.x)
      then self
      else NoPoints.new
    end
  end

  def intersect exp
    exp.intersectPoint self
  end

  def intersectWithSegmentAsLineResult seg
    # 运行到这一步，说明LineSegment和某一样东西结果是一个Point
    # 对应与SML文件里的东西，x代表x0，y代表y0
    # seg代表原来的线段，也就是SML中的v1
    if inbetween(x, seg.x1, seg.x2) and inbetween(y, seg.y1, seg.y2)
      Point.new(x, y)
    else
      NoPoints.new
    end
  end

  private
  def inbetween(v, end1, end2) # 这个主要是辅助的函数
    epsilon = GeometryExpression::Epsilon
    (end1 - epsilon <= v and v <= end2 + epsilon) or
	(end2 - epsilon <= v and v <= end1 + epsilon)
  end
end

class Line < GeometryValue # 线
  # *add* methods to this class -- do *not* change given code and do not
  # override any methods
  attr_reader :m, :b 
  def initialize(m,b)
    @m = m
    @b = b
  end

  def preprocess_prog
    self
  end

  def eval_prog env
    self
  end

  def shift (dx, dy) # 一条线段位移(dx, dy)的距离
    Line.new(m, b + dy - m * dx) # 重新构建一条线
  end

  def intersectPoint p # 线和点的交点，这样的话，转化一下,换成点和线段的交点
    p.intersectLine self
  end

  def intersectVerticalLine vline # 竖线和线的交点
    Point.new(vline.x, m * vline.x + b)
  end

  def intersectLine line # 线和线的交点
    if real_close(m, line.m) # 判断两条线的斜率是否一至
      then if real_close(b, line.b)
	     then self # 两个值都相等了，自然返回self
	     else NoPoints.new # 否则的话，就是平行了，没有交点
	   end
    else
	x = (line.b - b) / (m - line.m)
	y = m * x + b
	Point.new(x, y)
    end
  end

  def intersect exp # 这里说得好听一点，叫first dispatch
    exp.intersectLine self # 调用exp的intersectLine函数
  end

  def intersectWithSegmentAsLineResult seg
    # 运行到了这一步的话，说明线段和self的结果是一条线
    # 这里的seg对应与SML中的v1
    # 这里需要直接返回v1
    seg
  end

end

class VerticalLine < GeometryValue
  # *add* methods to this class -- do *not* change given code and do not
  # override any methods
  attr_reader :x
  def initialize x
    @x = x
  end

  def preprocess_prog
    self
  end

  def eval_prog env # 计算这段代码
    self
  end

  def shift(dx, dy)
    VerticalLine.new(x + dx)
  end

  def intersectVerticalLine vline # 求垂线和垂线的交点
    if real_close(x, vline.x)
      then self
      else NoPoints.new
    end
  end

  def intersect exp  # 好吧，这也是所谓的first dispatch
    exp.intersectVerticalLine self
  end

  def intersectWithSegmentAsLineResult seg
    # 和上面的类似
    seg
  end
end

class LineSegment < GeometryValue # 线段
  attr_reader :x1, :y1, :x2, :y2
  def initialize (x1,y1,x2,y2)
    @x1 = x1
    @y1 = y1
    @x2 = x2
    @y2 = y2
  end

  def preprocess_prog # LineSegment的预处理
    if real_close(x1, x2)
      if real_close(y1, y2)
	Point.new(x1, y1) # 两点坐标都非常接近，那么结果就是一个点
      elsif y1 > y2
	LineSegment.new(x2, y2, x1, y1)
      else
	self
      end
    elsif x1 > x2
      LineSegment.new(x2, y2, x1, y1)
    else
      self
    end
  end

  def eval_prog env
    self
  end

  def shift(dx, dy) # 线段的移动
    LineSegment.new(x1 + dx, y1 + dy, x2 + dx, y2 + dy)
  end


  def intersectWithSegmentAsLineResult seg
    # 好吧，这一部分算是最难理清楚的啦！
    # 这里的seg想当于SML文件中的v1
    # 而self相当与SML中的LineSegment seg2
    seg1 = [x1, y1, x2, y2]
    seg2 = [seg.x1, seg.y1, seg.x2, seg.y2]
    if real_close(x1, x2)
      aXstart, aYstart, aXend, aYend, bXstart, bYstart, bXend, bYend =
	  y1 < seg.y1 ? seg1 + seg2 : seg2 + seg1
      if real_close(aYend, bYstart)
	Point.new(aXend, aYend)
      elsif aYend < bYstart
	NoPoints.new
      elsif aYend > bYend
	LineSegment.new(bXstart, bYstart, bXend, bYend)
      else
	LineSegment.new(bXstart, bYstart, aXend, aYend)
      end
    else
      aXstart, aYstart, aXend, aYend, bXstart, bYstart, bXend, bYend =
	  x1 < seg.x1 ? seg1 + seg2 : seg2 + seg1
      if real_close(aXend, bXstart)
	Point.new(aXend, aYend)
      elsif aXend < bXstart
	NoPoints.new
      elsif aXend > bXend
	LineSegment.new(bXstart, bYstart, bXend, bYend)
      else
	LineSegment.new(bXstart, bYstart, aXend, aYend)
      end
    end
  end

  def intersect exp
    exp.intersectLineSegment self # 求exp和线段的交点
  end
end

# Note: there is no need for getter methods for the non-value classes
class Intersect < GeometryExpression
  # *add* methods to this class -- do *not* change given code and do not
  # override any methods
  def initialize(e1,e2)
    @e1 = e1
    @e2 = e2
  end

  def preprocess_prog
    Intersect.new(@e1.preprocess_prog, @e2.preprocess_prog) # 重新构建一个玩意
  end

  def eval_prog env
    # 到这里了，怎么玩
    @e1.eval_prog(env).intersect(@e2.eval_prog(env))
  end
end

class Let < GeometryExpression # let表达式
  def initialize(s,e1,e2)
    @s = s
    @e1 = e1
    @e2 = e2
  end

  def preprocess_prog # 构建出一个新的表达式，非常好啊！
    Let.new(@s, @e1.preprocess_prog, @e2.preprocess_prog)
  end

  def eval_prog env # let表达式的计算
    @e2.eval_prog(Array.new(env).unshift([@s, @e1]))
  end
end

class Var < GeometryExpression # 变量测试
  # *add* methods to this class -- do *not* change given code and do not
  # override any methods
  def initialize s
    @s = s
  end
  def eval_prog env # remember: do not change this method
    pr = env.assoc @s
    raise "undefined variable" if pr.nil?
    pr[1] # 返回这个值
  end
  def preprocess_prog
    self
  end
end

class Shift < GeometryExpression # shift表达式
  # *add* methods to this class -- do *not* change given code and do not
  # override any methods
  def initialize(dx,dy,e)
    @dx = dx
    @dy = dy
    @e = e
  end

  def preprocess_prog
    Shift.new(@dx, @dy, @e.preprocess_prog)
  end
  def eval_prog env
    @e.eval_prog(env).shift(@dx, @dy)
  end
end

Programming language 解题报告

Table of Contents

1 homework1

1.1 is_older

1.2 number_in_month

1.3 number_in_months

1.4 dates_in_month

1.5 dates_in_months

1.6 get_nth

1.7 date_to_string

1.8 number_before_reaching_sum

1.9 what_month

1.10 month_range

1.11 oldest

1.12 number_in_months_challenge

1.13 reasonable_date

2 homework2

2.1 all_except_iotion

2.2 get_substitutions1

2.3 get_substitutions2

2.4 similar_names

2.5 card_color

2.6 card_value

2.7 remove_card

2.8 all_same_color

2.9 sum_cards

2.10 score

2.11 officiate

3 homework3

3.1 count_wildcards

3.2 count_wildcards_e

3.3 count_wild_and_variable_lengths

3.4 count_some_var

3.5 check_pat

3.6 only_capitals

3.7 longest_string1

3.8 longest_string2

3.9 longest_string3

3.10 longest_string4

3.11 longest_string_helper

3.12 longest_capitalized

3.13 rev_string

3.14 first_answer

3.15 all_answers

3.16 match

3.17 first_match

4 homework4

5 homework5

6 homework6

7 homework7

Comments