├── README.md ├── code ├── closure.ml ├── datatypes.ml ├── goleta.dl ├── highorder.ml └── recursion.ml ├── homework ├── README.md ├── hw1 │ ├── .ocamlformat │ ├── README.md │ ├── dune-project │ ├── hw1.opam │ ├── lib │ │ ├── dune │ │ ├── part1.ml │ │ ├── part1.mli │ │ ├── part2.ml │ │ ├── part2.mli │ │ ├── part3.ml │ │ ├── part3.mli │ │ ├── part4.ml │ │ ├── part4.mli │ │ └── util.ml │ ├── res │ │ ├── programs.001.png │ │ ├── programs.002.png │ │ ├── programs.003.png │ │ └── programs.004.png │ ├── sol.md │ └── test │ │ ├── dune │ │ ├── hw1_test.ml │ │ ├── part1.ml │ │ ├── part2.ml │ │ ├── part3.ml │ │ ├── part4.ml │ │ └── utils.ml ├── hw2 │ ├── .ocamlformat │ ├── Makefile │ ├── README.md │ ├── bin │ │ ├── dune │ │ └── repl.ml │ ├── dune-project │ ├── hw2.opam │ ├── lib │ │ ├── part1 │ │ │ ├── dune │ │ │ ├── part1.ml │ │ │ └── part1.mli │ │ └── part2 │ │ │ ├── ast.ml │ │ │ ├── dune │ │ │ ├── err.ml │ │ │ ├── eval.ml │ │ │ ├── eval.mli │ │ │ ├── examples │ │ │ ├── add.lp │ │ │ ├── apply.lp │ │ │ └── true.lp │ │ │ ├── parse_util.ml │ │ │ ├── parser.mly │ │ │ ├── scanner.mll │ │ │ ├── vars.ml │ │ │ └── vars.mli │ ├── sol.md │ └── test │ │ ├── dune │ │ ├── hw2_test.ml │ │ ├── test_part1.ml │ │ └── test_part2.ml ├── hw3 │ ├── .ocamlformat │ ├── Makefile │ ├── README.md │ ├── bin │ │ ├── dune │ │ └── repl.ml │ ├── dune-project │ ├── hw3.opam │ ├── lamp │ │ ├── ast.ml │ │ ├── cmd.ml │ │ ├── dune │ │ ├── err.ml │ │ ├── eval.ml │ │ ├── eval.mli │ │ ├── lamp.opam │ │ ├── lexer.mll │ │ ├── menhir_parser.mly │ │ ├── parser.ml │ │ ├── vars.ml │ │ └── vars.mli │ └── test │ │ ├── dune │ │ ├── examples │ │ ├── add_n.lp │ │ ├── fib.lp │ │ ├── fib_int.lp │ │ ├── max_ext.lp │ │ ├── mutual_rec_int.lp │ │ ├── primes.lp │ │ └── primes_internal.lp │ │ ├── hw3_test.ml │ │ └── test_lamp.ml ├── hw4 │ ├── .ocamlformat │ ├── README.md │ ├── bin │ │ ├── dune │ │ └── repl.ml │ ├── dune-project │ ├── hw4.opam │ ├── lamp │ │ ├── ast.ml │ │ ├── cmd.ml │ │ ├── dune │ │ ├── err.ml │ │ ├── eval.ml │ │ ├── eval.mli │ │ ├── lexer.mll │ │ ├── menhir_parser.mly │ │ ├── parser.ml │ │ ├── typecheck.ml │ │ ├── typecheck.mli │ │ ├── vars.ml │ │ └── vars.mli │ └── test │ │ ├── dune │ │ ├── examples │ │ ├── add_n.lp │ │ └── fib.lp │ │ ├── hw4_test.ml │ │ └── test_typing.ml ├── hw5 │ ├── .ocamlformat │ ├── Makefile │ ├── README.md │ ├── bin │ │ ├── dune │ │ └── repl.ml │ ├── dune-project │ ├── hw5.opam │ ├── lamp │ │ ├── ast.ml │ │ ├── cmd.ml │ │ ├── curry_howard.ml │ │ ├── curry_howard.mli │ │ ├── dune │ │ ├── err.ml │ │ ├── eval.ml │ │ ├── eval.mli │ │ ├── lexer.mll │ │ ├── menhir_parser.mly │ │ ├── parser.ml │ │ ├── typecheck.ml │ │ ├── typecheck.mli │ │ ├── typeinfer.ml │ │ ├── typeinfer.mli │ │ ├── vars.ml │ │ └── vars.mli │ └── test │ │ ├── dune │ │ ├── examples │ │ ├── add_n.lp │ │ ├── fib.lp │ │ ├── foldr.lp │ │ ├── length.lp │ │ ├── length_poly.lp │ │ └── map_filter.lp │ │ ├── hw5_test.ml │ │ ├── test_typing.ml │ │ └── test_utils.ml └── lamp.pdf ├── lectures ├── 2-26-note.pdf ├── CS162-Curry-Howard-Isomorphism.pdf ├── CS162-Final-Review-Programming-Languages.pdf ├── curry_howard.ml ├── final-review-note.pdf ├── final-review.pdf ├── inference-rules.pdf ├── lambda-plus.pdf ├── lecture1.key ├── lecture1.pdf ├── lecture10.key ├── lecture10.pdf ├── lecture11.key ├── lecture11.pdf ├── lecture12.key ├── lecture12.pdf ├── lecture13.key ├── lecture13.pdf ├── lecture14.key ├── lecture14.pdf ├── lecture15.key ├── lecture15.pdf ├── lecture16.pdf ├── lecture2.key ├── lecture2.pdf ├── lecture3.key ├── lecture3.pdf ├── lecture4.key ├── lecture4.pdf ├── lecture5.key ├── lecture5.pdf ├── lecture6.key ├── lecture6.pdf ├── lecture7.key ├── lecture7.pdf ├── lecture8.key ├── lecture8.pdf ├── lecture9.key ├── lecture9.pdf ├── midterm-review.pdf └── win25-2-13-note.pdf └── sections ├── sec01 ├── install.md └── notes.md └── sec02 └── notes.pdf /README.md: -------------------------------------------------------------------------------- 1 | # CS162 Programming Languages 2 | 3 | Programming Languages are the bricks, mortar and steel of the information age. Over the last thirty years, a variety of languages with diverse features have been developed, expressive radically different perspectives of the idea of computation. CS 162 is an introduction to these different perspectives, the fundamental concepts of languages, and how modern language techniques and idioms can be used to engineer software systems. For this purpose, we will learn how to build a new programming language, λ+, from scratch, including its operational semantics, type checking, type inference, and correctness. 4 | 5 | # Logistics 6 | Instructor: Yu Feng (yufeng@cs.ucsb.edu) 7 | - Office hour: Tue, 9am-10am (HFH 2157) 8 | 9 | Class: Mon, Wed, 5pm, Theater & Dance West, 1701 10 | 11 | Discussion sections (Friday): 12 | - 10-10:50am, GIRV 2128 13 | - 11-11:50am, GIRV 2128 14 | - 12-12:50pm, GIRV 1115 15 | - 1-1:50pm, GIRV 1112 16 | 17 | TAs: 18 | - Junrui Liu ([junrui@ucsb.edu](mailto:junrui@ucsb.edu)) 19 | - Office hours: Monday 3-4pm and Thursday 10:30-11:30am at TA Trailer Room 103 ([map](https://ucsb-cs8.github.io/w20/info/mentorPhotos/trailer-map.png)) 20 | - Hongbo Wen ([hongbowen@ucsb.edu](mailto:hongbowen@ucsb.edu)) 21 | - Office hours: Thursday 2-3pm at CSIL 22 | - Hanzhi Liu ([hanzhi@ucsb.edu](mailto:hanzhi@ucsb.edu)) 23 | - Office hours: Thursday 3-4pm at CSIL 24 | 25 | Reader: 26 | - Jiaming Shan 27 | 28 | 29 | Textbook (optional): [Types and Programming Languages](https://www.amazon.com/Types-Programming-Languages-MIT-Press/dp/0262162091) 30 | 31 | # Schedule 32 | | Date | Topic | Slides | Read | Out | Due | 33 | | ---------------- | -------------------------- | ------------------------------- | ---------------- | ---------------------- | --- | 34 | | 1/6 | Hello, World! | [lec1](lectures/lecture1.pdf) | | | | 35 | | 1/8 | OCaml crash course I | [lec2](lectures/lecture2.pdf) | | | | 36 | | 1/13 | OCaml crash course II | [lec3](lectures/lecture3.pdf) | | [hw1](./homework/hw1/) | | 37 | | 1/15 | OCaml crash course III | [lec4](lectures/lecture4.pdf) | | | | 38 | | 1/20 (MLK) | No class | | | | | 39 | | 1/22 | Lambda Calculus I | [lec5](lectures/lecture5.pdf) | | [hw2](./homework/hw2) | hw1 | 40 | | 1/27 | Lambda Calculus II | [lec6](lectures/lecture6.pdf) | 8.1,8.2, 9.1-9.3 | | | 41 | | 1/29 | (Cancelled) | | | | | 42 | | 2/3 | λ+ | | | | | 43 | | 2/5 | Operational Semantics I | [lec7](lectures/lecture7.pdf) | 10.3 | | | 44 | | 2/10 | Operational Semantics II | [lec8](lectures/lecture8.pdf) | | | | 45 | | 2/12 | Type Checking | [lec9](lectures/lecture9.pdf) | | [hw3](./homework/hw3) | hw2 | 46 | | 2/17 (President) | No class | | | | | 47 | | 2/19 | Type Checking (continued) | [lec10](lectures/lecture10.pdf) | 22.1-22.4 | | | 48 | | 2/24 | Type Inference | [lec11](lectures/lecture11.pdf) | | [hw4](./homework/hw4) | hw3 | 49 | | 2/26 | Type Inference (continued) | [note](lectures/2-26-note.pdf) | | | | 50 | | 3/3 | Polymorphism | [lec12](lectures/lecture12.pdf) | | | | 51 | | 3/5 | Polymorphism (continued) | | 22.7 | [hw5](./homework/hw5) | hw4 | 52 | | 3/10 | Curry Howard isomorphism | [CHI](lectures/CS162-Curry-Howard-Isomorphism.pdf) | | | | 53 | | 3/12 | Final Review | [lecture](lectures/CS162-Final-Review-Programming-Languages.pdf) | | | | 54 | | 3/12 | Final Problems | [note](lectures/final-review-note.pdf) | | | | 55 | | 3/18 | Final | | | | | 56 | | 3/21 | | | | | hw5 | 57 | 58 | # Grading 59 | 60 | 1. 5 Programming Assignments: 60% 61 | 2. Final Exam: 40% 62 | 3. Class Participation：1% 63 | 64 | Below is the grading system used by CS162 (No curving). 65 | 66 | | Letter | Percentage | 67 | | ------ | ---------- | 68 | | A | 93–100% | 69 | | A- | 85–92% | 70 | | B+ | 80–84% | 71 | | B | 75–79% | 72 | | B- | 70–74% | 73 | | C+ | 65–69% | 74 | | C | 60–64% | 75 | | F | <60% | 76 | 77 | Credit: https://en.wikipedia.org/wiki/Academic_grading_in_the_United_States 78 | 79 | 80 | # Useful resources 81 | 82 | You will find the [λ+ materials](./homework/lamp.pdf) very helpful during 83 | this course. 84 | 85 | These resources are helpful for learning OCaml: 86 | 87 | 1. [OCaml From the Ground Up](https://ocamlbook.org/): this is a good 88 | step-by-step introduction to OCaml. 89 | 2. [Real World OCaml](https://dev.realworldocaml.org/guided-tour.html): a 90 | comprehensive guide on OCaml: how to use it, the ecosystem and tooling, and 91 | common libraries. 92 | 3. [The OCaml system](https://ocaml.org/releases/4.11/htmlman/index.html): the 93 | official user manual for OCaml. Part I is helpful for seeing examples of what 94 | OCaml has to offer. You may also want to look at Part III, Chapter 17 for 95 | information on how to use the debugger. 96 | 4. [OCaml official documentation](https://ocaml.org/learn/) 97 | 5. [Learning OCaml in Y mins](https://learnxinyminutes.com/docs/ocaml/) 98 | 99 | 100 | # Academic Integrity 101 | - Cheating WILL be taken seriously. It is not fair toward honest students to take cheating lightly, nor is it fair to the cheater to let him/her go on thinking that cheating is a reasonable alternative in life. 102 | - The following is not considered cheating: 103 | - discussing broad ideas about programming assignments in groups, without being at a computer (with code-writing and debugging done individually, later). 104 | - The following is considered cheating: 105 | - discussing programming assignments with someone who has already completed the problem, or looking at their completed solution. 106 | - looking at anyone else’s solution 107 | - Previous versions of the class. 108 | - leaving your code (for example in an online repository) visible to others, leading others to look at your solution. 109 | - receiving, providing, or soliciting assistance from unauthorized sources during a test. 110 | - Programming assignments are not intended to be grade-makers, but to prepare you for the tests, which are the grade-makers. Cheating on the programming assignment is not only unethical, but shows a fundamental misunderstanding of the purpose of these assignments. 111 | - Penalties: First time: a zero for the assignment; Second time: an “F” in the course. 112 | 113 | -------------------------------------------------------------------------------- /code/closure.ml: -------------------------------------------------------------------------------- 1 | let x = 1;; 2 | let f y = x + y;; 3 | let x = 2;; 4 | let y = 3;; 5 | f (x + y);; 6 | 7 | 8 | 9 | let x = 1;; 10 | let f y = 11 | let x = 2 in 12 | fun z -> x + y + z 13 | ;; 14 | 15 | let x = 100;; 16 | let g = (f 4);; 17 | let y = 100;; 18 | (g 1);; 19 | -------------------------------------------------------------------------------- /code/datatypes.ml: -------------------------------------------------------------------------------- 1 | (* DataTypes *) 2 | 3 | 4 | type attrib = 5 | | Name of string 6 | | Age of int 7 | | DOB of int * int * int 8 | | Address of string 9 | | Height of float 10 | | Alive of bool 11 | | Email of string 12 | ;; 13 | 14 | let a1 = Name "Bob";; 15 | 16 | let a2 = Height 5.83;; 17 | 18 | let year = 1977 ;; 19 | 20 | let a3 = DOB (9,8,year) ;; 21 | 22 | let a_l = [a1;a2;a3];; 23 | 24 | 25 | 26 | 27 | 28 | 29 | let a1 = (Alive false);; 30 | let a1 = (Name "Bob");; 31 | let a1 = (Age 11);; 32 | match a1 with 33 | | Name s -> 0 34 | | Age i -> i 35 | | _ -> 10;; 36 | 37 | 38 | 39 | 40 | match (Name "Hi") with 41 | | Name s -> (Printf.printf "Hello %s\n" s;0) 42 | | Age i -> (Printf.printf "%d years old\n" i;0) 43 | | _ -> (Printf.printf "\n"; 0) 44 | ;; 45 | 46 | 47 | 48 | 49 | 50 | match (Age 10) with 51 | | Age i when i < 10 -> Printf.sprintf "%d (young)" i 52 | | Age i -> Printf.sprintf "%d (older)" i 53 | | Email s -> Printf.sprintf "%s" s 54 | | _ -> "" 55 | ;; 56 | 57 | 58 | let to_str a = 59 | match a with 60 | | Name s -> s 61 | | Age i -> Printf.sprintf "%d" i 62 | | DOB (d,m,y) -> Printf.sprintf "%d / %d / %d" d m y 63 | | Address addr -> Printf.sprintf "%s" addr 64 | | Height h -> Printf.sprintf "%f" h 65 | | Alive b -> Printf.sprintf "%b" b 66 | | Email e -> Printf.sprintf "%s" e 67 | ;; 68 | 69 | 70 | 71 | type nat = 72 | | Z 73 | | S of nat;; 74 | 75 | 76 | 77 | 78 | Z;; (* represents 0 *) 79 | S Z;; (* represents 1 *) 80 | S (S Z);; (* represents 2 *) 81 | 82 | 83 | 84 | 85 | 86 | 87 | let rec plus n m = 88 | match n with 89 | | Z -> m 90 | | S n' -> S (plus n' m);; 91 | 92 | 93 | 94 | plus (S (S Z)) (S Z);; 95 | 96 | 97 | 98 | 99 | 100 | 101 | type int_list = 102 | | Nil 103 | | Cons of (int * int_list) ;; 104 | 105 | 106 | let l = Cons (10, Cons (10, Cons (10, Nil)));; 107 | 108 | 109 | let rec length l = 110 | match l with 111 | | Nil -> 0 112 | | Cons (i,t) -> 1 + length t;; 113 | 114 | let rec length l = 115 | match l with 116 | | [] -> 0 117 | | h::t -> 1+length t;; 118 | 119 | 120 | let max x y = if x > y then x else y;; 121 | 122 | 123 | 124 | 125 | let rec list_max xs = 126 | match xs with 127 | | Nil -> 0 128 | | Cons (x, xs') -> max x (list_max xs');; 129 | 130 | let rec list_max xs = 131 | match xs with 132 | | [] -> 0 133 | | x::xs' -> max x (list_max xs');; 134 | -------------------------------------------------------------------------------- /code/goleta.dl: -------------------------------------------------------------------------------- 1 | .decl sunny(c:symbol) 2 | .decl hot(c:symbol) 3 | .decl dry(c:symbol) 4 | 5 | .output dry 6 | 7 | sunny("goleta"). 8 | sunny("ucsb"). 9 | hot("ucsb"). 10 | 11 | dry(c) :- sunny(c), hot(c). 12 | -------------------------------------------------------------------------------- /code/highorder.ml: -------------------------------------------------------------------------------- 1 | let max x y = if x < y then y else x;; 2 | 3 | (* return max element of list l *) 4 | let list_max l = 5 | let rec l_max l = 6 | match l with 7 | [] -> 0 8 | | h::t -> max h (l_max t) 9 | in 10 | l_max l;; 11 | 12 | 13 | let list_max2 l = 14 | let rec helper cur l = 15 | match l with 16 | [] -> cur 17 | | h::t -> helper (max cur h) t 18 | in 19 | helper 0 l;; 20 | 21 | 22 | (* concatenate all strings in a list *) 23 | let concat l = 24 | let rec helper cur l = 25 | match l with 26 | [] -> cur 27 | | h::t -> helper (cur ^ h) t 28 | in 29 | helper "" l;; 30 | 31 | (* fold, the coolest function! *) 32 | let rec fold f cur l = 33 | match l with 34 | [] -> cur 35 | | h::t -> fold f (f cur h) t;; 36 | 37 | let list_max = fold max 0 [1;2;3];; 38 | 39 | let concat = fold (^) "" ["a";"b";"c"];; 40 | 41 | 42 | let rec map f l = 43 | match l with 44 | [] -> [] 45 | | h::t -> (f h)::(map f t);; 46 | 47 | 48 | let incr x = x+1;; 49 | 50 | let map_incr = map incr;; 51 | 52 | map_incr [1;2;3];; 53 | 54 | let compose f1 f2 = fun x -> (f1 (f2 x));; 55 | 56 | let map_incr_2 = compose map_incr map_incr;; 57 | map_incr_2 [1;2;3];; 58 | 59 | let map_incr_3 = compose map_incr map_incr_2;; 60 | map_incr_3 [1;2;3];; 61 | -------------------------------------------------------------------------------- /code/recursion.ml: -------------------------------------------------------------------------------- 1 | type tree = 2 | Leaf of int 3 | | Node of tree*tree;; 4 | 5 | 6 | Node(Node(Leaf 1, Leaf 2), Leaf 3);; 7 | 8 | 9 | let rec sum_leaf t = 10 | match t with 11 | | Leaf n -> n 12 | | Node(t1,t2) -> (sum_leaf t1) + (sum_leaf t2);; 13 | 14 | 15 | sum_leaf (Node(Node(Leaf 1, Leaf 2), Leaf 3));; 16 | 17 | let rec fact n = 18 | if n<=0 19 | then 1 20 | else n * fact (n-1);; 21 | 22 | fact 3;; 23 | 24 | let fact2 x = 25 | let rec helper x curr = 26 | if x <= 0 27 | then curr 28 | else helper (x - 1) (x * curr) 29 | in 30 | helper x 1;; 31 | 32 | fact2 3;; 33 | 34 | 35 | -------------------------------------------------------------------------------- /homework/README.md: -------------------------------------------------------------------------------- 1 | ## CS162 Programming Assignments 2 | 3 | The main goal of the programming assignments in CS162 is to build λ+, a small programming language from scratch. 4 | 5 | 1. [Grab your weapon! OCaml in action](hw1/) 6 | 7 | Since you will use OCaml to implement your λ+ programming language, in this assignment, you will complete some basic programming tasks (e.g., recursions, pattern matching, data types, etc.) in OCaml as the warm-up. 8 | 9 | 10 | 2. [Higher order functions in OCaml + Interpreting λ+](hw2/)
11 | 12 | In this assignment, you will first practice defining and using higher order functions in OCaml. Next, you will implement an interpreter for a subset of λ+ based on its operational semantics. 13 | 14 | 3. [Interpreting λ+ (continued)](hw3/)
15 | 16 | In this assignment, you will finish the interpreter for the full λ+ language. 17 | 18 | 19 | 4. [Type check your λ+ program](hw4/)
20 | 21 | In this assignment, you will write a type checker for your λ+ program such that your checker can reject ill-typed λ+ programs. 22 | 23 | 5. [Infer the types for your λ+](hw5/)
24 | 25 | In this assignment, you will implement the type inference algorithm that we learn in the class. 26 | 27 | 30 | 31 | 35 | -------------------------------------------------------------------------------- /homework/hw1/.ocamlformat: -------------------------------------------------------------------------------- 1 | profile = default 2 | version = 0.26.2 3 | -------------------------------------------------------------------------------- /homework/hw1/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.11) 2 | 3 | (name hw1) 4 | 5 | (generate_opam_files true) 6 | 7 | (source 8 | (github username/reponame)) 9 | 10 | (authors "Author Name") 11 | 12 | (maintainers "Maintainer Name") 13 | 14 | (documentation https://url/to/documentation) 15 | 16 | (package 17 | (name hw1) 18 | (allow_empty) 19 | (synopsis "A short synopsis") 20 | (description "A longer description") 21 | (depends 22 | (ocaml 23 | (= 5.1.1)) 24 | dune 25 | base 26 | alcotest 27 | ppx_deriving 28 | ppx_jane 29 | ppx_import 30 | utop 31 | fmt) 32 | (tags 33 | (topics "to describe" your project))) 34 | 35 | ; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project 36 | -------------------------------------------------------------------------------- /homework/hw1/hw1.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "A short synopsis" 4 | description: "A longer description" 5 | maintainer: ["Maintainer Name"] 6 | authors: ["Author Name"] 7 | tags: ["topics" "to describe" "your" "project"] 8 | homepage: "https://github.com/username/reponame" 9 | doc: "https://url/to/documentation" 10 | bug-reports: "https://github.com/username/reponame/issues" 11 | depends: [ 12 | "ocaml" {= "5.1.1"} 13 | "dune" {>= "3.11"} 14 | "base" 15 | "alcotest" 16 | "ppx_deriving" 17 | "ppx_jane" 18 | "ppx_import" 19 | "utop" 20 | "fmt" 21 | "odoc" {with-doc} 22 | ] 23 | build: [ 24 | ["dune" "subst"] {dev} 25 | [ 26 | "dune" 27 | "build" 28 | "-p" 29 | name 30 | "-j" 31 | jobs 32 | "@install" 33 | "@runtest" {with-test} 34 | "@doc" {with-doc} 35 | ] 36 | ] 37 | dev-repo: "git+https://github.com/username/reponame.git" 38 | -------------------------------------------------------------------------------- /homework/hw1/lib/dune: -------------------------------------------------------------------------------- 1 | (env 2 | (dev 3 | (flags 4 | (:standard -warn-error -A)))) 5 | 6 | (library 7 | (name hw1) 8 | (libraries base fmt) 9 | (preprocess 10 | (pps ppx_deriving.show)) 11 | (modules util part1 part2 part3 part4)) 12 | -------------------------------------------------------------------------------- /homework/hw1/lib/part1.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Util 3 | 4 | let rec fib (n : int) : int = todo () 5 | -------------------------------------------------------------------------------- /homework/hw1/lib/part1.mli: -------------------------------------------------------------------------------- 1 | val fib : int -> int 2 | -------------------------------------------------------------------------------- /homework/hw1/lib/part2.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Util 3 | 4 | let rec compress (equal : 'a -> 'a -> bool) (xs : 'a list) : 'a list = todo () 5 | let max (xs : int list) : int option = todo () 6 | let rec join (xs : 'a option list) : 'a list option = todo () 7 | 8 | let insert (key : 'k) (value : 'v) (dict : ('k * 'v) list) : ('k * 'v) list = 9 | (key, value) :: dict 10 | 11 | let rec lookup (equal : 'k -> 'k -> bool) (key : 'k) (dict : ('k * 'v) list) : 12 | 'v option = 13 | todo () 14 | -------------------------------------------------------------------------------- /homework/hw1/lib/part2.mli: -------------------------------------------------------------------------------- 1 | val compress : ('a -> 'a -> bool) -> 'a list -> 'a list 2 | 3 | val max : int list -> int option 4 | 5 | val join : 'a option list -> 'a list option 6 | 7 | val insert : 'k -> 'v -> ('k * 'v) list -> ('k * 'v) list 8 | 9 | val lookup : ('k -> 'k -> bool) -> 'k -> ('k * 'v) list -> 'v option 10 | -------------------------------------------------------------------------------- /homework/hw1/lib/part3.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Util 3 | 4 | type 'a tree = Leaf | Node of 'a * 'a tree * 'a tree [@@deriving show] 5 | 6 | let rec equal_tree (equal : 'a -> 'a -> bool) (t1 : 'a tree) (t2 : 'a tree) : 7 | bool = 8 | todo () 9 | 10 | let timestamp (t : 'a tree) : (int * 'a) tree = todo () 11 | -------------------------------------------------------------------------------- /homework/hw1/lib/part3.mli: -------------------------------------------------------------------------------- 1 | type 'a tree = Leaf | Node of 'a * 'a tree * 'a tree [@@deriving show] 2 | 3 | val equal_tree : ('a -> 'a -> bool) -> 'a tree -> 'a tree -> bool 4 | val timestamp : 'a tree -> (int * 'a) tree 5 | -------------------------------------------------------------------------------- /homework/hw1/lib/part4.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Util 3 | 4 | type expr = 5 | | Const of int 6 | | X 7 | | Add of expr * expr 8 | | Mul of expr * expr 9 | | Compose of expr * expr 10 | 11 | (* Pretty-printer *) 12 | let rec pp_expr ppf = 13 | let open Fmt in 14 | function 15 | | Const n -> int ppf n 16 | | X -> string ppf "x" 17 | | Add (e1, e2) -> pf ppf "@[(%a + %a)@]" pp_expr e1 pp_expr e2 18 | | Mul (e1, e2) -> pf ppf "@[(%a * %a)@]" pp_expr e1 pp_expr e2 19 | | Compose (e1, e2) -> pf ppf "@[(%a; %a)@]" pp_expr e1 pp_expr e2 20 | 21 | (* Convert an expression into a pretty string *) 22 | let show_expr (e : expr) : string = Fmt.to_to_string pp_expr e 23 | let rec eval_expr (x : int) (e : expr) : int = todo () 24 | let rec simplify (e : expr) : expr = todo () 25 | 26 | type poly = int list [@@deriving show] 27 | 28 | let rec eval_poly (x : int) (p : poly) : int = bonus () 29 | let rec normalize (e : expr) : poly = bonus () 30 | let semantic_equiv (e1 : expr) (e2 : expr) : bool = bonus () 31 | -------------------------------------------------------------------------------- /homework/hw1/lib/part4.mli: -------------------------------------------------------------------------------- 1 | type expr = 2 | | Const of int 3 | | X 4 | | Add of expr * expr 5 | | Mul of expr * expr 6 | | Compose of expr * expr 7 | 8 | val pp_expr : expr Fmt.t 9 | val eval_expr : int -> expr -> int 10 | val simplify : expr -> expr 11 | 12 | type poly = int list 13 | 14 | val pp_poly : poly Fmt.t 15 | val eval_poly : int -> poly -> int 16 | val normalize : expr -> poly 17 | val semantic_equiv : expr -> expr -> bool 18 | -------------------------------------------------------------------------------- /homework/hw1/lib/util.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | let todo () = failwith "TODO" 4 | let bonus () = failwith "Bonus" 5 | 6 | let show_list (show : 'a -> string) (xs : 'a list) : string = 7 | Fmt.to_to_string (Fmt.list (Fmt.of_to_string show)) xs 8 | 9 | let show_option (show : 'a -> string) (x : 'a option) : string = 10 | match x with None -> "None" | Some x -> "Some " ^ show x 11 | -------------------------------------------------------------------------------- /homework/hw1/res/programs.001.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/homework/hw1/res/programs.001.png -------------------------------------------------------------------------------- /homework/hw1/res/programs.002.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/homework/hw1/res/programs.002.png -------------------------------------------------------------------------------- /homework/hw1/res/programs.003.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/homework/hw1/res/programs.003.png -------------------------------------------------------------------------------- /homework/hw1/res/programs.004.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/homework/hw1/res/programs.004.png -------------------------------------------------------------------------------- /homework/hw1/sol.md: -------------------------------------------------------------------------------- 1 | # Solutions to HW1 Exercises 2 | 3 | 4 | ## Part 1 5 | 6 | ### Problem 2 7 | 1. Say we have `n : int`. Then `Some n : int option`. 8 | 2. `None : int option` 9 | 3. Yes. Say we have `x : t`. Then `Some x : t option`. Or `None: t option`. 10 | 4. Yes. `None : t option`. 11 | 5. Not always. We can get a `t` out of a `t option` if and only if `t option` is the case of `Some x`, in which case we can extract `x : t`. If you want to define a function of type `t option -> t`, you'd also have to provide a "default" value in case `t option` is `None`, so you would end up defining `t -> t option -> t`. In fact, the generic function `'a option -> 'a` is not definable as `'a` can be anything, and there is no way to provide a default value for any `'a`. 12 | 13 | 14 | ### Problem 3 15 | 1. Say we have `n : int`, `b : bool`, and `s : string`, then `(n, b, s) : int * bool * string`. 16 | 2. Say we have `x : t1` and `y : t2`: 17 | 1. Yes, with `(x, y) : t1 * t2`. 18 | 2. Yes, with `(y, x) : t2 * t1`. 19 | 3. Yes, with `(y, x, x, y, x) : t2 * t1 * t1 * t2 * t1`. 20 | 3. Yes. Say `p : t1 * t2`. You can pattern match on `p` as in `match p with (x, y) -> ...` or `let (x, y) = p in ...`. 21 | ``` 22 | ## Part 4 23 | 24 | ### Problem 0 25 | 1. With x = 1, 26 | ```ocaml 27 | (3 * (4 + x); 1 + x + 5) * 2; 100 * x 28 | == (3 * (4 + 1); 1 + x + 5) * 2; 100 * x 29 | == (3 * 5; 1 + x + 5) * 2; 100 * x 30 | == (15; 1 + x + 5) * 2; 100 * x 31 | == ( 1 + 15 + 5) * 2; 100 * x 32 | == 21 * 2; 100 * x 33 | == 42; 100 * x 34 | == 4200 35 | ``` 36 | 2. Here's one possible parse: 37 | ``` 38 | Compose( 39 | Mul( 40 | Compose( 41 | Add( 42 | Mul(Const 3, Const 4), 43 | X 44 | ), 45 | Add( 46 | Add( 47 | Const 1, 48 | X 49 | ), 50 | Const 5 51 | ) 52 | ), 53 | Const 2 54 | ), 55 | Mul( 56 | Const 100, 57 | X 58 | ) 59 | ) 60 | ``` 61 | 62 | 3. Potential sources of ambiguity: 63 | - `*` has higher precedence than `+` 64 | - It's not clear whether `*` and `+` are left-associative or right-associative 65 | - It is not clear what is the precedence of `;`. 66 | 67 | -------------------------------------------------------------------------------- /homework/hw1/test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name hw1_test) 3 | (libraries fmt alcotest hw1) 4 | (preprocess 5 | (staged_pps ppx_import ppx_deriving.show ppx_deriving.eq))) 6 | -------------------------------------------------------------------------------- /homework/hw1/test/hw1_test.ml: -------------------------------------------------------------------------------- 1 | (* open Base *) 2 | 3 | let () = 4 | Alcotest.run "hw1" 5 | (List.map 6 | (fun (name, tests) -> 7 | (name, List.map (Alcotest.test_case name `Quick) tests)) 8 | (Part1.tests @ Part2.tests @ Part3.tests @ Part4.tests)) 9 | -------------------------------------------------------------------------------- /homework/hw1/test/part1.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Hw1.Part1 3 | 4 | let test_fib = Utils.test_io Alcotest.int "same int" fib 5 | 6 | (** A list of (input, output) pairs *) 7 | let fib_tests = [ (10, 55) (* add your tests here *) ] 8 | 9 | let tests = [ ("fib", List.map ~f:test_fib fib_tests) ] 10 | -------------------------------------------------------------------------------- /homework/hw1/test/part2.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Hw1.Part2 3 | 4 | let test_compress = 5 | Utils.test_io Alcotest.(list string) "same list" (compress String.equal) 6 | 7 | let test_max = Utils.test_io Alcotest.(option int) "same int" max 8 | let test_join = Utils.test_io Alcotest.(option (list int)) "same list" join 9 | 10 | let test_lookup = 11 | Utils.test_io 12 | Alcotest.(option string) 13 | "same string" 14 | (Utils.uncurry (lookup Int.equal)) 15 | 16 | (** A list of (input, output) pairs *) 17 | let compress_tests = [ ([ "a"; "a" ], [ "a" ]) (* add your tests here *) ] 18 | 19 | (** A list of (input, output) pairs *) 20 | let max_tests = [ ([ 1; 2 ], Some 2) (* add your tests here *) ] 21 | 22 | (** A list of (input, output) pairs *) 23 | let join_tests = 24 | [ ([ Some 1; Some 2 ], Some [ 1; 2 ]) (* add your tests here *) ] 25 | 26 | (** A list of ((input key * input dict) * output) pairs *) 27 | let lookup_tests = [ ((1, [ (1, "hi") ]), Some "hi") (* add your tests here *) ] 28 | 29 | let tests = 30 | [ 31 | ("compress", List.map ~f:test_compress compress_tests); 32 | ("max", List.map ~f:test_max max_tests); 33 | ("join", List.map ~f:test_join join_tests); 34 | ("lookup", List.map ~f:test_lookup lookup_tests); 35 | ] 36 | -------------------------------------------------------------------------------- /homework/hw1/test/part3.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Hw1.Part3 3 | 4 | module Tree = struct 5 | type 'a t = [%import: 'a Hw1.Part3.tree] [@@deriving eq] 6 | 7 | (* A cleaner pretty-print function *) 8 | let rec pp ppf_a ppf = function 9 | | Leaf -> Fmt.pf ppf "Leaf" 10 | | Node (x, l, r) -> 11 | Fmt.pf ppf "Node (@[%a,@;%a,@;%a@])" ppf_a x (pp ppf_a) l (pp ppf_a) 12 | r 13 | end 14 | 15 | (** Wrapper functions for constructing trees. 16 | You can either use plain constructors to build an tree, or 17 | call the functions in this module. *) 18 | module DSL = struct 19 | (** Build a leaf node *) 20 | let leaf = Leaf 21 | 22 | (** Build a node with some data, a left subtree and a right subtree *) 23 | let node x l r = Node (x, l, r) 24 | 25 | (** Build a terminal node with some data (no subtrees) *) 26 | let term x = node x leaf leaf 27 | end 28 | 29 | let test_equal_tree = 30 | Utils.test_io Alcotest.bool "same bool" (Utils.uncurry (equal_tree Int.equal)) 31 | 32 | let test_timestamp = 33 | let t = 34 | Alcotest.( 35 | testable 36 | (Tree.pp (Fmt.of_to_string [%derive.show: int * char])) 37 | (Tree.equal [%derive.eq: int * char])) 38 | in 39 | Utils.test_io t "same tree" timestamp 40 | 41 | (** A list of ((input tree * input tree) * expected output) tests *) 42 | let equal_tree_tests = 43 | [ (DSL.(node 1 leaf leaf, node 1 leaf leaf), true) (* add your tests here *) ] 44 | 45 | (** A list of (input tree * output tree) tests *) 46 | let timestamp_tests = 47 | [ 48 | DSL. 49 | ( node 'o' 50 | (node 'm' (term 'c') (term 'a')) 51 | (node 'y' (term 'a') (term 'l')), 52 | node (0, 'o') 53 | (node (1, 'm') (term (2, 'c')) (term (3, 'a'))) 54 | (node (4, 'y') (term (5, 'a')) (term (6, 'l'))) ); 55 | (* add your tests here *) 56 | ] 57 | 58 | let tests = 59 | [ 60 | ("equal_tree", List.map ~f:test_equal_tree equal_tree_tests); 61 | ("timestamp", List.map ~f:test_timestamp timestamp_tests); 62 | ] 63 | -------------------------------------------------------------------------------- /homework/hw1/test/part4.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Hw1.Part4 3 | 4 | module Expr = struct 5 | type t = [%import: Hw1.Part4.expr] [@@deriving show, eq] 6 | end 7 | 8 | module Poly = struct 9 | type t = [%import: Hw1.Part4.poly] [@@deriving show, eq] 10 | end 11 | 12 | (** Wrapper functions for constructing ASTs. 13 | You can either use plain constructors to build an AST, or 14 | call the functions in this module. *) 15 | module DSL = struct 16 | (** Build a constant AST node *) 17 | let const (n : int) : expr = Const n 18 | 19 | (** Build a variable AST node *) 20 | let x : expr = X 21 | 22 | (** Build an addition AST node with a left AST and a right AST *) 23 | let add (e1 : expr) (e2 : expr) : expr = Add (e1, e2) 24 | 25 | (** Build a multiplication AST node with a left AST and a right AST *) 26 | let mul (e1 : expr) (e2 : expr) : expr = Mul (e1, e2) 27 | 28 | (** Build a composition AST node with a left AST and a right AST *) 29 | let comp (e1 : expr) (e2 : expr) : expr = Compose (e1, e2) 30 | end 31 | 32 | let test_eval_expr = 33 | Utils.test_io Alcotest.(int) "same int" (Utils.uncurry eval_expr) 34 | 35 | let test_simplify = 36 | Utils.test_io Alcotest.(testable Expr.pp Expr.equal) "same expr" simplify 37 | 38 | let test_eval_poly = 39 | Utils.test_io Alcotest.(int) "same int" (Utils.uncurry eval_poly) 40 | 41 | let test_normalize = Utils.test_io Alcotest.(list int) "same list" normalize 42 | 43 | let test_semantic_equiv = 44 | Utils.test_io Alcotest.bool "same bool" (Utils.uncurry semantic_equiv) 45 | 46 | let eval_expr_tests = 47 | [ ((3, DSL.(comp (add (const 1) (mul (const 2) x)) (add x (const 5)))), 12) ] 48 | 49 | let simplify_tests = 50 | [ DSL.(add x (add x (mul (const 1) (add (const 0) x))), add x (add x x)) ] 51 | 52 | let eval_poly_tests = [ ((3, [ 6; 7; 3 ]), 54) ] 53 | 54 | let normalize_tests = 55 | [ 56 | ( DSL.( 57 | add (const 4) (mul (add x (const 2)) (add (mul (const 3) x) (const 1)))), 58 | [ 6; 7; 3 ] ); 59 | ] 60 | 61 | let semantic_equiv_tests = 62 | [ 63 | ( DSL. 64 | ( add (const 4) (mul (add x (const 2)) (add (mul (const 3) x) (const 1))), 65 | add (const 6) (add (mul (const 7) x) (mul (const 3) (mul x x))) ), 66 | true ); 67 | ] 68 | 69 | let tests = 70 | [ 71 | ("eval_expr", List.map ~f:test_eval_expr eval_expr_tests); 72 | ("simplify", List.map ~f:test_simplify simplify_tests); 73 | ("eval_poly", List.map ~f:test_eval_poly eval_poly_tests); 74 | ("normalize", List.map ~f:test_normalize normalize_tests); 75 | ("semantic_equiv", List.map ~f:test_semantic_equiv semantic_equiv_tests); 76 | ] 77 | -------------------------------------------------------------------------------- /homework/hw1/test/utils.ml: -------------------------------------------------------------------------------- 1 | let test_io t msg f (i, o) () = 2 | Alcotest.(check' t) ~msg ~expected:o ~actual:(f i) 3 | 4 | let uncurry f (x, y) = f x y 5 | -------------------------------------------------------------------------------- /homework/hw2/.ocamlformat: -------------------------------------------------------------------------------- 1 | profile = default 2 | version = 0.26.2 -------------------------------------------------------------------------------- /homework/hw2/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: zip 2 | 3 | FILES := lib/part1/part1.ml lib/part2/eval.ml 4 | ARCHIVE := submission.zip 5 | 6 | $(ARCHIVE): $(FILES) 7 | zip -j $(ARCHIVE) $(FILES) 8 | 9 | zip: $(ARCHIVE) -------------------------------------------------------------------------------- /homework/hw2/bin/dune: -------------------------------------------------------------------------------- 1 | ; --------------- 2 | ; generate date information 3 | 4 | (rule 5 | (target build_metadata.ml) 6 | (deps (universe)) 7 | (action 8 | (run bash "-c" "echo let date = \\\"$(date)\\\" > %{target}"))) 9 | 10 | ; --------------- 11 | ; statically link the binary for CSIL if using musl libc 12 | 13 | (rule 14 | (target build_flags) 15 | (enabled_if 16 | (= %{ocaml-config:c_compiler} "musl-gcc")) 17 | (action 18 | (write-file %{target} "(-ccopt -static)"))) 19 | 20 | (rule 21 | (target build_flags) 22 | (enabled_if 23 | (<> %{ocaml-config:c_compiler} "musl-gcc")) 24 | (action 25 | (write-file %{target} "()"))) 26 | 27 | ; --------------- 28 | ; lamp repl 29 | 30 | (executable 31 | (name repl) 32 | (modules build_metadata repl) 33 | (libraries lamp linenoise) 34 | (flags 35 | :standard 36 | (:include build_flags)) 37 | (modes exe)) 38 | -------------------------------------------------------------------------------- /homework/hw2/bin/repl.ml: -------------------------------------------------------------------------------- 1 | open Lamp 2 | open Ast 3 | open Eval 4 | open Format 5 | 6 | module Opts = struct 7 | let path : string option ref = ref None 8 | end 9 | 10 | let handler (f : unit -> unit) : unit = 11 | try f () with 12 | | Parsing.Parse_error -> Fmt.epr "Syntax error\n%!" 13 | | Err.Syntax { sl; sc; el; ec } -> 14 | Fmt.epr "Syntax error: %d.%d-%d.%d\n%!" sl sc el ec 15 | | Err.Lexing { l; s } -> 16 | Fmt.epr "Lexing error: At offset %d: unexpected character: %s\n%!" l s 17 | | Stuck msg -> printf "runtime error: %s\n%!" msg 18 | | Stack_overflow -> 19 | Fmt.epr 20 | "Interpreter stack overflow; too many recursive function calls\n%!" 21 | 22 | let rec repl () = 23 | match LNoise.linenoise "> " with 24 | | None -> () 25 | | Some l -> 26 | LNoise.history_add l |> ignore; 27 | handler (fun () -> 28 | let e = Parse_util.parse l in 29 | Fmt.pr "<== %a\n%!" Pretty.expr e; 30 | let v = eval e in 31 | Fmt.pr "==> %a\n%!" Pretty.expr v); 32 | repl () 33 | 34 | let read_args () = 35 | let set_file s = Opts.path := Some s in 36 | let opts = [] in 37 | Arg.parse opts set_file "" 38 | 39 | let () = 40 | read_args (); 41 | match !Opts.path with 42 | | Some file_name -> 43 | let ch = open_in file_name in 44 | let contents = really_input_string ch (in_channel_length ch) in 45 | close_in ch; 46 | handler (fun () -> 47 | let e = Parse_util.parse contents in 48 | let v = eval e in 49 | Fmt.pr "%a\n%!" Pretty.expr v) 50 | | None -> 51 | (* repl mode *) 52 | Fmt.pr "Welcome to lambda+! Built on: %s\n%!" Build_metadata.date; 53 | LNoise.history_set ~max_length:100 |> ignore; 54 | repl () 55 | -------------------------------------------------------------------------------- /homework/hw2/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.11) 2 | 3 | (name hw2) 4 | 5 | (generate_opam_files true) 6 | 7 | (source 8 | (github username/reponame)) 9 | 10 | (authors "Author Name") 11 | 12 | (maintainers "Maintainer Name") 13 | 14 | (documentation https://url/to/documentation) 15 | 16 | (package 17 | (name hw2) 18 | (allow_empty) 19 | (synopsis "A short synopsis") 20 | (description "A longer description") 21 | (depends 22 | (ocaml 23 | (= 5.1.1)) 24 | dune 25 | base 26 | alcotest 27 | ppx_deriving 28 | ppx_jane 29 | utop 30 | linenoise 31 | fmt) 32 | (tags 33 | (topics "to describe" your project))) 34 | 35 | ; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project 36 | -------------------------------------------------------------------------------- /homework/hw2/hw2.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "A short synopsis" 4 | description: "A longer description" 5 | maintainer: ["Maintainer Name"] 6 | authors: ["Author Name"] 7 | tags: ["topics" "to describe" "your" "project"] 8 | homepage: "https://github.com/username/reponame" 9 | doc: "https://url/to/documentation" 10 | bug-reports: "https://github.com/username/reponame/issues" 11 | depends: [ 12 | "ocaml" {= "5.1.1"} 13 | "dune" {>= "3.11"} 14 | "base" 15 | "alcotest" 16 | "ppx_deriving" 17 | "ppx_jane" 18 | "utop" 19 | "linenoise" 20 | "fmt" 21 | "odoc" {with-doc} 22 | ] 23 | build: [ 24 | ["dune" "subst"] {dev} 25 | [ 26 | "dune" 27 | "build" 28 | "-p" 29 | name 30 | "-j" 31 | jobs 32 | "@install" 33 | "@runtest" {with-test} 34 | "@doc" {with-doc} 35 | ] 36 | ] 37 | dev-repo: "git+https://github.com/username/reponame.git" 38 | -------------------------------------------------------------------------------- /homework/hw2/lib/part1/dune: -------------------------------------------------------------------------------- 1 | (env 2 | (dev 3 | (flags 4 | (:standard -warn-error -A)))) 5 | 6 | (library 7 | (name part1)) 8 | -------------------------------------------------------------------------------- /homework/hw2/lib/part1/part1.ml: -------------------------------------------------------------------------------- 1 | let todo () = failwith "TODO" 2 | let singletons (xs : 'a list) : 'a list list = todo () 3 | let map2d (f : 'a -> 'b) (xss : 'a list list) : 'b list list = todo () 4 | let product (xs : 'a list) (ys : 'b list) : ('a * 'b) list list = todo () 5 | let power (xs : 'a list) : 'a list list = todo () 6 | 7 | let both : 'a option -> 'b option -> ('a * 'b) option = 8 | fun x -> match x with Some x -> todo () | None -> todo () 9 | -------------------------------------------------------------------------------- /homework/hw2/lib/part1/part1.mli: -------------------------------------------------------------------------------- 1 | val singletons : 'a list -> 'a list list 2 | val map2d : ('a -> 'b) -> 'a list list -> 'b list list 3 | val product : 'a list -> 'b list -> ('a * 'b) list list 4 | val power : 'a list -> 'a list list 5 | val both : 'a option -> 'b option -> ('a * 'b) option 6 | -------------------------------------------------------------------------------- /homework/hw2/lib/part2/ast.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | (** Binary operators *) 4 | type binop = Add | Sub | Mul [@@deriving equal, show] 5 | 6 | type 'a binder = string * 'a [@@deriving equal, show] 7 | (** Binder *) 8 | 9 | (** AST of Lambda+ expressions *) 10 | type expr = 11 | (* arithmetic *) 12 | | Num of int 13 | | Binop of binop * expr * expr 14 | (* variable *) 15 | | Var of string 16 | (* lambda calculus *) 17 | | Lambda of expr binder 18 | | App of expr * expr 19 | (* let expression *) 20 | | Let of expr * expr binder 21 | [@@deriving equal, show] 22 | 23 | (** Pretty-printers *) 24 | module Pretty = struct 25 | open Fmt 26 | 27 | let binop : binop Fmt.t = 28 | Fmt.(using (function Add -> "+" | Sub -> "-" | Mul -> "*") string) 29 | 30 | let rec expr : expr Fmt.t = 31 | fun ppf -> 32 | let is_complex = function Num _ | Var _ -> false | _ -> true in 33 | let pp_nested pp ppf e = 34 | if is_complex e then (parens pp) ppf e else pp ppf e 35 | in 36 | function 37 | | Num n -> int ppf n 38 | | Var x -> string ppf x 39 | | Binop (op, e1, e2) -> 40 | pf ppf "@[<2>%a@ %a@ %a@]" (pp_nested pp_expr) e1 pp_binop op 41 | (pp_nested pp_expr) e2 42 | | Lambda (x, e) -> pf ppf "@[<2>lambda %s.@ %a@]" x pp_expr e 43 | | Let (e1, (x, e2)) -> 44 | pf ppf "@[let %s = %a in@;%a@]" x pp_expr e1 pp_expr e2 45 | | App (e1, e2) -> 46 | pf ppf "@[<2>%a@ %a@]" (pp_nested pp_expr) e1 (pp_nested pp_expr) e2 47 | end 48 | -------------------------------------------------------------------------------- /homework/hw2/lib/part2/dune: -------------------------------------------------------------------------------- 1 | ; Build configuration 2 | 3 | ; Treat warnings as non-fatal 4 | 5 | (env 6 | (dev 7 | (flags 8 | (:standard -warn-error -A)))) 9 | 10 | (data_only_dirs examples) 11 | 12 | ; --------------- 13 | ; lamp main files 14 | 15 | (library 16 | (name lamp) 17 | (preprocess 18 | (pps ppx_jane ppx_deriving.show)) 19 | (libraries base fmt) 20 | (modules ast scanner parser parse_util vars eval err)) 21 | 22 | (ocamllex scanner) 23 | 24 | (ocamlyacc parser) 25 | -------------------------------------------------------------------------------- /homework/hw2/lib/part2/err.ml: -------------------------------------------------------------------------------- 1 | exception Syntax of { sl : int; sc : int; el : int; ec : int } 2 | exception Lexing of { l : int; s : string } 3 | 4 | let syntax_error () = 5 | let start_pos = Parsing.rhs_start_pos 1 in 6 | let end_pos = Parsing.rhs_end_pos 1 in 7 | let sl = start_pos.pos_lnum 8 | and sc = start_pos.pos_cnum - start_pos.pos_bol 9 | and el = end_pos.pos_lnum 10 | and ec = end_pos.pos_cnum - end_pos.pos_bol in 11 | raise (Syntax { sl; sc; el; ec }) 12 | -------------------------------------------------------------------------------- /homework/hw2/lib/part2/eval.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | let todo () = failwith "TODO" 4 | let bonus () = failwith "BONUS" 5 | 6 | exception Stuck of string 7 | (** Exception indicating that evaluation is stuck *) 8 | 9 | (** Raises an exception indicating that evaluation got stuck. *) 10 | let im_stuck msg = raise (Stuck msg) 11 | 12 | (** Computes the set of free variables in the given expression *) 13 | let rec free_vars (e : expr) : Vars.t = 14 | (* This line imports the functions in Vars, so you can write [diff .. ..] 15 | instead of [Vars.diff .. ..] *) 16 | let open Vars in 17 | (* Your code goes here *) 18 | match e with 19 | | Num _ -> empty 20 | | Binop (_, e1, e2) -> todo () 21 | | Var x -> todo () 22 | | Lambda binder -> todo () 23 | | App (e1, e2) -> todo () 24 | | Let (e1, binder) -> union (free_vars e1) (todo ()) 25 | 26 | (** Perform substitution c[x -> e], i.e., substituting x with e in c *) 27 | let rec subst (x : string) (e : expr) (c : expr) : expr = 28 | match c with 29 | | Num n -> Num n 30 | | Binop (op, c1, c2) -> todo () 31 | | Var y -> todo () 32 | | Lambda binder -> todo () 33 | | App (c1, c2) -> todo () 34 | | Let (c1, binder) -> Let (subst x e c1, todo ()) 35 | 36 | (** Evaluate expression e *) 37 | let rec eval (e : expr) : expr = 38 | try 39 | match e with 40 | | Num n -> Num n 41 | | Binop (op, e1, e2) -> todo () 42 | | Var x -> todo () 43 | | Lambda binder -> todo () 44 | | App (e1, e2) -> todo () 45 | | Let (e1, (x, e2)) -> todo () 46 | | _ -> im_stuck (Fmt.str "Ill-formed expression: %a" Pretty.expr e) 47 | with Stuck msg -> 48 | im_stuck (Fmt.str "%s\nin expression %a" msg Pretty.expr e) 49 | 50 | type sigma = (string * expr) list 51 | (** Substitution *) 52 | 53 | (** Perform simultaneous substitution c[sigma], i.e., substituting variables in c according to sigma *) 54 | let rec subst_multi (sigma : sigma) (c : expr) : expr = bonus () 55 | 56 | (** Alpha-equivalence *) 57 | let alpha_equiv (e1 : expr) (e2 : expr) : bool = bonus () 58 | -------------------------------------------------------------------------------- /homework/hw2/lib/part2/eval.mli: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | exception Stuck of string 4 | 5 | val free_vars : expr -> Vars.t 6 | (** Return the set of free variable references in an expression *) 7 | 8 | val subst : string -> expr -> expr -> expr 9 | (** Substitution *) 10 | 11 | val eval : expr -> expr 12 | (** Interpret an expression *) 13 | 14 | type sigma = (string * expr) list 15 | (** Substitution *) 16 | 17 | val subst_multi : sigma -> expr -> expr 18 | (** Simultaneous substitution *) 19 | 20 | val alpha_equiv : expr -> expr -> bool 21 | (** Alpha equivalence *) 22 | -------------------------------------------------------------------------------- /homework/hw2/lib/part2/examples/add.lp: -------------------------------------------------------------------------------- 1 | 1 + 2 -------------------------------------------------------------------------------- /homework/hw2/lib/part2/examples/apply.lp: -------------------------------------------------------------------------------- 1 | fun apply with f, x = 2 | f x 3 | in (lambda x. x * 2) x -------------------------------------------------------------------------------- /homework/hw2/lib/part2/examples/true.lp: -------------------------------------------------------------------------------- 1 | lambda x, y. x -------------------------------------------------------------------------------- /homework/hw2/lib/part2/parse_util.ml: -------------------------------------------------------------------------------- 1 | (** Helper function for parsing an expression. Useful for testing. *) 2 | let parse (s : string) : Ast.expr = 3 | Parser.main Scanner.token (Lexing.from_string s) 4 | 5 | let parse_file (f : string) : Ast.expr = 6 | let ch = open_in f in 7 | let contents = really_input_string ch (in_channel_length ch) in 8 | close_in ch; 9 | parse contents 10 | -------------------------------------------------------------------------------- /homework/hw2/lib/part2/parser.mly: -------------------------------------------------------------------------------- 1 | %{ 2 | open Ast 3 | let mk_lambdas (xs : string list) (e : expr) = 4 | let f x e' = Lambda((x,e')) in 5 | List.fold_right f xs e 6 | 7 | %} 8 | 9 | /* Tokens */ 10 | 11 | %token EOF FUN REC MATCH BAR END GT EQ LT LPAREN RPAREN DOT COMMA 12 | %token TRUE FALSE AND OR 13 | %token LET IN IF THEN ELSE WITH LAMBDA 14 | %token NIL CONS 15 | %token TYINT TYLIST THINARROW COLON LBRACK RBRACK 16 | 17 | %token PLUS SUB TIMES APP 18 | %token NUMBER 19 | %token ID 20 | 21 | %nonassoc LPAREN RPAREN ID NIL NUMBER TRUE FALSE LBRACK RBRACK 22 | %right LAMBDA 23 | %left AND OR 24 | %left LT GT EQ 25 | %left PLUS SUB 26 | %left TIMES 27 | %right CONS 28 | %left APP 29 | 30 | %right THINARROW TYLIST 31 | 32 | %start main 33 | %type main 34 | 35 | %% 36 | 37 | main: 38 | | expr EOF { $1 } 39 | | error EOF { Err.syntax_error() } 40 | 41 | bind: 42 | | ID { $1 } 43 | 44 | bindlist: 45 | | bind { [$1] } 46 | | bind COMMA bindlist { $1 :: $3 } 47 | 48 | 49 | /* split up exprs into multiple parts. This is to avoid reducing expr 50 | prematurely, otherwise we end up with situations like (lambda f. f 3) parsed 51 | as ((lambda f. f) 3) 52 | */ 53 | expr: 54 | | LAMBDA bindlist DOT expr %prec LAMBDA { mk_lambdas $2 $4 } 55 | | FUN bind WITH bindlist EQ expr IN expr { let x = $2 in Let(mk_lambdas $4 $6, (x,$8)) } 56 | | LET bind EQ expr IN expr { Let($4, ($2,$6)) } 57 | | binop { $1 } 58 | | term { $1 } 59 | 60 | atom: 61 | | ID { Var($1) } 62 | | NUMBER { Num($1) } 63 | 64 | binop: 65 | | expr PLUS expr { Binop(Add, $1, $3) } 66 | | expr SUB expr { Binop(Sub, $1, $3) } 67 | | expr TIMES expr { Binop(Mul, $1, $3) } 68 | 69 | term: 70 | | atom { $1 } 71 | | LPAREN expr RPAREN { $2 } 72 | | term term %prec APP { App($1, $2) } 73 | -------------------------------------------------------------------------------- /homework/hw2/lib/part2/scanner.mll: -------------------------------------------------------------------------------- 1 | { 2 | open Parser 3 | } 4 | 5 | rule token = parse 6 | | [' ' '\r' '\t'] { token lexbuf } 7 | | '\n' { Lexing.new_line lexbuf; token lexbuf } 8 | | "let" { LET } 9 | | "in" { IN } 10 | | "fun" { FUN } 11 | | "rec" { REC } 12 | | "with" { WITH } 13 | | "match" { MATCH } 14 | | "end" { END } 15 | | "lambda" { LAMBDA } 16 | | "if" { IF } 17 | | "then" { THEN } 18 | | "else" { ELSE } 19 | | "true" { TRUE } 20 | | "false" { FALSE } 21 | | "Nil" { NIL } 22 | | "::" { CONS } 23 | | "+" { PLUS } 24 | | "-" { SUB } 25 | | "*" { TIMES } 26 | | "Int" { TYINT } 27 | | "List" { TYLIST } 28 | | ['0'-'9']+ as n { NUMBER(int_of_string(n)) } 29 | | ['a'-'z' 'A'-'Z' '_']['a'-'z' 'A'-'Z' '0'-'9' '_']* as x { ID(x) } 30 | | "->" { THINARROW } 31 | | ':' { COLON } 32 | | ">" { GT } 33 | | '=' { EQ } 34 | | "&&" { AND } 35 | | "||" { OR } 36 | | "|" { BAR } 37 | | "<" { LT } 38 | | '(' { LPAREN } 39 | | ')' { RPAREN } 40 | | '[' { LBRACK } 41 | | ']' { RBRACK } 42 | | '.' { DOT } 43 | | ',' { COMMA } 44 | | "//" { comment lexbuf } 45 | | eof { EOF } 46 | | _ { raise (Err.Lexing {l = Lexing.lexeme_start lexbuf; s= Lexing.lexeme lexbuf} ) } 47 | 48 | and comment = parse 49 | | '\n' { Lexing.new_line lexbuf; token lexbuf } 50 | | _ { comment lexbuf } 51 | | eof { EOF } 52 | -------------------------------------------------------------------------------- /homework/hw2/lib/part2/vars.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | type t = Set.M(String).t 4 | 5 | let pp : t Fmt.t = 6 | Fmt.using Set.to_list Fmt.(braces @@ list ~sep:(any ", ") string) 7 | 8 | let equal = Set.equal 9 | let empty = Set.empty (module String) 10 | let diff = Set.diff 11 | let singleton = Set.singleton (module String) 12 | let add s v = Set.add v s 13 | let union = Set.union 14 | let mem s v = Set.mem v s 15 | let of_list = Set.of_list (module String) 16 | -------------------------------------------------------------------------------- /homework/hw2/lib/part2/vars.mli: -------------------------------------------------------------------------------- 1 | (** Signature for variable set module *) 2 | 3 | type t 4 | (** type of variable set *) 5 | 6 | val pp : t Fmt.t 7 | (** pretty printer for variable set *) 8 | 9 | val equal : t -> t -> bool 10 | (** equality function for variable set *) 11 | 12 | val empty : t 13 | (** empty set *) 14 | 15 | val mem : string -> t -> bool 16 | (** [mem x s] is true iff [x] is in [s] *) 17 | 18 | val diff : t -> t -> t 19 | (** [diff s1 s2] is the set of elements in [s1] but not in [s2] *) 20 | 21 | val singleton : string -> t 22 | (** [singleton x] is the singleton set containing [x] *) 23 | 24 | val add : string -> t -> t 25 | (** [add x s] is the set [s] with [x] added to it *) 26 | 27 | val union : t -> t -> t 28 | (** [union s1 s2] is the union of [s1] and [s2] *) 29 | 30 | val of_list : string list -> t 31 | (** [of_list l] converts a list [l] into a set *) 32 | -------------------------------------------------------------------------------- /homework/hw2/sol.md: -------------------------------------------------------------------------------- 1 | # Solutions to HW2 Exercises 2 | 3 | 4 | ## Part 1 5 | 6 | ### Problem 1.1 7 | ```ocaml 8 | fun (x: int) (y: int) (z: int): int -> x + y + z 9 | ``` 10 | 11 | ### Problem 1.2 12 | See [lecture 4](../../lectures/lecture4.pdf). 13 | 14 | ### Problem 1.6: 15 | See the [library implementation](https://github.com/ocaml/ocaml/blob/c82ce40504f0875969bf86b22e4d6ec7e26b3153/stdlib/list.ml#L125). 16 | 17 | ### Problem 1.7 18 | 19 | ```ocaml 20 | List.fold_left (fun acc (k,v) -> 21 | match acc with 22 | | None -> if equal k key then Some v else None 23 | | Some _ -> acc) None dict 24 | ``` 25 | 26 | ### Problem 1.8 27 | 1. `compress` 28 | - Using `fold_right`: 29 | ```ocaml 30 | List.fold_right (fun x acc -> 31 | match acc with 32 | | [] -> [x] 33 | | y::ys -> if equal x y then acc else x::acc) lst [] 34 | ``` 35 | - `compress` can't be implemented with just `fold_left` alone, but if you have `List.rev` available, you can do: 36 | ```ocaml 37 | List.rev (List.fold_left (fun acc x -> 38 | match acc with 39 | | [] -> [x] 40 | | y::ys -> if equal x y then acc else x::acc) [] xs) 41 | ``` 42 | Altneratively, if you have `last_opt: 'a list -> 'a option` that returns the last element of a list (and `None` if the list is empty), you can do: 43 | 44 | ```ocaml 45 | List.fold_left (fun acc x -> 46 | match last_opt acc with 47 | | None -> [x] 48 | | Some y -> if equal x y then acc else acc @ [x]) 49 | [] xs 50 | ``` 51 | 52 | 2. `max`: 53 | - Using `fold_right`: 54 | ```ocaml 55 | match xs with 56 | | [] -> None 57 | | x::xs -> Some (List.fold_right (fun x acc -> if x > acc then x else acc) xs x) 58 | ``` 59 | - Using `fold_left`: 60 | ```ocaml 61 | match xs with 62 | | [] -> None 63 | | x::xs -> Some (List.fold_left (fun acc x -> if x > acc then x else acc) x xs) 64 | ``` 65 | 3. `join`: 66 | - Using `fold_right`: 67 | ```ocaml 68 | List.fold_right (fun x acc -> 69 | match x, acc with 70 | | Some x, Some acc -> Some (x::acc) 71 | | _ -> None) xs (Some []) 72 | ``` 73 | - Using `fold_left`: 74 | ```ocaml 75 | List.fold_left (fun acc x -> 76 | match x, acc with 77 | | Some x, Some acc -> Some (acc @ [x]) 78 | | _ -> None) (Some []) xs 79 | ``` 80 | 4. It suffices to observe that `map` itself can be implemented using `fold_right` as: 81 | ```ocaml 82 | List.fold_right (fun x acc -> f x :: acc) xs [] 83 | ``` 84 | or using `fold_left` as: 85 | ```ocaml 86 | List.fold_left (fun acc x -> acc @ [f x]) [] xs 87 | ``` 88 | 5. See above. 89 | 6. `filter`: 90 | - Using `fold_right`: 91 | ```ocaml 92 | List.fold_right (fun x acc -> 93 | if p x then x::acc else acc) xs [] 94 | ``` 95 | - Using `fold_left`: 96 | ```ocaml 97 | List.fold_left (fun acc x -> 98 | if p x then acc @ [x] else acc) [] xs 99 | ``` 100 | 7. `length`: 101 | - Using `fold_right`: 102 | ```ocaml 103 | List.fold_right (fun _ acc -> acc + 1) xs 0 104 | ``` 105 | - Using `fold_left`: 106 | ```ocaml 107 | List.fold_left (fun acc _ -> acc + 1) 0 xs 108 | ``` 109 | 8. `id`: 110 | - Using `fold_right`: 111 | ```ocaml 112 | List.fold_right (fun x acc -> x::acc) xs [] 113 | ``` 114 | - Using `fold_left`: 115 | ```ocaml 116 | List.fold_left (fun acc x -> acc @ [x]) [] xs 117 | ``` 118 | 9. `rev` (note the symmetry with the previous problem): 119 | - Using `fold_right`: 120 | ```ocaml 121 | List.fold_right (fun x acc -> acc @ [x]) xs [] 122 | ``` 123 | - Using `fold_left`: 124 | ```ocaml 125 | List.fold_left (fun acc x -> x::acc) [] xs 126 | ``` 127 | 10. `append`: 128 | - Using `fold_right`: 129 | ```ocaml 130 | let append xs ys = 131 | List.fold_right (fun x acc -> x::acc) xs ys 132 | ``` 133 | - Not possible using `fold_left` if `@` isn't allowed. 134 | 11. `flatten`: 135 | - Using `fold_right`: 136 | ```ocaml 137 | List.fold_right (fun x acc -> x @ acc) xs [] 138 | ``` 139 | - Using `fold_left`: 140 | ```ocaml 141 | List.fold_left (fun acc x -> acc @ x) [] xs 142 | ``` 143 | 12. `concat_map`: 144 | - Using `fold_right`: 145 | ```ocaml 146 | List.fold_right (fun x acc -> f x @ acc) xs [] 147 | ``` 148 | - Using `fold_left`: 149 | ```ocaml 150 | List.fold_left (fun acc x -> acc @ f x) [] xs 151 | ``` 152 | Note that `concat_map` is just `map` followed by flatten. 153 | 154 | 155 | 156 | 157 | 158 | ## Part 2 159 | 160 | ### Problem 2.0 161 | 162 | 1. `let x = 2 in let y = x * x in x + y`: 163 | ```ocaml 164 | Let( 165 | Num 2, 166 | ("x", 167 | Let( 168 | Binop (Mul, Var "x", Var "x"), 169 | ("y", 170 | Binop (Add, Var "x", Var "y") 171 | ) 172 | ) 173 | ) 174 | ) 175 | ``` 176 | 177 | 2. `(lambda x, y. let z = x + y in z * z) 2 3` 178 | ```ocaml 179 | App ( 180 | App ( 181 | Lambda ( 182 | "x", 183 | Lambda ( 184 | "y", 185 | Let ( 186 | Binop (Add, Var "x", Var "y"), 187 | ( 188 | "z", 189 | Binop (Mul, Var "z", Var "z") 190 | ) 191 | ) 192 | ) 193 | ), 194 | Num 2), 195 | Num 3) 196 | ``` 197 | Note that application is left-associative. 198 | 199 | 3. `fun f with x = let x = x + 1 in x in f f`. First, `fun F with X,Y,.. = E1 in E2` is desugared into `let F = lambda X, Y,.. . E1 in E2`. The AST is thus 200 | ```ocaml 201 | Let ( 202 | Lambda ( 203 | "x", 204 | Let ( 205 | Binop (Add, Var "x", Num 1), 206 | ("x", Var "x") 207 | ) 208 | ), 209 | ("f", App (Var "f", Var "f")) 210 | ) 211 | ``` 212 | -------------------------------------------------------------------------------- /homework/hw2/test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name hw2_test) 3 | (libraries fmt base alcotest part1 lamp) 4 | (preprocess 5 | (pps ppx_jane)) 6 | (deps 7 | (source_tree ../lib/part4))) 8 | -------------------------------------------------------------------------------- /homework/hw2/test/hw2_test.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | let () = 4 | Alcotest.run "hw2" 5 | (List.map 6 | ~f:(fun (name, tests) -> 7 | (name, List.map ~f:(Alcotest.test_case name `Quick) tests)) 8 | (Test_part1.tests @ Test_part2.tests)) 9 | -------------------------------------------------------------------------------- /homework/hw2/test/test_part1.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Part1 3 | 4 | let test_singletons (xs, expected) () = 5 | Alcotest.(check' (list (list int))) 6 | ~msg:"same list" ~expected ~actual:(singletons xs) 7 | 8 | let test_map2d (f, xxs, expected) () = 9 | Alcotest.(check' (list (list int))) 10 | ~msg:"same list" ~expected ~actual:(map2d f xxs) 11 | 12 | let test_product (xs, ys, expected) () = 13 | Alcotest.(check' (list (list (pair int bool)))) 14 | ~msg:"same list" ~expected ~actual:(product xs ys) 15 | 16 | let test_power (xs, expected) () = 17 | let sort = 18 | Fn.compose 19 | (* sort subsets *) 20 | (List.sort ~compare:[%compare: int list]) 21 | (* sort elements in each subset *) 22 | (List.map ~f:(List.sort ~compare:[%compare: int])) 23 | in 24 | Alcotest.(check' (list (list int))) 25 | ~msg:"same list after sorting" ~expected:(sort expected) 26 | ~actual:(sort (power xs)) 27 | 28 | let test_both (x, y, expected) () = 29 | Alcotest.( 30 | check' 31 | (option (pair int string)) 32 | ~msg:"same option" ~expected ~actual:(both x y)) 33 | 34 | let singletons_tests = 35 | [ (* input *) ([ 6; 7; 3 ], (* expected output *) [ [ 6 ]; [ 7 ]; [ 3 ] ]) ] 36 | 37 | let map2d_tests = 38 | [ 39 | ( (* input function *) (fun x -> x + 1), 40 | (* input list *) [ [ 1; 2 ]; [ 3; 4 ] ], 41 | (* expected output *) [ [ 2; 3 ]; [ 4; 5 ] ] ); 42 | ] 43 | 44 | let product_tests = 45 | [ 46 | ( (* input xs *) [ 1; 2 ], 47 | (* input ys *) [ true; false ], 48 | (* expected output *) 49 | [ [ (1, true); (1, false) ]; [ (2, true); (2, false) ] ] ); 50 | ] 51 | 52 | let power_tests = 53 | [ 54 | ( (* input *) [ 1; 2; 3 ], 55 | (* expected output *) 56 | [ []; [ 1 ]; [ 2 ]; [ 3 ]; [ 1; 2 ]; [ 1; 3 ]; [ 2; 3 ]; [ 1; 2; 3 ] ] ); 57 | ] 58 | 59 | let both_tests = 60 | [ 61 | ( (* input 1 *) Some 1, 62 | (* input 2 *) Some "a", 63 | (* expected output *) Some (1, "a") ); 64 | ] 65 | 66 | let tests = 67 | [ 68 | ("singletons", List.map ~f:test_singletons singletons_tests); 69 | ("map2d", List.map ~f:test_map2d map2d_tests); 70 | ("product", List.map ~f:test_product product_tests); 71 | ("power", List.map ~f:test_power power_tests); 72 | ("both", List.map ~f:test_both both_tests); 73 | ] 74 | -------------------------------------------------------------------------------- /homework/hw2/test/test_part2.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lamp 3 | open Ast 4 | open Eval 5 | 6 | module Dsl = struct 7 | let lam x e = Lambda (x, e) 8 | let ( ?? ) x = Var x 9 | let ( ! ) n = Num n 10 | let ( + ) e1 e2 = Binop (Add, e1, e2) 11 | let ( - ) e1 e2 = Binop (Sub, e1, e2) 12 | let ( * ) e1 e2 = Binop (Mul, e1, e2) 13 | let let_ x e1 ~in_:e2 = Let (e1, (x, e2)) 14 | let app e1 e2 = App (e1, e2) 15 | end 16 | 17 | (* Unit test utilities *) 18 | let texpr = Alcotest.testable Pretty.expr equal_expr 19 | let tvars = Alcotest.testable Vars.pp Vars.equal 20 | 21 | let parse s = 22 | try Parse_util.parse s 23 | with _ -> Alcotest.fail (Fmt.str "parse failed for %s" s) 24 | 25 | let parse_file filename = 26 | try Parse_util.parse_file filename 27 | with _ -> Alcotest.fail (Fmt.str "parse failed for %s" filename) 28 | 29 | (** Test free variable function *) 30 | let test_free_vars ((e, expected) : expr * string list) () = 31 | Alcotest.(check' tvars) 32 | ~msg:"same set" ~expected:(Vars.of_list expected) ~actual:(free_vars e) 33 | 34 | (** Test free variable function with concrete syntax input *) 35 | let test_free_vars_s ((e_str, expected) : string * string list) () = 36 | test_free_vars (parse e_str, expected) () 37 | 38 | (** Test substitution c[ x |-> e ] = expected *) 39 | let test_subst (x, e, c, expected) () = 40 | let c' = 41 | try subst x e c with Stuck msg -> failwith ("Got stuck!\n" ^ msg) 42 | in 43 | Alcotest.(check' texpr) ~msg:"same expr" ~expected ~actual:c' 44 | 45 | (** Test substitution c[ x |-> e ] = expected, with concrete syntax inputs *) 46 | let test_subst_s (x, e, c, expected) = 47 | test_subst (x, parse e, parse c, parse expected) 48 | 49 | (** Check an expression evaluate to the expected value *) 50 | let test_eval (e, expected) () = 51 | let v = try eval e with Stuck msg -> failwith ("Got stuck!\n" ^ msg) in 52 | Alcotest.(check' texpr) ~msg:"eval" ~expected ~actual:v 53 | 54 | (** Check a expression (concrete syntax) evaluate to the expected value (concrete syntax) *) 55 | let test_eval_s (e_str, expected_str) = 56 | test_eval (parse e_str, parse expected_str) 57 | 58 | (** Check an expression gets stuck during evaluation *) 59 | let test_stuck (e : expr) () = 60 | try 61 | let v = eval e in 62 | Alcotest.fail (Fmt.str "evaluated to %a" Pretty.expr v) 63 | with Stuck _ -> () 64 | 65 | (** Check a expression (concrete syntax) gets stuck during evaluation *) 66 | let test_stuck_s (e_str : string) = test_stuck (parse e_str) 67 | 68 | let test_subst_multi (sigma, e, expected) () = 69 | let e' = 70 | try subst_multi sigma e with Stuck msg -> failwith ("Got stuck!\n" ^ msg) 71 | in 72 | Alcotest.(check' texpr) ~msg:"same expr" ~expected ~actual:e' 73 | 74 | let test_subst_multi_s (sigma, e, expected) = 75 | test_subst_multi 76 | (List.map ~f:(fun (x, s) -> (x, parse s)) sigma, parse e, parse expected) 77 | 78 | let test_alpha_equiv (e1, e2, expected) () = 79 | Alcotest.(check' bool) 80 | ~msg:"alpha equiv" ~expected ~actual:(alpha_equiv e1 e2) 81 | 82 | let test_alpha_equiv_s (e1, e2, expected) = 83 | test_alpha_equiv (parse e1, parse e2, expected) 84 | 85 | let free_vars_tests = [ ("lambda x. y", [ "y" ]) ] 86 | 87 | let subst_tests = 88 | [ test_subst_s ("tmp", "1", "tmp + tmp2", (*expected *) "1 + tmp2") ] 89 | 90 | let eval_tests = 91 | [ 92 | test_eval_s ((* input *) "1+2", (* expected *) "3"); 93 | test_eval_s 94 | ( "let q = lambda x. x+1 in let b = lambda x, _. x in let a = lambda \ 95 | y,x,f. f y (y x f) in let l = lambda x. x 0 (lambda _.q) in let k = \ 96 | lambda p. p (lambda p.p) (lambda q,d,p. a (d p)) in let j = lambda p. \ 97 | p (lambda p.b) (lambda q,d,p.k p (d p)) in let x = lambda p. p \ 98 | (lambda p.a b) (lambda q,d,p.j p (d p)) in let m = lambda x. x b \ 99 | (lambda x,y.x) in let o = lambda p. p (lambda p.p) (lambda q,d,p. d \ 100 | (m p)) in let f = lambda f,x,y. f y x in l b + l (m (a (a b))) + l (f \ 101 | o (a (a (a (a b)))) (a (a b))) + l (k (a b) (a (a b))) + l (j (a (a \ 102 | b)) (a (a b))) + l (f x (a (a (a (a (a b))))) (a b))", 103 | "15" ); 104 | ] 105 | 106 | let eval_stuck_tests = [ test_stuck_s (* input *) "(lambda x. x) + 1" ] 107 | 108 | let subst_multi_tests = 109 | [ 110 | test_subst_multi_s 111 | ([ ("x", "1"); ("y", "2") ], "x + y", (* expected *) "1 + 2"); 112 | ] 113 | 114 | let alpha_equiv_tests = 115 | [ 116 | test_alpha_equiv_s ("lambda x. x", "lambda y. y", (* expected output *) true); 117 | test_alpha_equiv_s 118 | ("lambda x. y", "lambda y. x", (* expected output *) false); 119 | ] 120 | 121 | let tests = 122 | [ 123 | ("free_vars", List.map ~f:test_free_vars_s free_vars_tests); 124 | ("subst", subst_tests); 125 | ("eval", eval_tests); 126 | ("eval_stuck", eval_stuck_tests); 127 | ("subst_multi", subst_multi_tests); 128 | ("alpha_equiv", alpha_equiv_tests); 129 | ] 130 | -------------------------------------------------------------------------------- /homework/hw3/.ocamlformat: -------------------------------------------------------------------------------- 1 | profile = default 2 | version = 0.26.2 -------------------------------------------------------------------------------- /homework/hw3/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: zip 2 | 3 | FILES := lamp/eval.ml 4 | ARCHIVE := submission.zip 5 | 6 | $(ARCHIVE): $(FILES) 7 | zip -j $(ARCHIVE) $(FILES) 8 | 9 | zip: $(ARCHIVE) -------------------------------------------------------------------------------- /homework/hw3/bin/dune: -------------------------------------------------------------------------------- 1 | ; Build configuration 2 | 3 | ; Treat warnings as non-fatal 4 | 5 | (env 6 | (dev 7 | (flags 8 | (:standard -warn-error -A)))) 9 | 10 | ; --------------- 11 | ; generate date information 12 | 13 | (rule 14 | (target build_metadata.ml) 15 | (deps (universe)) 16 | (action 17 | (run bash "-c" "echo let date = \\\"$(date)\\\" > %{target}"))) 18 | 19 | ; --------------- 20 | ; statically link the binary for CSIL if using musl libc 21 | 22 | (rule 23 | (target build_flags) 24 | (enabled_if 25 | (= %{ocaml-config:c_compiler} "musl-gcc")) 26 | (action 27 | (write-file %{target} "(-ccopt -static)"))) 28 | 29 | (rule 30 | (target build_flags) 31 | (enabled_if 32 | (<> %{ocaml-config:c_compiler} "musl-gcc")) 33 | (action 34 | (write-file %{target} "()"))) 35 | 36 | ; --------------- 37 | ; lamp repl 38 | 39 | (executable 40 | (name repl) 41 | (modules build_metadata repl) 42 | (libraries base lamp linenoise cmdliner) 43 | (flags 44 | :standard 45 | (:include build_flags)) 46 | (modes exe)) 47 | 48 | (install 49 | (section bin) 50 | (files repl.exe)) 51 | -------------------------------------------------------------------------------- /homework/hw3/bin/repl.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lamp 3 | open Ast 4 | 5 | module Opts = struct 6 | let path : string option ref = ref None 7 | let quiet : bool ref = ref false 8 | end 9 | 10 | let () = 11 | let open Parser in 12 | Expr.pp_exceptions (); 13 | Command.pp_exceptions (); 14 | Script.pp_exceptions () 15 | 16 | let get_eval () e = Eval.eval e 17 | 18 | let handler (f : unit -> unit) : unit = 19 | try f () with 20 | | Eval.Stuck msg -> Fmt.pr "runtime error: %s\n%!" msg 21 | | Stack_overflow -> 22 | Fmt.epr 23 | "Interpreter stack overflow; too many recursive function calls\n%!" 24 | 25 | let context : (string * expr) list ref = ref [] 26 | let get_context () = context 27 | 28 | let print_context () = 29 | Fmt.pr ">> context >>\n%!"; 30 | Fmt.pr " @[%a@]\n%!" 31 | Fmt.( 32 | vbox (list ~sep:cut (box (pair ~sep:(any " ->@ ") string Pretty.expr)))) 33 | (Base.List.rev !(get_context ())); 34 | Fmt.pr "<< context <<\n%!" 35 | 36 | let context_expr e = 37 | Base.List.fold_left ~init:e 38 | ~f:(fun e (x, def) -> Ast.DSL.let_ x def ~in_:e) 39 | !(get_context ()) 40 | 41 | let check_and_run (e : expr) : expr = get_eval () e 42 | 43 | let handle_let_or_eval (c : Cmd.t) = 44 | match c with 45 | | CLet (x, def) -> 46 | (let v = check_and_run (context_expr def) in 47 | Fmt.pr "%s = @[%a@]\n%!" x Pretty.expr v); 48 | get_context () := (x, def) :: !(get_context ()) 49 | | CEval e -> 50 | Fmt.pr "<== @[%a@]\n%!" Pretty.expr e; 51 | if not !Opts.quiet then Fmt.pr "<== AST:\n%a\n%!" Ast.pp_expr e; 52 | let v = check_and_run (context_expr e) in 53 | Fmt.pr "[eval] ==> @[%a@]\n%!" Pretty.expr v 54 | | _ -> failwith "Impossible" 55 | 56 | let replayable = function Cmd.CLet _ -> true | _ -> false 57 | 58 | let rec repl () = 59 | try 60 | match LNoise.linenoise "> " with 61 | | None -> () 62 | | Some l -> 63 | LNoise.history_add l |> ignore; 64 | handler (fun () -> 65 | match Lamp.Parser.Command.parse_string l with 66 | | CPrint -> print_context () 67 | | CClear -> 68 | get_context () := []; 69 | Fmt.pr ". context cleared\n%!" 70 | | CLoad f -> 71 | (* match LNoise.history_load ~filename:f with 72 | | Ok () -> *) 73 | Fmt.pr ". loading history from %s\n%!" f; 74 | Fmt.pr ". replaying history...\n%!"; 75 | (* load content of file f and split it into lines *) 76 | Parser.Script.parse_file f 77 | |> Base.List.filter ~f:replayable 78 | |> Base.List.iter ~f:(fun c -> 79 | try handle_let_or_eval c with _ -> ()); 80 | Fmt.pr ". history replayed\n%!" 81 | (* | Error e -> Fmt.pr ". error loading history: %s\n%!" e) *) 82 | | CSave f -> ( 83 | match LNoise.history_save ~filename:f with 84 | | Ok () -> Fmt.pr ". history saved to %s\n%!" f 85 | | Error e -> Fmt.pr ". error saving history: %s\n%!" e) 86 | | (CLet _ | CEval _) as c -> handle_let_or_eval c); 87 | repl () 88 | with Stdlib.Sys.Break -> repl () 89 | 90 | let read_args () = 91 | let set_file s = Opts.path := Some s in 92 | let opts = 93 | [ 94 | ("-q", Stdlib.Arg.Set Opts.quiet, "suppress AST printing (default: off)"); 95 | ] 96 | in 97 | Stdlib.Arg.parse opts set_file "" 98 | 99 | let main () = 100 | read_args (); 101 | match !Opts.path with 102 | | Some file_name -> 103 | handler (fun () -> 104 | let e = Parser.Expr.parse_file file_name in 105 | if not !Opts.quiet then Fmt.pr "Parsed: @[%a@]\n%!" Pretty.expr e; 106 | let v = check_and_run e in 107 | Fmt.pr "@[%a@]\n%!" Pretty.expr v) 108 | | None -> 109 | (* repl mode *) 110 | Fmt.pr "Welcome to lambda+! Built on: %s\n%!" Build_metadata.date; 111 | LNoise.history_set ~max_length:100 |> ignore; 112 | repl () 113 | ;; 114 | 115 | main () 116 | -------------------------------------------------------------------------------- /homework/hw3/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.11) 2 | 3 | (name hw3) 4 | 5 | (generate_opam_files true) 6 | 7 | (source 8 | (github username/reponame)) 9 | 10 | (authors "Junrui Liu, Bryan Tan, Yu Feng") 11 | 12 | (maintainers "Junrui Liu") 13 | 14 | (documentation https://url/to/documentation) 15 | 16 | (using menhir 2.1) 17 | 18 | (package 19 | (name hw3) 20 | (allow_empty) 21 | (synopsis "A short synopsis") 22 | (description "A longer description") 23 | (depends 24 | dune 25 | base 26 | alcotest 27 | ppx_deriving 28 | ppx_jane 29 | utop 30 | linenoise 31 | fmt 32 | nice_parser 33 | menhir) 34 | (tags 35 | (topics "to describe" your project))) 36 | 37 | ; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project 38 | -------------------------------------------------------------------------------- /homework/hw3/hw3.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "A short synopsis" 4 | description: "A longer description" 5 | maintainer: ["Junrui Liu"] 6 | authors: ["Junrui Liu, Bryan Tan, Yu Feng"] 7 | tags: ["topics" "to describe" "your" "project"] 8 | homepage: "https://github.com/username/reponame" 9 | doc: "https://url/to/documentation" 10 | bug-reports: "https://github.com/username/reponame/issues" 11 | depends: [ 12 | "dune" {>= "3.11"} 13 | "base" 14 | "alcotest" 15 | "ppx_deriving" 16 | "ppx_jane" 17 | "utop" 18 | "linenoise" 19 | "fmt" 20 | "nice_parser" 21 | "menhir" 22 | "odoc" {with-doc} 23 | ] 24 | build: [ 25 | ["dune" "subst"] {dev} 26 | [ 27 | "dune" 28 | "build" 29 | "-p" 30 | name 31 | "-j" 32 | jobs 33 | "@install" 34 | "@runtest" {with-test} 35 | "@doc" {with-doc} 36 | ] 37 | ] 38 | dev-repo: "git+https://github.com/username/reponame.git" 39 | -------------------------------------------------------------------------------- /homework/hw3/lamp/ast.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | (** Binary operators *) 4 | type binop = Add | Sub | Mul [@@deriving equal, show] 5 | 6 | (** Relational comparison operators *) 7 | type relop = Eq | Lt | Gt [@@deriving equal, show] 8 | 9 | type 'a binder = string * 'a [@@deriving equal, show] 10 | 11 | (** AST of Lambda+ expressions *) 12 | type expr = 13 | (* binding *) 14 | | Var of string 15 | (* lambda calculus *) 16 | | Lambda of expr binder 17 | | App of expr * expr 18 | (* let expression *) 19 | | Let of expr * expr binder 20 | (* boolean *) 21 | | True 22 | | False 23 | | IfThenElse of expr * expr * expr 24 | (* arithmetic *) 25 | | Num of int 26 | | Binop of binop * expr * expr 27 | | Comp of relop * expr * expr 28 | (* list *) 29 | | ListNil 30 | | ListCons of expr * expr 31 | | ListMatch of expr * expr * expr binder binder 32 | (* fix *) 33 | | Fix of expr binder 34 | (* external choice *) 35 | | Both of expr * expr 36 | | I1 of expr 37 | | I2 of expr 38 | (* internal choice *) 39 | | E1 of expr 40 | | E2 of expr 41 | | Either of expr * expr binder * expr binder 42 | [@@deriving equal, show] 43 | 44 | (** Pretty-printers *) 45 | module Pretty = struct 46 | open Fmt 47 | 48 | let pp_binop : binop Fmt.t = 49 | fun ppf op -> 50 | string ppf (match op with Add -> "+" | Sub -> "-" | Mul -> "*") 51 | 52 | let pp_relop : relop Fmt.t = 53 | fun ppf op -> string ppf (match op with Eq -> "=" | Lt -> "<" | Gt -> ">") 54 | 55 | let rec expr : expr Fmt.t = 56 | fun ppf -> 57 | let is_complex = function 58 | | Num _ | Var _ | True | False | Both _ | ListNil | I1 _ | I2 _ -> false 59 | | _ -> true 60 | in 61 | let pp_nested pp ppf e = 62 | if is_complex e then (parens pp) ppf e else pp ppf e 63 | in 64 | let pp = pp_nested expr in 65 | function 66 | | Num n -> int ppf n 67 | | Var x -> string ppf x 68 | | Binop (op, e1, e2) -> pf ppf "%a %a@ %a" pp e1 pp_binop op pp e2 69 | | Lambda (x, e) -> pf ppf "lambda %s.@ %a" x expr e 70 | | Let (e1, (x, e2)) -> 71 | pf ppf "@[le@[t %s = %a in@]@ @[%a@]@]" x expr e1 expr e2 72 | | App (e1, e2) -> pf ppf "%a@ %a" pp e1 pp e2 73 | | True -> string ppf "true" 74 | | False -> string ppf "false" 75 | | IfThenElse (e1, e2, e3) -> 76 | pf ppf "@[if %a@ then %a@ else %a@]" expr e1 expr e2 expr e3 77 | | Comp (op, e1, e2) -> pf ppf "%a %a@ %a" pp e1 pp_relop op pp e2 78 | | ListNil -> pf ppf "Nil" 79 | | ListCons (e1, e2) -> pf ppf "%a ::@ %a" pp e1 pp e2 80 | | ListMatch (e1, e2, (h, (t, e3))) -> 81 | pf ppf "@[match %a with@;| Nil -> %a@;| %s :: %s -> %a@;end@]" expr 82 | e1 expr e2 h t expr e3 83 | | E1 e -> pf ppf "$1@ %a" pp e 84 | | E2 e -> pf ppf "$2@ %a" pp e 85 | | Either (e1, (x, e2), (y, e3)) -> 86 | pf ppf 87 | "@[match @[%a@] with@;| $1 %s -> @[%a@]@;| $2 %s -> @[%a@]@;end@]" 88 | expr e1 x expr e2 y expr e3 89 | | Fix (f, e) -> pf ppf "fix %s is@ %a" f expr e 90 | | Both (e1, e2) -> pf ppf "(%a,@ %a)" expr e1 expr e2 91 | | I1 e -> pf ppf "%a.1" pp e 92 | | I2 e -> pf ppf "%a.2" pp e 93 | end 94 | 95 | module DSL = struct 96 | let lam x e = Lambda (x, e) 97 | let v x = Var x 98 | let i n = Num n 99 | let ( + ) e1 e2 = Binop (Add, e1, e2) 100 | let ( - ) e1 e2 = Binop (Sub, e1, e2) 101 | let ( * ) e1 e2 = Binop (Mul, e1, e2) 102 | let let_ x e1 ~in_:e2 = Let (e1, (x, e2)) 103 | let app e1 e2 = App (e1, e2) 104 | let ( = ) e1 e2 = Comp (Eq, e1, e2) 105 | let ( < ) e1 e2 = Comp (Lt, e1, e2) 106 | let ( > ) e1 e2 = Comp (Gt, e1, e2) 107 | let if_ e1 ~then_:e2 ~else_:e3 = IfThenElse (e1, e2, e3) 108 | let fix x ~is:e = Fix (x, e) 109 | let nil = ListNil 110 | let cons e1 e2 = ListCons (e1, e2) 111 | 112 | let match_ e1 ~with_nil:e2 ~with_cons:(x, y, e3) = 113 | ListMatch (e1, e2, (x, (y, e3))) 114 | 115 | let pair e1 e2 = Both (e1, e2) 116 | let fst e = I1 e 117 | let snd e = I2 e 118 | end 119 | -------------------------------------------------------------------------------- /homework/hw3/lamp/cmd.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | type t = 4 | | CLet of string * expr 5 | | CLoad of string 6 | | CSave of string 7 | | CPrint 8 | | CClear 9 | | CEval of expr 10 | 11 | type script = t list 12 | -------------------------------------------------------------------------------- /homework/hw3/lamp/dune: -------------------------------------------------------------------------------- 1 | ; Build configuration 2 | 3 | ; Treat warnings as non-fatal 4 | 5 | (env 6 | (dev 7 | (flags 8 | (:standard -warn-error -A)))) 9 | 10 | ; --------------- 11 | ; lamp main files 12 | 13 | (library 14 | (name lamp) 15 | (preprocess 16 | (pps ppx_deriving.show ppx_jane ppx_sexp_conv)) 17 | (libraries base fmt nice_parser)) 18 | 19 | (ocamllex lexer) 20 | 21 | (menhir 22 | (modules menhir_parser)) 23 | -------------------------------------------------------------------------------- /homework/hw3/lamp/err.ml: -------------------------------------------------------------------------------- 1 | exception Syntax of { sl : int; sc : int; el : int; ec : int } 2 | exception Lexing of { l : int; s : string } 3 | 4 | let syntax_error () = 5 | let start_pos = Parsing.rhs_start_pos 1 in 6 | let end_pos = Parsing.rhs_end_pos 1 in 7 | let sl = start_pos.pos_lnum 8 | and sc = start_pos.pos_cnum - start_pos.pos_bol 9 | and el = end_pos.pos_lnum 10 | and ec = end_pos.pos_cnum - end_pos.pos_bol in 11 | raise (Syntax { sl; sc; el; ec }) 12 | -------------------------------------------------------------------------------- /homework/hw3/lamp/eval.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | let todo () = failwith "TODO" 4 | 5 | exception Stuck of string 6 | (** Exception indicating that evaluation is stuck *) 7 | 8 | (** Raises an exception indicating that evaluation got stuck. *) 9 | let im_stuck msg = raise (Stuck msg) 10 | 11 | (** Computes the set of free variables in the given expression *) 12 | let rec free_vars (e : expr) : Vars.t = 13 | (* This line imports the functions in Vars, so you can write [diff .. ..] 14 | instead of [Vars.diff .. ..] *) 15 | let open Vars in 16 | match e with _ -> todo () 17 | 18 | (** Perform substitution c[x -> e], i.e., substituting x with e in c *) 19 | let rec subst (x : string) (e : expr) (c : expr) : expr = 20 | match c with _ -> todo () 21 | 22 | (** Evaluate expression e *) 23 | let rec eval (e : expr) : expr = 24 | try match e with _ -> todo () 25 | with Stuck msg -> 26 | im_stuck (Fmt.str "%s\nin expression %a" msg Pretty.expr e) 27 | -------------------------------------------------------------------------------- /homework/hw3/lamp/eval.mli: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | exception Stuck of string 4 | 5 | val free_vars : expr -> Vars.t 6 | (** Return the set of free variable references in an expression *) 7 | 8 | val subst : string -> expr -> expr -> expr 9 | (** Substitution *) 10 | 11 | val eval : expr -> expr 12 | (** Interpret an expression *) 13 | -------------------------------------------------------------------------------- /homework/hw3/lamp/lamp.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "lambda-plus" 3 | version: "0.1" 4 | synopsis: "Lambda+ programming language" 5 | depends: [ 6 | "alcotest" {with-test} 7 | "linenoise" 8 | "dune" {>= "2.4"} 9 | ] 10 | maintainer: ["junrui@ucsb.edu" "bryantan@ucsb.edu" "yufeng@cs.ucsb.edu"] 11 | -------------------------------------------------------------------------------- /homework/hw3/lamp/lexer.mll: -------------------------------------------------------------------------------- 1 | { 2 | open Menhir_parser 3 | exception LexError of string 4 | 5 | let failwith msg = raise (LexError msg) 6 | 7 | let illegal c = 8 | failwith (Printf.sprintf "[lexer] unexpected character: '%c'" c) 9 | } 10 | 11 | let ws = ' ' | '\t' 12 | let newline = "\r\n" | '\r' | '\n' 13 | 14 | rule next_token = parse 15 | | ws+ { next_token lexbuf } 16 | | newline { Lexing.new_line lexbuf; next_token lexbuf } 17 | | "#load" { CLOAD } 18 | | "#save" { CSAVE } 19 | | "#print" { CPRINT } 20 | | "#clear" { CCLEAR } 21 | | "#let" { CLET } 22 | | "let" { LET } 23 | | "in" { IN } 24 | | "fun" { FUN } 25 | | "rec" { REC } 26 | | "with" { WITH } 27 | | "match" { MATCH } 28 | | "end" { END } 29 | | "lambda" { LAMBDA } 30 | | "if" { IF } 31 | | "then" { THEN } 32 | | "else" { ELSE } 33 | | "true" { TRUE } 34 | | "false" { FALSE } 35 | | "fix" { FIX } 36 | | "is" { IS } 37 | | ".1" { FST } 38 | | ".2" { SND } 39 | | "Nil" { NIL } 40 | | "::" { CONS } 41 | | "+" { PLUS } 42 | | "-" { SUB } 43 | | "*" { TIMES } 44 | | "$1" { E1 } 45 | | "$2" { E2 } 46 | | ['0'-'9']+ as n { NUMBER(Base.Int.of_string(n)) } 47 | | ['a'-'z' 'A'-'Z' '_']['a'-'z' 'A'-'Z' '0'-'9' '_']* as x { ID(x) } 48 | | ['a'-'z' 'A'-'Z' '0'-'9' '_' '-' '/' ]+ ".txt" as x { FILE(x) } 49 | | "->" { THINARROW } 50 | | ">" { GT } 51 | | '=' { EQ } 52 | | "|" { BAR } 53 | | "<" { LT } 54 | | '(' { LPAREN } 55 | | ')' { RPAREN } 56 | | '.' { DOT } 57 | | ',' { COMMA } 58 | | "//" { comment lexbuf } 59 | | eof { EOF } 60 | | _ as c { illegal c } 61 | 62 | and comment = parse 63 | | newline { Lexing.new_line lexbuf; next_token lexbuf } 64 | | _ { comment lexbuf } 65 | | eof { EOF } 66 | -------------------------------------------------------------------------------- /homework/hw3/lamp/menhir_parser.mly: -------------------------------------------------------------------------------- 1 | %{ 2 | 3 | let mk_lambdas (xs : string list) (e : Ast.expr) : Ast.expr = 4 | let f x e' = Ast.Lambda((x,e')) in 5 | List.fold_right f xs e 6 | %} 7 | 8 | /* Tokens */ 9 | 10 | %token EOF FUN REC MATCH BAR END GT EQ LT LPAREN RPAREN DOT COMMA FIX IS 11 | %token TRUE FALSE 12 | %token LET IN IF THEN ELSE WITH LAMBDA 13 | %token NIL CONS 14 | %token THINARROW 15 | %token CLET CPRINT CCLEAR CLOAD CSAVE 16 | %token FST SND E1 E2 17 | 18 | %token PLUS SUB TIMES 19 | %token NUMBER 20 | %token ID 21 | %token FILE 22 | 23 | %nonassoc IN DOT ELSE IS 24 | %right CONS 25 | %left LT GT EQ 26 | %left PLUS SUB 27 | %left TIMES 28 | %nonassoc E1 E2 29 | 30 | %start expr_eof 31 | %type expr_eof 32 | 33 | %start repl_command_eof 34 | %type repl_command_eof 35 | 36 | %start script_eof 37 | %type script_eof 38 | 39 | %% 40 | 41 | file_command: 42 | | CLET bind EQ expr 43 | { let x = $2 in Cmd.CLet(x,$4) } 44 | | CPRINT 45 | { Cmd.CPrint} 46 | | CCLEAR 47 | { Cmd.CClear} 48 | | CLOAD FILE 49 | { Cmd.CLoad $2 } 50 | | CSAVE FILE 51 | { Cmd.CSave $2 } 52 | 53 | repl_command: 54 | | c=file_command 55 | { c } 56 | | expr 57 | { Cmd.CEval $1 } 58 | 59 | repl_command_eof: 60 | | c=repl_command EOF 61 | { c } 62 | 63 | script_eof: 64 | | cs=list(file_command) EOF 65 | { cs } 66 | 67 | expr_eof: 68 | | e=expr EOF 69 | { e } 70 | 71 | bind: 72 | | x=ID 73 | { x } 74 | 75 | bindlist: 76 | | l=separated_nonempty_list(COMMA, bind) 77 | { l } 78 | 79 | expr: 80 | | e=app 81 | { e } 82 | | LAMBDA bs=bindlist DOT e=expr 83 | { mk_lambdas bs e } 84 | | FUN REC x=bind WITH bs=bindlist EQ e1=expr IN e2=expr 85 | { Let(Fix ((x, mk_lambdas bs e1)), (x, e2)) } 86 | | FUN x=bind WITH xs=bindlist EQ e1=expr IN e2=expr 87 | { Let(mk_lambdas xs e1, (x, e2)) } 88 | | FIX x=bind IS e=expr 89 | { Fix (x,e) } 90 | | LET b=bind EQ e1=expr IN e2=expr 91 | { let x = b in 92 | Ast.Let (e1, (x,e2)) } 93 | | IF e1=expr THEN e2=expr ELSE e3=expr 94 | { IfThenElse(e1, e2, e3) } 95 | | e=list_match 96 | { e } 97 | | e=sum_match 98 | { e } 99 | | e=binop(expr) 100 | { e } 101 | | E1; e=expr 102 | { E1 e } 103 | | E2; e=expr 104 | { E2 e } 105 | 106 | binop(expr): 107 | | expr PLUS expr 108 | { Binop(Add, $1, $3) } 109 | | expr SUB expr 110 | { Binop(Sub, $1, $3) } 111 | | expr TIMES expr 112 | { Binop(Mul, $1, $3) } 113 | | expr LT expr 114 | { Comp(Lt, $1, $3) } 115 | | expr GT expr 116 | { Comp(Gt, $1, $3) } 117 | | expr EQ expr 118 | { Comp(Eq, $1, $3) } 119 | | expr CONS expr 120 | { ListCons($1, $3) } 121 | 122 | app: 123 | | term 124 | { $1 } 125 | | e1=app e2=term 126 | { App(e1, e2) } 127 | 128 | nil_branch: 129 | | NIL THINARROW e=expr 130 | { e } 131 | 132 | cons_branch: 133 | | x=ID CONS y=ID THINARROW e=expr 134 | { (x, y, e) } 135 | 136 | list_match: 137 | | MATCH e1=expr WITH option(BAR) e2=nil_branch BAR b3=cons_branch END 138 | { 139 | let (x,y,e3) = b3 in 140 | Ast.ListMatch(e1, e2, (x, (y, e3)))} 141 | 142 | branch(TAG): 143 | | TAG x=ID THINARROW e=expr 144 | { (x, e) } 145 | 146 | sum_match: 147 | | MATCH e1=expr WITH option(BAR) b2=branch(E1) BAR b3=branch(E2) END 148 | { Ast.Either(e1, b2, b3) } 149 | 150 | term: 151 | | x=ID 152 | { Ast.Var x } 153 | | n=NUMBER 154 | { Ast.Num n } 155 | | TRUE 156 | { Ast.True } 157 | | FALSE 158 | { Ast.False } 159 | | NIL 160 | { ListNil } 161 | | LPAREN e=expr RPAREN 162 | { e } 163 | | LPAREN e1=expr COMMA e2=expr RPAREN 164 | { Ast.Both(e1, e2) } 165 | | e=term FST 166 | { Ast.I1 e } 167 | | e=term SND 168 | { Ast.I2 e } 169 | 170 | -------------------------------------------------------------------------------- /homework/hw3/lamp/parser.ml: -------------------------------------------------------------------------------- 1 | module Expr = Nice_parser.Make (struct 2 | type result = Ast.expr 3 | type token = Menhir_parser.token 4 | 5 | exception ParseError = Menhir_parser.Error 6 | 7 | let parse = Menhir_parser.expr_eof 8 | 9 | include Lexer 10 | end) 11 | 12 | module Command = Nice_parser.Make (struct 13 | type result = Cmd.t 14 | type token = Menhir_parser.token 15 | 16 | exception ParseError = Menhir_parser.Error 17 | 18 | let parse = Menhir_parser.repl_command_eof 19 | 20 | include Lexer 21 | end) 22 | 23 | module Script = Nice_parser.Make (struct 24 | type result = Cmd.script 25 | type token = Menhir_parser.token 26 | 27 | exception ParseError = Menhir_parser.Error 28 | 29 | let parse = Menhir_parser.script_eof 30 | 31 | include Lexer 32 | end) 33 | -------------------------------------------------------------------------------- /homework/hw3/lamp/vars.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | type t = Set.M(String).t 4 | 5 | let pp : t Fmt.t = 6 | Fmt.using Set.to_list Fmt.(braces @@ list ~sep:(any ", ") string) 7 | 8 | let show = Fmt.to_to_string pp 9 | let equal = Set.equal 10 | let compare = Set.compare_direct 11 | let empty = Set.empty (module String) 12 | let diff = Set.diff 13 | let singleton = Set.singleton (module String) 14 | let add s v = Set.add v s 15 | let union = Set.union 16 | let mem s v = Set.mem v s 17 | let of_list = Set.of_list (module String) 18 | let to_list = Set.to_list 19 | let size = Set.length 20 | -------------------------------------------------------------------------------- /homework/hw3/lamp/vars.mli: -------------------------------------------------------------------------------- 1 | (** Signature for variable set module *) 2 | 3 | type t [@@deriving equal, compare, show] 4 | (** type of variable set *) 5 | 6 | val empty : t 7 | (** empty set *) 8 | 9 | val mem : string -> t -> bool 10 | (** [mem x s] is true iff [x] is in [s] *) 11 | 12 | val diff : t -> t -> t 13 | (** [diff s1 s2] is the set of elements in [s1] but not in [s2] *) 14 | 15 | val singleton : string -> t 16 | (** [singleton x] is the singleton set containing [x] *) 17 | 18 | val add : string -> t -> t 19 | (** [add x s] is the set [s] with [x] added to it *) 20 | 21 | val union : t -> t -> t 22 | (** [union s1 s2] is the union of [s1] and [s2] *) 23 | 24 | val of_list : string list -> t 25 | (** [of_list l] converts a list [l] into a set *) 26 | 27 | val to_list : t -> string list 28 | (** [to_list x] converts a set [s] into a list *) 29 | 30 | val size : t -> int 31 | (** Return the size of a set *) 32 | -------------------------------------------------------------------------------- /homework/hw3/test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name hw3_test) 3 | (libraries fmt alcotest lamp) 4 | (preprocess 5 | (pps ppx_jane ppx_deriving.show)) 6 | (deps 7 | (source_tree examples))) 8 | -------------------------------------------------------------------------------- /homework/hw3/test/examples/add_n.lp: -------------------------------------------------------------------------------- 1 | // increments every element of a list by n 2 | fun rec add_n with l, n = 3 | match l with 4 | | Nil -> Nil 5 | | x::xs -> x + n :: add_n xs n 6 | end 7 | in add_n (1::2::Nil) 10 // evaluates to 11::12::Nil -------------------------------------------------------------------------------- /homework/hw3/test/examples/fib.lp: -------------------------------------------------------------------------------- 1 | fun rec fib with n = 2 | if n = 0 then 0 3 | else if n = 1 then 1 4 | else fib (n-1) + fib (n-2) 5 | in fib 30 -------------------------------------------------------------------------------- /homework/hw3/test/examples/fib_int.lp: -------------------------------------------------------------------------------- 1 | fun rec fib with p, n = 2 | if n = 0 then p.1 3 | else 4 | let x = p.1 in 5 | let y = p.2 in 6 | fib (y, x+y) (n-1) 7 | in fib (0, 1) 30 -------------------------------------------------------------------------------- /homework/hw3/test/examples/max_ext.lp: -------------------------------------------------------------------------------- 1 | fun rec max with l = 2 | match l with 3 | | Nil -> $2 false 4 | | x::t -> $1 (match max t with 5 | | $1 y -> if x > y then x else y 6 | | $2 _ -> x 7 | end) 8 | end 9 | in 10 | max (7::10::5::1::4::2::Nil) -------------------------------------------------------------------------------- /homework/hw3/test/examples/mutual_rec_int.lp: -------------------------------------------------------------------------------- 1 | // Mutual recursion can be realized by combining fix and internal choice 2 | let even_odd = fix even_odd is 3 | ( 4 | lambda n. 5 | let odd = even_odd.2 in 6 | if n = 0 then true 7 | else odd (n-1) 8 | , 9 | lambda n. 10 | let even = even_odd.1 in 11 | if n = 0 then false 12 | else even (n-1) 13 | ) in 14 | let even = even_odd.1 in 15 | let odd = even_odd.2 in 16 | if odd 11111 then even 11111 else even 0 -------------------------------------------------------------------------------- /homework/hw3/test/examples/primes.lp: -------------------------------------------------------------------------------- 1 | // an infinite list can be represented as a lambda that, 2 | // when called with anything, returns a list whose head is 3 | // the first element of the list and whose tail is another 4 | // infinite list 5 | 6 | // an infinite list containing n, n+1, n+2, ... 7 | fun rec countfrom with n = 8 | lambda _. n :: countfrom (n+1) in 9 | 10 | // the infinite list of natural numbers 0, 1, 2, ... 11 | let nat = countfrom 0 in 12 | 13 | // force the materialization of an infinite list by calling it with 14 | // a dummy argument 15 | fun force with l = l false in 16 | 17 | // filter a (potentially infinite) list 18 | fun rec filter with l, p = 19 | lambda _. 20 | match force l with 21 | | Nil -> Nil 22 | | h::t -> 23 | if p h then h :: filter t p 24 | else force (filter t p) 25 | end in 26 | 27 | // take the length-n prefix of a (potentially infinite) list 28 | fun rec take with l, n = 29 | match force l with 30 | | Nil -> Nil 31 | | h::t -> if n = 0 then Nil else h::(take t (n-1)) 32 | end in 33 | 34 | // check if x divides y 35 | fun rec divides with x, y = 36 | if x > y then false 37 | else if x = y then true 38 | else divides x (y-x) in 39 | 40 | // boolean negation 41 | let not = lambda b. if b then false else true in 42 | 43 | // sieve of Eratosthenes 44 | // https://youtu.be/bnRNiE_OVWA 45 | fun rec sieve with l = 46 | lambda _. 47 | match force l with 48 | | Nil -> Nil // unreachable branch 49 | | h :: t -> 50 | h :: sieve (filter t (lambda n. not (divides h n))) 51 | end in 52 | 53 | // infinite list of primes: 2, 3, 5, 7, ... 54 | let primes = sieve (countfrom 2) in 55 | 56 | // the first 50 primes 57 | take primes 50 58 | 59 | // feel free to replace 50 with other numbers! -------------------------------------------------------------------------------- /homework/hw3/test/examples/primes_internal.lp: -------------------------------------------------------------------------------- 1 | // an infinite list can be represented as an internal choice (an object) 2 | // with two behaviors: querying the head element, and querying the tail 3 | 4 | fun hd with l = l.1 in 5 | fun tl with l = l.2 in 6 | 7 | // take the length-n prefix of a (potentially infinite) list 8 | fun rec take with l, n = 9 | if n = 0 10 | then Nil 11 | else hd l :: take (tl l) (n-1) in 12 | 13 | // an infinite list containing n, n+1, n+2, ... 14 | fun rec countfrom with n = 15 | (n, countfrom (n+1)) in 16 | 17 | // the infinite list of natural numbers 0, 1, 2, ... 18 | let nat = countfrom 0 in 19 | 20 | // take nat 10 21 | 22 | // filter an infinite list 23 | fun rec filter with l, p = 24 | let h = hd l in 25 | if p h 26 | then (h, filter (tl l) p) 27 | else filter (tl l) p in 28 | 29 | // check if x divides y 30 | fun rec divides with x, y = 31 | if x > y then false 32 | else if x = y then true 33 | else divides x (y-x) 34 | in 35 | 36 | let is_even = lambda n. divides 2 n in 37 | 38 | // take (filter nat is_even) 10 39 | 40 | // boolean negation 41 | let not = lambda b. if b then false else true in 42 | 43 | // sieve of Eratosthenes 44 | // https://youtu.be/bnRNiE_OVWA 45 | fun rec sieve with l = 46 | let h = hd l in 47 | (h, sieve (filter (tl l) (lambda n. not (divides h n)))) in 48 | 49 | // infinite list of primes: 2, 3, 5, 7, ... 50 | let primes = sieve (countfrom 2) in 51 | 52 | // the first 50 primes 53 | take primes 50 54 | 55 | // feel free to replace 50 with other numbers! -------------------------------------------------------------------------------- /homework/hw3/test/hw3_test.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | let () = 4 | Alcotest.run "hw3" 5 | (List.map 6 | ~f:(fun (name, tests) -> 7 | (name, List.map ~f:(Alcotest.test_case name `Quick) tests)) 8 | Test_lamp.tests) 9 | -------------------------------------------------------------------------------- /homework/hw3/test/test_lamp.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lamp 3 | open Ast 4 | open Eval 5 | 6 | exception Timeout 7 | 8 | (* run a function with specified timeout: 9 | https://discuss.ocaml.org/t/computation-with-time-constraint/5548/9 *) 10 | let with_timeout timeout f = 11 | let _ = 12 | Stdlib.Sys.set_signal Stdlib.Sys.sigalrm 13 | (Stdlib.Sys.Signal_handle (fun _ -> raise Timeout)) 14 | in 15 | ignore (Unix.alarm timeout); 16 | try 17 | let r = f () in 18 | ignore (Unix.alarm 0); 19 | r 20 | with e -> 21 | ignore (Unix.alarm 0); 22 | raise e 23 | 24 | (* Unit test utilities *) 25 | let texpr = Alcotest.testable Pretty.expr equal_expr 26 | let tvars = Alcotest.testable Vars.pp Vars.equal 27 | 28 | let parse s = 29 | try Parser.Expr.parse_string s 30 | with _ -> Alcotest.fail ("Failed to parse: " ^ s) 31 | 32 | (** Test free variable function *) 33 | let test_free_vars (e : expr) (expected : string list) () = 34 | Alcotest.(check' tvars) 35 | ~msg:"same set" ~expected:(Vars.of_list expected) ~actual:(free_vars e) 36 | 37 | (** Test free variable function with concrete syntax input *) 38 | let test_free_vars_s (e_str : string) (expected : string list) () = 39 | test_free_vars (parse e_str) expected () 40 | 41 | (** Test substitution c[ x |-> e ] = expected *) 42 | let test_subst ~(x : string) ~(e : expr) ~(c : expr) (expected : expr) () = 43 | let c' = 44 | try subst x e c with Stuck msg -> failwith ("Got stuck!\n" ^ msg) 45 | in 46 | Alcotest.(check' texpr) ~msg:"same expr" ~expected ~actual:c' 47 | 48 | (** Test substitution c[ x |-> e ] = expected, with concrete syntax inputs *) 49 | let test_subst_s ~(x : string) ~(e : string) ~(c : string) (expected : string) 50 | () = 51 | test_subst ~x ~e:(parse e) ~c:(parse c) (parse expected) () 52 | 53 | (** Check an expression evaluate to the expected value *) 54 | let test_eval_with (e : expr) (expected : expr) ~f () = 55 | try 56 | with_timeout 10 (fun () -> 57 | let v = f e in 58 | Alcotest.(check' texpr) 59 | ~msg:(Fmt.str "%a" Pretty.expr e) 60 | ~expected ~actual:v) 61 | with 62 | | Stuck msg -> Alcotest.fail ("Got stuck!\n" ^ msg) 63 | | Timeout -> Alcotest.fail "Timeout!" 64 | 65 | (** Check an expression evaluate to the expected value *) 66 | let test_eval = test_eval_with ~f:eval 67 | 68 | (** Check a expression (concrete syntax) evaluate to the expected value (concrete syntax) *) 69 | let test_eval_s (e_str : string) (expected_str : string) () = 70 | test_eval (parse e_str) (parse expected_str) () 71 | 72 | let test_eval_file (filename : string) (expected_str : string) () = 73 | let e = Parser.Expr.parse_file filename in 74 | let expected = parse expected_str in 75 | test_eval e expected () 76 | 77 | (** Check an expression gets stuck during evaluation *) 78 | let test_stuck (e : expr) () = 79 | try 80 | let v = eval e in 81 | Alcotest.fail (Fmt.str "evaluated to %a" Pretty.expr v) 82 | with Stuck _ -> Alcotest.(check' unit) ~msg:"stuck" ~expected:() ~actual:() 83 | 84 | (** Check a expression (concrete syntax) gets stuck during evaluation *) 85 | let test_stuck_s (e_str : string) = test_stuck (parse e_str) 86 | 87 | let free_vars_tests = 88 | let t = test_free_vars_s in 89 | [ t "fix x is y" [ "y" ] ] 90 | 91 | let subst_tests = 92 | let t x e c = test_subst_s ~x ~e ~c in 93 | [ t (* arguments *) "var" "1" "var < var" (*expected *) "1 < 1" ] 94 | 95 | let eval_tests = 96 | (* test an input expression evaluates to the expected output *) 97 | let t = test_eval_s in 98 | (* parse the file containing an input expression, and check that it evaluates to the expected output *) 99 | let tf = test_eval_file in 100 | [ 101 | t (* input *) "1+2" (* expected *) "3"; 102 | tf (* input file *) "examples/fib.lp" (* expected *) "832040"; 103 | tf "examples/add_n.lp" "11::12::Nil"; 104 | tf "examples/primes.lp" 105 | "2::3::5::7::11::13::17::19::23::29::31::37::41::43::47::53::59::61::67::71::Nil"; 106 | ] 107 | 108 | let eval_stuck_tests = 109 | let t = test_stuck_s in 110 | [ t (* input *) "if 1 then 2 else 3" ] 111 | 112 | let tests = 113 | [ 114 | ("free_vars", free_vars_tests); 115 | ("subst", subst_tests); 116 | ("eval", eval_tests); 117 | ("eval_stuck", eval_stuck_tests); 118 | ] 119 | -------------------------------------------------------------------------------- /homework/hw4/.ocamlformat: -------------------------------------------------------------------------------- 1 | profile = default 2 | version = 0.26.2 -------------------------------------------------------------------------------- /homework/hw4/README.md: -------------------------------------------------------------------------------- 1 | # Homework Assignment 4 2 | 3 | **Due Wednesday, March 5th, 11:59PM (Pacific Time)** 4 | 5 | In this assignment, you will use OCaml to implement the type system of λ+. 6 | 7 | ## Instructions 8 | 9 | 0. Make sure you download the latest version of the reference manual [using this link](https://github.com/fredfeng/CS162/blob/master/homework/lamp.pdf). You will need to refer to the chapter on type checking in the language reference manual. 10 | 1. Either clone this directory, or download the zipped directory using [this link](https://download-directory.github.io/?url=https%3A%2F%2Fgithub.com%2Ffredfeng%2FCS162%2Ftree%2Fmaster%2Fhomework%2Fhw4). 11 | 2. The files required for this assignment are located in this folder. In particular, you will need to implement the `abstract_eval` function in [lamp/typecheck.ml](./lamp/typecheck.ml). 12 | 3. You must not change the type signatures of the original functions. Otherwise, your program will not compile. If you accidentally change the type signatures, you can refer to the corresponding `.mli` file to see what the expected type signatures are. 13 | 4. Once you're done, submit `lamp/typecheck.ml` to Gradescope. 14 | 5. If your program contains print statements, please remove them before submitting. You do not need to submit any other file, including any `.mli` file or test code. The autograder will automatically compile your code together with our testing infrastructure and run the tests. 15 | 16 | 17 | 18 | ### Mandatory type annotations 19 | 20 | Note that the typing rules only provide a method for proving that a given expression has a *given* type. In a type "checker", we are more interested in _computing_ the type of an expression. 21 | 22 | This is usually straightforward when the type of an expression can be assembled from the types of its subexpressions. However, this is not the case with lambdas, fix, and nil, which we require mandatory type annotations from the programmer that uses $\lambda^+$. (It is possible to write an algorithm to _infer_ the annotations needed; in fact, you will be implementing type inference in HW5.) 23 | 24 | We thus add type annotations to the concrete syntax of $\lambda^+$ as follows: 25 | * Lambdas are now of the form `lambda x: T. e`, where `T` is the type of `x`. 26 | * Nil is now of the form `Nil[T]`, where `T` is the type of the elements of the list, **not the type of the list itself**! 27 | * The fixed-point operator is now of the form `fix x: T is e`, where `T` is the type of `x`. 28 | * The `fun` syntax has changed so that it is now 29 | `fun f: Tr with x1: T1, ..., xn: Tn = e1 in e2`, where `Ti` is the 30 | type of `xi` for each `i`, and `Tr` is the *return type* of the function `f`. 31 | 32 | 33 | In terms of abstract syntax, the appropriate AST constructors have been augmented to take type annotations of the form `ty option`: 34 | ```diff 35 | type expr = 36 | ... 37 | - | Lambda of expr binder 38 | + | Lambda of ty option * expr binder 39 | 40 | - | Fix of expr binder 41 | + | Fix of ty option * expr binder 42 | 43 | - | ListNil 44 | + | ListNil of ty option 45 | ... 46 | ``` 47 | The reason we use `ty option` instead of `ty` even though those type annotations are mandatory for type checking is that in HW5 the annotations will become optional, so we anticipate the change and keep the AST consistent across assignments. 48 | 49 | But for this assignment, you can assume that **any expression that is not correctly annotated is ill-typed**. In other words, when your code expects a mandatory type annotation (for `ListNil`, `Lambda`, or `Fix`), you can assume the `ty option` part of the AST is always `Some ty`. In case the annotation is missing (i.e., it's a `None`), then you can simply crash the program or do whatever you want. 50 | 51 | 52 | 53 | ### Optional type annotations 54 | 55 | In contrast with the mandatory annotations discussed above, there are also "truly optional" type annotations. We introduce the syntax `e : T` to denote the annotation that `e` has type `T`. The associated AST constructor is `Annot of expr * ty`. 56 | 57 | In the concrete syntax, let-bindings can also take an optional type annotation via `let x: T = e1 in e2`. This will be de-sugared into `let x = (e1 : T) in e2` after parsing, so we don't need to change the AST constructor for `Let`. For example, `let f: Int -> Int = lambda x: Int. x + 5 in f 0` will be parsed into: 58 | ```ocaml 59 | Let( 60 | App(Var "f", Num 0), 61 | ( 62 | "f", 63 | Annot( 64 | Lambda( 65 | Some TInt, 66 | ("x", Binop(Add, Var "x", Num 5))), 67 | TFun(TInt, TInt) 68 | ) 69 | ) 70 | ) 71 | ``` 72 | 73 | Your code should correctly handle all optional annotations according to the T-Annot rule in the reference manual. 74 | 75 | 76 | 77 | ## Part 1: 📝 Exercises 78 | 79 | For each of the following expressions $e$: 80 | - Does there exist a type $T$ such that $\cdot \vdash e: T$, i.e., whether the expression is well-typed under an empty typing environment. If so, draw the type derivation tree. 81 | - If no such $T$ exists, does there exists a combination of $\Gamma$ and $T$ such that $\Gamma \vdash e: T$. If so, draw the type derivation tree. 82 | 83 | 1. `lambda x: Bool. x + 2 * x` 84 | 2. `x` 85 | 3. `(lambda x: Int. x + 2 * y) 3` 86 | 4. `10 < 10` 87 | 5. `1::2::3+4::Nil[Int]` 88 | 6. `Nil[Bool]::(lambda x:Bool.x::Nil[Bool->Bool])::true::Nil[Bool]` 89 | 7. `if true then false else true` 90 | 8. `match Nil[Bool] with Nil -> Nil[Bool] | _::_ -> Nil[Int] end` 91 | 9. `(if 3>4 then 5 else 7+10*3) = 10`. 92 | 10. `let f = lambda x:Bool. if x then false else true in f (10 > 0)` 93 | 11. `1 :: 10 :: Nil[Int] :: Nil[Int]` 94 | 12. `(1::10) :: Nil[Int] :: Nil[List[Int]]` 95 | 13. `match 1::Nil[Int] with Nil -> 0 | hd::_ -> hd end` 96 | 14. `match 1::Nil[Int] with Nil -> 0 | _::tl -> tl end` 97 | 15. `match 1::2 with Nil -> 3 | x::y -> x+y end` 98 | 16. `(fix recur: Int -> Int is lambda n: Int. if n < 1 then 1 else recur (n-1) + recur (n-2)) 2`. 99 | 17. `(fix recur:List[Bool] -> Int is lambda xs: List[Bool]. match xs with Nil -> 0 | _::ys -> 1 + recur ys end) (false::true::Nil)` 100 | 18. `(fix recur:List[List[Int]] -> Int is lambda xs: List[List[Int]]. match xs with Nil -> 0 | _::ys -> 1 + recur ys end) Nil[List[Int]]` 101 | 19. `(fix recur: Int -> Int -> Bool is lambda n: Int. recur (n-1) 10` 102 | 20. `(fix recur: Int -> Int is lambda n: Int. n-1) 10` 103 | 104 | 105 | 106 | ## Part 2: Implementing the type checker (🧑‍💻) 107 | 108 | Your task is to implement the `abstract_eval` function in [lamp/typecheck.ml](./lamp/typecheck.ml). Given a typing environment and expression, `abstract_eval` should either 1) evaluate the expression "abstractly" and return the type of the expression; or 2) raise a `Type_error` by calling `ty_err` if the expression cannot be proven to be well-typed. You need to implement the typing rules as described in the reference manual. 109 | 110 | Before implementing `abstract_eval`, we suggest you implement an `equal_ty` helper function that checks if two types are the same. Later in your `abstract_eval`, use this function to check if the type of an expression matches the expected type, or to assert that two expressions have the same type. 111 | 112 | We encourage you to construct your own test cases and test your type checker locally. Use the typing rules in combination with your own intuition to construct well-typed and ill-typed expressions. You can find unit test helpers in `test/test_typing.ml`, and you can execute unit tests with `dune runtest`. 113 | 114 | If you wish to test your type checker interactively through REPL, run `dune exec bin/repl.exe -- -typed`, which will spawn an interpreter with type checking enabled. Although we will not be testing your `eval` function when grading this homework, feel free to copy over your `eval.ml` (otherwise the REPL will crash whenever it calls the stub `eval` function). If you do, you will need to slightly modify your `eval` to account for the type annotations. 115 | 116 | The reference interpreter includes a type checker. You can enable type checking by running `~junrui/lamp -typed`. 117 | 118 | 119 | 120 | ## Tips 121 | * Start with the basics: implement the typing rules for integer, booleans, nil, and cons values. 122 | * Move on to the arithmetic, comparison, if-then-else, and type annotation rules. Make sure that a type error is raised when e.g. adding a number to a list or comparing two expression of different types. 123 | * Lastly, implement the remaining rules, which require you to handle the typing environment $\Gamma$. 124 | 125 | 126 | 127 | ## Part 3: Extra Credit Problems 128 | 129 |
130 | Click to show extra credit problems 131 | 132 | 133 | ### Problem 3.1 (1pt): 134 | 135 | We introduce two new language constructs: 136 | 137 | 1. The first one is called *unit*. 138 | - There is one syntactic form to make a unit value: `()`. In this AST, this is represented by `Unit` in the AST. There is no way to consume the unit value. 139 | - We introduce a new concrete type `()` for the unit value (represented by `TUnit` in the AST). 140 | 141 | Your task is to reverse engineer the operational semantics **and** the typing rule(s) of unit by augmenting your `eval` and `abstract_eval` functions. 142 | 143 | 2. The second construct is called *void*. 144 | - There is no syntactic form to make a void value. There is one way to consume a void value: `match e with end`, represented as `Absurd of expr` in the AST. 145 | - We introduce a new concrete type `!` for void (represented by `TVoid` in the AST. Your task is to reverse engineer the operational semantics of void by augmenting your `eval` function. 146 | 147 | *Though experiment:* Is it possible to type check void in your `abstract_eval` function? If so, how? If not, what would you need to change in the type system to make it possible? 148 | 149 | ---- 150 | ### Problem 3.2 (1pt) 151 | In HW3, you reverse-engineered the operational semantics of *internal choice*. 152 | >
Spoiler 153 | > Internal choices are just pairs/tuples with *lazy* evaluation semantics. 154 | >
155 | 156 | Now, we introduce a new concrete type `T1 * T2` to represent an internal choice between values of type `T1` and values of type `T2`. This type is represented in the AST by `TProd` (short for **prod**uct). Your task is to reverse engineer the typing rules of products. 157 | 158 | 159 | 160 | ---- 161 | ### Problem 3.3 (1pt) 162 | In HW3, you reverse-engineered the operational semantics of *external choice*. 163 | >
Spoiler 164 | > External choices are just enums with exactly two cases. 165 | >
166 | 167 | We introduce a new concrete type `T1 + T2` to represent an *external choice* between values of type `T1` and values of type `T2`. This type is represented in the AST by `TSum`. 168 | 169 | Your tasks are: 170 | 171 | 1. On paper, design the typing rules for `E1`, `E2`, and `Either`. Then, you use your typing rules to draw the type derivation tree for the [max_ext.lp](../hw3/test/examples/max_ext.lp) example program from HW3. 172 | 2. Is it possible to implement your rules in the `abstract_eval` function? If so, how? If not, what would you need to change in the type system or the type checking algorithm to make it possible? 173 | 174 | You do not need to write any code for this problem; simply let Junrui know your solutions by DM'ing him on Slack or going to his office hours. 175 | 176 | 177 | 178 | ---- 179 | #### Problem 3.4 (1pt) 180 | Define a function `size: typ -> int option` that computes the number of behaviorally distinct expressions that provably have a given type. If the type has infinitely many such members, return `None`. 181 | 182 | For example, 183 | - `size(Bool)` should return `Some 2` since the only boolean values are `true` and `false`. Note that we consider `true` and `2>1` to be behaviorally indistinguishable, since both of them evaluate to `true` under any context, so we don't count them separately. 184 | - `size(Int)` should return `None` since there are infinitely many integers. 185 | - `size(Bool -> Bool)` should return `Some 4`, since there are 4 boolean functions with distinct behaviors: 186 | 1. The identity function that returns its input unchanged 187 | 2. The constant function that always returns `true` 188 | 3. The constant function that always returns `false` 189 | 4. The function that negates its input 190 | 191 | In implementing `size`: 192 | - You need to handle all of the newly introduced types, including `TUnit`, `TVoid`, `TProd`, and `TSum`. 193 | - You do not need to consider expressions that may not terminate. I.e., you only need to count expressions that don't use `Fix`. 194 | - You do not need to consider ill-typed expressions like `1+true`. 195 | 196 |
197 | Hint 198 | There's an edge case for the list type. The other ones are elementary-school math. 199 |
200 | 201 |
-------------------------------------------------------------------------------- /homework/hw4/bin/dune: -------------------------------------------------------------------------------- 1 | ; Build configuration 2 | 3 | ; Treat warnings as non-fatal 4 | 5 | (env 6 | (dev 7 | (flags 8 | (:standard -warn-error -A)))) 9 | 10 | ; --------------- 11 | ; generate date information 12 | 13 | (rule 14 | (target build_metadata.ml) 15 | (deps (universe)) 16 | (action 17 | (run bash "-c" "echo let date = \\\"$(date)\\\" > %{target}"))) 18 | 19 | ; --------------- 20 | ; statically link the binary for CSIL if using musl libc 21 | 22 | (rule 23 | (target build_flags) 24 | (enabled_if 25 | (= %{ocaml-config:c_compiler} "musl-gcc")) 26 | (action 27 | (write-file %{target} "(-ccopt -static)"))) 28 | 29 | (rule 30 | (target build_flags) 31 | (enabled_if 32 | (<> %{ocaml-config:c_compiler} "musl-gcc")) 33 | (action 34 | (write-file %{target} "()"))) 35 | 36 | ; --------------- 37 | ; lamp repl 38 | 39 | (executable 40 | (name repl) 41 | (modules build_metadata repl) 42 | (libraries base lamp linenoise cmdliner) 43 | (flags 44 | :standard 45 | (:include build_flags)) 46 | (modes exe)) 47 | 48 | (install 49 | (section bin) 50 | (files repl.exe)) 51 | -------------------------------------------------------------------------------- /homework/hw4/bin/repl.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lamp 3 | open Ast 4 | 5 | module Opts = struct 6 | let path : string option ref = ref None 7 | let fast : bool ref = ref false 8 | let quiet : bool ref = ref false 9 | let typed : bool ref = ref false 10 | let tyinf : bool ref = ref false 11 | let poly : bool ref = ref false 12 | end 13 | 14 | let () = 15 | let open Parser in 16 | Expr.pp_exceptions (); 17 | Command.pp_exceptions (); 18 | Script.pp_exceptions (); 19 | Ty.pp_exceptions () 20 | 21 | let get_eval () e = Eval.eval e 22 | 23 | let handler (f : unit -> unit) : unit = 24 | try f () with 25 | | Eval.Stuck msg -> Fmt.pr "runtime error: %s\n%!" msg 26 | | Stack_overflow -> 27 | Fmt.epr 28 | "Interpreter stack overflow; too many recursive function calls\n%!" 29 | | Typecheck.Type_error s -> Fmt.epr "Type error: %s\n%!" s 30 | 31 | let context : ((string * ty option) * expr) list ref = ref [] 32 | let get_context () = context 33 | 34 | let print_context () = 35 | Fmt.pr ">> context >>\n%!"; 36 | Fmt.pr " @[%a@]\n%!" 37 | Fmt.( 38 | vbox 39 | (list ~sep:cut 40 | (box 41 | (pair ~sep:(any " ->@ ") 42 | (pair string (option (const string " : " ++ Pretty.ty))) 43 | Pretty.expr)))) 44 | (Base.List.rev !(get_context ())); 45 | Fmt.pr "<< context <<\n%!" 46 | 47 | let context_expr e = 48 | Base.List.fold_left ~init:e 49 | ~f:(fun e ((x, t), def) -> 50 | Ast.Let 51 | ((match t with None -> def | Some t -> Ast.Annot (def, t)), (x, e))) 52 | !(get_context ()) 53 | 54 | let check_and_run (e : expr) : expr = 55 | (if !Opts.typed then 56 | let ty = Typecheck.abstract_eval [] e in 57 | Fmt.pr "<-- type: @[%a@]\n%!" Pretty.ty ty); 58 | get_eval () e 59 | 60 | let handle_let_or_eval (c : Cmd.t) = 61 | match c with 62 | | CLet (x, t, def) -> 63 | (let v = check_and_run (context_expr def) in 64 | Fmt.pr "%s = @[%a@]\n%!" x Pretty.expr v); 65 | get_context () := ((x, t), def) :: !(get_context ()) 66 | | CEval e -> 67 | Fmt.pr "<== @[%a@]\n%!" Pretty.expr e; 68 | if not !Opts.quiet then Fmt.pr "<== AST:\n@[%a@]\n%!" Ast.pp_expr e; 69 | let v = check_and_run (context_expr e) in 70 | Fmt.pr "[eval] ==> @[%a@]\n%!" Pretty.expr v 71 | | _ -> failwith "Impossible" 72 | 73 | let replayable = function Cmd.CLet _ -> true | _ -> false 74 | 75 | let rec repl () = 76 | try 77 | match LNoise.linenoise "> " with 78 | | None -> () 79 | | Some l -> 80 | LNoise.history_add l |> ignore; 81 | handler (fun () -> 82 | match Lamp.Parser.Command.parse_string l with 83 | | CPrint -> print_context () 84 | | CClear -> 85 | get_context () := []; 86 | Fmt.pr ". context cleared\n%!" 87 | | CLoad f -> 88 | (* match LNoise.history_load ~filename:f with 89 | | Ok () -> *) 90 | Fmt.pr ". loading history from %s\n%!" f; 91 | Fmt.pr ". replaying history...\n%!"; 92 | (* load content of file f and split it into lines *) 93 | Parser.Script.parse_file f 94 | |> Base.List.filter ~f:replayable 95 | |> Base.List.iter ~f:(fun c -> 96 | try handle_let_or_eval c with _ -> ()); 97 | Fmt.pr ". history replayed\n%!" 98 | (* | Error e -> Fmt.pr ". error loading history: %s\n%!" e) *) 99 | | CSave f -> ( 100 | match LNoise.history_save ~filename:f with 101 | | Ok () -> Fmt.pr ". history saved to %s\n%!" f 102 | | Error e -> Fmt.pr ". error saving history: %s\n%!" e) 103 | | (CLet _ | CEval _) as c -> handle_let_or_eval c 104 | | _ -> ()); 105 | repl () 106 | with Stdlib.Sys.Break -> repl () 107 | 108 | let read_args () = 109 | let set_file s = Opts.path := Some s in 110 | let opts = 111 | [ 112 | ( "-typed", 113 | Stdlib.Arg.Set Opts.typed, 114 | "enable type checking in interpreter (default: off)" ); 115 | ( "-tyinf", 116 | Stdlib.Arg.Set Opts.tyinf, 117 | "enable type inference in interpreter (default: off)" ); 118 | ( "-poly", 119 | Stdlib.Arg.Set Opts.poly, 120 | "enable let-polymorphism (default: off)" ); 121 | ("-q", Stdlib.Arg.Set Opts.quiet, "suppress AST printing (default: off)"); 122 | ( "-fast", 123 | Stdlib.Arg.Set Opts.fast, 124 | "use closure semantics instead of eager substitution (default: off)" ); 125 | ] 126 | in 127 | Stdlib.Arg.parse opts set_file "" 128 | 129 | let main () = 130 | read_args (); 131 | match !Opts.path with 132 | | Some file_name -> 133 | handler (fun () -> 134 | let v = check_and_run (Parser.Expr.parse_file file_name) in 135 | Fmt.pr "@[%a@]\n%!" Pretty.expr v) 136 | | None -> 137 | (* repl mode *) 138 | Fmt.pr "Welcome to lambda+! Built on: %s\n%!" Build_metadata.date; 139 | LNoise.history_set ~max_length:100 |> ignore; 140 | repl () 141 | ;; 142 | 143 | main () 144 | -------------------------------------------------------------------------------- /homework/hw4/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.11) 2 | 3 | (name hw4) 4 | 5 | (generate_opam_files true) 6 | 7 | (source 8 | (github username/reponame)) 9 | 10 | (authors "Junrui Liu, Bryan Tan, Yu Feng") 11 | 12 | (maintainers "Junrui Liu") 13 | 14 | (documentation https://url/to/documentation) 15 | 16 | (using menhir 2.1) 17 | 18 | (package 19 | (name hw4) 20 | (allow_empty) 21 | (synopsis "A short synopsis") 22 | (description "A longer description") 23 | (depends dune base menhir nice_parser alcotest utop linenoise fmt) 24 | (tags 25 | (topics "to describe" your project))) 26 | 27 | ; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project 28 | -------------------------------------------------------------------------------- /homework/hw4/hw4.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "A short synopsis" 4 | description: "A longer description" 5 | maintainer: ["Junrui Liu"] 6 | authors: ["Junrui Liu, Bryan Tan, Yu Feng"] 7 | tags: ["topics" "to describe" "your" "project"] 8 | homepage: "https://github.com/username/reponame" 9 | doc: "https://url/to/documentation" 10 | bug-reports: "https://github.com/username/reponame/issues" 11 | depends: [ 12 | "dune" {>= "3.11"} 13 | "base" 14 | "menhir" 15 | "nice_parser" 16 | "alcotest" 17 | "utop" 18 | "linenoise" 19 | "fmt" 20 | "odoc" {with-doc} 21 | ] 22 | build: [ 23 | ["dune" "subst"] {dev} 24 | [ 25 | "dune" 26 | "build" 27 | "-p" 28 | name 29 | "-j" 30 | jobs 31 | "@install" 32 | "@runtest" {with-test} 33 | "@doc" {with-doc} 34 | ] 35 | ] 36 | dev-repo: "git+https://github.com/username/reponame.git" 37 | -------------------------------------------------------------------------------- /homework/hw4/lamp/ast.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | (** Monomorphic types *) 4 | type ty = 5 | | TVar of string (** Type variable *) 6 | | TInt 7 | | TBool 8 | | TList of ty 9 | | TFun of ty * ty 10 | | TUnit 11 | | TVoid 12 | | TProd of ty * ty 13 | | TSum of ty * ty 14 | [@@deriving equal, show] 15 | 16 | (** Binary operators *) 17 | type binop = Add | Sub | Mul [@@deriving equal, show] 18 | 19 | (** Relational comparison operators *) 20 | type relop = Eq | Lt | Gt [@@deriving equal, show] 21 | 22 | type 'a binder = string * 'a [@@deriving equal, show] 23 | 24 | (** AST of Lambda+ expressions *) 25 | type expr = 26 | (* arithmetic *) 27 | | Num of int 28 | | Binop of binop * expr * expr 29 | (* binding *) 30 | | Var of string 31 | (* lambda calculus *) 32 | | Lambda of ty option * expr binder 33 | | App of expr * expr 34 | (* let expression *) 35 | | Let of expr * expr binder 36 | (* booleans *) 37 | | True 38 | | False 39 | | IfThenElse of expr * expr * expr 40 | | Comp of relop * expr * expr 41 | (* lists *) 42 | | ListNil of ty option 43 | | ListCons of expr * expr 44 | | ListMatch of expr * expr * expr binder binder 45 | (* fix *) 46 | | Fix of ty option * expr binder 47 | (* type annotation *) 48 | | Annot of expr * ty 49 | (* unit *) 50 | | Unit 51 | (* internal choice *) 52 | | Both of expr * expr 53 | | I1 of expr 54 | | I2 of expr 55 | (* void *) 56 | | Absurd of expr 57 | (* external choice *) 58 | | E1 of expr 59 | | E2 of expr 60 | | Either of expr * expr binder * expr binder 61 | [@@deriving equal, show] 62 | 63 | (** Pretty-printers *) 64 | module Pretty = struct 65 | open Fmt 66 | 67 | (** Pretty print a [ty] *) 68 | let rec ty : ty Fmt.t = 69 | fun ppf -> 70 | let open Fmt in 71 | function 72 | | TVar x -> string ppf x 73 | | TInt -> string ppf "Int" 74 | | TBool -> string ppf "Bool" 75 | | TFun (t1, t2) -> pf ppf "@[%a -> %a@]" (pp_nested pp_ty) t1 pp_ty t2 76 | | TList t -> pf ppf "List[%a]" pp_ty t 77 | | TSum (t1, t2) -> 78 | pf ppf "@[%a + %a@]" (pp_nested pp_ty) t1 (pp_nested pp_ty) t2 79 | | TProd (t1, t2) -> 80 | pf ppf "@[%a * %a@]" (pp_nested pp_ty) t1 (pp_nested pp_ty) t2 81 | | TUnit -> string ppf "()" 82 | | TVoid -> string ppf "!" 83 | 84 | and pp_nested pp ppf t = 85 | let is_complex_ty = function TFun _ | TProd _ -> true | _ -> false in 86 | if is_complex_ty t then Fmt.parens pp ppf t else pp ppf t 87 | 88 | let binop : binop Fmt.t = 89 | fun ppf op -> 90 | string ppf (match op with Add -> "+" | Sub -> "-" | Mul -> "*") 91 | 92 | let relop : relop Fmt.t = 93 | fun ppf op -> string ppf (match op with Eq -> "=" | Lt -> "<" | Gt -> ">") 94 | 95 | let rec expr : expr Fmt.t = 96 | fun ppf -> 97 | let is_complex = function 98 | | Num _ | Var _ | True | False | Both _ | ListNil _ -> false 99 | | _ -> true 100 | in 101 | let pp_nested pp ppf e = 102 | if is_complex e then (parens pp) ppf e else pp ppf e 103 | in 104 | let pp = pp_nested pp_expr in 105 | function 106 | | Num n -> int ppf n 107 | | Var x -> string ppf x 108 | | Binop (op, e1, e2) -> pf ppf "%a %a@ %a" pp e1 pp_binop op pp e2 109 | | Lambda (topt, (x, e)) -> 110 | pf ppf "lambda %s%a.@ %a" x 111 | (option (const string ": " ++ pp_ty)) 112 | topt pp_expr e 113 | | Let (e1, (x, e2)) -> 114 | pf ppf "@[le@[t %s = %a in@]@ @[%a@]@]" x pp_expr e1 pp_expr e2 115 | | App (e1, e2) -> pf ppf "%a@ %a" pp e1 pp e2 116 | | True -> string ppf "true" 117 | | False -> string ppf "false" 118 | | IfThenElse (e1, e2, e3) -> 119 | pf ppf "@[if %a@ then %a@ else %a@]" pp_expr e1 pp_expr e2 pp_expr 120 | e3 121 | | Comp (op, e1, e2) -> pf ppf "%a %a@ %a" pp e1 pp_relop op pp e2 122 | | ListNil topt -> pf ppf "Nil%a" (option (brackets pp_ty)) topt 123 | | ListCons (e1, e2) -> pf ppf "%a ::@ %a" pp e1 pp e2 124 | | ListMatch (e1, e2, (h, (t, e3))) -> 125 | pf ppf "@[match %a with@;| Nil -> %a@;| %s :: %s -> %a@;end@]" 126 | pp_expr e1 pp_expr e2 h t pp_expr e3 127 | | E1 e -> pf ppf "$1@ %a" pp e 128 | | E2 e -> pf ppf "$2@ %a" pp e 129 | | Either (e1, (x, e2), (y, e3)) -> 130 | pf ppf 131 | "@[match @[%a@] with@;| $1 %s -> @[%a@]@;| $2 %s -> @[%a@]@;end@]" 132 | pp_expr e1 x pp_expr e2 y pp_expr e3 133 | | Fix (topt, (f, e)) -> 134 | pf ppf "fix %s%a is@ %a" f 135 | (option (const string ": " ++ pp_ty)) 136 | topt pp_expr e 137 | | Both (e1, e2) -> pf ppf "(%a,@ %a)" pp e1 pp e2 138 | | I1 e -> pf ppf "%a.1" pp e 139 | | I2 e -> pf ppf "%a.2" pp e 140 | | Annot (e, t) -> pf ppf "%a :@ %a" pp e pp_ty t 141 | | Unit -> string ppf "()" 142 | | Absurd e -> pf ppf "match %a with end" pp e 143 | end 144 | -------------------------------------------------------------------------------- /homework/hw4/lamp/cmd.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | type t = 4 | | CLet of string * ty option * expr 5 | | CLoad of string 6 | | CSave of string 7 | | CPrint 8 | | CClear 9 | | CEval of expr 10 | | CSynth of ty 11 | 12 | type script = t list 13 | -------------------------------------------------------------------------------- /homework/hw4/lamp/dune: -------------------------------------------------------------------------------- 1 | ; Build configuration 2 | 3 | ; Treat warnings as non-fatal 4 | 5 | (env 6 | (dev 7 | (flags 8 | (:standard -warn-error -A)))) 9 | 10 | ; --------------- 11 | ; lamp main files 12 | 13 | (library 14 | (name lamp) 15 | (preprocess 16 | (pps ppx_deriving.show ppx_jane ppx_sexp_conv)) 17 | (libraries base fmt nice_parser)) 18 | 19 | (ocamllex lexer) 20 | 21 | (menhir 22 | (modules menhir_parser)) 23 | -------------------------------------------------------------------------------- /homework/hw4/lamp/err.ml: -------------------------------------------------------------------------------- 1 | exception Syntax of { sl : int; sc : int; el : int; ec : int } 2 | exception Lexing of { l : int; s : string } 3 | 4 | let syntax_error () = 5 | let start_pos = Parsing.rhs_start_pos 1 in 6 | let end_pos = Parsing.rhs_end_pos 1 in 7 | let sl = start_pos.pos_lnum 8 | and sc = start_pos.pos_cnum - start_pos.pos_bol 9 | and el = end_pos.pos_lnum 10 | and ec = end_pos.pos_cnum - end_pos.pos_bol in 11 | raise (Syntax { sl; sc; el; ec }) 12 | -------------------------------------------------------------------------------- /homework/hw4/lamp/eval.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | let todo () = failwith "TODO" 4 | 5 | exception Stuck of string 6 | (** Exception indicating that evaluation is stuck *) 7 | 8 | (** Raises an exception indicating that evaluation got stuck. *) 9 | let im_stuck msg = raise (Stuck msg) 10 | 11 | (** Computes the set of free variables in the given expression *) 12 | let rec free_vars (e : expr) : Vars.t = 13 | (* This line imports the functions in Vars, so you can write [diff .. ..] 14 | instead of [Vars.diff .. ..] *) 15 | let open Vars in 16 | match e with _ -> todo () 17 | 18 | (** Perform substitution c[x -> e], i.e., substituting x with e in c *) 19 | let rec subst (x : string) (e : expr) (c : expr) : expr = 20 | match c with _ -> todo () 21 | 22 | (** Evaluate expression e *) 23 | let rec eval (e : expr) : expr = 24 | try match e with _ -> todo () 25 | with Stuck msg -> 26 | im_stuck (Fmt.str "%s\nin expression %a" msg Pretty.expr e) 27 | -------------------------------------------------------------------------------- /homework/hw4/lamp/eval.mli: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | exception Stuck of string 4 | 5 | val free_vars : expr -> Vars.t 6 | (** Return the set of free variable references in an expression *) 7 | 8 | val subst : string -> expr -> expr -> expr 9 | (** Substitution *) 10 | 11 | val eval : expr -> expr 12 | (** Interpret an expression *) 13 | -------------------------------------------------------------------------------- /homework/hw4/lamp/lexer.mll: -------------------------------------------------------------------------------- 1 | { 2 | open Menhir_parser 3 | exception LexError of string 4 | 5 | let failwith msg = raise (LexError msg) 6 | 7 | let illegal c = 8 | failwith (Printf.sprintf "[lexer] unexpected character: '%c'" c) 9 | } 10 | 11 | let ws = ' ' | '\t' 12 | let newline = "\r\n" | '\r' | '\n' 13 | 14 | rule next_token = parse 15 | | ws+ { next_token lexbuf } 16 | | newline { Lexing.new_line lexbuf; next_token lexbuf } 17 | | "#load" { CLOAD } 18 | | "#save" { CSAVE } 19 | | "#print" { CPRINT } 20 | | "#clear" { CCLEAR } 21 | | "#let" { CLET } 22 | | "#synth" { CSYNTH } 23 | | "let" { LET } 24 | | "in" { IN } 25 | | "fun" { FUN } 26 | | "rec" { REC } 27 | | "with" { WITH } 28 | | "match" { MATCH } 29 | | "end" { END } 30 | | "lambda" { LAMBDA } 31 | | "if" { IF } 32 | | "then" { THEN } 33 | | "else" { ELSE } 34 | | "true" { TRUE } 35 | | "false" { FALSE } 36 | | "fix" { FIX } 37 | | "is" { IS } 38 | | ".1" { FST } 39 | | ".2" { SND } 40 | | "Nil" { NIL } 41 | | "::" { CONS } 42 | | "+" { PLUS } 43 | | "-" { SUB } 44 | | "*" { TIMES } 45 | | "Int" { TYINT } 46 | | "Bool" { TYBOOL } 47 | | "List" { TYLIST } 48 | | '\'' { TICK } 49 | | "->" { THINARROW } 50 | | ':' { COLON } 51 | | ">" { GT } 52 | | '=' { EQ } 53 | | "|" { BAR } 54 | | "<" { LT } 55 | | '(' { LPAREN } 56 | | ')' { RPAREN } 57 | | '[' { LBRACK } 58 | | ']' { RBRACK } 59 | | '.' { DOT } 60 | | ',' { COMMA } 61 | | "$1" { CASE1 } 62 | | "$2" { CASE2 } 63 | | '!' { VOID } 64 | | "//" { comment lexbuf } 65 | | "forall" { FORALL } 66 | | ['0'-'9']+ as n { NUMBER(Base.Int.of_string(n)) } 67 | | ['a'-'z' 'A'-'Z' '_']['a'-'z' 'A'-'Z' '0'-'9' '_']* as x { ID(x) } 68 | | ['a'-'z' 'A'-'Z' '0'-'9' '_' '-' '/' ]+ ".txt" as x { FILE(x) } 69 | | eof { EOF } 70 | | _ as c { illegal c } 71 | 72 | and comment = parse 73 | | newline { Lexing.new_line lexbuf; next_token lexbuf } 74 | | _ { comment lexbuf } 75 | | eof { EOF } 76 | -------------------------------------------------------------------------------- /homework/hw4/lamp/menhir_parser.mly: -------------------------------------------------------------------------------- 1 | %{ 2 | 3 | let mk_lambdas (xs : (string * Ast.ty option) list) (e : Ast.expr) (r: Ast.ty option) = 4 | let f (x, topt) e' = Ast.Lambda(topt, (x,e')) in 5 | List.fold_right f xs (match r with None -> e | Some r -> Annot(e, r)) 6 | 7 | let mk_tfun_of_list (xs: (string * Ast.ty option) list) (r: Ast.ty option) : Ast.ty option = 8 | match r with 9 | | Some r -> 10 | List.fold_right (fun (x,topt) fo -> 11 | match topt, fo with 12 | | Some t, Some r -> Some (Ast.TFun(t,r)) 13 | | _ -> None) xs (Some r) 14 | | None -> None 15 | let mk_let (x: string) (ty: Ast.ty option) (e1: Ast.expr) (e2: Ast.expr) : Ast.expr = 16 | match ty with 17 | | Some t -> Ast.Let(Ast.Annot(e1, t), (x, e2)) 18 | | None -> Ast.Let(e1, (x, e2)) 19 | %} 20 | 21 | /* Tokens */ 22 | 23 | %token EOF FUN REC MATCH BAR END GT EQ LT LPAREN RPAREN DOT COMMA FIX IS 24 | %token TRUE FALSE TYBOOL 25 | %token LET IN IF THEN ELSE WITH LAMBDA 26 | %token NIL CONS 27 | %token TYINT TYLIST THINARROW COLON LBRACK RBRACK 28 | %token CLET CPRINT CCLEAR CLOAD CSAVE CSYNTH 29 | %token TICK FORALL 30 | %token FST SND CASE1 CASE2 VOID 31 | 32 | %token PLUS SUB TIMES 33 | %token NUMBER 34 | %token ID 35 | %token FILE 36 | 37 | %nonassoc IN DOT ELSE IS CASE1 CASE2 38 | %nonassoc COLON 39 | %right CONS 40 | %left LT GT EQ 41 | %left PLUS SUB 42 | %right THINARROW 43 | %left TIMES 44 | 45 | %start expr_eof 46 | %type expr_eof 47 | 48 | %start repl_command_eof 49 | %type repl_command_eof 50 | 51 | %start script_eof 52 | %type script_eof 53 | 54 | %start ty_eof 55 | %type ty_eof 56 | 57 | 58 | %% 59 | 60 | file_command: 61 | | CLET bind EQ expr 62 | { let (x,t) = $2 in Cmd.CLet(x,t,$4) } 63 | | CPRINT 64 | { Cmd.CPrint} 65 | | CCLEAR 66 | { Cmd.CClear} 67 | | CLOAD FILE 68 | { Cmd.CLoad $2 } 69 | | CSAVE FILE 70 | { Cmd.CSave $2 } 71 | | CSYNTH ty 72 | { Cmd.CSynth $2 } 73 | 74 | repl_command: 75 | | c=file_command 76 | { c } 77 | | expr 78 | { Cmd.CEval $1 } 79 | 80 | repl_command_eof: 81 | | c=repl_command EOF 82 | { c } 83 | 84 | script_eof: 85 | | cs=list(file_command) EOF 86 | { cs } 87 | 88 | expr_eof: 89 | | e=expr EOF 90 | { e } 91 | 92 | ty_var: 93 | | TICK ID 94 | { ("\'" ^ $2) } 95 | 96 | ty_atom: 97 | | x=ty_var 98 | { Ast.TVar x } 99 | | TYINT 100 | { Ast.TInt } 101 | | TYBOOL 102 | { Ast.TBool } 103 | | LPAREN t=ty RPAREN 104 | { t } 105 | | LPAREN RPAREN 106 | { Ast.TUnit } 107 | | VOID 108 | { Ast.TVoid } 109 | 110 | ty_eof: 111 | | t=ty EOF 112 | { t } 113 | 114 | ty: 115 | | t=ty_atom 116 | { t } 117 | | t1=ty THINARROW t2=ty 118 | { TFun (t1, t2) } 119 | | t1=ty TIMES t2=ty 120 | { TProd (t1, t2) } 121 | | t1=ty PLUS t2=ty 122 | { TSum (t1, t2) } 123 | | TYLIST LBRACK t=ty RBRACK 124 | { TList t } 125 | 126 | bind: 127 | | x=ID COLON t=ty 128 | { (x, Some t) } 129 | | x=ID 130 | { (x, None) } 131 | 132 | bindlist: 133 | | l=separated_nonempty_list(COMMA, bind) 134 | { l } 135 | 136 | expr: 137 | | e=app 138 | { e } 139 | | e=expr COLON t=ty 140 | { Ast.Annot(e, t) } 141 | | LAMBDA bs=bindlist DOT e=expr 142 | { mk_lambdas bs e None } 143 | | FUN REC b=bind WITH bs=bindlist EQ e1=expr IN e2=expr 144 | { let (x,r) = b in 145 | Let(Fix (mk_tfun_of_list bs r, (x, mk_lambdas bs e1 r)), (x, e2)) } 146 | | FUN b=bind WITH bs=bindlist EQ e1=expr IN e2=expr 147 | { let (x,r) = b in 148 | Let(mk_lambdas bs e1 r, (x, e2)) } 149 | | FIX b=bind IS e=expr 150 | { let (x, topt) = b in Fix (topt, (x, e)) } 151 | | LET b=bind EQ e1=expr IN e2=expr 152 | { let (x, topt) = b in 153 | mk_let x topt e1 e2 } 154 | | IF e1=expr THEN e2=expr ELSE e3=expr 155 | { IfThenElse(e1, e2, e3) } 156 | | e=list_match 157 | { e } 158 | | e=sum_match 159 | { e } 160 | | e=void_match 161 | { e } 162 | | e=binop(expr) 163 | { e } 164 | | CASE1; e=expr 165 | { E1 e } 166 | | CASE2; e=expr 167 | { E2 e } 168 | 169 | binop(expr): 170 | | expr PLUS expr 171 | { Binop(Add, $1, $3) } 172 | | expr SUB expr 173 | { Binop(Sub, $1, $3) } 174 | | expr TIMES expr 175 | { Binop(Mul, $1, $3) } 176 | | expr LT expr 177 | { Comp(Lt, $1, $3) } 178 | | expr GT expr 179 | { Comp(Gt, $1, $3) } 180 | | expr EQ expr 181 | { Comp(Eq, $1, $3) } 182 | | expr CONS expr 183 | { ListCons($1, $3) } 184 | 185 | app: 186 | | term 187 | { $1 } 188 | | e1=app e2=term 189 | { App(e1, e2) } 190 | 191 | tyarg_opt: 192 | | LBRACK ty RBRACK 193 | { Some $2 } 194 | | 195 | { None } 196 | 197 | nil_branch: 198 | | NIL THINARROW e=expr 199 | { e } 200 | 201 | cons_branch: 202 | | x=ID CONS y=ID THINARROW e=expr 203 | { (x, y, e) } 204 | 205 | list_match: 206 | | MATCH e1=expr WITH option(BAR) e2=nil_branch BAR b3=cons_branch END 207 | { 208 | let (x,y,e3) = b3 in 209 | Ast.ListMatch(e1, e2, (x, (y, e3)))} 210 | 211 | case(TAG): 212 | | TAG x=ID THINARROW e=expr 213 | { (x, e) } 214 | 215 | sum_match: 216 | | MATCH e1=expr WITH option(BAR) b2=case(CASE1) BAR b3=case(CASE2) END 217 | { Ast.Either(e1, b2, b3) } 218 | 219 | void_match: 220 | | MATCH e1=expr WITH END 221 | { Ast.Absurd e1 } 222 | 223 | term: 224 | | x=ID 225 | { Ast.Var x } 226 | | n=NUMBER 227 | { Ast.Num n } 228 | | TRUE 229 | { Ast.True } 230 | | FALSE 231 | { Ast.False } 232 | | NIL t=tyarg_opt 233 | { ListNil t } 234 | | LPAREN e=expr RPAREN 235 | { e } 236 | | LPAREN e1=expr COMMA e2=expr RPAREN 237 | { Ast.Both(e1, e2) } 238 | | e=term FST 239 | { Ast.I1 e } 240 | | e=term SND 241 | { Ast.I2 e } 242 | | LPAREN RPAREN 243 | { Ast.Unit } 244 | 245 | -------------------------------------------------------------------------------- /homework/hw4/lamp/parser.ml: -------------------------------------------------------------------------------- 1 | module Expr = Nice_parser.Make (struct 2 | type result = Ast.expr 3 | type token = Menhir_parser.token 4 | 5 | exception ParseError = Menhir_parser.Error 6 | 7 | let parse = Menhir_parser.expr_eof 8 | 9 | include Lexer 10 | end) 11 | 12 | module Command = Nice_parser.Make (struct 13 | type result = Cmd.t 14 | type token = Menhir_parser.token 15 | 16 | exception ParseError = Menhir_parser.Error 17 | 18 | let parse = Menhir_parser.repl_command_eof 19 | 20 | include Lexer 21 | end) 22 | 23 | module Script = Nice_parser.Make (struct 24 | type result = Cmd.script 25 | type token = Menhir_parser.token 26 | 27 | exception ParseError = Menhir_parser.Error 28 | 29 | let parse = Menhir_parser.script_eof 30 | 31 | include Lexer 32 | end) 33 | 34 | module Ty = Nice_parser.Make (struct 35 | type result = Ast.ty 36 | type token = Menhir_parser.token 37 | 38 | exception ParseError = Menhir_parser.Error 39 | 40 | let parse = Menhir_parser.ty_eof 41 | 42 | include Lexer 43 | end) 44 | -------------------------------------------------------------------------------- /homework/hw4/lamp/typecheck.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | open Base 3 | 4 | type env = (string * ty) list 5 | (** Typing environment, aka Gamma *) 6 | 7 | (** Helper function to look up a variable in the env *) 8 | let find : env -> string -> ty option = List.Assoc.find ~equal:String.equal 9 | 10 | (** Helper function to insert a (variable, ty) pair into the env *) 11 | let add : env -> string -> ty -> env = List.Assoc.add ~equal:String.equal 12 | 13 | exception Type_error of string 14 | 15 | let ty_err msg = raise (Type_error msg) 16 | let rec equal_ty (t1 : ty) (t2 : ty) : bool = failwith "TODO" 17 | 18 | let rec abstract_eval (env : env) (e : expr) : ty = 19 | try 20 | match e with 21 | (* T-Int rule *) 22 | | Num _ -> TInt 23 | (* T-True and T-false *) 24 | | True | False -> TBool 25 | (* Your code here *) 26 | | _ -> failwith "TODO" 27 | with Type_error msg -> ty_err (msg ^ "\nin expression " ^ show_expr e) 28 | -------------------------------------------------------------------------------- /homework/hw4/lamp/typecheck.mli: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | type env = (string * ty) list 4 | 5 | val abstract_eval : env -> Ast.expr -> ty 6 | 7 | exception Type_error of string 8 | -------------------------------------------------------------------------------- /homework/hw4/lamp/vars.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | type t = Set.M(String).t 4 | 5 | let pp : t Fmt.t = 6 | Fmt.using Set.to_list Fmt.(braces @@ list ~sep:(any ", ") string) 7 | 8 | let show = Fmt.to_to_string pp 9 | let equal = Set.equal 10 | let compare = Set.compare_direct 11 | let empty = Set.empty (module String) 12 | let diff = Set.diff 13 | let singleton = Set.singleton (module String) 14 | let add s v = Set.add v s 15 | let union = Set.union 16 | let mem s v = Set.mem v s 17 | let of_list = Set.of_list (module String) 18 | let to_list = Set.to_list 19 | let size = Set.length 20 | -------------------------------------------------------------------------------- /homework/hw4/lamp/vars.mli: -------------------------------------------------------------------------------- 1 | (** Signature for variable set module *) 2 | 3 | type t [@@deriving equal, compare, show] 4 | (** type of variable set *) 5 | 6 | val empty : t 7 | (** empty set *) 8 | 9 | val mem : string -> t -> bool 10 | (** [mem x s] is true iff [x] is in [s] *) 11 | 12 | val diff : t -> t -> t 13 | (** [diff s1 s2] is the set of elements in [s1] but not in [s2] *) 14 | 15 | val singleton : string -> t 16 | (** [singleton x] is the singleton set containing [x] *) 17 | 18 | val add : string -> t -> t 19 | (** [add x s] is the set [s] with [x] added to it *) 20 | 21 | val union : t -> t -> t 22 | (** [union s1 s2] is the union of [s1] and [s2] *) 23 | 24 | val of_list : string list -> t 25 | (** [of_list l] converts a list [l] into a set *) 26 | 27 | val to_list : t -> string list 28 | (** [to_list x] converts a set [s] into a list *) 29 | 30 | val size : t -> int 31 | (** Return the size of a set *) 32 | -------------------------------------------------------------------------------- /homework/hw4/test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name hw4_test) 3 | (libraries fmt alcotest lamp) 4 | (preprocess 5 | (pps ppx_deriving.show ppx_jane)) 6 | (deps 7 | (source_tree examples))) 8 | -------------------------------------------------------------------------------- /homework/hw4/test/examples/add_n.lp: -------------------------------------------------------------------------------- 1 | fun rec map : List[Int] with f: Int -> Int, l: List[Int] = 2 | match l with 3 | | Nil -> Nil[Int] 4 | | x::xs -> f x :: map f l 5 | end in 6 | 7 | // increments every element of a list by n 8 | fun add_n : List[Int] with l: List[Int], n: Int = 9 | map (lambda m: Int. n + m) l in 10 | 11 | add_n (1::2::Nil[Int]) 10 -------------------------------------------------------------------------------- /homework/hw4/test/examples/fib.lp: -------------------------------------------------------------------------------- 1 | fun rec fib: Int with n: Int = 2 | if n = 0 then 0 3 | else if n = 1 then 1 4 | else 5 | let x = fib (n-1) in 6 | let y : Int = fib (n-2) in 7 | x + y 8 | in (fib 30 : Int) -------------------------------------------------------------------------------- /homework/hw4/test/hw4_test.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | let () = 4 | Alcotest.run "hw4" 5 | (List.map 6 | ~f:(fun (name, tests) -> 7 | (name, List.map ~f:(Alcotest.test_case name `Quick) tests)) 8 | Test_typing.tests) 9 | -------------------------------------------------------------------------------- /homework/hw4/test/test_typing.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lamp 3 | open Ast 4 | 5 | exception Timeout 6 | 7 | (* run a function with specified timeout: 8 | https://discuss.ocaml.org/t/computation-with-time-constraint/5548/9 *) 9 | let with_timeout timeout f = 10 | let _ = 11 | Stdlib.Sys.set_signal Stdlib.Sys.sigalrm 12 | (Stdlib.Sys.Signal_handle (fun _ -> raise Timeout)) 13 | in 14 | ignore (Unix.alarm timeout); 15 | try 16 | let r = f () in 17 | ignore (Unix.alarm 0); 18 | r 19 | with e -> 20 | ignore (Unix.alarm 0); 21 | raise e 22 | 23 | (* Unit test utilities *) 24 | let texpr = Alcotest.testable Pretty.expr equal_expr 25 | let tvars = Alcotest.testable Vars.pp Vars.equal 26 | let tty = Alcotest.testable Pretty.ty Ast.equal_ty 27 | 28 | let parse s = 29 | try Parser.Expr.parse_string s 30 | with _ -> Alcotest.fail ("Failed to parse: " ^ s) 31 | 32 | let parse_file filename = 33 | try Parser.Expr.parse_file filename 34 | with _ -> Alcotest.fail ("Failed to parse file: " ^ filename) 35 | 36 | let parse_ty s = 37 | try Parser.Ty.parse_string s 38 | with _ -> Alcotest.fail ("Failed to parse: " ^ s) 39 | 40 | (** Helper function to check that the type checker abstractly evaluates 41 | * the expression to type t *) 42 | let check_well_typed ~gamma e t () = 43 | let tact = 44 | try Typecheck.abstract_eval gamma e 45 | with Typecheck.Type_error msg -> failwith ("Type error!\n" ^ msg) 46 | in 47 | Alcotest.(check' tty) 48 | ~msg:(Fmt.str "%a" Pretty.expr e) 49 | ~expected:t ~actual:tact 50 | 51 | (** Helper function to check that the type checker abstractly evaluates 52 | * the expression (given as a string) to type t *) 53 | let check_well_typed_s ~gamma s t () = 54 | check_well_typed 55 | ~gamma:(List.map gamma ~f:(fun (x, t) -> (x, parse_ty t))) 56 | (parse s) (parse_ty t) () 57 | 58 | let check_well_typed_file s t () = 59 | check_well_typed ~gamma:[] (parse_file s) (parse_ty t) () 60 | 61 | (** Helper function to check that the type checker determines that the expression is 62 | ill-typed. *) 63 | let check_ill_typed ~gamma s () = 64 | try 65 | let t = Typecheck.abstract_eval gamma (parse s) in 66 | Alcotest.fail ("abstractly evaluated to " ^ show_ty t) 67 | with Typecheck.Type_error _ -> () 68 | 69 | let well_typed_tests = 70 | [ 71 | check_well_typed_s ~gamma:[] (* input expression *) "0" 72 | (* expected output type *) "Int"; 73 | check_well_typed_s 74 | ~gamma:[ ("x", "Bool") ] 75 | (* input expression *) "x" (* expected output type *) "Bool"; 76 | check_well_typed_file "examples/fib.lp" "Int"; 77 | check_well_typed_file "examples/add_n.lp" "List[Int]"; 78 | ] 79 | 80 | let ill_typed_tests = 81 | [ check_ill_typed ~gamma:[] (* input expression *) "1 + true" ] 82 | 83 | let tests = [ ("well_typed", well_typed_tests); ("ill_typed", ill_typed_tests) ] 84 | -------------------------------------------------------------------------------- /homework/hw5/.ocamlformat: -------------------------------------------------------------------------------- 1 | profile = default 2 | version = 0.26.2 -------------------------------------------------------------------------------- /homework/hw5/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: zip 2 | 3 | FILES := lamp/typeinfer.ml lamp/curry_howard.ml 4 | ARCHIVE := submission.zip 5 | 6 | $(ARCHIVE): $(FILES) 7 | zip -j $(ARCHIVE) $(FILES) 8 | 9 | zip: $(ARCHIVE) -------------------------------------------------------------------------------- /homework/hw5/bin/dune: -------------------------------------------------------------------------------- 1 | ; Build configuration 2 | 3 | ; Treat warnings as non-fatal 4 | 5 | (env 6 | (dev 7 | (flags 8 | (:standard -warn-error -A)))) 9 | 10 | ; --------------- 11 | ; generate date information 12 | 13 | (rule 14 | (target build_metadata.ml) 15 | (deps (universe)) 16 | (action 17 | (run bash "-c" "echo let date = \\\"$(date)\\\" > %{target}"))) 18 | 19 | ; --------------- 20 | ; statically link the binary for CSIL if using musl libc 21 | 22 | (rule 23 | (target build_flags) 24 | (enabled_if 25 | (= %{ocaml-config:c_compiler} "musl-gcc")) 26 | (action 27 | (write-file %{target} "(-ccopt -static)"))) 28 | 29 | (rule 30 | (target build_flags) 31 | (enabled_if 32 | (<> %{ocaml-config:c_compiler} "musl-gcc")) 33 | (action 34 | (write-file %{target} "()"))) 35 | 36 | ; --------------- 37 | ; lamp repl 38 | 39 | (executable 40 | (name repl) 41 | (modules build_metadata repl) 42 | (libraries base lamp linenoise cmdliner) 43 | (flags 44 | :standard 45 | (:include build_flags)) 46 | (modes exe)) 47 | 48 | (install 49 | (section bin) 50 | (files repl.exe)) 51 | -------------------------------------------------------------------------------- /homework/hw5/bin/repl.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lamp 3 | open Ast 4 | 5 | module Opts = struct 6 | let path : string option ref = ref None 7 | let fast : bool ref = ref false 8 | let quiet : bool ref = ref false 9 | let typed : bool ref = ref false 10 | let tyinf : bool ref = ref true 11 | end 12 | 13 | let () = 14 | let open Parser in 15 | Expr.pp_exceptions (); 16 | Command.pp_exceptions (); 17 | Script.pp_exceptions (); 18 | Ty.pp_exceptions () 19 | 20 | let get_eval () e = Eval.eval e 21 | 22 | let handler (f : unit -> unit) : unit = 23 | try f () with 24 | | Eval.Stuck msg -> Fmt.pr "runtime error: %s\n%!" msg 25 | | Stack_overflow -> 26 | Fmt.epr 27 | "Interpreter stack overflow; too many recursive function calls\n%!" 28 | | Typecheck.Type_error s -> Fmt.epr "Type error: %s\n%!" s 29 | | Typeinfer.Type_error s -> Fmt.epr "Type error: %s\n%!" s 30 | 31 | let context : ((string * ty option) * expr) list ref = ref [] 32 | let meta_context : ((string * ty option) * expr) list ref = ref [] 33 | let get_context () = context 34 | 35 | let print_context () = 36 | Fmt.pr ">> context >>\n%!"; 37 | Fmt.pr " @[%a@]\n%!" 38 | Fmt.( 39 | vbox 40 | (list ~sep:cut 41 | (box 42 | (pair ~sep:(any " ->@ ") 43 | (pair string (option (const string " : " ++ Pretty.ty))) 44 | Pretty.expr)))) 45 | (Base.List.rev !(get_context ())); 46 | Fmt.pr "<< context <<\n%!" 47 | 48 | let context_expr e = 49 | Base.List.fold_left ~init:e 50 | ~f:(fun e ((x, t), def) -> Ast.Expr.lett x ~t def ~in_:e) 51 | !(get_context ()) 52 | 53 | let check_and_run (e : expr) : expr = 54 | (if !Opts.typed then 55 | let ty = Typecheck.abstract_eval [] e in 56 | Fmt.pr "type ==> @[%a@]\n%!" Pretty.ty ty 57 | else if !Opts.tyinf then 58 | let ty = Typeinfer.infer e in 59 | Fmt.pr "inferred type ==> @[%a@]\n%!" Pretty.ty ty); 60 | get_eval () e 61 | 62 | let handle_let_or_eval (c : Cmd.t) = 63 | match c with 64 | | CLet (x, t, def) -> 65 | (let v = check_and_run (context_expr def) in 66 | Fmt.pr "%s = @[%a@]\n%!" x Pretty.expr v); 67 | get_context () := ((x, t), def) :: !(get_context ()) 68 | | CEval e -> 69 | Fmt.pr "<== @[%a@]\n%!" Pretty.expr e; 70 | if not !Opts.quiet then Fmt.pr "<== AST:\n@[%a@]\n%!" Ast.Pretty.expr e; 71 | let v = check_and_run (context_expr e) in 72 | Fmt.pr "[eval] ==> @[%a@]\n%!" Pretty.expr v 73 | | _ -> failwith "Impossible" 74 | 75 | let commands = [ "#print"; "#clear"; "#load"; "#save" ] 76 | let replayable = function Cmd.CLet _ -> true | _ -> false 77 | 78 | let rec repl () = 79 | try 80 | match LNoise.linenoise "> " with 81 | | None -> () 82 | | Some l -> 83 | LNoise.history_add l |> ignore; 84 | handler (fun () -> 85 | match Lamp.Parser.Command.parse_string l with 86 | | CPrint -> print_context () 87 | | CClear -> 88 | get_context () := []; 89 | Fmt.pr ". context cleared\n%!" 90 | | CLoad f -> 91 | (* match LNoise.history_load ~filename:f with 92 | | Ok () -> *) 93 | Fmt.pr ". loading history from %s\n%!" f; 94 | Fmt.pr ". replaying history...\n%!"; 95 | (* load content of file f and split it into lines *) 96 | Parser.Script.parse_file f 97 | |> Base.List.filter ~f:replayable 98 | |> Base.List.iter ~f:(fun c -> 99 | try handle_let_or_eval c with _ -> ()); 100 | Fmt.pr ". history replayed\n%!" 101 | (* | Error e -> Fmt.pr ". error loading history: %s\n%!" e) *) 102 | | CSave f -> ( 103 | match LNoise.history_save ~filename:f with 104 | | Ok () -> Fmt.pr ". history saved to %s\n%!" f 105 | | Error e -> Fmt.pr ". error saving history: %s\n%!" e) 106 | | (CLet _ | CEval _) as c -> handle_let_or_eval c 107 | | CSynth t -> ( 108 | match Curry_howard.synthesize t with 109 | | Some e -> 110 | Fmt.pr "[synthesis] ==> %a\n%!" Fmt.(Pretty.expr) e; 111 | ignore @@ check_and_run e 112 | | None -> Fmt.pr "[synthesis] fail\n%!")); 113 | repl () 114 | with Stdlib.Sys.Break -> repl () 115 | 116 | let read_args () = 117 | let set_file s = Opts.path := Some s in 118 | let opts = 119 | [ 120 | ( "-typed", 121 | Stdlib.Arg.Set Opts.typed, 122 | "enable type checking in interpreter (default: off)" ); 123 | ( "-tyinf", 124 | Stdlib.Arg.Set Opts.tyinf, 125 | "enable type inference in interpreter (default: off)" ); 126 | ("-q", Stdlib.Arg.Set Opts.quiet, "suppress AST printing (default: off)"); 127 | ( "-fast", 128 | Stdlib.Arg.Set Opts.fast, 129 | "use closure semantics instead of eager substitution (default: off)" ); 130 | ] 131 | in 132 | Stdlib.Arg.parse opts set_file "" 133 | 134 | let main () = 135 | read_args (); 136 | match !Opts.path with 137 | | Some file_name -> 138 | handler (fun () -> 139 | let v = check_and_run (Parser.Expr.parse_file file_name) in 140 | Fmt.pr "@[%a@]\n%!" Pretty.expr v) 141 | | None -> 142 | (* repl mode *) 143 | Fmt.pr "Welcome to lambda+! Built on: %s\n%!" Build_metadata.date; 144 | LNoise.history_set ~max_length:100 |> ignore; 145 | repl () 146 | ;; 147 | 148 | main () 149 | -------------------------------------------------------------------------------- /homework/hw5/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.11) 2 | 3 | (name hw5) 4 | 5 | (generate_opam_files true) 6 | 7 | (source 8 | (github username/reponame)) 9 | 10 | (authors "Junrui Liu, Bryan Tan, Yu Feng") 11 | 12 | (maintainers "Junrui Liu") 13 | 14 | (documentation https://url/to/documentation) 15 | 16 | (using menhir 2.1) 17 | 18 | (package 19 | (name hw5) 20 | (allow_empty) 21 | (synopsis "A short synopsis") 22 | (description "A longer description") 23 | (depends 24 | (ocaml 25 | (= 4.14.1)) 26 | dune 27 | base 28 | alcotest 29 | ppx_deriving 30 | ppx_import 31 | ppx_sexp_conv 32 | utop 33 | linenoise 34 | fmt) 35 | (tags 36 | (topics "to describe" your project))) 37 | 38 | ; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project 39 | -------------------------------------------------------------------------------- /homework/hw5/hw5.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "A short synopsis" 4 | description: "A longer description" 5 | maintainer: ["Junrui Liu"] 6 | authors: ["Junrui Liu, Bryan Tan, Yu Feng"] 7 | tags: ["topics" "to describe" "your" "project"] 8 | homepage: "https://github.com/username/reponame" 9 | doc: "https://url/to/documentation" 10 | bug-reports: "https://github.com/username/reponame/issues" 11 | depends: [ 12 | "ocaml" {= "4.14.1"} 13 | "dune" {>= "3.11"} 14 | "base" 15 | "alcotest" 16 | "ppx_deriving" 17 | "ppx_import" 18 | "ppx_sexp_conv" 19 | "utop" 20 | "linenoise" 21 | "fmt" 22 | "odoc" {with-doc} 23 | ] 24 | build: [ 25 | ["dune" "subst"] {dev} 26 | [ 27 | "dune" 28 | "build" 29 | "-p" 30 | name 31 | "-j" 32 | jobs 33 | "@install" 34 | "@runtest" {with-test} 35 | "@doc" {with-doc} 36 | ] 37 | ] 38 | dev-repo: "git+https://github.com/username/reponame.git" 39 | -------------------------------------------------------------------------------- /homework/hw5/lamp/ast.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | (** Monomorphic types *) 4 | type ty = 5 | | TVar of string (** Type variable *) 6 | | TInt 7 | | TBool 8 | | TList of ty 9 | | TFun of ty * ty 10 | | TProd of ty * ty 11 | | TSum of ty * ty 12 | | TUnit 13 | | TVoid 14 | [@@deriving equal, compare, show, sexp] 15 | 16 | (** Binary operators *) 17 | type binop = Add | Sub | Mul [@@deriving equal, show] 18 | 19 | (** Relational comparison operators *) 20 | type relop = Eq | Lt | Gt [@@deriving equal, show] 21 | 22 | type 'a binder = string * 'a [@@deriving equal, show] 23 | 24 | (** AST of Lambda+ expressions *) 25 | type expr = 26 | (* arithmetic *) 27 | | Num of int 28 | | Binop of binop * expr * expr 29 | (* binding *) 30 | | Var of string 31 | (* lambda calculus *) 32 | | Lambda of ty option * expr binder 33 | | App of expr * expr 34 | (* let expression *) 35 | | Let of expr * expr binder 36 | (* booleans *) 37 | | True 38 | | False 39 | | IfThenElse of expr * expr * expr 40 | | Comp of relop * expr * expr 41 | (* lists *) 42 | | ListNil of ty option 43 | | ListCons of expr * expr 44 | | ListMatch of expr * expr * expr binder binder 45 | (* cases *) 46 | | E1 of expr 47 | | E2 of expr 48 | | Either of expr * expr binder * expr binder 49 | (* fix *) 50 | | Fix of ty option * expr binder 51 | (* products *) 52 | | Both of expr * expr 53 | | I1 of expr 54 | | I2 of expr 55 | (* type annotation *) 56 | | Annot of expr * ty 57 | (* unit *) 58 | | Unit 59 | (* void *) 60 | | Absurd of expr 61 | [@@deriving equal, show] 62 | 63 | (** Pretty-printers *) 64 | module Pretty = struct 65 | open Fmt 66 | 67 | (** Pretty print a [ty] *) 68 | let rec ty : ty Fmt.t = 69 | fun ppf -> 70 | let open Fmt in 71 | function 72 | | TVar x -> string ppf x 73 | | TInt -> string ppf "Int" 74 | | TBool -> string ppf "Bool" 75 | | TFun (t1, t2) -> pf ppf "@[%a -> %a@]" (pp_nested ty) t1 ty t2 76 | | TList t -> pf ppf "List[%a]" ty t 77 | | TSum (t1, t2) -> pf ppf "@[%a + %a@]" (pp_nested ty) t1 (pp_nested ty) t2 78 | | TProd (t1, t2) -> pf ppf "@[%a * %a@]" (pp_nested ty) t1 (pp_nested ty) t2 79 | | TUnit -> string ppf "()" 80 | | TVoid -> string ppf "!" 81 | 82 | and pp_nested pp ppf t = 83 | let is_complex_ty = function TFun _ | TProd _ -> true | _ -> false in 84 | if is_complex_ty t then Fmt.parens pp ppf t else pp ppf t 85 | 86 | let pp_binop : binop Fmt.t = 87 | fun ppf op -> 88 | string ppf (match op with Add -> "+" | Sub -> "-" | Mul -> "*") 89 | 90 | let pp_relop : relop Fmt.t = 91 | fun ppf op -> string ppf (match op with Eq -> "=" | Lt -> "<" | Gt -> ">") 92 | 93 | let rec expr : expr Fmt.t = 94 | fun ppf -> 95 | let is_complex = function 96 | | Num _ | Var _ | True | False | Both _ | ListNil _ -> false 97 | | _ -> true 98 | in 99 | let pp_nested pp ppf e = 100 | if is_complex e then (parens pp) ppf e else pp ppf e 101 | in 102 | let pp = pp_nested expr in 103 | function 104 | | Num n -> int ppf n 105 | | Var x -> string ppf x 106 | | Binop (op, e1, e2) -> pf ppf "%a %a@ %a" pp e1 pp_binop op pp e2 107 | | Lambda (topt, (x, e)) -> 108 | pf ppf "lambda %s%a.@ %a" x 109 | (option (const string ": " ++ ty)) 110 | topt expr e 111 | | Let (e1, (x, e2)) -> 112 | pf ppf "@[le@[t %s = %a in@]@ @[%a@]@]" x expr e1 expr e2 113 | | App (e1, e2) -> pf ppf "%a@ %a" pp e1 pp e2 114 | | True -> string ppf "true" 115 | | False -> string ppf "false" 116 | | IfThenElse (e1, e2, e3) -> 117 | pf ppf "@[if %a@ then %a@ else %a@]" expr e1 expr e2 expr e3 118 | | Comp (op, e1, e2) -> pf ppf "%a %a@ %a" pp e1 pp_relop op pp e2 119 | | ListNil topt -> pf ppf "Nil%a" (option (brackets ty)) topt 120 | | ListCons (e1, e2) -> pf ppf "%a ::@ %a" pp e1 pp e2 121 | | ListMatch (e1, e2, (h, (t, e3))) -> 122 | pf ppf "@[match %a with@;| Nil -> %a@;| %s :: %s -> %a@;end@]" expr 123 | e1 expr e2 h t expr e3 124 | | E1 e -> pf ppf "$1@ %a" pp e 125 | | E2 e -> pf ppf "$2@ %a" pp e 126 | | Either (e1, (x, e2), (y, e3)) -> 127 | pf ppf 128 | "@[match @[%a@] with@;| $1 %s -> @[%a@]@;| $2 %s -> @[%a@]@;end@]" 129 | expr e1 x expr e2 y expr e3 130 | | Fix (topt, (f, e)) -> 131 | pf ppf "fix %s%a is@ %a" f 132 | (option (const string ": " ++ ty)) 133 | topt expr e 134 | | Both (e1, e2) -> pf ppf "(%a,@ %a)" pp e1 pp e2 135 | | I1 e -> pf ppf "%a.1" pp e 136 | | I2 e -> pf ppf "%a.2" pp e 137 | | Annot (e, t) -> pf ppf "%a :@ %a" pp e ty t 138 | | Unit -> string ppf "()" 139 | | Absurd e -> pf ppf "match %a with end" pp e 140 | end 141 | 142 | module Expr = struct 143 | let lam x e = Lambda (None, (x, e)) 144 | let lamt ~t x e = Lambda (Some t, (x, e)) 145 | let v x = Var x 146 | let i n = Num n 147 | let ( + ) e1 e2 = Binop (Add, e1, e2) 148 | let ( - ) e1 e2 = Binop (Sub, e1, e2) 149 | let ( * ) e1 e2 = Binop (Mul, e1, e2) 150 | let let_ x e1 ~in_:e2 = Let (e1, (x, e2)) 151 | let app e1 e2 = App (e1, e2) 152 | let ( = ) e1 e2 = Comp (Eq, e1, e2) 153 | let ( < ) e1 e2 = Comp (Lt, e1, e2) 154 | let ( > ) e1 e2 = Comp (Gt, e1, e2) 155 | let if_ e1 ~then_:e2 ~else_:e3 = IfThenElse (e1, e2, e3) 156 | let fix x ~is:e = Fix (None, (x, e)) 157 | let nil = ListNil None 158 | let cons e1 e2 = ListCons (e1, e2) 159 | 160 | let match_ e1 ~with_nil:e2 ~with_cons:(x, y, e3) = 161 | ListMatch (e1, e2, (x, (y, e3))) 162 | 163 | let pair e1 e2 = Both (e1, e2) 164 | let fst e = I1 e 165 | let snd e = I2 e 166 | let ( @: ) e t = Annot (e, t) 167 | 168 | let lett x ~t e1 ~in_:e2 = 169 | match t with None -> let_ x e1 ~in_:e2 | Some t -> Let (e1 @: t, (x, e2)) 170 | end 171 | 172 | module Ty = struct 173 | (* Helper functions to construct types. 174 | * Example: You can write [DSL.(list int => bool)] instead of 175 | * [IFun (IList (IInt), IBool)] *) 176 | 177 | let ( ?? ) (x : string) = TVar x 178 | let int = TInt 179 | let bool = TBool 180 | let ( => ) (t1 : ty) (t2 : ty) : ty = TFun (t1, t2) 181 | let list (t : ty) : ty = TList t 182 | let ( * ) (a : ty) (b : ty) : ty = TProd (a, b) 183 | let ( + ) (a : ty) (b : ty) : ty = TSum (a, b) 184 | end 185 | -------------------------------------------------------------------------------- /homework/hw5/lamp/cmd.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | type t = 4 | | CLet of string * ty option * expr 5 | | CLoad of string 6 | | CSave of string 7 | | CPrint 8 | | CClear 9 | | CEval of expr 10 | | CSynth of ty 11 | 12 | type script = t list 13 | -------------------------------------------------------------------------------- /homework/hw5/lamp/curry_howard.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Ast 3 | 4 | let todo () = failwith "TODO" 5 | 6 | (** These types can be interpreted as propositions *) 7 | let types : (string * ty) list = 8 | List.map 9 | ~f:(fun (p, s) -> (p, Parser.Ty.parse_string s)) 10 | [ 11 | ("always_true", "()"); 12 | ("always_false", "!"); 13 | ("everything", "'p"); 14 | ("everything_implies_truth", "'p -> ()"); 15 | ("falsehood_implies_everything", "! -> 'q"); 16 | ("everything_implies_itself", "'p -> 'p"); 17 | ("modus_ponens", "'p * ('p -> 'q) -> 'q"); 18 | ("both_true_implies_left_true", "'p * 'q -> 'p"); 19 | ("either_true_implies_left_true", "'p + 'q -> 'p"); 20 | ("conjunction_is_commutative", "'p * 'q -> 'q * 'p"); 21 | ("disjunction_is_commutative", "'p + 'q -> 'q + 'p"); 22 | ( "conjunction_distributes_over_disjunction", 23 | "'p * ('q + 'r) -> ('p * 'q) + ('p * 'r)" ); 24 | ( "disjunction_distributes_over_conjunction", 25 | "'p + ('q * 'r) -> ('p + 'q) * ('p + 'r)" ); 26 | ("curry", "('p * 'q -> 'r) -> ('p -> ('q -> 'r))"); 27 | ("uncurry", "('p -> ('q -> 'r)) -> ('p * 'q -> 'r)"); 28 | ] 29 | 30 | (** For each proposition, determine whether it is valid (i.e. the truth table is always T) *) 31 | let is_valid () : (string * bool) list = 32 | [ 33 | ("always_true", todo ()); 34 | ("everything", todo ()); 35 | ("everything_implies_truth", todo ()); 36 | ("falsehood_implies_everything", todo ()); 37 | ("everything_implies_itself", todo ()); 38 | ("modus_ponens", todo ()); 39 | ("both_true_implies_left_true", todo ()); 40 | ("either_true_implies_left_true", todo ()); 41 | ("conjunction_is_commutative", todo ()); 42 | ("disjunction_is_commutative", todo ()); 43 | ("conjunction_distributes_over_disjunction", todo ()); 44 | ("disjunction_distributes_over_conjunction", todo ()); 45 | ("curry", todo ()); 46 | ("uncurry", todo ()); 47 | ] 48 | 49 | (** For each type, give a lambda-plus expression that can be inferred to have said type. 50 | If there're no such expressions, simply put a [None]. Otherwise, put [Some ] where 51 | is the expression in concrete syntax. *) 52 | let expressions () : (string * expr option) list = 53 | List.map 54 | ~f:(fun (p, s) -> (p, Option.map ~f:Parser.Expr.parse_string s)) 55 | [ 56 | ("always_true", Some "()"); 57 | ("everything", None); 58 | ("everything_implies_truth", todo ()); 59 | ("falsehood_implies_everything", todo ()); 60 | ("everything_implies_itself", todo ()); 61 | ("modus_ponens", todo ()); 62 | ("both_true_implies_left_true", todo ()); 63 | ("either_true_implies_left_true", todo ()); 64 | ("conjunction_is_commutative", todo ()); 65 | ("disjunction_is_commutative", todo ()); 66 | ("conjunction_distributes_over_disjunction", todo ()); 67 | ("disjunction_distributes_over_conjunction", todo ()); 68 | ("curry", todo ()); 69 | ("uncurry", todo ()); 70 | ] 71 | 72 | let synthesize (t : ty) : expr option = todo () 73 | -------------------------------------------------------------------------------- /homework/hw5/lamp/curry_howard.mli: -------------------------------------------------------------------------------- 1 | val types : (string * Ast.ty) list 2 | val is_valid : unit -> (string * bool) list 3 | val expressions : unit -> (string * Ast.expr option) list 4 | val synthesize : Ast.ty -> Ast.expr option 5 | -------------------------------------------------------------------------------- /homework/hw5/lamp/dune: -------------------------------------------------------------------------------- 1 | (env 2 | (dev 3 | (flags 4 | (:standard -warn-error -A)))) 5 | 6 | (library 7 | (name lamp) 8 | (preprocess 9 | (pps ppx_deriving.show ppx_jane ppx_sexp_conv)) 10 | (libraries base fmt nice_parser)) 11 | 12 | (ocamllex lexer) 13 | 14 | (menhir 15 | (modules menhir_parser)) 16 | -------------------------------------------------------------------------------- /homework/hw5/lamp/err.ml: -------------------------------------------------------------------------------- 1 | exception Syntax of { sl : int; sc : int; el : int; ec : int } 2 | exception Lexing of { l : int; s : string } 3 | 4 | let syntax_error () = 5 | let start_pos = Parsing.rhs_start_pos 1 in 6 | let end_pos = Parsing.rhs_end_pos 1 in 7 | let sl = start_pos.pos_lnum 8 | and sc = start_pos.pos_cnum - start_pos.pos_bol 9 | and el = end_pos.pos_lnum 10 | and ec = end_pos.pos_cnum - end_pos.pos_bol in 11 | raise (Syntax { sl; sc; el; ec }) 12 | -------------------------------------------------------------------------------- /homework/hw5/lamp/eval.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | let todo () = failwith "TODO" 4 | 5 | exception Stuck of string 6 | (** Exception indicating that evaluation is stuck *) 7 | 8 | (** Raises an exception indicating that evaluation got stuck. *) 9 | let im_stuck msg = raise (Stuck msg) 10 | 11 | (** Computes the set of free variables in the given expression *) 12 | let rec free_vars (e : expr) : Vars.t = 13 | (* This line imports the functions in Vars, so you can write [diff .. ..] 14 | instead of [Vars.diff .. ..] *) 15 | let open Vars in 16 | match e with _ -> todo () 17 | 18 | (** Perform substitution c[x -> e], i.e., substituting x with e in c *) 19 | let rec subst (x : string) (e : expr) (c : expr) : expr = 20 | match c with _ -> todo () 21 | 22 | (** Evaluate expression e *) 23 | let rec eval (e : expr) : expr = 24 | try match e with _ -> todo () 25 | with Stuck msg -> 26 | im_stuck (Fmt.str "%s\nin expression %a" msg Pretty.expr e) 27 | -------------------------------------------------------------------------------- /homework/hw5/lamp/eval.mli: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | exception Stuck of string 4 | 5 | val free_vars : expr -> Vars.t 6 | (** Return the set of free variable references in an expression *) 7 | 8 | val subst : string -> expr -> expr -> expr 9 | (** Substitution *) 10 | 11 | val eval : expr -> expr 12 | (** Interpret an expression *) 13 | -------------------------------------------------------------------------------- /homework/hw5/lamp/lexer.mll: -------------------------------------------------------------------------------- 1 | { 2 | open Menhir_parser 3 | exception LexError of string 4 | 5 | let failwith msg = raise (LexError msg) 6 | 7 | let illegal c = 8 | failwith (Printf.sprintf "[lexer] unexpected character: '%c'" c) 9 | } 10 | 11 | let ws = ' ' | '\t' 12 | let newline = "\r\n" | '\r' | '\n' 13 | 14 | rule next_token = parse 15 | | ws+ { next_token lexbuf } 16 | | newline { Lexing.new_line lexbuf; next_token lexbuf } 17 | | "#load" { CLOAD } 18 | | "#save" { CSAVE } 19 | | "#print" { CPRINT } 20 | | "#clear" { CCLEAR } 21 | | "#let" { CLET } 22 | | "#synth" { CSYNTH } 23 | | "let" { LET } 24 | | "in" { IN } 25 | | "fun" { FUN } 26 | | "rec" { REC } 27 | | "with" { WITH } 28 | | "match" { MATCH } 29 | | "end" { END } 30 | | "lambda" { LAMBDA } 31 | | "if" { IF } 32 | | "then" { THEN } 33 | | "else" { ELSE } 34 | | "true" { TRUE } 35 | | "false" { FALSE } 36 | | "fix" { FIX } 37 | | "is" { IS } 38 | | ".1" { FST } 39 | | ".2" { SND } 40 | | "Nil" { NIL } 41 | | "::" { CONS } 42 | | "+" { PLUS } 43 | | "-" { SUB } 44 | | "*" { TIMES } 45 | | "Int" { TYINT } 46 | | "Bool" { TYBOOL } 47 | | "List" { TYLIST } 48 | | '\'' { TICK } 49 | | "->" { THINARROW } 50 | | ':' { COLON } 51 | | ">" { GT } 52 | | '=' { EQ } 53 | | "|" { BAR } 54 | | "<" { LT } 55 | | '(' { LPAREN } 56 | | ')' { RPAREN } 57 | | '[' { LBRACK } 58 | | ']' { RBRACK } 59 | | '.' { DOT } 60 | | ',' { COMMA } 61 | | "$1" { CASE1 } 62 | | "$2" { CASE2 } 63 | | '!' { VOID } 64 | | "//" { comment lexbuf } 65 | | ['0'-'9']+ as n { NUMBER(Base.Int.of_string(n)) } 66 | | ['a'-'z' 'A'-'Z' '_']['a'-'z' 'A'-'Z' '0'-'9' '_']* as x { ID(x) } 67 | | ['a'-'z' 'A'-'Z' '0'-'9' '_' '-' '/' ]+ ".txt" as x { FILE(x) } 68 | | eof { EOF } 69 | | _ as c { illegal c } 70 | 71 | and comment = parse 72 | | newline { Lexing.new_line lexbuf; next_token lexbuf } 73 | | _ { comment lexbuf } 74 | | eof { EOF } 75 | -------------------------------------------------------------------------------- /homework/hw5/lamp/menhir_parser.mly: -------------------------------------------------------------------------------- 1 | %{ 2 | 3 | let mk_lambdas (xs : (string * Ast.ty option) list) (e : Ast.expr) (r: Ast.ty option) = 4 | let f (x, topt) e' = Ast.Lambda(topt, (x,e')) in 5 | List.fold_right f xs (match r with None -> e | Some r -> Annot(e, r)) 6 | 7 | let mk_tfun_of_list (xs: (string * Ast.ty option) list) (r: Ast.ty option) : Ast.ty option = 8 | match r with 9 | | Some r -> 10 | List.fold_right (fun (x,topt) fo -> 11 | match topt, fo with 12 | | Some t, Some r -> Some (Ast.TFun(t,r)) 13 | | _ -> None) xs (Some r) 14 | | None -> None 15 | let mk_let (x: string) (ty: Ast.ty option) (e1: Ast.expr) (e2: Ast.expr) : Ast.expr = 16 | match ty with 17 | | Some t -> Ast.Let(Ast.Annot(e1, t), (x, e2)) 18 | | None -> Ast.Let(e1, (x, e2)) 19 | %} 20 | 21 | /* Tokens */ 22 | 23 | %token EOF FUN REC MATCH BAR END GT EQ LT LPAREN RPAREN DOT COMMA FIX IS 24 | %token TRUE FALSE TYBOOL 25 | %token LET IN IF THEN ELSE WITH LAMBDA 26 | %token NIL CONS 27 | %token TYINT TYLIST THINARROW COLON LBRACK RBRACK 28 | %token CLET CPRINT CCLEAR CLOAD CSAVE CSYNTH 29 | %token TICK 30 | %token FST SND CASE1 CASE2 VOID 31 | 32 | %token PLUS SUB TIMES 33 | %token NUMBER 34 | %token ID 35 | %token FILE 36 | 37 | %nonassoc IN DOT ELSE IS CASE1 CASE2 38 | %nonassoc COLON 39 | %right CONS 40 | %left LT GT EQ 41 | %right THINARROW 42 | %left PLUS SUB 43 | %left TIMES 44 | 45 | %start expr_eof 46 | %type expr_eof 47 | 48 | %start repl_command_eof 49 | %type repl_command_eof 50 | 51 | %start script_eof 52 | %type script_eof 53 | 54 | %start ty_eof 55 | %type ty_eof 56 | 57 | 58 | %% 59 | 60 | file_command: 61 | | CLET bind EQ expr 62 | { let (x,t) = $2 in Cmd.CLet(x,t,$4) } 63 | | CPRINT 64 | { Cmd.CPrint} 65 | | CCLEAR 66 | { Cmd.CClear} 67 | | CLOAD FILE 68 | { Cmd.CLoad $2 } 69 | | CSAVE FILE 70 | { Cmd.CSave $2 } 71 | | CSYNTH ty 72 | { Cmd.CSynth $2 } 73 | 74 | repl_command: 75 | | c=file_command 76 | { c } 77 | | expr 78 | { Cmd.CEval $1 } 79 | 80 | repl_command_eof: 81 | | c=repl_command EOF 82 | { c } 83 | 84 | script_eof: 85 | | cs=list(file_command) EOF 86 | { cs } 87 | 88 | expr_eof: 89 | | e=expr EOF 90 | { e } 91 | 92 | ty_var: 93 | | TICK ID 94 | { ("\'" ^ $2) } 95 | 96 | ty_atom: 97 | | x=ty_var 98 | { Ast.TVar x } 99 | | TYINT 100 | { Ast.TInt } 101 | | TYBOOL 102 | { Ast.TBool } 103 | | LPAREN t=ty RPAREN 104 | { t } 105 | | LPAREN RPAREN 106 | { Ast.TUnit } 107 | | VOID 108 | { Ast.TVoid } 109 | 110 | ty_eof: 111 | | t=ty EOF 112 | { t } 113 | 114 | ty: 115 | | t=ty_atom 116 | { t } 117 | | t1=ty THINARROW t2=ty 118 | { TFun (t1, t2) } 119 | | t1=ty TIMES t2=ty 120 | { TProd (t1, t2) } 121 | | t1=ty PLUS t2=ty 122 | { TSum (t1, t2) } 123 | | TYLIST LBRACK t=ty RBRACK 124 | { TList t } 125 | 126 | bind: 127 | | x=ID COLON t=ty 128 | { (x, Some t) } 129 | | x=ID 130 | { (x, None) } 131 | 132 | bindlist: 133 | | l=separated_nonempty_list(COMMA, bind) 134 | { l } 135 | 136 | expr: 137 | | e=app 138 | { e } 139 | | e=expr COLON t=ty 140 | { Ast.Annot(e, t) } 141 | | LAMBDA bs=bindlist DOT e=expr 142 | { mk_lambdas bs e None } 143 | | FUN REC b=bind WITH bs=bindlist EQ e1=expr IN e2=expr 144 | { let (x,r) = b in 145 | Let(Fix (mk_tfun_of_list bs r, (x, mk_lambdas bs e1 r)), (x, e2)) } 146 | | FUN b=bind WITH bs=bindlist EQ e1=expr IN e2=expr 147 | { let (x,r) = b in 148 | Let(mk_lambdas bs e1 r, (x, e2)) } 149 | | FIX b=bind IS e=expr 150 | { let (x, topt) = b in Fix (topt, (x, e)) } 151 | | LET b=bind EQ e1=expr IN e2=expr 152 | { let (x, topt) = b in 153 | mk_let x topt e1 e2 } 154 | | IF e1=expr THEN e2=expr ELSE e3=expr 155 | { IfThenElse(e1, e2, e3) } 156 | | e=list_match 157 | { e } 158 | | e=sum_match 159 | { e } 160 | | e=void_match 161 | { e } 162 | | e=binop(expr) 163 | { e } 164 | | CASE1; e=expr 165 | { E1 e } 166 | | CASE2; e=expr 167 | { E2 e } 168 | 169 | binop(expr): 170 | | expr PLUS expr 171 | { Binop(Add, $1, $3) } 172 | | expr SUB expr 173 | { Binop(Sub, $1, $3) } 174 | | expr TIMES expr 175 | { Binop(Mul, $1, $3) } 176 | | expr LT expr 177 | { Comp(Lt, $1, $3) } 178 | | expr GT expr 179 | { Comp(Gt, $1, $3) } 180 | | expr EQ expr 181 | { Comp(Eq, $1, $3) } 182 | | expr CONS expr 183 | { ListCons($1, $3) } 184 | 185 | app: 186 | | term 187 | { $1 } 188 | | e1=app e2=term 189 | { App(e1, e2) } 190 | 191 | tyarg_opt: 192 | | LBRACK ty RBRACK 193 | { Some $2 } 194 | | 195 | { None } 196 | 197 | nil_branch: 198 | | NIL THINARROW e=expr 199 | { e } 200 | 201 | cons_branch: 202 | | x=ID CONS y=ID THINARROW e=expr 203 | { (x, y, e) } 204 | 205 | list_match: 206 | | MATCH e1=expr WITH option(BAR) e2=nil_branch BAR b3=cons_branch END 207 | { 208 | let (x,y,e3) = b3 in 209 | Ast.ListMatch(e1, e2, (x, (y, e3)))} 210 | 211 | case(TAG): 212 | | TAG x=ID THINARROW e=expr 213 | { (x, e) } 214 | 215 | sum_match: 216 | | MATCH e1=expr WITH option(BAR) b2=case(CASE1) BAR b3=case(CASE2) END 217 | { Ast.Either(e1, b2, b3) } 218 | 219 | void_match: 220 | | MATCH e1=expr WITH END 221 | { Ast.Absurd e1 } 222 | 223 | term: 224 | | x=ID 225 | { Ast.Var x } 226 | | n=NUMBER 227 | { Ast.Num n } 228 | | TRUE 229 | { Ast.True } 230 | | FALSE 231 | { Ast.False } 232 | | NIL t=tyarg_opt 233 | { ListNil t } 234 | | LPAREN e=expr RPAREN 235 | { e } 236 | | LPAREN e1=expr COMMA e2=expr RPAREN 237 | { Ast.Both(e1, e2) } 238 | | e=term FST 239 | { Ast.I1 e } 240 | | e=term SND 241 | { Ast.I2 e } 242 | | LPAREN RPAREN 243 | { Ast.Unit } 244 | 245 | -------------------------------------------------------------------------------- /homework/hw5/lamp/parser.ml: -------------------------------------------------------------------------------- 1 | module Expr = Nice_parser.Make (struct 2 | type result = Ast.expr 3 | type token = Menhir_parser.token 4 | 5 | exception ParseError = Menhir_parser.Error 6 | 7 | let parse = Menhir_parser.expr_eof 8 | 9 | include Lexer 10 | end) 11 | 12 | module Command = Nice_parser.Make (struct 13 | type result = Cmd.t 14 | type token = Menhir_parser.token 15 | 16 | exception ParseError = Menhir_parser.Error 17 | 18 | let parse = Menhir_parser.repl_command_eof 19 | 20 | include Lexer 21 | end) 22 | 23 | module Script = Nice_parser.Make (struct 24 | type result = Cmd.script 25 | type token = Menhir_parser.token 26 | 27 | exception ParseError = Menhir_parser.Error 28 | 29 | let parse = Menhir_parser.script_eof 30 | 31 | include Lexer 32 | end) 33 | 34 | module Ty = Nice_parser.Make (struct 35 | type result = Ast.ty 36 | type token = Menhir_parser.token 37 | 38 | exception ParseError = Menhir_parser.Error 39 | 40 | let parse = Menhir_parser.ty_eof 41 | 42 | include Lexer 43 | end) 44 | -------------------------------------------------------------------------------- /homework/hw5/lamp/typecheck.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | open Base 3 | 4 | type env = (string * ty) list 5 | (** Typing environment, aka Gamma *) 6 | 7 | (** Helper function to look up a variable in the env *) 8 | let find : env -> string -> ty option = List.Assoc.find ~equal:String.equal 9 | 10 | (** Helper function to insert a (variable, ty) pair into the env *) 11 | let add : env -> string -> ty -> env = List.Assoc.add ~equal:String.equal 12 | 13 | exception Type_error of string 14 | 15 | let ty_err msg = raise (Type_error msg) 16 | let rec equal_ty (t1 : ty) (t2 : ty) : bool = failwith "TODO" 17 | 18 | let rec abstract_eval (env : env) (e : expr) : ty = 19 | try 20 | match e with 21 | (* T-Int rule *) 22 | | Num _ -> TInt 23 | (* T-True and T-false *) 24 | | True | False -> TBool 25 | (* Your code here *) 26 | | _ -> failwith "TODO" 27 | with Type_error msg -> ty_err (msg ^ "\nin expression " ^ show_expr e) 28 | -------------------------------------------------------------------------------- /homework/hw5/lamp/typecheck.mli: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | val equal_ty : ty -> ty -> bool 4 | val abstract_eval : (string * ty) list -> Ast.expr -> ty 5 | 6 | exception Type_error of string 7 | -------------------------------------------------------------------------------- /homework/hw5/lamp/typeinfer.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Ast 3 | 4 | let todo () = failwith "TODO" 5 | 6 | (* Shadow the Base version of common list functions *) 7 | let map = Stdlib.List.map 8 | let fold_left = Stdlib.List.fold_left 9 | let fold_right = Stdlib.List.fold_right 10 | let filter = Stdlib.List.filter 11 | 12 | exception Type_error of string 13 | 14 | let ty_err msg = raise (Type_error msg) 15 | 16 | (********************************************** 17 | * Typing Environment (Gamma) * 18 | *********************************************) 19 | 20 | type gamma = (string * ty) list [@@deriving equal, compare, show] 21 | (** Gamma is the type environment that maps variables to types *) 22 | 23 | let uncurry f (x, y) = f x y 24 | 25 | (** Pretty-printer for gamma *) 26 | let pp_gamma : gamma Fmt.t = 27 | let open Fmt in 28 | let pp_pair = hbox (pair ~sep:(any " : ") string Pretty.ty) in 29 | vbox 30 | @@ iter_bindings ~sep:comma (fun f l -> List.iter ~f:(uncurry f) l) pp_pair 31 | 32 | (** Find the type of a variable in gamma *) 33 | let find : gamma -> string -> ty option = List.Assoc.find ~equal:String.equal 34 | 35 | (** Add a (var, type) pair to gamma *) 36 | let add : gamma -> string -> ty -> gamma = List.Assoc.add ~equal:String.equal 37 | 38 | type cons = ty * ty [@@deriving equal, compare, show] 39 | (** A constraint is a pair (t1,t2) that asserts t1 == t2 *) 40 | 41 | (** Pretty-printer for cons *) 42 | let pp_cons : cons Fmt.t = 43 | fun ppf (t1, t2) -> Fmt.pf ppf "%a == %a" Pretty.ty t1 Pretty.ty t2 44 | 45 | (******************************************* 46 | * Type Substitution (Sigma) * 47 | *******************************************) 48 | 49 | type soln = (string * ty) list [@@deriving equal, compare, show] 50 | (** The solution to a list of type equations is 51 | * a substitution from type variables to types *) 52 | 53 | (** Pretty-printer for soln *) 54 | let pp_soln : soln Fmt.t = 55 | let open Fmt in 56 | let pp_pair = hbox (pair ~sep:(any " |-> ") string Pretty.ty) in 57 | iter_bindings (fun f l -> List.iter ~f:(uncurry f) l) pp_pair 58 | 59 | (******************************************* 60 | * Type Inference Utils * 61 | *******************************************) 62 | 63 | module Utils = struct 64 | (** Substitute type variable [x] with type [t] in [ty] context [c] *) 65 | let rec subst (x : string) (t : ty) (c : ty) : ty = todo () 66 | 67 | (** Compute the free variable set of an [ty] *) 68 | let rec free_vars (t : ty) : Vars.t = 69 | match t with 70 | | TVar x -> Vars.singleton x 71 | | TInt | TBool -> Vars.empty 72 | | TList t' -> free_vars t' 73 | | TFun (t1, t2) | TProd (t1, t2) | TSum (t1, t2) -> 74 | Vars.union (free_vars t1) (free_vars t2) 75 | | TUnit | TVoid -> Vars.empty 76 | 77 | (** Apply a soln [s] to type [t] by performing all substitutions in [s] *) 78 | let apply_soln (s : soln) (t : ty) : ty = todo () 79 | 80 | let cata ~var : ty -> ty = 81 | let rec go = function 82 | | TVar x -> var x 83 | | (TInt | TBool | TUnit | TVoid) as t -> t 84 | | TList t -> TList (go t) 85 | | TFun (t1, t2) -> TFun (go t1, go t2) 86 | | TProd (t1, t2) -> TProd (go t1, go t2) 87 | | TSum (t1, t2) -> TSum (go t1, go t2) 88 | in 89 | go 90 | 91 | let subst_multi (s : soln) : ty -> ty = 92 | cata ~var:(fun x -> 93 | match List.Assoc.find ~equal:String.equal s x with 94 | | Some t -> t 95 | | None -> raise (Type_error Fmt.(str "Unbound type variable %s" x))) 96 | 97 | (** Alpha-rename type variables (to 't0, 't1, 't2, ...) *) 98 | let normalize (t : ty) : ty = 99 | let s = 100 | t |> free_vars |> Vars.to_list 101 | |> List.mapi ~f:(fun i x -> (x, TVar ("'t" ^ Int.to_string (i + 1)))) 102 | in 103 | subst_multi s t 104 | end 105 | 106 | (******************************************* 107 | * Type Inference Engine * 108 | *******************************************) 109 | module Infer = struct 110 | (** The list of accumulated constraints *) 111 | let _cs : cons list ref = ref [] 112 | 113 | (** Add a constraint to the accumulator. Call it with [t1 === t2]. *) 114 | let ( === ) (t1 : ty) (t2 : ty) : unit = 115 | (* If you prefer the "printf" school of debugging, uncomment the following line, 116 | BUT DON'T FORGET TO REMOVE IT BEFORE YOU SUBMIT *) 117 | (* Fmt.epr "[constraint] %a\n%!" pp_cons (t1, t2); *) 118 | _cs := (t1, t2) :: !_cs 119 | 120 | (** Return the current list of constraints *) 121 | let curr_cons_list () : cons list = !_cs 122 | 123 | (****************************************** 124 | * Fresh Variable Helpers * 125 | ******************************************) 126 | 127 | (** Counter to produce fresh variables *) 128 | let var_counter = ref 1 129 | 130 | (** Type string *) 131 | let ty_str_of_int (i : int) : string = "'X" ^ Int.to_string i 132 | 133 | (** Return the current var counter and increment it *) 134 | let incr () = 135 | let v = !var_counter in 136 | var_counter := v + 1; 137 | v 138 | 139 | (** Generate a fresh string. For internal use only. *) 140 | let fresh_var_str () : string = ty_str_of_int (incr ()) 141 | 142 | (** Generate a fresh [ty] type variable. Call it using [fresh_var ()]. *) 143 | let fresh_var () : ty = TVar (fresh_var_str ()) 144 | 145 | (******************************************* 146 | * Constraint Generation * 147 | *******************************************) 148 | 149 | (** Abstractly evaluate an expression to a type. 150 | * This function also generates constraints and accumulates them into 151 | * the list [cs] whenever you call [t1 === t2]. *) 152 | let rec abstract_eval (gamma : gamma) (e : expr) : ty = 153 | (* The following line loads functions in Ast.Ty module, allowing you to write 154 | [int] for [TInt], [bool] for [TBool], [t1 => t2] for [TFun(t1, t2)], 155 | [list t] for TList(t), and [t1 * t2] for [TProd(t1, t2)]. 156 | However, you don't have to use the Ast.Ty functions, and you can just 157 | call the appropriate [ty] constructors. *) 158 | let open Ty in 159 | (* If you prefer the "printf" school of debugging, uncomment the following line, 160 | BUT DON'T FORGET TO COMMENT IT OUT BEFORE YOU SUBMIT *) 161 | (* Fmt.epr "[abstract_eval] %a\n%!" Ast.Pretty.expr e; *) 162 | (* Fmt.epr "[abstract_eval] Gamma:\n%! %a\n%!" pp_gamma gamma; *) 163 | try match e with Num _ -> TInt | True | False -> TBool | _ -> todo () 164 | with Type_error msg -> 165 | ty_err (msg ^ Fmt.(str "\nin expression %a" Pretty.expr e)) 166 | 167 | (******************************************* 168 | * Constraint Solving * 169 | *******************************************) 170 | 171 | (** unification algorithm *) 172 | and unify (cs : cons list) : soln = 173 | match cs with 174 | | [] -> 175 | (* empty solution *) 176 | [] 177 | | c :: cs' -> 178 | (* extract the first constraint as [c], and the remaining as [cs'] *) 179 | todo () 180 | end 181 | 182 | (******************************************* 183 | * Type inference * 184 | *******************************************) 185 | 186 | (** Infer the type of expression [e] in the environment [g] *) 187 | let infer_with_gamma ~(gamma : gamma) (e : expr) : ty = 188 | let t = Infer.abstract_eval gamma e in 189 | let s = Infer.unify (Infer.curr_cons_list ()) in 190 | Utils.apply_soln s t |> Utils.normalize 191 | 192 | (** Infer the type of expression [e] *) 193 | let infer (e : expr) : ty = infer_with_gamma ~gamma:[] e 194 | -------------------------------------------------------------------------------- /homework/hw5/lamp/typeinfer.mli: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | type gamma = (string * ty) list 4 | 5 | exception Type_error of string 6 | 7 | module Utils : sig 8 | val normalize : ty -> ty 9 | end 10 | 11 | type soln = (string * ty) list [@@deriving show, equal] 12 | 13 | val infer : expr -> ty 14 | val infer_with_gamma : gamma:gamma -> expr -> ty 15 | -------------------------------------------------------------------------------- /homework/hw5/lamp/vars.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | type t = Set.M(String).t 4 | 5 | let pp : t Fmt.t = 6 | Fmt.using Set.to_list Fmt.(braces @@ list ~sep:(any ", ") string) 7 | 8 | let show = Fmt.to_to_string pp 9 | let equal = Set.equal 10 | let compare = Set.compare_direct 11 | let empty = Set.empty (module String) 12 | let diff = Set.diff 13 | let singleton = Set.singleton (module String) 14 | let add s v = Set.add v s 15 | let union = Set.union 16 | let mem s v = Set.mem v s 17 | let of_list = Set.of_list (module String) 18 | let to_list = Set.to_list 19 | let size = Set.length 20 | -------------------------------------------------------------------------------- /homework/hw5/lamp/vars.mli: -------------------------------------------------------------------------------- 1 | (** Signature for variable set module *) 2 | 3 | type t [@@deriving equal, compare, show] 4 | (** type of variable set *) 5 | 6 | val empty : t 7 | (** empty set *) 8 | 9 | val mem : string -> t -> bool 10 | (** [mem x s] is true iff [x] is in [s] *) 11 | 12 | val diff : t -> t -> t 13 | (** [diff s1 s2] is the set of elements in [s1] but not in [s2] *) 14 | 15 | val singleton : string -> t 16 | (** [singleton x] is the singleton set containing [x] *) 17 | 18 | val add : string -> t -> t 19 | (** [add x s] is the set [s] with [x] added to it *) 20 | 21 | val union : t -> t -> t 22 | (** [union s1 s2] is the union of [s1] and [s2] *) 23 | 24 | val of_list : string list -> t 25 | (** [of_list l] converts a list [l] into a set *) 26 | 27 | val to_list : t -> string list 28 | (** [to_list x] converts a set [s] into a list *) 29 | 30 | val size : t -> int 31 | (** Return the size of a set *) 32 | -------------------------------------------------------------------------------- /homework/hw5/test/dune: -------------------------------------------------------------------------------- 1 | (env 2 | (dev 3 | (flags 4 | (:standard -warn-error -A)))) 5 | 6 | (test 7 | (name hw5_test) 8 | (libraries fmt alcotest lamp) 9 | (preprocess 10 | (pps ppx_jane ppx_deriving.show)) 11 | (deps 12 | (source_tree examples))) 13 | -------------------------------------------------------------------------------- /homework/hw5/test/examples/add_n.lp: -------------------------------------------------------------------------------- 1 | // increments every element of a list by n 2 | (fix add_n is 3 | lambda l, n. 4 | match l with 5 | | Nil -> Nil 6 | | x::xs -> x + n :: add_n xs n 7 | end 8 | ) (1::2::Nil[Int]) 10 // evaluates to 11::12::Nil -------------------------------------------------------------------------------- /homework/hw5/test/examples/fib.lp: -------------------------------------------------------------------------------- 1 | fun rec fib with n = 2 | if n = 0 then 0 3 | else if n = 1 then 1 4 | else 5 | let x = fib (n-1) in 6 | let y = fib (n-2) in 7 | x + y 8 | in (fib 30 : Int) -------------------------------------------------------------------------------- /homework/hw5/test/examples/foldr.lp: -------------------------------------------------------------------------------- 1 | let foldr = fix foldr is 2 | lambda init: 'b, f: 'a -> 'b -> 'b, xs: List['a]. 3 | (match xs with 4 | | Nil -> init 5 | | y::ys -> f y (foldr init f ys) 6 | end : 'b) 7 | in 8 | let map: List['a] -> List['b] = lambda f: 'a -> 'b. 9 | foldr Nil (lambda x,acc. f x :: acc) 10 | in 11 | map (lambda x.x>1) (1::2::3::Nil) 12 | -------------------------------------------------------------------------------- /homework/hw5/test/examples/length.lp: -------------------------------------------------------------------------------- 1 | fun rec length: Int with xs: List['a] = 2 | match xs with 3 | | Nil -> 0 4 | | _::ys -> 1 + length ys 5 | end 6 | in 7 | length (Nil::Nil::Nil) -------------------------------------------------------------------------------- /homework/hw5/test/examples/length_poly.lp: -------------------------------------------------------------------------------- 1 | fun rec length: Int with xs: List['a] = 2 | match xs with 3 | | Nil -> 0 4 | | _::ys -> 1 + length ys 5 | end 6 | in 7 | length (1::Nil) + length (false::true::false::Nil) -------------------------------------------------------------------------------- /homework/hw5/test/examples/map_filter.lp: -------------------------------------------------------------------------------- 1 | let map = 2 | fix map is lambda f: 'a -> 'b, xs:List['a]. 3 | match xs with 4 | | Nil -> Nil 5 | | x::ys -> f x :: map f ys 6 | end 7 | in 8 | let filter = 9 | fix filter is lambda p: 'a -> Bool, xs:List['a]. 10 | match xs with 11 | | Nil -> Nil 12 | | x::ys -> if p x then x::filter p ys else filter p ys 13 | end 14 | in 15 | let pipe = lambda x,f. f x 16 | in 17 | pipe (pipe (pipe (pipe (pipe (pipe 18 | (1::2::3::Nil) 19 | (filter (lambda x. x > 1))) 20 | (map (lambda x. x - 2))) 21 | (map (lambda x. x * 2))) 22 | (map (lambda x. x > 0))) 23 | (filter (lambda b. b))) 24 | (map (lambda b. if b then (lambda x,y.x) else (lambda x,y.y))) -------------------------------------------------------------------------------- /homework/hw5/test/hw5_test.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | let () = 4 | Alcotest.run "hw5" 5 | (List.map 6 | ~f:(fun (name, tests) -> 7 | (name, List.map ~f:(Alcotest.test_case name `Quick) tests)) 8 | Test_typing.tests) 9 | -------------------------------------------------------------------------------- /homework/hw5/test/test_typing.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lamp 3 | open Ast 4 | 5 | exception Timeout 6 | 7 | (* run a function with specified timeout: 8 | https://discuss.ocaml.org/t/computation-with-time-constraint/5548/9 *) 9 | let with_timeout timeout f = 10 | let _ = 11 | Stdlib.Sys.set_signal Stdlib.Sys.sigalrm 12 | (Stdlib.Sys.Signal_handle (fun _ -> raise Timeout)) 13 | in 14 | ignore (Unix.alarm timeout); 15 | try 16 | let r = f () in 17 | ignore (Unix.alarm 0); 18 | r 19 | with e -> 20 | ignore (Unix.alarm 0); 21 | raise e 22 | 23 | (* Unit test utilities *) 24 | let texpr = Alcotest.testable Pretty.expr equal_expr 25 | let tvars = Alcotest.testable Vars.pp Vars.equal 26 | let tty = Alcotest.testable Pretty.ty equal_ty 27 | 28 | let parse s = 29 | try Parser.Expr.parse_string s 30 | with _ -> Alcotest.fail ("Failed to parse: " ^ s) 31 | 32 | let parse_file filename = 33 | try Parser.Expr.parse_file filename 34 | with _ -> Alcotest.fail ("Failed to parse file: " ^ filename) 35 | 36 | let parse_ty s = 37 | try Parser.Ty.parse_string s 38 | with _ -> Alcotest.fail ("Failed to parse: " ^ s) 39 | 40 | (** Helper function to check that [e] is inferred to have type [expected] 41 | * under [gamma]. The [p] flag enables let-polymorphism. *) 42 | let check_well_typed ~gamma (e : expr) (expected : ty) () = 43 | let actual = 44 | try with_timeout 1 (fun () -> Typeinfer.infer_with_gamma ~gamma e) 45 | with Typeinfer.Type_error msg -> failwith ("Type error!\n" ^ msg) 46 | in 47 | Alcotest.(check' tty) 48 | ~msg:(Fmt.str "%a" Pretty.expr e) 49 | ~expected:(Typeinfer.Utils.normalize expected) 50 | ~actual:(Typeinfer.Utils.normalize actual) 51 | 52 | (** Helper function to check that [e_str] (concrete syntax) is inferred 53 | * to have type [expected] under [gamma]. The [p] flag enables 54 | * let-polymorphism. *) 55 | let check_well_typed_s ~gamma (e_str : string) (expected_str : string) () = 56 | check_well_typed ~gamma (parse e_str) (parse_ty expected_str) () 57 | 58 | let check_well_typed_file ~gamma filename t () = 59 | check_well_typed ~gamma (parse_file filename) t () 60 | 61 | (** Helper function to check that type inference determines that [e] is ill-typed *) 62 | let check_ill_typed ~gamma (e : expr) () = 63 | try 64 | let t = with_timeout 1 (fun () -> Typeinfer.infer_with_gamma ~gamma e) in 65 | Alcotest.fail Fmt.(str "inferred %a" Pretty.ty t) 66 | with Typeinfer.Type_error _ -> () 67 | 68 | (** Helper function to check that type inference determines that [e_str] 69 | (concrete syntax) is ill-typed. *) 70 | let check_ill_typed_s ~gamma (e_str : string) () = 71 | check_ill_typed ~gamma (parse e_str) () 72 | 73 | let well_typed_tests = 74 | let t = check_well_typed_s ~gamma:[] in 75 | [ 76 | check_well_typed_s (* typing environment *) 77 | ~gamma:[] (* input expression *) "0" (* expected inferred type *) "Int"; 78 | t "lambda x. x" "'a -> 'a"; 79 | ] 80 | 81 | let ill_typed_tests = [ check_ill_typed_s ~gamma:[] "true+1" ] 82 | let tests = [ ("well_typed", well_typed_tests); ("ill_typed", ill_typed_tests) ] 83 | -------------------------------------------------------------------------------- /homework/hw5/test/test_utils.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Ast 3 | open Typeinfer 4 | 5 | exception Timeout 6 | 7 | let get_var_name i = "_" ^ Int.to_string i 8 | 9 | let _normalize t = 10 | let rename = ref (Map.empty (module String)) in 11 | let mem x = Map.mem !rename x in 12 | let get x = TVar (Map.find_exn !rename x) in 13 | let set x t = rename := Map.add_exn !rename ~key:x ~data:t in 14 | let counter = ref 0 in 15 | let next () = 16 | counter := !counter - 1; 17 | get_var_name !counter 18 | in 19 | let rec helper = function 20 | | TVar x -> 21 | if mem x then get x 22 | else 23 | let y = next () in 24 | set x y; 25 | get x 26 | | TInt -> TInt 27 | | TBool -> TBool 28 | | TFun (t1, t2) -> TFun (helper t1, helper t2) 29 | | TList t -> TList (helper t) 30 | | TProd (t1, t2) -> TProd (helper t1, helper t2) 31 | in 32 | let t' = helper t in 33 | (t', !rename) 34 | 35 | let normalize t = fst (_normalize t) 36 | 37 | let normalize_pty = function 38 | | Mono t -> Mono (normalize t) 39 | | Scheme (xs, t) -> 40 | let t', rename = _normalize t in 41 | let xs' = 42 | xs |> Vars.to_list 43 | |> List.map ~f:(fun x -> Map.find_exn rename x) 44 | |> Vars.of_list 45 | in 46 | Scheme (xs', t') 47 | 48 | exception DoesNotRefine 49 | 50 | (** t1 refines t2 if there's a substitution from t2 to t1 *) 51 | let refines t1 t2 = 52 | let t1 = normalize t1 in 53 | let t2 = normalize t2 in 54 | let refinement = ref (Map.empty (module String)) in 55 | 56 | let rec helper t1 t2 = 57 | (* Fmt.epr "helper\n%! %a <= %a\n%!" Pretty.pp_ty t1 Pretty.pp_ty t2; *) 58 | match (t1, t2) with 59 | | _, TVar x -> ( 60 | match Map.find !refinement x with 61 | | None -> refinement := Map.add_exn !refinement ~key:x ~data:t1 62 | | Some t1' -> if not (equal_ty t1 t1') then raise DoesNotRefine else ()) 63 | | TInt, TInt -> () 64 | | TBool, TBool -> () 65 | | TFun (t1, t2), TFun (t1', t2') -> 66 | helper t1 t1'; 67 | helper t2 t2' 68 | | TList t1, TList t2 -> helper t1 t2 69 | | TProd (t1, t2), TProd (t1', t2') -> 70 | helper t1 t1'; 71 | helper t2 t2' 72 | | _ -> raise DoesNotRefine 73 | in 74 | try 75 | let () = helper t1 t2 in 76 | true 77 | with DoesNotRefine -> false 78 | 79 | (* Unit test utilities *) 80 | let texpr = Alcotest.testable Pretty.pp_expr equal_expr 81 | let tvars = Alcotest.testable Vars.pp Vars.equal 82 | let tty = Alcotest.testable Pretty.pp_ty equal_ty 83 | 84 | let tpty = 85 | Alcotest.testable pp_pty (fun p1 p2 -> 86 | equal_pty (normalize_pty p1) (normalize_pty p2)) 87 | 88 | let tsigma = 89 | Alcotest.testable pp_sigma (fun s1 s2 -> 90 | let sort = List.sort ~compare:(fun (x, _) (y, _) -> String.compare x y) in 91 | let s1' = sort s1 in 92 | let s2' = sort s2 in 93 | equal_sigma s1' s2') 94 | 95 | let generalize gamma t = 96 | let module I = Infer (struct 97 | let polymorphic = true 98 | end) in 99 | I.generalize gamma t 100 | 101 | let solve : cons list -> sigma = 102 | let module I = Infer (struct 103 | let polymorphic = false 104 | end) in 105 | I.solve 106 | 107 | let parse s = 108 | try Parse_util.parse s with _ -> Alcotest.fail ("Failed to parse: " ^ s) 109 | 110 | let parse_file filename = 111 | try Parse_util.parse_file filename 112 | with _ -> Alcotest.fail ("Failed to parse file: " ^ filename) 113 | 114 | let parse_ty s = 115 | try Parse_util.parse_ty s with _ -> Alcotest.fail ("Failed to parse: " ^ s) 116 | 117 | (* run a function with specified timeout: 118 | https://discuss.ocaml.org/t/computation-with-time-constraint/5548/9 *) 119 | let with_timeout timeout f = 120 | let _ = 121 | Stdlib.Sys.set_signal Stdlib.Sys.sigalrm 122 | (Stdlib.Sys.Signal_handle (fun _ -> raise Timeout)) 123 | in 124 | ignore (Unix.alarm timeout); 125 | try 126 | let r = f () in 127 | ignore (Unix.alarm 0); 128 | r 129 | with e -> 130 | ignore (Unix.alarm 0); 131 | raise e 132 | -------------------------------------------------------------------------------- /homework/lamp.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/homework/lamp.pdf -------------------------------------------------------------------------------- /lectures/2-26-note.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/2-26-note.pdf -------------------------------------------------------------------------------- /lectures/CS162-Curry-Howard-Isomorphism.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/CS162-Curry-Howard-Isomorphism.pdf -------------------------------------------------------------------------------- /lectures/CS162-Final-Review-Programming-Languages.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/CS162-Final-Review-Programming-Languages.pdf -------------------------------------------------------------------------------- /lectures/curry_howard.ml: -------------------------------------------------------------------------------- 1 | (* OCaml's type system *) 2 | (* algebraic data type + parametric polymorphism *) 3 | 4 | (* 1. algebraic data type = generalized enum *) 5 | 6 | (* basic enum *) 7 | type color = Red | Green | Blue 8 | 9 | (* each case is a constructor that accepts some data *) 10 | type expr = NumLit of int | Add of int * int | ... 11 | 12 | (* parametric polymorphism = "template" for producing new types *) 13 | 14 | (* e.g., represent the fact that a computation may either return an int, or may produce an error *) 15 | type maybe_int = Nothing | Just of int 16 | let safe_div (x: int) (y: int) : maybe_int = 17 | if y = 0 then Nothing else Just (x/y) 18 | (* what if the computation returns either a bool, or may produce an error *) 19 | type maybe_bool = Nothing | Just of bool 20 | (* what if the computation returns either a float, or may produce an error *) 21 | type maybe_float = Nothing | Just of float 22 | (* there are infinitely many types in OCaml (because we can manufacture new ones using algebraic data types) *) 23 | 24 | (* so we write a single template, where the return type becomes a parameter and may be replaced with any type *) 25 | type 'a maybe = Nothing | Just of 'a 26 | let safe_div (x: int) (y: int) : int maybe = 27 | if y = 0 then Nothing else Just (x/y) 28 | 29 | (* 2. polymorphism = function works over multiple types *) 30 | (* parametric = those multiple types are represented using a type parameter *) 31 | (* algebraic data type + parametric polymorphism *) 32 | 33 | (* side note: there can be multiple parameters *) 34 | type 'a exception_bad = Error of 'a | Just of 'a 35 | (* problem: the data carried by error must have the same type as Just *) 36 | type ('e, 'a) myexception = Error of 'e | Just of 'a 37 | 38 | (* Two perspectives on OCaml types: 39 | 1. Types = sets 40 | 2. Types = logical propositions *) 41 | 42 | (* Perspective 1: types are sets *) 43 | (* What can you do with sets: 44 | - check for membership relationship (manifested by simple type systems like lambda-plus') 45 | - check for subset relationship (need a more powerful types like subset types) 46 | - measure its size! 47 | *) 48 | type mybool = MyTrue | MyFalse 49 | (* |mybool| = 2 *) 50 | type myunit = MyUnitValue 51 | (* |myunit| = 1 *) 52 | type myvoid = | 53 | (* |myvoid| = 0 *) 54 | type color = Red | Green | Blue 55 | (* |color| = 3 *) 56 | type myint = MyZero | MySucc of myint 57 | (* |myint| = inf = |Z| *) 58 | 59 | type 'a idenitty = Id of 'a 60 | (* |mybool myidentity| = ? *) 61 | (* |myunit myidentity| = ? *) 62 | (* |myint myidentity| = ? *) 63 | (* |'a myidentity| = |'a| *) 64 | type ('a, 'b) pair = Pair of 'a * 'b 65 | (* |(myunit, myunit) pair| = 1 *) 66 | (* |(mybool, myunit) pair| = 2 *) 67 | (* |(mybool, mycolor) pair| = 6 *) 68 | (* |(myvoid, myunit) pair| = 0 *) 69 | (* |('a, 'b) pair| = |'a| * |'b| *) 70 | type ('a, 'b) either = Left of 'a | Right of 'b 71 | (* |(myunit, myunit) either| = 2 *) 72 | (* |(mybool, myunit) either| = 3 *) 73 | (* |(mybool, mycolor) either| = 5 *) 74 | (* |(myvoid, myunit) pair| = 1 *) 75 | (* |('a, 'b) either| = |'a| + |'b| *) 76 | (* "algebraic" because "|" is like "+", and "*" is like "\times" *) 77 | 78 | type 'a mylist = MyNil | 'a * 'a mylist 79 | (* |mybool mylist| = 1 + 2 + 4 + 8 + ... *) 80 | (* Suppose |'a| = x. |'a mylist| = x^0 + x^1 + x^2 + x^3 + ... *) 81 | (* list <-> the polynomial function f(x) = x^0 + x^1 + x^2 + x^3 + ... *) 82 | 83 | (* in general, an algebraic data type (with k parameters) is equivalent to (<->) a polynomial function in k variables *) 84 | (* Let 'x t1 <-> f(x), 'y t2 <-> g(y) *) 85 | 86 | (* what can we do to polynomial functions? *) 87 | (* addition: f(x) + g(y). What type corresponds to h(x,y) = f(x) + g(y) ? *) 88 | (* multiplication: f(x) * g(y). What type corresponds to h(x,y) = f(x) * g(y) ? *) 89 | (* taking derivative: f'(x). What type corresponds to h(x) = f'(x) ? 90 | answer: the zipper data structure: *) 91 | 92 | 93 | (* Perspective 2: Interpreting OCaml types as logical propositions *) 94 | 95 | 96 | (* There are two equivalent ways of defining two-argument functions *) 97 | 98 | (* curried: *) 99 | let add : int -> int -> int 100 | = fun x -> fun y -> x + y 101 | 102 | (* uncurried: *) 103 | let add': (int * int) -> int = fun (x,y) -> x+y 104 | 105 | (* `curry` takes a uncurried function, and returns an equivalent curried function *) 106 | let curry (f: ('a * 'b) -> 'c) : 'a -> 'b -> 'c = 107 | fun x -> fun y -> f (x,y) 108 | (* The type looks like the proposition: ((A & B) -> C) -> (A -> B -> C) *) 109 | 110 | (* `uncurry` takes a curried function, and returns an equivalent uncurried function *) 111 | let uncurry (g: 'a -> 'b -> 'c) : ('a * 'b) -> 'c = 112 | fun xy -> 113 | match xy with 114 | | (x, y) -> g x y 115 | (* The type looks like the proposition: (A -> B -> C) -> ((A & B) -> C) *) 116 | 117 | (* Those two propositions are valid: their truth tables only contain TRUE! *) 118 | 119 | type ('a, 'b) p_and = | Both of 'a * 'b 120 | (* Interpretation: 121 | To prove A && B, we need to a proof of A and a proof of B *) 122 | 123 | let curry (f: ('a, 'b) p_and -> 'c) : 'a -> 'b -> 'c = 124 | fun x -> fun y -> f (Both (x, y)) 125 | 126 | let uncurry (g: 'a -> 'b -> 'c) : ('a, 'b) p_and -> 'c = 127 | fun xy -> 128 | match xy with 129 | | Both (x,y) -> g x y 130 | 131 | (* A && B -> B && A *) 132 | let proof_that_and_is_commutative: ('a, 'b) p_and -> ('b, 'a) p_and = 133 | fun xy -> 134 | match xy with 135 | | Both (x, y) -> Both (y, x) 136 | 137 | type ('a, 'b) p_or = Left of 'a | Right of 'b 138 | (* Interpretation: 139 | To prove A || B, we need to either a proof of A, or a proof of B *) 140 | (* this type is the same as myexception & either *) 141 | 142 | (* A || B -> B || A *) 143 | let proof_that_or_is_commutative: ('a, 'b) p_or -> ('b, 'a) p_or = 144 | fun x_or_y -> 145 | match x_or_y with 146 | | Left x -> Right x 147 | | Right y -> Left y 148 | 149 | (* A && (B || C) -> A && B || A && C *) 150 | let proof_that_and_is_distributive: ('a, ('b, 'c) p_or) p_and -> (('a, 'b) p_and, ('a, 'c) p_and) p_or = 151 | fun a__and__b_or_c -> 152 | match a__and__b_or_c with 153 | | Both (a, b_or_c) -> 154 | match b_or_c with 155 | | Left b -> Left (Both (a, b)) 156 | | Right c -> Right (Both (a, c)) 157 | 158 | (* There is only one proof of TRUE *) 159 | type p_true = | Obvious 160 | (* this is the same as myunit *) 161 | 162 | (* There is no proof of FALSE *) 163 | type p_false = | 164 | (* this is the same as myvoid *) 165 | 166 | (* A -> TRUE *) 167 | let proof_that_anything_implies_true: 'a -> p_true = 168 | fun _ -> Obvious 169 | 170 | (* FALSE -> A *) 171 | let proof_that_false_implies_anything: p_false -> 'a = 172 | fun f -> match f with | _ -> failwith "this branch is unreachable" 173 | 174 | (* TRUE && FALSE -> FALSE *) 175 | let proof_that_true_and_false_implies_false: (p_true, p_false) p_and -> p_false = 176 | fun t_f -> 177 | match t_f with 178 | | Both (t, f) -> proof_that_false_implies_anything f 179 | 180 | (* "not A" is defined to be "A implies FALSE" *) 181 | type 'a p_not = 'a -> p_false 182 | 183 | (* Sanity check 1: not TRUE -> FALSE *) 184 | let proof_that_not_true_implies_false : p_true p_not -> p_false = 185 | fun not_t -> 186 | not_t Obvious 187 | 188 | (* Or equivalently *) 189 | let not_not_true_is_provable : p_true p_not p_not = 190 | proof_that_not_true_implies_false 191 | 192 | (* Sanity check 2: not FALSE *) 193 | let not_false_is_provable: p_false p_not = 194 | proof_that_false_implies_anything 195 | 196 | (* Sanity check 3: A -> not A -> FALSE *) 197 | let contradiction: 'a -> ('a p_not) -> p_false = 198 | fun a -> 199 | fun not_a -> 200 | not_a a 201 | 202 | (* A -> not (not A) *) 203 | (* which is A -> ((A -> FALSE) -> FALSE) *) 204 | let proof_that_a_implies_not_not_a: 'a -> 'a p_not p_not = 205 | fun a -> 206 | (* want not (not A), which is (A -> FALSE) -> FALSE *) 207 | fun not_a -> contradiction a not_a 208 | 209 | (* (A->B) -> (not B -> not A) *) 210 | (* which is (A->B) -> ((B->FALSE) -> (A->FALSE)) *) 211 | (* Example: 212 | If you've taken CS162, then you love OCaml 213 | <-> If you don't love OCaml, then you haven't taken CS162 214 | I.e., 215 | in an imaginary world where everyone who has taken CS162 loves OCaml, 216 | we know that anyone who doesn't love OCaml must haven't taken CS162. *) 217 | let proof_of_contrapositive: ('taken -> 'love) -> ('love p_not -> 'taken p_not) = 218 | fun taken_implies_love -> 219 | fun not_love -> 220 | (* Want: not taken_cs162, which is taken_cs162 -> FALSE *) 221 | (fun taken -> 222 | (* Want: FALSE *) 223 | let love = taken_implies_love taken (* modus ponens <=> function application *) 224 | in contradiction love not_love) 225 | 226 | (* The following three intuitive propositions are not provable! *) 227 | (* let not_not_a_implies_a: 'a p_not p_not -> 'a = 228 | fun not_not_a -> ??? *) 229 | (* let law_of_excluded_middle: ('a, 'a p_not) p_or = ??? *) 230 | (* let de_morgans_law: ('a, 'b) p_or p_not -> ('a p_not, 'b p_not) p_and = 231 | fun not__a_or_b -> ??? *) 232 | 233 | (* Curry-Howard correspondence *) 234 | (* Type = Proposition *) 235 | (* Program = Proof *) 236 | (* Program P has type T = There is a constructive proof P for proposition T *) 237 | 238 | (* Coq is a language with a type system strictly more powerful than OCaml's *) 239 | (* You can encode any statement you want to prove into a type. Then you can write a functional program with that type. 240 | If your program type-checks, then you have a certificate that the statement is formally proven, and the proof has been mechanically verified by the type checker. *) 241 | (* Catch: if the type system is so powerful, why don't we use it everywhere? 242 | Answer: The type system is so powerful that the halting problem can be stated as a type. 243 | So type checking can't be fully automated (otherwise the halting problem would be decidable). 244 | As a consequence, programmers need to provide a lot of hints (aka type annotations) to the type checker, 245 | which is too much for practical purposes. 246 | The typical ratio of program to annotation in Coq is usually 1/10. 247 | I.e., every 1 line of code needs 10 lines of annotation. 248 | This is clearly impractical for most software systems. 249 | However, the tradeoff may be worthwhile for safety-critical systems (like aviation/medical/finacial software). 250 | 251 | Mainstream functional languages usually use a much less powerful type system called System F (or Hindley-Milner), 252 | which is expressive enough that a lot of interesting and common properties can still be encoded and 253 | automatically checked, but not so expressive to encode the halting problem. 254 | *) -------------------------------------------------------------------------------- /lectures/final-review-note.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/final-review-note.pdf -------------------------------------------------------------------------------- /lectures/final-review.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/final-review.pdf -------------------------------------------------------------------------------- /lectures/inference-rules.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/inference-rules.pdf -------------------------------------------------------------------------------- /lectures/lambda-plus.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lambda-plus.pdf -------------------------------------------------------------------------------- /lectures/lecture1.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture1.key -------------------------------------------------------------------------------- /lectures/lecture1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture1.pdf -------------------------------------------------------------------------------- /lectures/lecture10.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture10.key -------------------------------------------------------------------------------- /lectures/lecture10.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture10.pdf -------------------------------------------------------------------------------- /lectures/lecture11.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture11.key -------------------------------------------------------------------------------- /lectures/lecture11.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture11.pdf -------------------------------------------------------------------------------- /lectures/lecture12.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture12.key -------------------------------------------------------------------------------- /lectures/lecture12.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture12.pdf -------------------------------------------------------------------------------- /lectures/lecture13.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture13.key -------------------------------------------------------------------------------- /lectures/lecture13.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture13.pdf -------------------------------------------------------------------------------- /lectures/lecture14.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture14.key -------------------------------------------------------------------------------- /lectures/lecture14.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture14.pdf -------------------------------------------------------------------------------- /lectures/lecture15.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture15.key -------------------------------------------------------------------------------- /lectures/lecture15.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture15.pdf -------------------------------------------------------------------------------- /lectures/lecture16.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture16.pdf -------------------------------------------------------------------------------- /lectures/lecture2.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture2.key -------------------------------------------------------------------------------- /lectures/lecture2.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture2.pdf -------------------------------------------------------------------------------- /lectures/lecture3.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture3.key -------------------------------------------------------------------------------- /lectures/lecture3.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture3.pdf -------------------------------------------------------------------------------- /lectures/lecture4.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture4.key -------------------------------------------------------------------------------- /lectures/lecture4.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture4.pdf -------------------------------------------------------------------------------- /lectures/lecture5.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture5.key -------------------------------------------------------------------------------- /lectures/lecture5.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture5.pdf -------------------------------------------------------------------------------- /lectures/lecture6.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture6.key -------------------------------------------------------------------------------- /lectures/lecture6.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture6.pdf -------------------------------------------------------------------------------- /lectures/lecture7.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture7.key -------------------------------------------------------------------------------- /lectures/lecture7.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture7.pdf -------------------------------------------------------------------------------- /lectures/lecture8.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture8.key -------------------------------------------------------------------------------- /lectures/lecture8.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture8.pdf -------------------------------------------------------------------------------- /lectures/lecture9.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture9.key -------------------------------------------------------------------------------- /lectures/lecture9.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/lecture9.pdf -------------------------------------------------------------------------------- /lectures/midterm-review.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/midterm-review.pdf -------------------------------------------------------------------------------- /lectures/win25-2-13-note.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/lectures/win25-2-13-note.pdf -------------------------------------------------------------------------------- /sections/sec01/install.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | # Setting up OCaml 4 | 5 | > Adapted from [this guide](https://github.com/fredfeng/CS162/blob/winter-2021/sections/section1/install_ocaml.md) written by Bryan Tan. 6 | 7 | 8 | ## Step 1. Installing `opam` 9 | 10 | First, you need to install `opam`, OCaml's package manager, which allows you to install OCaml-related tools. 11 | 12 | 13 | ### macOS 14 | Make sure you have [homebrew](https://brew.sh/). Then run 15 | ``` 16 | brew install opam 17 | ``` 18 | 19 | 20 | ### Windows 21 | Windows users are recommended to use [Windows Subsystem for Linux](https://learn.microsoft.com/en-us/windows/wsl/install), and then follow the instructions under the **(Non-CSIL) Linux** section, since OCaml doesn't work too well on Windows. 22 | 23 | As a last resort, you can also try CSIL, although some students have found it difficult to set up the environment on CSIL. 24 | 25 | 26 | ### (Non-CSIL) Linux 27 | Follow [these step](https://opam.ocaml.org/doc/Install.html#Binary-distribution), under the "Binary distribution" section. Make sure you install opam version >= 2.1.0. 28 | 29 | 30 | ### CSIL 31 | 32 | Log onto a CSIL machine. Download the `opam` binary using: 33 | ```bash 34 | curl -LR 'https://github.com/ocaml/opam/releases/download/2.1.4/opam-2.1.4-x86_64-linux' -o opam 35 | ``` 36 | 37 | Then make sure the downloaded binary is executable, and move it to `~/bin/opam`: 38 | ```bash 39 | chmod +x opam 40 | mkdir -p ~/bin/ 41 | mv opam ~/bin/opam 42 | ``` 43 | Check to make sure it's on `PATH`: 44 | ``` 45 | [junrui@csilvm-01 ~]$ opam --version 46 | 2.1.4 47 | ``` 48 | 49 | > **Note:** If you had an unsuccessful installation of `opam`, please run `rm -rf ~/.opam` to clean up partial installation before retrying the steps below. 50 | 51 | 52 | 53 | 54 | ## Step 2. Installing OCaml, for real 55 | 56 | > **Note:** Use the commands below one-by-one, read the instructions on the screen and proceed accordingly, since some of the commands below are interactive. 57 | 58 | After installing `opam`, you need to first tell your shell where the stuff `opam` installs lives. Use the following command to initialize the environment: 59 | 60 | ``` 61 | opam init 62 | ``` 63 | 64 | Please note that: 65 | - You need to have at least 1GB of available disk space. Otherwise the initialization will fail with a cryptic error message. 66 | - It may prompt you once or twice during the process. We highly recommend you **respond with Y to each prompt** to make your life easier in the future. 67 | - This command will take 30-40 minutes to run. Don't force quit even if you see the `Done` message. Only exit once you see a new shell prompt in which you can type the next shell command. ~~One more reason to not wait until the last minute to start hw1.~~ 68 | 69 | 70 | After `opam init` is done, type the following command so you can have the OCaml tools in your current shell session: 71 | 72 | ``` 73 | eval `opam env` 74 | ``` 75 | 76 | Now, you are ready to install OCaml. Use the following command to install a version of OCaml (called a switch by `opam`): 77 | 78 | ``` 79 | opam switch create cs162 ocaml-base-compiler.5.1.1 80 | ``` 81 | 82 | After the command above is done, you need to tell your shell where OCaml is again: 83 | 84 | ``` 85 | eval $(opam env) 86 | ``` 87 | 88 | At this point, if everything went well, when you type `ocaml`, you should see a prompt like this when you type `ocaml`: 89 | 90 | ``` 91 | % ocaml 92 | OCaml version 5.1.1 93 | Enter #help;; for help. 94 | 95 | # 96 | ``` 97 | 98 | Then, you can proceed to the next stage, installing [`utop`](https://opam.ocaml.org/blog/about-utop/). 99 | 100 | 101 | ## Step 3. Installing `utop`. 102 | 103 | `utop` is is an enhanced REPL interpreter for OCaml with features like autocompletion. Install it with 104 | 105 | ``` 106 | opam install utop 107 | ``` 108 | 109 | Then `utop` should be available as a command. You can run as a REPL interpreter by entering a few OCaml expressions, e.g., 110 | 111 | ```ocaml 112 | 1 + 2;; 113 | ``` 114 | 115 | You should see 116 | ```ocaml 117 | - : int = 3 118 | ``` 119 | as a reponse. That is, OCaml infers that the expression we entered has type `int`, and it evaluates the expression to `3`. 120 | 121 | In REPL mode, every expression needs to be terminated with `;;` before you hit the enter key. Otherwise, you'll just start a new line by hitting enter, and `utop` will patiently wait for you to type `;;` before it can start interpreting the expression. This contrasts with file mode, in which you do not have to terminate every expression with `;;`. 122 | 123 | 124 | ## Loading an OCaml file in `utop` 125 | 126 | Make a new file called `hello.ml` containing the following line: 127 | ``` 128 | print_endline "hello!" 129 | ``` 130 | 131 | Now, open `utop` and load `hello.ml` with 132 | ``` 133 | #use "hello.ml";; 134 | ``` 135 | 136 | You should see `hello!` printed on your console, along with 137 | ```ocaml 138 | - : unit = () 139 | ``` 140 | indicating that the result of evaluating `print_endline "hello!"` is the unit value `()`, whose type is the unit type. (The unit type is usually used to indicate that the expression has some side effect without procuding a concrete value.) 141 | 142 | For homework assignments, you can use any text editor you like. We recommend [VSCode](https://code.visualstudio.com/) with the [OCaml Platform plugin](https://marketplace.visualstudio.com/items?itemName=ocamllabs.ocaml-platform). In addition, if you are working remotely with CSIL, you might want to install the [remote SSH plugin](https://code.visualstudio.com/docs/remote/ssh-tutorial) on your laptop to avoid having to manually sync files between your computer and CSIL. -------------------------------------------------------------------------------- /sections/sec02/notes.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fredfeng/CS162/c5c78d469233522607bac75e0b6c4295c07f4151/sections/sec02/notes.pdf --------------------------------------------------------------------------------