Rahat Zaman

AnnoGram

rahatzamancse@gmail.com (Rahat Zaman) — Thu, 25 Sep 2025 08:06:40 -0600

ChannelExplorer

rahatzamancse@gmail.com (Rahat Zaman) — Thu, 25 Sep 2025 08:06:40 -0600

Wastewater Dashboard

rahatzamancse@gmail.com (Rahat Zaman) — Thu, 25 Sep 2025 08:06:40 -0600

jsPsych Data Manager

rahatzamancse@gmail.com (Rahat Zaman) — Thu, 25 Sep 2025 09:30:00 +0600

Latent State Learning Experiment

rahatzamancse@gmail.com (Rahat Zaman) — Thu, 25 Sep 2025 09:30:00 +0600

MarkUI – PDF to Markdown Converter

rahatzamancse@gmail.com (Rahat Zaman) — Thu, 25 Sep 2025 09:30:00 +0600

Proton Game Saves Manager

rahatzamancse@gmail.com (Rahat Zaman) — Thu, 25 Sep 2025 09:30:00 +0600

A Declarative Layer Visualization Grammar for Deep Learning Models

rahatzamancse@gmail.com (Rahat Zaman) — Mon, 01 Sep 2025 22:22:50 +0600

A Declarative Layer Visualization Grammar for Deep Learning Models

This post outlines a compact, Layer Visualization Grammar (LVG) for building scalable, reproducible visualizations across different models like CNNs, LSTM, Transformers, and Diffusion models. The grammar supports both generic tensor views and targeted model-specific views, and it uses a global state manager to coordinate interactions across panels and sessions.

Core Spec Shape

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46


interface LVGSpec {
 $schema: "https://lvg.dev/v1";
 id?: string;
 title?: string;
 description?: string;

 target: {
 model_id: string; // runtime handle
 layer: string; // e.g., "blocks.5.attn"
 pass?: "train" | "eval" | "inference";
 scope?: "forward" | "backward";
 batch?: number | "active";
 };

 inputs?: InputBinding[];
 parameters?: Param[];
 signals?: Signal[];
 state?: StateBindings; // global state read/write

 views: (GenericView | TargetedView | CompositeView)[];
 layout?: { type?: "grid" | "hstack" | "vstack" | "tabs"; columns?: number; gap?: number; responsive?: "none" | "wrap" };
}

type InputBinding = {
 as: string;
 from: TensorRef | MetaRef;
 slice?: SliceSpec;
 normalize?: "none" | "layer" | "channel" | "token" | "minmax" | "zscore";
};

type TensorRef = { type: "tensor"; source: "layer_output" | "layer_input" | "param" | "upstream" | "downstream" | "cache"; name?: string };
type MetaRef = { type: "meta"; key: "shape" | "param_count" | "receptive_field" | "token_strings" | "class_labels" | "timesteps" };
type SliceSpec = { axes?: Array<number | "last">; index?: Array<number | { start?: number; end?: number; step?: number } | "all"> };

type Param = {
 name: string; value: number | string | boolean | number[] | string[];
 ui?: { type: "slider" | "select" | "checkbox" | "text" | "range"; min?: number; max?: number; step?: number; options?: Array<{label:string; value:any}> };
};

type Signal = { name: string; value?: any; on?: Array<{ event: UIEvent; update: Expr }> };
type UIEvent = { type: "pointerhover" | "click" | "brush" | "keydown"; view?: string; key?: string };

type StateBindings = {
 read?: Array<{ key: string; as: string; default?: any }>;
 write?: Array<{ key: string; from: Expr | string; on: UIEvent | "immediate" }>;
};

Views, Transforms, and Encodings

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78


interface GenericView {
 type: "generic";
 id: string;
 title?: string;
 data: Dataflow;
 encoding: Encoding;
 interactions?: Interaction[];
 actions?: Action[];
}

interface TargetedView {
 type: "targeted";
 id: string;
 title?: string;
 preset:
 | "transformer_attention_matrix"
 | "transformer_head_grid"
 | "cnn_channel_heatmap"
 | "cnn_featuremap_gallery"
 | "diffusion_step_preview"
 | "diffusion_noise_to_image"
 | "rnn_gate_timelines"
 | "token_saliency_grid";
 inputs?: Record<string, string>;
 options?: Record<string, any>;
 interactions?: Interaction[];
 actions?: Action[];
}

interface CompositeView {
 type: "composite";
 id: string;
 title?: string;
 layout: LVGSpec["layout"];
 children: (GenericView | TargetedView)[];
}

type Dataflow = {
 sources: Array<{ name: string; from: string; kind: "tensor" | "meta" | "state" | "literal"; value?: any }>;
 transforms: Transform[];
 output: string;
};

type Transform =
 | { op: "reshape"; from: string; to: "table" | "matrix"; axis_names?: string[] }
 | { op: "slice"; from: string; spec: SliceSpec; as: string }
 | { op: "reduce"; from: string; dims?: number[]; fn: "mean" | "max" | "min" | "sum" | "std" | "var" | "norm"; keepdims?: boolean; as: string }
 | { op: "normalize"; from: string; mode: "minmax" | "zscore" | "l2"; along?: "row" | "col" | "global"; as: string }
 | { op: "project"; from: string; method: "pca" | "umap" | "tsne"; k: number; seed?: number; metric?: "cosine" | "euclidean"; as: string }
 | { op: "similarity"; from: string; against?: string; metric: "cosine" | "dot" | "jaccard"; topk?: number; threshold?: number; as: string }
 | { op: "compare"; a: string; b: string; mode: "diff" | "ratio" | "corr"; as: string }
 | { op: "rank"; from: string; by: string; order?: "asc" | "desc"; groupby?: string[]; as: string }
 | { op: "quantiles"; from: string; q: number[]; as: string }
 | { op: "aggregate"; from: string; by: string[]; ops: Array<{ fn: "mean"|"max"|"count"|"sum"|"std"; as: string }> }
 | { op: "threshold"; from: string; by: string; op: ">" | "<" | ">=" | "<="; value: number; as: string }
 | { op: "topk"; from: string; by: string; k: number; as: string }
 | { op: "join"; left: string; right: string; on: string[]; how: "inner" | "left" | "right" | "outer"; as: string }
 | { op: "expr"; from: string; expr: Expr; as: string };

type Encoding = {
 mark: "scatter" | "heatmap" | "image" | "line" | "bar" | "table";
 data: string;
 x?: Channel; y?: Channel; color?: Channel; size?: Channel; shape?: Channel; text?: Channel;
 axes?: { x?: Axis; y?: Axis };
 legend?: boolean | { position?: "right" | "bottom" };
 tooltip?: string[];
};

type Channel = { field: string; type: "quant" | "ordinal" | "nominal" | "index" };
type Axis = { label?: string; grid?: boolean; tickCount?: number };

type Interaction =
 | { type: "brush"; target: "x" | "y" | "xy"; signal: string }
 | { type: "select"; on: "click" | "hover"; fields: string[]; signal: string }
 | { type: "link"; with: string; using: string[] };

type Action =
 | { id: string; label: string; kind: "export_csv" | "export_png" | "write_state" | "mutate_model" | "compare_with_state"; payload?: any; from?: string; toStateKey?: string };

Targeted Presets: Contracts

transformer_attention_matrix
Inputs: attn [batch, heads, tokens, tokens], optional token_strings.
Options: head, softmax_temp, normalize_along (row|col).
transformer_head_grid
Inputs: Q, K, V.
Options: head selector; shows norms and head-wise similarities.
cnn_channel_heatmap
Inputs: acts [batch, channels, H, W].
Options: summary (l2|mean|max), rank_by (class_separation|variance).
cnn_featuremap_gallery
Inputs: acts.
Options: topk, normalize, tiling mode.
diffusion_step_preview
Inputs: x_t, eps_pred, timesteps, scheduler params.
Options: scheduler, eta, t, decode.
diffusion_noise_to_image
Inputs: same as above; runs a short denoise loop from t to t-k.
rnn_gate_timelines
Inputs: i,f,o,g over time.
Options: sequence range, aggregation.
token_saliency_grid
Inputs: saliency [tokens] or [layers,tokens], optional token_strings.
Options: normalization, threshold.

Example: Transformer Attention Debugger

The following spec composes generic and targeted views for a Transformer self-attention layer. It:

Projects token embeddings (from V) via DR and allows brushing.
Shows a head-selectable attention matrix targeted view.
Compares the current head’s attention submatrix to a pinned baseline stored in global state.

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129


{
 "$schema": "https://lvg.dev/v1",
 "id": "transformer-attn-debugger",
 "title": "Transformer Attention Debugger",
 "target": {
 "model_id": "active_model",
 "layer": "encoder.blocks.5.self_attn",
 "pass": "inference",
 "scope": "forward",
 "batch": "active"
 },
 "inputs": [
 { "as": "Q", "from": { "type": "tensor", "source": "layer_output", "name": "Q" } },
 { "as": "K", "from": { "type": "tensor", "source": "layer_output", "name": "K" } },
 { "as": "V", "from": { "type": "tensor", "source": "layer_output", "name": "V" } },
 { "as": "ATTN", "from": { "type": "tensor", "source": "layer_output", "name": "attn" } },
 { "as": "TOKENS", "from": { "type": "meta", "key": "token_strings" } }
 ],
 "parameters": [
 { "name": "head", "value": 0, "ui": { "type": "slider", "min": 0, "max": 11, "step": 1 } },
 {
 "name": "dr_method",
 "value": "pca",
 "ui": { "type": "select", "options": [ { "label": "PCA", "value": "pca" }, { "label": "UMAP", "value": "umap" } ] }
 }
 ],
 "signals": [
 { "name": "hover_token", "value": null },
 { "name": "selected_tokens", "value": [] }
 ],
 "state": {
 "read": [
 { "key": "debug.selected_tokens", "as": "selected_tokens", "default": [] },
 { "key": "debug.selected_head", "as": "head", "default": 0 }
 ],
 "write": [
 { "key": "debug.selected_tokens", "from": "selected_tokens", "on": { "type": "brush", "view": "token-embed" } },
 { "key": "debug.selected_head", "from": "head", "on": "immediate" }
 ]
 },
 "layout": { "type": "grid", "columns": 2, "gap": 12, "responsive": "wrap" },
 "views": [
 {
 "type": "generic",
 "id": "token-embed",
 "title": "Token Embedding (V) — DR Scatter",
 "data": {
 "sources": [
 { "name": "V_src", "from": "V", "kind": "tensor" },
 { "name": "TOK", "from": "TOKENS", "kind": "meta" }
 ],
 "transforms": [
 { "op": "reshape", "from": "V_src", "to": "table", "axis_names": ["batch","tokens","heads","dim"] },
 { "op": "reduce", "from": "V_src", "dims": [2], "fn": "mean", "keepdims": false, "as": "V_tokens" },
 { "op": "project", "from": "V_tokens", "method": { "$param": "dr_method" }, "k": 2, "as": "V_2d" },
 { "op": "expr", "from": "V_2d", "expr": "add_field(index(),'tok_idx')", "as": "V_xy" },
 { "op": "join", "left": "V_xy", "right": "TOK", "on": ["tok_idx"], "how": "left", "as": "V_labeled" }
 ],
 "output": "V_labeled"
 },
 "encoding": {
 "mark": "scatter",
 "data": "V_labeled",
 "x": { "field": "x0", "type": "quant" },
 "y": { "field": "x1", "type": "quant" },
 "color": { "field": "tok_idx", "type": "index" },
 "size": { "field": "variance", "type": "quant" },
 "tooltip": ["tok_idx", "token_string"]
 },
 "interactions": [
 { "type": "brush", "target": "xy", "signal": "selected_tokens" },
 { "type": "select", "on": "hover", "fields": ["tok_idx"], "signal": "hover_token" }
 ],
 "actions": [
 { "id": "export-embed", "label": "Export CSV", "kind": "export_csv", "from": "V_labeled" }
 ]
 },
 {
 "type": "targeted",
 "id": "attn-matrix",
 "title": "Attention Matrix — Head & Token Subset",
 "preset": "transformer_attention_matrix",
 "inputs": { "attn": "ATTN", "token_strings": "TOKENS" },
 "options": { "head": { "$param": "head" }, "normalize_along": "row" },
 "interactions": [
 { "type": "link", "with": "token-embed", "using": ["tok_idx"] }
 ],
 "actions": [
 { "id": "pin-head", "label": "Set as Compare A", "kind": "write_state", "toStateKey": "debug.compare.attnA", "from": "head" },
 { "id": "pin-selection", "label": "Set Tokens as Compare A", "kind": "write_state", "toStateKey": "debug.compare.tokensA", "from": "selected_tokens" }
 ]
 },
 {
 "type": "generic",
 "id": "attn-compare",
 "title": "Compare Current Head vs Pinned",
 "data": {
 "sources": [
 { "name": "ATTN_src", "from": "ATTN", "kind": "tensor" },
 { "name": "head_curr", "from": "head", "kind": "state" },
 { "name": "head_A", "from": "debug.compare.attnA", "kind": "state" },
 { "name": "sel_tokens", "from": "selected_tokens", "kind": "state" },
 { "name": "tokensA", "from": "debug.compare.tokensA", "kind": "state" }
 ],
 "transforms": [
 { "op": "slice", "from": "ATTN_src", "spec": { "axes": [0,1,2,3], "index": ["all", { "$state": "head_curr" }, "all", "all"] }, "as": "A_curr" },
 { "op": "slice", "from": "ATTN_src", "spec": { "axes": [0,1,2,3], "index": ["all", { "$state": "head_A" }, "all", "all"] }, "as": "A_pin" },
 { "op": "reduce", "from": "A_curr", "dims": [0], "fn": "mean", "as": "A_curr2D" },
 { "op": "reduce", "from": "A_pin", "dims": [0], "fn": "mean", "as": "A_pin2D" },
 { "op": "slice", "from": "A_curr2D", "spec": { "axes": [0,1], "index": [ { "$state": "sel_tokens" }, { "$state": "sel_tokens" } ] }, "as": "A_curr_sub" },
 { "op": "slice", "from": "A_pin2D", "spec": { "axes": [0,1], "index": [ { "$state": "tokensA" }, { "$state": "tokensA" } ] }, "as": "A_pin_sub" },
 { "op": "compare", "a": "A_curr_sub", "b": "A_pin_sub", "mode": "diff", "as": "A_diff" }
 ],
 "output": "A_diff"
 },
 "encoding": {
 "mark": "heatmap",
 "data": "A_diff",
 "x": { "field": "col", "type": "index" },
 "y": { "field": "row", "type": "index" },
 "color": { "field": "value", "type": "quant" },
 "tooltip": ["row","col","value"]
 },
 "actions": [
 { "id": "export-diff", "label": "Export Diff CSV", "kind": "export_csv", "from": "A_diff" }
 ]
 }
 ]
}

CNN Example: Channel Heatmap + DR Scatter

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48


{
 "$schema": "https://lvg.dev/v1",
 "id": "cnn-channels",
 "title": "CNN Channel Heatmap + DR",
 "target": { "model_id": "active_model", "layer": "features.17", "pass": "inference", "scope": "forward", "batch": "active" },
 "inputs": [
 { "as": "ACTS", "from": { "type": "tensor", "source": "layer_output", "name": "activations" } },
 { "as": "LABELS", "from": { "type": "meta", "key": "class_labels" } }
 ],
 "parameters": [
 { "name": "summary", "value": "l2", "ui": { "type": "select", "options": [ { "label": "L2", "value": "l2" }, { "label": "Mean", "value": "mean" }, { "label": "Max", "value": "max" } ] } },
 { "name": "topk", "value": 64, "ui": { "type": "slider", "min": 8, "max": 256, "step": 8 } }
 ],
 "layout": { "type": "grid", "columns": 2, "gap": 12 },
 "views": [
 {
 "type": "targeted",
 "id": "chan-heat",
 "title": "Channel Heatmap (summary × images)",
 "preset": "cnn_channel_heatmap",
 "inputs": { "acts": "ACTS" },
 "options": { "summary": { "$param": "summary" }, "rank_by": "variance", "topk": { "$param": "topk" } }
 },
 {
 "type": "generic",
 "id": "chan-dr",
 "title": "Channel DR (H×W reduced)",
 "data": {
 "sources": [ { "name": "A", "from": "ACTS", "kind": "tensor" } ],
 "transforms": [
 { "op": "reduce", "from": "A", "dims": [2,3], "fn": "norm", "as": "A_ch" }, // [batch, channels]
 { "op": "reduce", "from": "A_ch", "dims": [0], "fn": "mean", "as": "A_ch_mean" }, // [channels]
 { "op": "project", "from": "A_ch_mean", "method": "pca", "k": 2, "as": "A_2d" },
 { "op": "expr", "from": "A_2d", "expr": "add_field(index(),'ch')", "as": "A_xy" }
 ],
 "output": "A_xy"
 },
 "encoding": {
 "mark": "scatter",
 "data": "A_xy",
 "x": { "field": "x0", "type": "quant" },
 "y": { "field": "x1", "type": "quant" },
 "color": { "field": "ch", "type": "index" },
 "tooltip": ["ch"]
 }
 }
 ]
}

Diffusion Example: Single-Step Preview

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33


{
 "$schema": "https://lvg.dev/v1",
 "id": "diffusion-preview",
 "title": "Diffusion Step Preview (DDIM)",
 "target": { "model_id": "sd15", "layer": "unet.down_blocks.2", "pass": "inference", "scope": "forward", "batch": "active" },
 "inputs": [
 { "as": "X_T", "from": { "type": "tensor", "source": "upstream", "name": "x_t" } },
 { "as": "EPS", "from": { "type": "tensor", "source": "layer_output", "name": "eps_pred" } },
 { "as": "T", "from": { "type": "meta", "key": "timesteps" } }
 ],
 "parameters": [
 { "name": "t", "value": 350, "ui": { "type": "slider", "min": 0, "max": 999, "step": 1 } },
 { "name": "eta", "value": 0.0, "ui": { "type": "slider", "min": 0, "max": 1, "step": 0.05 } }
 ],
 "state": {
 "write": [
 { "key": "diff.t", "from": "t", "on": "immediate" }
 ]
 },
 "views": [
 {
 "type": "targeted",
 "id": "ddim-preview",
 "title": "x_{t-1} and Decoded Image",
 "preset": "diffusion_step_preview",
 "inputs": { "x_t": "X_T", "eps_pred": "EPS", "timesteps": "T" },
 "options": { "scheduler": "ddim", "eta": { "$param": "eta" }, "t": { "$param": "t" }, "decode": true },
 "actions": [
 { "id": "pin-t", "label": "Pin t", "kind": "write_state", "toStateKey": "diff.t_pinned", "from": "t" }
 ]
 }
 ]
}

Implementation Notes

Backend adapters: Resolve TensorRef to framework tensors; convert to ndarray for transforms. Cache transform outputs keyed by (model_id, layer, input_name, params_hash).
Presets: Thin wrappers over generic transforms with domain helpers (e.g., softmax temperature, head tiling, DDIM step).
Global state: JSON-serializable values with subscriptions; updates trigger recomputation of dependent specs.
Interactivity: Brushing and linking rely on shared identifiers (tok_idx, ch, t) across views.

JsPsych Experiment with Vite and TypeScript

rahatzamancse@gmail.com (Rahat Zaman) — Wed, 23 Oct 2024 10:21:45 -0600

In this guide, we’ll walk you through setting up a simple psychology experiment using JsPsych within a Vite and TypeScript project. We’ll assume you have little to no prior experience with JsPsych, Vite, or TypeScript. This step-by-step guide will explain the basics and get you up and running quickly.

What is JsPsych?

JsPsych is a library for creating behavioral experiments that run in a web browser. It is often used in psychology and cognitive science research to create experiments that participants can complete online.

Why Use Vite and TypeScript with JsPsych?

Vite helps you develop web applications quickly, refreshing the page whenever you make changes, which speeds up development.
TypeScript ensures that your code is easier to read and less prone to errors by adding extra checks.
JsPsych provides the structure and tools needed to create an experiment, such as displaying stimuli and recording participant responses.

Now, let’s set up everything step by step.

Step 1: Set Up a Vite + TypeScript Project

If you haven’t already set up a Vite + TypeScript project, follow these instructions:

1.1 Open Your Terminal

Start by opening your Terminal (or Command Prompt on Windows).

1.2 Create a New Vite Project

In the terminal, type the following command and press Enter:

1

npm create vite@latest

Answer the questions:

Project name: Enter a name (e.g., jspsych-experiment).
Framework: Choose vanilla (basic JavaScript).
Variant: Choose TypeScript.

Once the project is created, move into your new project folder:

1

cd jspsych-experiment

1.3 Install Dependencies

Run the following command to install all the required files:

1

npm install

To know more about what these steps are doing, check out the Introduction to Vite + Typescript tutorial.

Now, you’ve set up your Vite + TypeScript project!

Step 2: Install JsPsych

JsPsych is not included by default in your Vite project, so you need to install it manually.

In the terminal, run the following command to add JsPsych to your project:

1
2


npm install jspsych # to install the core library
npm install @jspsych/plugin-button-response # to install the button-response plugin

This will download JsPsych and add it to your project’s dependencies.

Step 3: Modify Your Project Files

Next, we’ll edit the project files to display a simple JsPsych experiment.

3.1 Set Up Your HTML File

First, let’s modify the index.html file, which is the main web page for your experiment.

Open index.html in your code editor (like VS Code).

Modify it to include a placeholder where the JsPsych experiment will be displayed:

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14


<!DOCTYPE html>
<html lang="en">
<head>
 <meta charset="UTF-8" />
 <meta name="viewport" content="width=device-width, initial-scale=1.0" />
 <title>JsPsych Experiment</title>
</head>
<body>
 <h1>Welcome to My JsPsych Experiment</h1>
 <div id="jspsych-experiment"></div>

 <script type="module" src="/src/main.ts"></script>
</body>
</html>

3.2 Create a Simple JsPsych Experiment

Now, let’s write the code for a basic JsPsych experiment in main.ts. This code will create a simple trial where the participant sees a message and responds by pressing a key.

Open src/main.ts in your editor.

Add the following code:

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17


import { initJsPsych } from 'jspsych';
import jsPsychButtonResponse from '@jspsych/plugin-button-response';

const jsPsych: JsPsych = jsPsychInit();

// Create a simple timeline with one trial
const timeline: any[] = [];

const trial = {
 type: jsPsychButtonResponse,
 stimulus: '<p>Press any key to begin the experiment.</p>',
};

timeline.push(trial);

// Initialize the JsPsych experiment
jsPsych.run(timeline);

Breakdown of the Code:

import { initJsPsych } from 'jspsych';: This imports the JsPsych library into your project.
const jsPsych: JsPsych = initJsPsych();: This initializes JsPsych and assigns it to the jsPsych variable.
const timeline: any[] = [];: A timeline in JsPsych is a list of trials that define your experiment. We create an empty timeline and add our trials to it.
const trial = {...}: This is a basic trial that presents a message and waits for the participant to press any key.
jsPsych.run(timeline);: This starts the experiment using the timeline we created.

Step 4: Run the Experiment

With everything set up, you’re ready to run the experiment and see it in action!

Open the terminal (if it’s not already open).
Run the development server with this command:
1

npm run dev

Vite will start a local development server and give you an address like http://localhost:3000/. Open this address in your web browser.

You should see your experiment with the message “Press any key to begin the experiment.” When you press a key, the trial will complete.

Conclusion

You have successfully set up a simple JsPsych experiment using Vite and TypeScript! Here’s what we did in this tutorial:

Created a Vite + TypeScript project.
Installed JsPsych to run psychology experiments.
Wrote a simple experiment where a participant presses a key.
Ran the experiment in a browser.

Recap:

Vite makes your development faster by reloading changes automatically.
TypeScript helps catch mistakes in your code early.
JsPsych allows you to easily create browser-based behavioral experiments.

Now you can continue to build more complex experiments by adding more trials and customizing how participants interact with the experiment. Happy experimenting!

Introduction to Vite Typescript

rahatzamancse@gmail.com (Rahat Zaman) — Wed, 23 Oct 2024 09:58:43 -0600

This guide will walk you through setting up a project using Vite and TypeScript from scratch. Don’t worry if you’re unfamiliar with programming or technical terms. We’ll explain everything in simple terms.

What Is Vite?

Before diving into the steps, let’s first understand what Vite is and why it’s useful.

Vite (pronounced like “veet”) is a tool that helps you develop websites. When building a website, you usually need to set up many things—like how to handle multiple files and make your website load quickly. Vite takes care of all that for you, so you can focus on writing your website’s code.
It makes development faster, especially when your project gets larger.
Instead of loading everything at once (which can make your website slow), Vite loads only what’s needed when you start developing.

Why use Vite? Let’s look at an example:

Imagine you’re building a website using plain HTML and JavaScript (the language used to make websites interactive). As your website grows, it gets slower because you have to load all the files at once. Vite helps avoid this by loading just the files you’re working on, making it much faster to work with.

Why is Vite Better than Plain HTML and JavaScript?

Faster development: Vite refreshes only the part of the page you’re working on, while with plain HTML/JavaScript, you’d have to reload the entire page.
Organized code: You can split your code into smaller parts, which Vite helps combine neatly.
Support for modern technologies: It makes it easier to use new web development features like TypeScript.

What is TypeScript?

Now, let’s talk about TypeScript:

TypeScript is a programming language that builds on JavaScript. It adds extra features, such as “types,” which help you avoid common mistakes when writing code.
It helps make your code more predictable, reducing the chances of bugs.

You don’t need to fully understand TypeScript yet to follow this guide, but think of it as a “safer” version of JavaScript that helps you write cleaner, less error-prone code.

Why Use TypeScript?

Catch errors early: TypeScript checks your code for potential problems before it runs, so you can fix them before they break your website.
Better collaboration: If you’re working with other developers, TypeScript makes it easier for everyone to understand how the code works.

Now that we know why Vite and TypeScript are useful, let’s get started with setting them up.

Step 1: Setting Up Your Development Environment

Before we can use Vite and TypeScript, you’ll need to install a few basic tools:

1.1 Install Node.js

Node.js is a tool that lets you run JavaScript (and TypeScript) outside of a web browser. Vite uses Node.js to manage your website’s files during development.
Download Node.js from its official website.
- Choose the LTS version (it stands for Long Term Support, meaning it is more stable).
- Once downloaded, install it by following the on-screen instructions.

1.2 Install a Code Editor

You’ll need a place to write your code. The most popular tool for this is Visual Studio Code (VS Code):

Download Visual Studio Code from its official site and install it.
This editor comes with useful features like error checking and highlighting code, which makes it beginner-friendly.

Step 2: Starting a Vite + TypeScript Project

With Node.js installed, you can create your Vite + TypeScript project.

2.1 Open Your Terminal

On your computer, open the Terminal or Command Prompt. If you’re using Windows, search for “Command Prompt” in the Start menu.

2.2 Create a New Vite Project

Now, let’s create your first Vite project:

In the terminal, type the following command and press Enter:
1

npm create vite@latest
- This command tells Node.js to create a new project using Vite.
You’ll be asked a few questions:
- Project name: Enter a name for your project (e.g., my-vite-project).
- Framework: Choose vanilla (this means basic JavaScript).
- Variant: Choose TypeScript (this sets up TypeScript automatically for you).
Once you’ve answered the questions, the terminal will set up your project. Next, move into the project folder by typing:
1

cd my-vite-project

2.3 Install Dependencies

Next, you’ll need to install some files that Vite needs to run your project. These are called dependencies.

Run this command in your terminal:
1

npm install

This will download all the necessary files.

Step 3: Running Your Project

You’re now ready to start your Vite project and see it in action!

In the terminal, type the following command:
1

npm run dev
Vite will start a local server, and it will tell you an address to visit in your web browser, something like:
```
Local: http://localhost:3000/
```
- Open your browser and go to this address. You should see a page that says Vite + TypeScript. Congratulations! You now have a basic Vite project running with TypeScript.

Step 4: Understanding Your Project’s Structure

Let’s break down what Vite has created for you:

index.html: This is the main page of your website. It tells the browser what content to display.
main.ts: This is the main TypeScript file. It is where you will write your code to make the page interactive.
style.css: This file contains the styles for your website. It controls how things look, such as colors and layouts.

You don’t need to worry too much about these files yet. Over time, as you add more features, you’ll add more files.

Step 5: Making Changes to Your Project

Now, let’s modify your project to see how easy it is to work with Vite and TypeScript.

5.1 Changing Text on the Page

Open index.html in your code editor.
Find the line that says:
1

<h1>Vite + TypeScript</h1>
Change it to:
1

<h1>Hello, World!</h1>
Save the file.

When you go back to your browser (the one you opened in Step 3), you’ll see the text has changed without refreshing the page! This is one of Vite’s cool features—it automatically updates the page when you save changes.

5.2 Adding Some Interactivity

Open main.ts in your editor.

Add the following code at the end of the file:

1
2
3
4
5
6
7


const button = document.createElement('button');
button.textContent = 'Click Me';
document.body.appendChild(button);

button.addEventListener('click', () => {
 alert('You clicked the button!');
});

Save the file.

When you look at your browser again, you’ll see a button has appeared. If you click it, an alert will pop up! This is an example of how you can make your page interactive using TypeScript.

Conclusion

You’ve now set up a project using Vite and TypeScript, made some changes, and added a button to your webpage. By using Vite, you can develop websites quickly, and with TypeScript, you can write code that’s safer and easier to manage.

Recap:

Vite helps you develop faster by loading only what you need and refreshing changes automatically.
TypeScript helps catch potential errors before they happen, making your code more reliable.

You can now continue building your project by exploring more TypeScript features or adding more pages to your website.

Happy coding!

BTRFS + SWAP + HIBERNATE

rahatzamancse@gmail.com (Rahat Zaman) — Wed, 02 Oct 2024 22:22:50 +0600

How to enable hibernation in EndeavourOS+BTRFS+swapfile

First, we need to make sure that the swap file is at least of the size of the ram.

1

free -h

1
2
3


 total used free shared buff/cache available
Mem: 15Gi 3.3Gi 10Gi 1.1Gi 2.9Gi 11Gi
Swap: 16Gi 0B 16Gi

Ok, so it is larger than the memory. If it is not, then we need to recreate the swap file with a larger size. To do that, first stop and remove the existing swapfile (is this case, the default location of swapfile is in /swap/swapfile).

1
2


sudo swapoff /swap/swapfile # stops the swap
sudo rm -f /swap/swapfile # remove the swapfile

Then we create a new swapfile. Usually it can be done with the dd command, but btrfs has a special command already for this.

1
2


sudo btrfs filesystem mkswapfile /swap/swapfile -s 17G
sudo swapon /swap/swapfile

Now we should be a swapfile that is larger than our memory.

Next, we need to enable the resume hook for our initramfs generator. The most common generator is mkinitcpio. In that case, we can add resume in /etc/mkinitcpio.conf like below:

1

HOOKS=(base udev autodetect modconf block kbd_backlight encrypt filesystems keyboard fsck resume)

But endeavourOS has switched to Dracut. In this case, we edit the file /etc/ostree-mkinitcpio.conf and add the resume flag like below:

1

HOOKS="base udev autodetect modconf block kbd_backlight encrypt filesystems keyboard fsck resume"

Then we rebuild the initramfs with sudo dracut-rebuild.

Next we grab two important variables about the swapfile in btrfs filesystem. The first one is the UUID of the swapfile:

1

sudo findmnt -no UUID -T /swap/swapfile # <the-uuid> = a44a89ea-0560-4bff-bbf1-1855ef63e6e6

Then we get the offset of the swapfile. For non-btrfs partitions, it can be obtained with findmnt as well, but for btrfs, it does not work. For btrfs, we need to obtain the offset by:

1

sudo btrfs inspect-internal map-swapfile -r /swap/swapfile # <offset> = 373845

After getting these two information, we need to add these to /etc/default/grub in the GRUB_CMDLINE_LINUX_DEFAULT variable like below:

1
2
3
4
5
6
7


# GRUB boot loader configuration

GRUB_DEFAULT='0'
GRUB_TIMEOUT='5'
GRUB_DISTRIBUTOR='EndeavourOS'
GRUB_CMDLINE_LINUX_DEFAULT='nowatchdog nvme_load=YES loglevel=3 resume_offset=373845 resume=UUID=a44a89ea-0560-4bff-bbf1-1855ef63e6e6'
GRUB_CMDLINE_LINUX=""

Then create the grub configs by running sudo grub-mkconfig -o /boot/grub/grub.cfg.

Finally reboot the system. Now test if hibernation works by running sudo systemctl hibernate. This will turn your computer off. Then upon starting, this will boot straight to the last session you were.

Advanced Computer Architecture

rahatzamancse@gmail.com (Rahat Zaman) — Mon, 21 Aug 2023 00:00:00 +0000

Welcome! My name is Vijay Nagarajan, and I am excited to teach this course as this is my area of research. This course presents fundamental principles in computer architecture. You will learn about pipelining, branch prediction, dynamic scheduling, superscalars, caches, virtual memory, shared-memory multiprocessors, memory consistency, cache coherence, hardware support for synchronization, multithreading, SIMD/Vector processing, and GPUs. You will learn some of these concepts (likely branch prediction and prefetching) in depth by implementing them using the Intel Pin dynamic binary instrumentation tool.

Lectures

MoWe/01:25PM-02:45PM WEB L105

Piazza

Please sign up as a student at this link: https://piazza.com/utah/fall2023/csece6810
Please post any question about the course at Piazza first. You are actively encouraged to answer questions too. The TAs and I will be monitoring Piazza.
Any high-level clarification questions on the assignments are permitted, but please do not post answers!

Material

No required textbooks. Everything that is covered in class could be tested.
Optional textbook: HP5 (available as ebook at the library), Computer Architecture A Quantitative Approach - 5th or 6th Edition
Optional: Primer (free ebook), A Primer on Memory Consistency and Cache Coherence, 2nd edition.

Teaching Team:

Instructor: Vijay Nagarajan, email: vijay@cs.utah.edu, Office hours: Friday: 3 pm - 4 pm, WEB 2897 (Happy to discuss anything about the course, or anything related to the area. Questions about the practical assignments should be directed to the TAs.)
TA: Aditya Gattu, email: u1418754@gcloud.utah.edu, Office hours: Tuesday: 3 pm - 5 pm, CADE Lab (Questions about the practicals and questions about the course welcome.)
TA: Sharad Bhat, email: u1418984@utah.edu, Office hours: Wednesday: 3 pm - 5 pm, CADE Lab (Questions about the practicals and questions about the course welcome.)
Grader: An Qi Zhang

Assessment:

Two practical assignments each worth 20 points, for a total of 40 points.
Two in-class quizzes, each worth 10 points. The best of the two goes towards the final grade. So total of 10 points.
One final in-class exam worth 50 points.
Grading: 100–94: A, 93.9–90: A-, 89.9–87: B+, 86.9–84: B, 83.9 –80: B-, 79.9 –77: C+, 76.9–74: C, 73.9–70: C-, 69.9–67: D+, 66.9–64: D, 63.9–60: D-, 59.9–0: E

Prerequisites:

You are expected to know introductory computer architecture concepts such as those covered in CS 3810 including instruction set architecture, assembly programming, combinational logic, and sequential logic.
There will be significant C++ programming in this course. You are expected to be well-versed in C++, or be prepared to pick up C++ programming. Here is a C++ tutorial.

Policies:

We have zero tolerance for cheating. If your score in the assignments are significantly higher than the scores in the exam, only your score in the exam will count towards your grade.
For the two practical assignments, you are given a grace period of 24 hours with a penalty of 10 percent of the score in that assignment. Assignments that are submitted more than 24 hours late will get a zero unless there is a serious reason (e.g., medical reason with doctor’s evidence).
Please read the SoC policy on Academic Misconduct. Discussing high-level ideas behind the practical assignments is permitted and encouraged, but the code you turn in must be your own. You may not copy code from others or the internet, and you may not allow another student to copy your code. Use of tools such as AutoPilot and ChatGPT is not permitted. Any violation of the above is considered cheating and may result in a failing grade. TAs will be on the lookout for code that look similar using an automated tool that is not going to be fooled by changing variable names.

How to do well in this class?

Attend the lectures. Study the reading material, if any, before the class. (Don’t worry if you don’t fully understand it. ) If there are any problems posted, please attempt to solve them before the lecture.
Take advantage of office hours and get your questions clarified.
Please start the practical assignments early. Do not wait till the deadline.
The exam will test your understanding and problem solving ability and will not test bookwork. So, please ensure you understand the material deeply.
Think critically about the subject, read up on papers related to the topic, and most importantly, have fun!

Date	Topic	Before class	Event
M, Aug 21	Introduction	Read: HP5: 1.1 – 1.6
W, 23	Measuring Performance	Read: HP5: 1.8 – end
M, 28	Measuring Performance/ Instruction set architecture	HP5: Appendix A
W, 30	Instruction set architecture	Problem-set-1, Read RISC-V manual Chapters 2,6, and 7. How does RISC-V compare to MIPS?
W, Sep 6	Pipelining	Read C.1, C.2
M, 11	Pipelining
W, 13	Handling Hazards	Read: HP5: C.3, C.5, 3.3
M, 18	Handling Hazards	Problem-set-2	1st practical: Out
W, 20	Dynamic Scheduling (Scoreboarding)	Read: HP5: C.7
M, 25	Dynamic Scheduling (Tomasulo’s Algorithm)	Read: HP5: 3.4, 3.5
W, 27	Tomasulo’s
M, Oct 2	Tomasulo’s		1st practical: Due
W, 4	Quiz-1/Superscalars	Read: HP5: 3.7 – 3.10
M, 16	Superscalars
W, 18	Caches	Read: HP5: B.1
M, 23	Cache performance
W, 25	Cache performance		2nd Practical Out
M, 30	Virtual Memory	B.4, 2.6
W, Nov 1	Multiprocessors	Primer: 1.1, 1.2, 2, 3
M, 6	Snooping Coherence	Primer: 7.1, 7.2
W, 8	Directory Coherence	Primer: 8.1, 8.2	2nd Practical: Due
M, 13	Directory Coherence
W, 15	Memory Consistency	Primer: 3.1, 3.2, 3.3,
M, 20	Memory Consistency	Primer: 4.1, 5.1	Problem-set-3
W, 22	Quiz-2
M, 27	Synchronization	Primer: 3.9, 4.4.1
W, 29	Synchronization
M, Dec 4
W, 6
M, 11
W, 13	Final exam: 1 pm - 3pm		Final exam

Slides

All Slides Together

Programming Assignments

PA 1 (PDF)

Implementation Details

Implementation of PHT

Line 107 to 140 is the implementation of the class PHT. The class has an array pointer named table that contains an array of unsigned short representing each pattern history. This class also has a getPrediction method that returns the prediction at the given index. Also it has two convenient function inc and dec to do saturated increment and decrement.

Implementation of LHR

Line 71 to 105 has the implementation of the class LHR. The class has an array pointer named regs that contains an array of array of bool representing local history registers. This class has a shift and get method that shifts the register at a given index and returns the value at the given index correspondingly.

Besides these, line 142 to 148 is a helper function that takes an ADDRINT and returns the nBits LSB of it.

Implementation of Each Branch Predictor

1. Local Branch Predictor

LocalBranchPredictor class is implemented from line 150 to 172. It has a PHT and a LHR as its member variable. It has a getPrediction method that returns the prediction at the given address. It also has a update method that updates the PHT and LHR at the given address with the given outcome.

2. Global Branch Predictor

GshareBranchPredictor class is implemented from line 174 to 208. It has a PHT but no LHR. Instead it maintains a single register named ghr. Like Local Branch Predictor, it also has a getPrediction method that returns the prediction at the given address. It also has a update method that updates the PHT and LHR at the given address with the given outcome.

3. Tournament Branch Predictor

TournamentBranchPredictor class is implemented from line 210 to 244. It has it’s meta PHT, and instance of LocalBranchPredictor and GshareBranchPredictor. It also has a getPrediction method that first gets the prediction from metaPHT and then chooses the predictor, and then gets prediction from it’s members. For the train method, it stores the prediction of both local and global predictor first and then trains them. Finally based on whether it’s prediction for predictor is correct or not, it trains the metaPHT accordingly.

Question Answers

Q. Why and how varying the size of the PHT impacts (or not) the prediction accuracy for each of the predictors?

The larger the size of PHT, the larger the size of the indexing of the PHT has to be. Hence the larger the size of LHR or GHR will be. So LHR or GHR will be able to remember more history. Hence the prediction accuracy will be higher.

Q. What are the advantages and disadvantages of the Local predictor?

Advantages: This is simplest of all the predictors. It works well for programs that does not have nested loops.

Disadvantages: It does not work well for programs that have nested loops. For it’s simplicity, it does not have a good prediction accuracy for general programs and cannot capture control hazards that depend on other branches.

Q. What are the advantages and disadvantages of the Gshare predictor?

Advantages: It works well for programs that have nested loops. It has a better prediction accuracy than local predictor for general programs. It only requires a single register to store the global history instead of multiple registers in local predictor.

Disadvantages: It works a little worse than tournament predictor for general programs. Same register will be used too frequently for all the branch instructions in the program, leading to latency in some cases.

Q. What benefits did you expect from the addition of the Tournament predictor? Did the results match your expectations?

I expected the tournament predictor to have a better prediction accuracy than both local and gshare predictor and results matched my expectations.

Also I expected tournament predictor to be the slowest of all the predictors and it was the slowest of all the predictors.

Finally, I predicted that having more number of PHT entries will increase the prediction accuracy even more compared to local and gshare predictor. As I saw in the benchmark results, local branch predictor kind of saturates after having more than 1024 PHT entries (noticable in GOBMK benchmark). Gshare branch predictor also saturates similarly (noticable in Matrix Multiplication benchmark). But tournament predictor does not saturate even after having 4096 PHT entries (noticable in all the benchmarks). So my this expectation also matched with the result.

Q. Comment on the impact of the different benchmark programs on the branch predictor accuracies. Is there a difference between the benchmarks? If so (or if not), why do you think that is the case?

GOBMK and Sjeng benchmark programs behaved very similarly. Among these two, GOBMK was the hardest one for branch prediction. As GOBMK has a lot of nested loops, local branch predictor did a very bad job compared to other predictors. For both gshare and tournament predictor, I found that they need an even more number of entries in the PHT for higher accuracy (at the cost of hardware for bigger PHTs).

Finally the Matrix-multiplication was the simplest program among these three. For this program, I think ~99.6% is the optimal performance any predictor can do, so all three predictors saturated at the accuracy with very few (1024) number of entries.

Benchmark Results

Here are the three benchmark results for each of the predictors.

I find it a little difficult for the y axis limits being from 0 to 100 (especially for the Matrix Multiplication benchmark). So I have also included the same graphs with better y axis limits. Also I make the x axis in log scale.

Appendix

Code for plotting

The python program used to generate the plots right from the result file.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50


import numpy as np
import seaborn as sns
import matplotlib.pyplot as plt

cache_sizes = [128, 1024, 4096]
bps = [
 "Local Predictor",
 "Gshare Predictor",
 "Tournament Predictor",
]

prob_line_start = {
 'Sjeng': 0,
 'GOBMK': 10,
 'Matrix-Multiplication': 20,
}

with open('results') as f:
 all_lines = f.readlines()
 for prob_line_name, prob_line in prob_line_start.items():
 lines = all_lines[prob_line:prob_line+9]
 vals = list(map(lambda x: round(float(x.strip().split()[4])*100, 2), lines))
 for i, bp in enumerate(bps):
 y_vals = vals[i*3:(i+1)*3]
 print(y_vals)
 sns.lineplot(x=cache_sizes, y=y_vals, label=bp, marker='o')

 plt.grid(True, which='both', linestyle='--', linewidth=0.5)
 plt.xlabel("PHT Entries")
 # plt.xscale("log", base=2)
 locs, _ = plt.xticks()
 labels = [str(int(loc)) for loc in locs]
 plt.xticks(ticks=locs, labels=labels)
 plt.ylim(0, 100)
 # if prob_line_name == 'Sjeng' or prob_line_name == 'GOBMK':
 # # plt.ylim(60, 100)
 # else:
 # plt.ylim(99, 100)

 locs, labels = plt.yticks()
 labels = [label.get_text() + '%' for label in labels]
 plt.yticks(ticks=locs, labels=labels)
 plt.ylabel("Prediction Accuracy")
 plt.title("Benchmark: " + prob_line_name)
 plt.legend(loc="lower right")
 plt.xlim(0, 4500)

 # plt.savefig(prob_line_name + "-corr.png")
 plt.savefig(prob_line_name + ".png")
 plt.close()

My Makefile

I also used this Makefile to run the benchmarks in a single command. Note: I ran it on my local machine instead of CADE and pin was in PATH on my machine. (Also ran it on Cade afterwards to make sure it compiles)

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42


PIN=pin
BP=obj-intel64/branch_predictor_example.so
BP_PATH=BPExample
TARGET_PLATFORM=intel64

# BENCHMARK=car_asn1_files/benchmarks/458.sjeng/run_base_ref_amd64-m64-gcc41-nn.0000/sjeng_base.amd64-m64-gcc41-nn
# BENCHMARK_REF=car_asn1_files/benchmarks/458.sjeng/run_base_ref_amd64-m64-gcc41-nn.0000/ref.txt
# BENCHMARK=car_asn1_files/benchmarks/matrix_multiplication.exe
# BENCHMARK_REF=
BENCHMARK=car_asn1_files/benchmarks/445.gobmk/run_base_ref_amd64-m64-gcc41-nn.0000/gobmk_base.amd64-m64-gcc41-nn
BENCHMARK_REF=--quiet < car_asn1_files/benchmarks/445.gobmk/run_base_ref_amd64-m64-gcc41-nn.0000/13x13.tst -o 13x13.out

BP: $(BP_PATH)/branch_predictor_example.cpp
 mkdir -p $(BP_PATH)/obj-intel64
 make -C $(BP_PATH) $(BP) TARGET=$(TARGET_PLATFORM)

always.out: BP
 $(PIN) -t $(BP_PATH)/$(BP) -BP_type always_taken -num_BP_entries 128 -o stats_always-128.out -- $(BENCHMARK) $(BENCHMARK_REF) > always-128.out
 $(PIN) -t $(BP_PATH)/$(BP) -BP_type always_taken -num_BP_entries 1024 -o stats_always-1024.out -- $(BENCHMARK) $(BENCHMARK_REF) > always-1024.out
 $(PIN) -t $(BP_PATH)/$(BP) -BP_type always_taken -num_BP_entries 4096 -o stats_always-4096.out -- $(BENCHMARK) $(BENCHMARK_REF) > always-4096.out

local.out: BP
 $(PIN) -t $(BP_PATH)/$(BP) -BP_type local -num_BP_entries 128 -o stats_local-128.out -- $(BENCHMARK) $(BENCHMARK_REF) > local-128.out
 $(PIN) -t $(BP_PATH)/$(BP) -BP_type local -num_BP_entries 1024 -o stats_local-1024.out -- $(BENCHMARK) $(BENCHMARK_REF) > local-1024.out
 $(PIN) -t $(BP_PATH)/$(BP) -BP_type local -num_BP_entries 4096 -o stats_local-4096.out -- $(BENCHMARK) $(BENCHMARK_REF) > local-4096.out

gshare.out: BP
 $(PIN) -t $(BP_PATH)/$(BP) -BP_type gshare -num_BP_entries 128 -o stats_gshare-128.out -- $(BENCHMARK) $(BENCHMARK_REF) > gshare-128.out
 $(PIN) -t $(BP_PATH)/$(BP) -BP_type gshare -num_BP_entries 1024 -o stats_gshare-1024.out -- $(BENCHMARK) $(BENCHMARK_REF) > gshare-1024.out
 $(PIN) -t $(BP_PATH)/$(BP) -BP_type gshare -num_BP_entries 4096 -o stats_gshare-4096.out -- $(BENCHMARK) $(BENCHMARK_REF) > gshare-4096.out

tournament.out: BP
 $(PIN) -t $(BP_PATH)/$(BP) -BP_type tournament -num_BP_entries 128 -o stats_tournament-128.out -- $(BENCHMARK) $(BENCHMARK_REF) > tournament-128.out
 $(PIN) -t $(BP_PATH)/$(BP) -BP_type tournament -num_BP_entries 1024 -o stats_tournament-1024.out -- $(BENCHMARK) $(BENCHMARK_REF) > tournament-1024.out
 $(PIN) -t $(BP_PATH)/$(BP) -BP_type tournament -num_BP_entries 4096 -o stats_tournament-4096.out -- $(BENCHMARK) $(BENCHMARK_REF) > tournament-4096.out

all: always.out local.out gshare.out tournament.out

clean:
 make -C $(BP_PATH) clean
 rm -f *.out
 rm -f *.log

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437


#include <cstdint>
#include <iostream>
#include <fstream>
#include <cstdlib>
#include<cmath>
#include "pin.H"
using std::cerr;
using std::endl;
using std::ios;
using std::ofstream;
using std::string;

// Simulation will stop when this number of instructions have been executed
//
#define STOP_INSTR_NUM 1000000000 // 1b instrs

// Simulator heartbeat rate
//
#define SIMULATOR_HEARTBEAT_INSTR_NUM 100000000 // 100m instrs

/* Base branch predictor class */
// You are highly recommended to follow this design when implementing your branch predictors
//
class BranchPredictorInterface {
public:
 //This function returns a prediction for a branch instruction with address branchPC
 virtual bool getPrediction(ADDRINT branchPC) = 0;

 //This function updates branch predictor's history with outcome of branch instruction with address branchPC
 virtual void train(ADDRINT branchPC, bool branchWasTaken) = 0;
};

// This is a class which implements always taken branch predictor
class AlwaysTakenBranchPredictor : public BranchPredictorInterface {
public:
 AlwaysTakenBranchPredictor(UINT64 numberOfEntries) {}; //no entries here: always taken branch predictor is the simplest predictor
 virtual bool getPrediction(ADDRINT branchPC) {
 return true; // predict taken
 }
 virtual void train(ADDRINT branchPC, bool branchWasTaken) {} //nothing to do here: always taken branch predictor does not have history
};

//------------------------------------------------------------------------------
//##############################################################################
/*
 * Insert your changes below here...
 *
 * Put your branch predictor implementation here
 *
 * For example:
 * class LocalBranchPredictor : public BranchPredictorInterface {
 *
 * ***put private members for Local branch predictor here
 *
 * public:
 * virtual bool getPrediction(ADDRINT branchPC) {
 * ***put your implementation here
 * }
 * virtual void train(ADDRINT branchPC, bool branchWasTaken) {
 * ***put your implementation here
 * }
 * }
 *
 * You also need to create an object of branch predictor class in main()
 * (i.e. at line 193 in the original unmodified version of this file).
 */
//##############################################################################
//------------------------------------------------------------------------------


// This class is the implementation of a local history register.
class LHR {
 // there are 128 registers of size nBits
 bool *regs[128];
 unsigned long nBits; // size of each register
public:
 LHR(UINT64 numberOfEntries) {
 // If numberOfEntries is zero, then the number of entries in the branch predictor is not valid
 if(numberOfEntries <= 0) {
 std::cerr << "Error: number of entries in branch predictor must be positive." << std::endl;
 std::exit(EXIT_FAILURE);
 }
 // nBits is the number of bits in each register
 nBits = std::log10(numberOfEntries) / std::log10(2);
 // initialize the registers with 0
 // default value of bool is false
 for (auto i = u_long(0); i < 128; i++)
 regs[i] = new bool[nBits];
 }

 // shift the register at index to the left and add newBit to the right
 void shift(int index, int newBit) {
 for (auto i = u_long(0); i < nBits - 1; i++)
 regs[index][i] = regs[index][i + 1];
 regs[index][nBits - 1] = newBit;
 }

 // get the value of the register at index
 u_long get(int index) {
 auto result = u_long(0);
 for (auto i = u_long(0); i < nBits; i++)
 result |= regs[index][i] << i;
 return result;
 }
};

// This class is the implementation of a pattern history table.
// Instead of having only 2-bit registers, you can use this class to have n-bit registers.
class PHT {
 unsigned short *table;
 unsigned long nBits;

public:
 PHT(UINT64 numberOfEntries, int nBits): nBits(nBits) {
 if(numberOfEntries <= 0) {
 std::cerr << "Error: number of entries in branch predictor must be positive." << std::endl;
 std::exit(EXIT_FAILURE);
 }

 // initialize the table with all 1s
 table = new unsigned short[numberOfEntries];
 for (auto i = u_long(0); i < numberOfEntries; i++)
 table[i] = std::pow(2, nBits) - 1;
 }

 // get the prediction for the branch instruction at index
 bool getPrediction(unsigned long idx) {
 return table[idx] >= std::pow(2, nBits - 1);
 }

 // increment or decrement the register at index
 void inc(unsigned long index) {
 if (table[index] < std::pow(2, nBits) - 1)
 table[index]++;
 }
 void dec(unsigned long index) {
 if (table[index] > 0)
 table[index]--;
 }
};

// get the first n bits of branchPC
unsigned long getFirstNBits(ADDRINT branchPC, unsigned long nBits) {
 unsigned long mask = 0;
 for (auto i = u_long(0); i < nBits; i++)
 mask += std::pow(2, i);
 return branchPC & mask;
}

class LocalBranchPredictor : public BranchPredictorInterface {
 LHR lhr;
 PHT pht;

public:
 LocalBranchPredictor(UINT64 numberOfEntries): lhr(numberOfEntries), pht(numberOfEntries, 2) {}
 // we get the first 7 bits of PC, and use it as the index of the LHR, and then use the value of the LHR as the index of the PHT
 bool getPrediction(ADDRINT branchPC) {
 return pht.getPrediction(
 lhr.get(
 getFirstNBits(branchPC, 7)
 )
 );
 }
 void train(ADDRINT branchPC, bool branchWasTaken) {
 auto index = getFirstNBits(branchPC, 7);
 auto phtIndex = lhr.get(index);
 // strengthen or weaken the pht
 branchWasTaken ? pht.inc(phtIndex) : pht.dec(phtIndex);
 // update the lhr for next prediction
 lhr.shift(index, branchWasTaken);
 }
};

class GshareBranchPredictor : public BranchPredictorInterface {
 // gshare only has one global history register of nBits bits
 bool *ghr;
 unsigned long nBits;
 PHT pht;

 // get the first nBits bits of branchPC XORed with the value of ghr
 unsigned long getPHTIndex(ADDRINT branchPC) {
 auto ghrInt = u_long(0);
 for (auto i = u_long(0); i < nBits; i++)
 ghrInt += ghr[i] * std::pow(2, i);
 return getFirstNBits(branchPC, nBits) ^ ghrInt;
 }
public:
 GshareBranchPredictor(UINT64 numberOfEntries): pht(numberOfEntries, 2) {
 nBits = std::log10(numberOfEntries) / std::log10(2);
 ghr = new bool[nBits];
 };
 // Just using the private method to the PHT index from branchPC and then get the prediction
 bool getPrediction(ADDRINT branchPC) {
 return pht.getPrediction(
 getPHTIndex(branchPC)
 );
 }
 void train(ADDRINT branchPC, bool branchWasTaken) {
 auto index = getPHTIndex(branchPC);
 // strengthen or weaken the pht
 branchWasTaken ? pht.inc(index) : pht.dec(index);
 // shift ghr
 for (auto i = u_long(0); i < nBits - 1; i++)
 ghr[i] = ghr[i + 1];
 // add new bit to ghr right
 ghr[nBits - 1] = branchWasTaken;
 }
};

class TournamentBranchPredictor : public BranchPredictorInterface {
 PHT metaPHT;
 LocalBranchPredictor localBP;
 GshareBranchPredictor gshareBP;
 unsigned long nBits;
public:
 TournamentBranchPredictor(UINT64 numberOfEntries): metaPHT(numberOfEntries, 2), localBP(numberOfEntries), gshareBP(numberOfEntries) {
 nBits = std::log10(numberOfEntries) / std::log10(2);
 };
 // Here first we get the prediction from the metaPHT, and then use the prediction to get the prediction from either localBP or gshareBP
 bool getPrediction(ADDRINT branchPC) {
 return metaPHT.getPrediction(
 getFirstNBits(branchPC, nBits)
 ) ? gshareBP.getPrediction(branchPC) : localBP.getPrediction(branchPC);
 }
 void train(ADDRINT branchPC, bool branchWasTaken) {
 auto index = getFirstNBits(branchPC, nBits);
 auto metaPred = metaPHT.getPrediction(index);
 auto localPred = localBP.getPrediction(branchPC);
 auto gsharePred = gshareBP.getPrediction(branchPC);
 // strengthen or weaken both local and gshare
 localBP.train(branchPC, branchWasTaken);
 gshareBP.train(branchPC, branchWasTaken);
 // if metaPred is correct
 if(!metaPred && localPred == branchWasTaken)
 metaPHT.dec(index);
 else if (metaPred && gsharePred == branchWasTaken)
 metaPHT.inc(index);
 // otherwise
 if (!metaPred && gsharePred == branchWasTaken)
 metaPHT.inc(index);
 else if (metaPred && localPred == branchWasTaken)
 metaPHT.dec(index);
 }
};

ofstream OutFile;
BranchPredictorInterface *branchPredictor;

// Define the command line arguments that Pin should accept for this tool
//
KNOB<string> KnobOutputFile(KNOB_MODE_WRITEONCE, "pintool",
 "o", "BP_stats.out", "specify output file name");
KNOB<UINT64> KnobNumberOfEntriesInBranchPredictor(KNOB_MODE_WRITEONCE, "pintool",
 "num_BP_entries", "1024", "specify number of entries in a branch predictor");
KNOB<string> KnobBranchPredictorType(KNOB_MODE_WRITEONCE, "pintool",
 "BP_type", "always_taken", "specify type of branch predictor to be used");

// The running counts of branches, predictions and instructions are kept here
//
static UINT64 iCount = 0;
static UINT64 correctPredictionCount = 0;
static UINT64 conditionalBranchesCount = 0;
static UINT64 takenBranchesCount = 0;
static UINT64 notTakenBranchesCount = 0;
static UINT64 predictedTakenBranchesCount = 0;
static UINT64 predictedNotTakenBranchesCount = 0;

VOID docount() {
 // Update instruction counter
 iCount++;
 // Print this message every SIMULATOR_HEARTBEAT_INSTR_NUM executed
 if (iCount % SIMULATOR_HEARTBEAT_INSTR_NUM == 0) {
 std::cerr << "Executed " << iCount << " instructions." << endl;
 }
 // Release control of application if STOP_INSTR_NUM instructions have been executed
 if (iCount == STOP_INSTR_NUM) {
 PIN_Detach();
 }
}



VOID TerminateSimulationHandler(VOID *v) {
 OutFile.setf(ios::showbase);
 // At the end of a simulation, print counters to a file
 OutFile << "Prediction accuracy:\t" << (double)correctPredictionCount / (double)conditionalBranchesCount << endl
 << "Number of conditional branches:\t" << conditionalBranchesCount << endl
 << "Number of correct predictions:\t" << correctPredictionCount << endl
 << "Number of taken branches:\t" << takenBranchesCount << endl
 << "Number of non-taken branches:\t" << notTakenBranchesCount << endl
 ;
 OutFile.close();

 std::cerr << endl << "PIN has been detached at iCount = " << STOP_INSTR_NUM << endl;
 std::cerr << endl << "Simulation has reached its target point. Terminate simulation." << endl;
 std::cerr << "Prediction accuracy:\t" << (double)correctPredictionCount / (double)conditionalBranchesCount << endl;
 std::exit(EXIT_SUCCESS);
}

//
VOID Fini(int code, VOID * v)
{
 TerminateSimulationHandler(v);
}

// This function is called before every conditional branch is executed
//
static VOID AtConditionalBranch(ADDRINT branchPC, BOOL branchWasTaken) {
 /*
 * This is the place where the predictor is queried for a prediction and trained
 */

 // Step 1: make a prediction for the current branch PC
 //
 bool wasPredictedTaken = branchPredictor->getPrediction(branchPC);

 // Step 2: train the predictor by passing it the actual branch outcome
 //
 branchPredictor->train(branchPC, branchWasTaken);

 // Count the number of conditional branches executed
 conditionalBranchesCount++;

 // Count the number of conditional branches predicted taken and not-taken
 if (wasPredictedTaken) {
 predictedTakenBranchesCount++;
 } else {
 predictedNotTakenBranchesCount++;
 }

 // Count the number of conditional branches actually taken and not-taken
 if (branchWasTaken) {
 takenBranchesCount++;
 } else {
 notTakenBranchesCount++;
 }

 // Count the number of correct predictions
 if (wasPredictedTaken == branchWasTaken)
 correctPredictionCount++;
}

// Pin calls this function every time a new instruction is encountered
// Its purpose is to instrument the benchmark binary so that when
// instructions are executed there is a callback to count the number of
// executed instructions, and a callback for every conditional branch
// instruction that calls our branch prediction simulator (with the PC
// value and the branch outcome).
//
VOID Instruction(INS ins, VOID *v) {
 // Insert a call before every instruction that simply counts instructions executed
 INS_InsertCall(ins, IPOINT_BEFORE, (AFUNPTR)docount, IARG_END);

 // Insert a call before every conditional branch
 if ( INS_IsBranch(ins) && INS_HasFallThrough(ins) ) {
 INS_InsertCall(ins, IPOINT_BEFORE, (AFUNPTR)AtConditionalBranch, IARG_INST_PTR, IARG_BRANCH_TAKEN, IARG_END);
 }
}

// Print Help Message
INT32 Usage() {
 cerr << "This tool simulates different types of branch predictors" << endl;
 cerr << endl << KNOB_BASE::StringKnobSummary() << endl;
 return -1;
}

int main(int argc, char * argv[]) {
 // Initialize pin
 if (PIN_Init(argc, argv)) return Usage();

 // Create a branch predictor object of requested type
 if (KnobBranchPredictorType.Value() == "always_taken") {
 std::cerr << "Using always taken BP" << std::endl;
 branchPredictor = new AlwaysTakenBranchPredictor(KnobNumberOfEntriesInBranchPredictor.Value());
 }
//------------------------------------------------------------------------------
//##############################################################################
/*
 * Insert your changes below here...
 *
 * In the following cascading if-statements instantiate branch predictor objects
 * using the classes that you have implemented for each of the three types of
 * predictor.
 *
 * The choice of predictor, and the number of entries in its prediction table
 * can be obtained from the command line arguments of this Pin tool using:
 *
 * KnobNumberOfEntriesInBranchPredictor.Value()
 * returns the integer value specified by tool option "-num_BP_entries".
 *
 * KnobBranchPredictorType.Value()
 * returns the value specified by tool option "-BP_type".
 * The argument of tool option "-BP_type" must be one of the strings:
 * "always_taken", "local", "gshare", "tournament"
 *
 * Please DO NOT CHANGE these strings - they will be used for testing your code
 */
//##############################################################################
//------------------------------------------------------------------------------
 else if (KnobBranchPredictorType.Value() == "local") {
 std::cerr << "Using Local BP." << std::endl;
/* Uncomment when you have implemented a Local branch predictor */
 branchPredictor = new LocalBranchPredictor(KnobNumberOfEntriesInBranchPredictor.Value());
 }
 else if (KnobBranchPredictorType.Value() == "gshare") {
 std::cerr << "Using Gshare BP."<< std::endl;
/* Uncomment when you have implemented a Gshare branch predictor */
 branchPredictor = new GshareBranchPredictor(KnobNumberOfEntriesInBranchPredictor.Value());
 }
 else if (KnobBranchPredictorType.Value() == "tournament") {
 std::cerr << "Using Tournament BP." << std::endl;
/* Uncomment when you have implemented a Tournament branch predictor */
 branchPredictor = new TournamentBranchPredictor(KnobNumberOfEntriesInBranchPredictor.Value());
 }
 else {
 std::cerr << "Error: No such type of branch predictor. Simulation will be terminated." << std::endl;
 std::exit(EXIT_FAILURE);
 }

 std::cerr << "The simulation will run " << STOP_INSTR_NUM << " instructions." << std::endl;

 OutFile.open(KnobOutputFile.Value().c_str());

 // Pin calls Instruction() when encountering each new instruction executed
 INS_AddInstrumentFunction(Instruction, 0);

 // Function to be called if the program finishes before it completes 10b instructions
 PIN_AddFiniFunction(Fini, 0);

 // Callback functions to invoke before Pin releases control of the application
 PIN_AddDetachFunction(TerminateSimulationHandler, 0);

 // Start the benchmark program. This call never returns...
 PIN_StartProgram();

 return 0;
}

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29


Sjeng local 128 : 0.788741
Sjeng local 1024 : 0.812107
Sjeng local 4096 : 0.823909
Sjeng gshare 128 : 0.703676
Sjeng gshare 1024 : 0.787845
Sjeng gshare 4096 : 0.863479
Sjeng Tournament 128 : 0.785817
Sjeng Tournament 1024 : 0.83761
Sjeng Tournament 4096 : 0.878563

Gobmk local 128 : 0.740518
Gobmk local 1024 : 0.751152
Gobmk local 4096 : 0.757742
Gobmk gshare 128 : 0.692081
Gobmk gshare 1024 : 0.758448
Gobmk gshare 4096 : 0.802452
Gobmk Tournament 128 : 0.742259
Gobmk Tournament 1024 : 0.787875
Gobmk Tournament 4096 : 0.819516

Matrix_Mul local 128 : 0.996622
Matrix_Mul local 1024 : 0.996742
Matrix_Mul local 4096 : 0.996729
Matrix_Mul gshare 128 : 0.992749
Matrix_Mul gshare 1024 : 0.996342
Matrix_Mul gshare 4096 : 0.996446
Matrix_Mul Tournament 128 : 0.99672
Matrix_Mul Tournament 1024 : 0.997134
Matrix_Mul Tournament 4096 : 0.997139

PA 2 (PDF)

Solution Code

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561



#include "pin.H"


#include <stdlib.h>
#include <random>

#include "dcache_for_prefetcher.hpp"
#include "pin_profile.H"

class PrefetcherInterface {
public:
 virtual void prefetch(ADDRINT addr, ADDRINT loadPC) = 0;
 virtual void train(ADDRINT addr, ADDRINT loadPC) = 0;
};

PrefetcherInterface *prefetcher;

ofstream outFile;
Cache *cache;
UINT64 loads;
UINT64 stores;
UINT64 hits;
UINT64 accesses, prefetches;
string prefetcherName;
int sets;
int associativity;
int blockSize;
UINT64 checkpoint = 100000000;
UINT64 endpoint = 2000000000;

/* ===================================================================== */
/* Commandline Switches */
/* ===================================================================== */

KNOB<string> KnobPrefetcherName(KNOB_MODE_WRITEONCE, "pintool",
 "pref_type","none", "prefetcher name");
KNOB<UINT32> KnobAggression(KNOB_MODE_WRITEONCE, "pintool",
 "aggr", "2", "the aggression of the prefetcher");
KNOB<string> KnobOutputFile(KNOB_MODE_WRITEONCE, "pintool",
 "o", "data", "specify output file name");
KNOB<UINT32> KnobCacheSets(KNOB_MODE_WRITEONCE, "pintool",
 "sets", "64", "cache size in kilobytes");
KNOB<UINT32> KnobLineSize(KNOB_MODE_WRITEONCE, "pintool",
 "b", "4", "cache block size in bytes");
KNOB<UINT32> KnobAssociativity(KNOB_MODE_WRITEONCE, "pintool",
 "a", "2", "cache associativity (1 for direct mapped)");

/* ===================================================================== */

// Print a message explaining all options if invalid options are given
INT32 Usage()
{
 cerr << "This tool represents a cache simulator." << endl;
 cerr << KNOB_BASE::StringKnobSummary() << endl;
 return -1;
}

// Take checkpoints with stats in the output file
void takeCheckPoint()
{
 outFile << "The checkpoint has been reached" << endl;
 outFile << "Accesses: " << accesses << " Loads: "<< loads << " Stores: " << stores << endl;
 outFile << "Hits: " << hits << endl;
 outFile << "Hit rate: " << double(hits) / double(accesses) << endl;
 outFile << "Prefetches: " << prefetches << endl;
 outFile << "Successful prefetches: " << cache->getSuccessfulPrefs() << endl;
 if (accesses == endpoint) exit(0);
}

/* ===================================================================== */

/* None Prefetcher
 This does not prefetch anything.
*/
class NonePrefetcher : public PrefetcherInterface {
public:
 void prefetch(ADDRINT addr, ADDRINT loadPC) {
 return;
 }

 void train(ADDRINT addr, ADDRINT loadPC) {
 return;
 }
};

/* ===================================================================== */

/* Next Line Prefetcher
 This is an example implementation of the next line Prefetcher.
 The stride prefetcher would also need the program counter of the load instruction.
*/
class NextNLinePrefetcher : public PrefetcherInterface {
public:
 void prefetch(ADDRINT addr, ADDRINT loadPC) {
 for (int i = 1; i <= aggression; i++) {
 UINT64 nextAddr = addr + i * blockSize;
 if (!cache->exists(nextAddr)) { // Use the member function Cache::exists(UINT64) to query whether a block exists in the cache w/o triggering any LRU changes (not after a demand access)
 cache->prefetchFillLine(nextAddr); // Use the member function Cache::prefetchFillLine(UINT64) when you fill the cache in the LRU way for prefetch accesses
 prefetches++;
 }
 }
 }

 void train(ADDRINT addr, ADDRINT loadPC) {
 return;
 }
};

//---------------------------------------------------------------------
//##############################################
/*
 * Your changes here.
 *
 * Put your prefetcher implementation here
 *
 * Example:
 *
 * class StridePrefetcher : public PrefetcherInterface {
 * private:
 * // set up private members
 *
 * public:
 * void prefetch(ADDRINT addr, ADDRINT loadPC) {
 * // Prefetcher implementation
 * }
 *
 * void train(ADDRINT addr, ADDRINT loadPC) {
 * // Training implementation
 * }
 * };
 *
 * You can modify the functions Load() and Store() where necessary to implement your functionality
 *
 * DIRECTIONS ON USING THE COMMAND LINE ARGUMENT
 * The string variable "prefetcherName" indicates the name of the prefetcher that is passed as a command line argument (-pref_type)
 * The integer variable "aggression" indicates the aggressiveness indicated by the command line argument (-aggr)
 *
 * STATS:
 * ***Note that these exist to help you debug your program and produce your graphs
 * The member function Cache::getSuccessfulPrefs() returns how many of the prefetched block into the cache were actually used. This applies in the case where no prefetch buffer is used.
 * The integer variable "prefetches" should count the number of prefetched blocks
 * The integer variable "accesses" counts the number of memory accesses performed by the program
 * The integer variable "hits" counts the number of memory accesses that actually hit in either the data cache or the prefetch buffer such that hits = cacheHits + prefHits
 *
 */
//##############################################
//---------------------------------------------------------------------


// Returns a random number between 0 and a-1
int getRandomNumber(unsigned int a) {
 std::random_device rd;
 std::mt19937 gen(rd());

 // Create a uniform integer distribution from 0 to a-1
 std::uniform_int_distribution<> dis(0, a-1);

 // Generate and return the random number
 return dis(gen);
}


// The states from the state diagram of the stride prefetcher
enum StrideRPTState {
 INITIAL = 0,
 TRANSIENT = 1,
 STEADY = 2,
 NO_PREDICTION = 3
};

// A single entry in the RPT
class StrideRPTEntry {
public:
 ADDRINT tag;
 ADDRINT prevAddr;
 int stride;
 StrideRPTState state;
 StrideRPTEntry(): tag(0), prevAddr(0), stride(0), state(StrideRPTState::INITIAL) {}
};

// The RPT of stride prefetcher
class StrideRPT {
public:
 StrideRPTEntry *entries;
 unsigned long numEntries;
 // This tracks which of the entries are initialized
 // This just adds some optimization to the code
 bool* initialized;
 StrideRPT(const int numEntries): numEntries(numEntries) {
 entries = new StrideRPTEntry[numEntries];
 initialized = new bool[numEntries];
 for(int i = 0; i < numEntries; i++) {
 initialized[i] = false;
 }
 }

 // Adds a new entry to RPT according to the random replacement policy
 void addNewEntry(const ADDRINT tag, const ADDRINT prevAddr) {
 auto non_initialized = find(initialized, initialized + numEntries, false);

 if(non_initialized == initialized + numEntries) {
 // If all entries are initialized
 int index = getRandomNumber(numEntries);
 entries[index].tag = tag;
 entries[index].stride = 0;
 entries[index].state = StrideRPTState::INITIAL;
 entries[index].prevAddr = prevAddr;
 }
 else {
 // If some entries are not initialized
 int index = non_initialized - initialized;
 entries[index].tag = tag;
 entries[index].stride = 0;
 entries[index].state = StrideRPTState::INITIAL;
 entries[index].prevAddr = prevAddr;
 initialized[index] = true;
 }
 }

 // Returns the entry corresponding to the tag
 StrideRPTEntry* getEntry(const ADDRINT tag) {
 auto entryPtr = find_if(entries, entries + numEntries, [&tag](const StrideRPTEntry &e) { return e.tag == tag; });
 if (entryPtr == entries + numEntries) {
 return nullptr;
 }
 return entryPtr;
 }
};

// Simulate the state diagram of the stride prefetcher
StrideRPTState updateRPTStateCorrect(StrideRPTState state) {
 switch (state) {
 case StrideRPTState::INITIAL:
 return StrideRPTState::STEADY;
 case StrideRPTState::TRANSIENT:
 return StrideRPTState::STEADY;
 case StrideRPTState::STEADY:
 return StrideRPTState::STEADY;
 case StrideRPTState::NO_PREDICTION:
 return StrideRPTState::TRANSIENT;
 default:
 return StrideRPTState::INITIAL;
 }
}

// Simulate the state diagram of the stride prefetcher
StrideRPTState updateRPTStateIncorrect(StrideRPTState state) {
 switch (state) {
 case StrideRPTState::INITIAL:
 return StrideRPTState::TRANSIENT;
 case StrideRPTState::TRANSIENT:
 return StrideRPTState::NO_PREDICTION;
 case StrideRPTState::STEADY:
 return StrideRPTState::INITIAL;
 case StrideRPTState::NO_PREDICTION:
 return StrideRPTState::NO_PREDICTION;
 default:
 return StrideRPTState::INITIAL;
 }
}

class StridePrefetcher : public PrefetcherInterface {
private:
 int aggressiveness;
 StrideRPT rpt;
public:
 StridePrefetcher(const int aggressiveness, unsigned long entries): aggressiveness(aggressiveness), rpt(entries) {}
 void prefetch(ADDRINT addr, ADDRINT loadPC) {
 auto rptEntry = rpt.getEntry(loadPC);
 if(rptEntry == nullptr) return;
 if(rptEntry->prevAddr + rptEntry->stride == addr) {
 // if pred is correct
 if(rptEntry->state == StrideRPTState::STEADY) {
 auto prefetched_addr = addr;
 for(int i = 1; i <= aggressiveness; i++) {
 prefetched_addr = addr + rptEntry->stride * i;
 if(!cache->exists(prefetched_addr)) {
 cache->prefetchFillLine(prefetched_addr);
 prefetches++;
 }
 }
 rptEntry->prevAddr = prefetched_addr;
 }
 else {
 rptEntry->prevAddr = addr;
 }
 rptEntry->state = updateRPTStateCorrect(rptEntry->state);
 }
 else {
 // if pred is wrong
 if(rptEntry->state != StrideRPTState::STEADY) {
 rptEntry->stride = addr - rptEntry->prevAddr;
 }
 rptEntry->state = updateRPTStateIncorrect(rptEntry->state);
 rptEntry->prevAddr = addr;
 }
 }
 void train(ADDRINT addr, ADDRINT loadPC) {
 auto rptEntry = rpt.getEntry(loadPC);
 if(rptEntry == nullptr) {
 rpt.addNewEntry(loadPC, addr);
 }
 }
};

class DistanceRPTEntry {
public:
 signed long tag;
 signed long *distance;
 unsigned int numDistances;
 DistanceRPTEntry(long tag, unsigned int numDistances): tag(tag), numDistances(numDistances) {
 distance = new long[numDistances];
 for(unsigned int i = 0; i < numDistances; i++) {
 distance[i] = 0;
 }
 }

 ~DistanceRPTEntry() {
 delete[] distance;
 }

 void addDistance(const long dist) {
 auto non_initialized = find(distance, distance + numDistances, 0);

 if(non_initialized == distance + numDistances) {
 // If all entries are initialized
 int index = getRandomNumber(numDistances);
 distance[index] = dist;
 }
 else {
 // If some entries are not initialized
 int index = non_initialized - distance;
 distance[index] = dist;
 }
 }
};

class DistanceRPT {
public:
 DistanceRPTEntry *entries;
 unsigned long numEntries;
 unsigned long numDistances;
 bool *initialized;
 // This distance RPT is generalized for any number of entries and any number of distances
 DistanceRPT(const unsigned long numEntries, const unsigned long numDistances): numEntries(numEntries), numDistances(numDistances) {
 entries = static_cast<DistanceRPTEntry*>(operator new[](numEntries * sizeof(DistanceRPTEntry)));
 initialized = new bool[numEntries];
 for(unsigned long i = 0; i < numEntries; i++) {
 initialized[i] = false;
 new(&entries[i]) DistanceRPTEntry(0, numDistances);
 }
 }

 ~DistanceRPT() {
 delete[] initialized;
 for(unsigned long i = 0; i < numEntries; i++) {
 entries[i].~DistanceRPTEntry();
 }
 operator delete[](entries);
 }

 // Adds new entry according to the random replacement policy
 DistanceRPTEntry* addNewEntry(const long dist) {
 auto non_initialized = find(initialized, initialized + numEntries, false);

 if(non_initialized == initialized + numEntries) {
 // If all entries are initialized
 int index = getRandomNumber(numEntries);
 entries[index].tag = dist;
 for(unsigned long i = 0; i < numDistances; i++) {
 entries[index].distance[i] = 0;
 }
 return entries + index;
 }
 else {
 // If some entries are not initialized
 int index = non_initialized - initialized;
 entries[index].~DistanceRPTEntry();
 new(&entries[index]) DistanceRPTEntry(dist, numDistances);
 initialized[index] = true;
 return entries + index;
 }
 }

 // Returns the entry corresponding to the tag
 DistanceRPTEntry* getEntry(const long tag) {
 auto entryPtr = find_if(entries, entries + numEntries, [&tag](const DistanceRPTEntry &e) { return e.tag == tag; });
 if (entryPtr == entries + numEntries) {
 return nullptr;
 }
 return entryPtr;
 }
};

class DistancePrefetcher : public PrefetcherInterface {
private:
 unsigned long numEntries;
 unsigned long numDistances;
 DistanceRPT rpt;
 ADDRINT prevAddr;
 long prevDist;
public:
 DistancePrefetcher(const unsigned long aggressiveness, const unsigned long numEntries): numEntries(numEntries), numDistances(aggressiveness), rpt(numEntries, aggressiveness), prevAddr(0), prevDist(0) {}

 void prefetch(ADDRINT addr, ADDRINT loadPC) {
 if(prevAddr == 0) {
 prevAddr = addr;
 return;
 }
 long dist = ((long)addr - (long)prevAddr);
 auto rptEntry = rpt.getEntry(dist);
 if(rptEntry == nullptr) {
 // If rpt is miss
 rpt.addNewEntry(dist);
 }
 else {
 // if rpt is hit
 for (unsigned long i = 0; i < numDistances; i++) {
 if (rptEntry->distance[i] != 0) {
 auto prefetched_addr = addr + rptEntry->distance[i];
 if (!cache->exists(prefetched_addr)) {
 cache->prefetchFillLine(prefetched_addr);
 prefetches++;
 }
 }
 }
 }
 }
 void train(ADDRINT addr, ADDRINT loadPC) {
 // Training implementation
 auto rptEntry = rpt.getEntry(prevDist);
 if(rptEntry == nullptr) {
 rptEntry = rpt.addNewEntry(prevDist);
 }
 signed long newDist = ((long)addr - (long)prevAddr);
 rptEntry->addDistance(newDist);
 prevDist = newDist;
 prevAddr = addr;
 }
};

/* ===================================================================== */

/* Action taken on a load. Load takes 2 arguments:
 addr: the address of the demanded block (in bytes)
 pc: the program counter of the load instruction
*/
void Load(ADDRINT addr, ADDRINT pc)
{
 accesses++;
 loads++;
 if (cache->probeTag(addr)) { // Use the function Cache::probeTag(UINT64) when you are probing the cache after a demand access
 hits++;
 }
 else {
 cache->fillLine(addr); // Use the member function Cache::fillLine(addr) when you fill in the MRU way for demand accesses
 prefetcher->prefetch(addr, pc);
 prefetcher->train(addr, pc);
 }
 if (accesses % checkpoint == 0) takeCheckPoint();
}

/* ===================================================================== */

//Action taken on a store
void Store(ADDRINT addr, ADDRINT pc)
{
 accesses++;
 stores++;
 if (cache->probeTag(addr)) hits++;
 else cache->fillLine(addr);
 if (accesses % checkpoint == 0) takeCheckPoint();
}

/* ===================================================================== */

// Receives all instructions and takes action if the instruction is a load or a store
// DO NOT MODIFY THIS FUNCTION
void Instruction(INS ins, void * v)
{
 if (INS_IsMemoryRead(ins) && INS_IsStandardMemop(ins)) {
 INS_InsertPredicatedCall(
 ins, IPOINT_BEFORE, (AFUNPTR) Load,
 (IARG_MEMORYREAD_EA), IARG_INST_PTR, IARG_END);
 }
 if ( INS_IsMemoryWrite(ins) && INS_IsStandardMemop(ins))
 {
 INS_InsertPredicatedCall(
 ins, IPOINT_BEFORE, (AFUNPTR) Store,
 (IARG_MEMORYWRITE_EA), IARG_INST_PTR, IARG_END);
 }
}

/* ===================================================================== */

// Gets called when the program finishes execution
void Fini(int code, VOID * v)
{
 outFile << "The program has completed execution" << endl;
 takeCheckPoint();
 cout << double(hits) / double(accesses) << endl;
 outFile.close();
}

/* ===================================================================== */
/* Main */
/* ===================================================================== */

int main(int argc, char *argv[])
{
 PIN_InitSymbols();
 if( PIN_Init(argc,argv) )
 {
 return Usage();
 }

 // Initialize stats
 hits = 0;
 accesses = 0;
 prefetches = 0;
 loads = 0;
 stores = 0;
 aggression = KnobAggression.Value();
 sets = KnobCacheSets.Value();
 associativity = KnobAssociativity.Value();
 blockSize = KnobLineSize.Value();
 prefetcherName = KnobPrefetcherName;

 if (prefetcherName == "none") {
 prefetcher = new NonePrefetcher();
 } else if (prefetcherName == "next_n_lines") {
 prefetcher = new NextNLinePrefetcher();
 } else if (prefetcherName == "stride") {
 // Uncomment when you implement the stride prefetcher
 prefetcher = new StridePrefetcher(aggression, 64);
 } else if (prefetcherName == "distance") {
 // Uncomment when you implement the distance prefetcher
 prefetcher = new DistancePrefetcher(aggression, 64);
 } else {
 std::cerr << "Error: No such type of prefetcher. Simulation will be terminated." << std::endl;
 std::exit(EXIT_FAILURE);
 }

 // create a data cache
 cache = new Cache(sets, associativity, blockSize);

 outFile.open(KnobOutputFile.Value());
 INS_AddInstrumentFunction(Instruction, 0);
 PIN_AddFiniFunction(Fini, 0);

 // Never returns

 PIN_StartProgram();

 return 0;
}

/* ===================================================================== */
/* eof */
/* ===================================================================== */

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24


Benchmark1 Stride 1: 0.756934
Benchmark1 Stride 3: 0.768855
Benchmark1 Stride 10: 0.623999
Benchmark1 Distance 1: 0.767119
Benchmark1 Distance 3: 0.815763
Benchmark1 Distance 10: 0.836971

Benchmark2 Stride 1: 0.693055
Benchmark2 Stride 3: 0.725872
Benchmark2 Stride 10: 0.724311
Benchmark2 Distance 1: 0.76798
Benchmark2 Distance 3: 0.801601
Benchmark2 Distance 10: 0.79966

Benchmark3 Stride 1: 0.763073
Benchmark3 Stride 3: 0.761434
Benchmark3 Stride 10: 0.634916
Benchmark3 Distance 1: 0.770956
Benchmark3 Distance 3: 0.81665
Benchmark3 Distance 10: 0.837684

Note:
- The columns are benchmark name, prefetcher name, aggression value.
- Do not edit this file, except to add your numbers.

Question Answers

Q. What are the advantages and disadvantages of the Next-N-Line prefetcher?

Advantages: Next-N-Line prefetcher are simple to implement as they only require a single counter to keep track of the number of lines to prefetch. They are also very effective in sequential prefetching as they prefetch the next N lines in the cache line.

Disadvantages: Next-N-Line prefetchers are very ineffective for non-sequential access patterns. For example, if you are accessing only a single member variable of an array of objects, the Next-N-Line prefetcher will prefetch the entire cache line for the array, which is a waste of memory bandwidth. Also for this same reason, for higher aggressiveness it will prefetch many cache lines that will never be used, polluting the cache by evicting useful cache lines. I found the lowest accuracy for Next-N-Line prefetcher.

Q. What are the advantages and disadvantages of the Stride prefetcher?

Advantages: Stride prefetching is effective when there is a constant stride between the memory accesses. For example, the above case where accessing a single variable from array of objects will be very effective with stride prefetcher. It also pollutes lesser than Next-N-Line prefetcher as it only prefetches that it is certain will be used by checking the stride is correct or not and maintaining steady state.

Disadvantages: I find stride prefetcher to be most complex to implement. Also, for non-sequential access patterns (e.g. 1, 5, 2, 6, 3, 7 …), it is not effective as it will not be able to detect any fixed stride and will not prefetch anything.

Q. What are the advantages and disadvantages of the Distance prefetcher?

Advantages: Distance prefetch is good for both Temporal and Spatial locality. It is very effective for non-sequential access patterns as it prefetches the next line that is accessed after a certain number of cycles. It is also very effective for sequential access patterns just like Stride prefetcher. I found the highest accuracy for Distance prefetcher.

Disadvantages: Distance prefetcher uses the biggest RPT table among these 3 prefetchers. This is because it stores several distances for each entry in the RPT table. This makes it more complex to implement and also requires more memory. Also, I found distance prefetcher to be the slowest among these 3 prefetchers.

Q. Why and how, varying aggressiveness impacts (or not) the hit ratio?

I ran all the benchmarks with 1-20 aggression values and tried to find the sweet spot.

Next-N-Line: Simple array accesses will get benefit from higher aggressiveness. But for non-sequential access patterns, higher aggressiveness will pollute the cache a lot. This will decrease the hit ratio. Best aggression value is 1.

Stride: Higher aggressiveness was bad for all microbenchmarks I ran. I think this is because the stride prefetcher is not able to detect the stride correctly for higher aggressiveness. This results in a lot of cache pollution and hence lower hit ratio. Best aggression value is 2-3.

Distance: Higher aggressiveness was good for all microbenchmarks I ran. This is because distance prefetcher is taking advantage of both next-n-line prefetcher and stride prefetcher. Most of the time, it is only using on distance value for each load instruction, except very few instructions where is is using 2 distances for each RPT entry. This results in lesser cache pollution and hence higher hit ratio. Best aggression value is 7-15.

Q. Which prefetcher would you choose and why?

I would choose Distance prefetcher because it is the most effective prefetcher among these 3 prefetchers for all microbenchmarks. Even for microbenchmark2, where random access of array is happening, distance prefetcher maintained a good hit ratio. I also find it very easy to implement compared to stride prefetcher. Also the number of prefetches was lower than other prefetchers, polluting less.

Deep Learning

rahatzamancse@gmail.com (Rahat Zaman) — Mon, 21 Aug 2023 00:00:00 +0000

CS 6353: Deep Learning

Fall 2023: Tue/Thu, 3:40-5:00pm; GC 2900

Instructor: Anna Fariha
Office Location: WEB 2851
Office hours: Tue/Thu, after class.
TA hours:
- Join the TA queue Links to an external site. and wait for your turn.
- Zoom hours may overlap with the in-person office hours and in-person students will be given priority. You may have to wait a bit in the overlapping Zoom hours.
- Additional TA hours: available during the weeks when assignments are due.

Exam, Quiz, and Homework Dates

Event	Note	Due/Event Date (all due dates are 11:59 PM Mountain Time)	Weight
Homework 1	Image Classification, kNN, SVM, Softmax, Neural Network	September 22 (Friday)	10%
Quiz 1	In-class, Based on Homework 1, Duration: 30 mins	September 26 (Tuesday)	10%
Homework 2	Part 1: Fully-Connected Nets, Batch Normalization Part 2: Dropout, Convolutional Nets	October 20 (Friday)	10%
Quiz 2	In-class, Based on Homework 2, Duration: 30 mins	October 24 (Tuesday)	10%
Mid Term	In-class, Duration: 70 minutes.	October 31 (Tuesday)	20%
Homework 3	Image Captioning, Fooling Images, Image Generation	November 17 (Friday)	10%
Quiz 3	In-class, Based on Homework 3, Duration: 30 mins	November 21 (Tuesday)	10%
Final	In-class, Duration: 70 minutes (can be used to replace mid)	December 11 (Monday) 3:30 – 5:30 pm	20%
Project (Optional)	Project Guideline You can choose to either do a project or take the final exam. You can do both and the best of these two will be counted towards your final grade.	December 11 (Monday)	20%

Lectures

Here is the table converted to markdown:

Event	Date	Topic	Additional Materials
Lecture 1	Aug 22	Course Organization and Structure, Introduction and Background	Jupyter Notebook Tutorial, Python and numpy tutorial, Google Colab Tutorial, Accessing compute resources in CADE lab
Lecture 2	Aug 24	Image classification and the data-driven approach, k-nearest neighbor, Linear classification
Lecture 3	Aug 29	Loss Functions
Lecture 4	Aug 31	Optimization	Interactive Web Demo
Lecture 5	Sep 5	Backpropagation	Vector, Matrix, and Tensor Derivatives (Erik Learned-Miller, UMass Amherst), Derivatives, Backpropagation, and Vectorization (Justin Johnson)
Lecture 6	Sep 7	Neural Networks, Activation Functions	Calculus on Computational Graphs: Backpropagation, How the backpropagation algorithm works, Learning: Neural Nets, Back Propagation, Efficient Backpropagation
Lecture 7	Sep 12	Training Neural Networks, Weight initialization, batch normalization	deeplearning.net tutorial with Theano, ConvNetJS demos, Michael Nielsen’s tutorials, Additional Slides for BatchNorm
Lecture 8	Sep 14	Training Neural Network II: Network Architecture and Learning	Dropout: A Simple Way to Prevent Neural Networks from Overfitting, Dropout Training as Adaptive Regularization, DropConnect, ElasticNet
Lecture 9	Sep 19	Training Neural Network III: Review of Backpropagation for SoftMax, Hyperparameter Tuning	Large Scale Distributed Deep Networks, RmsProp, SGD tips and tricks, Efficient BackProp, Practical Recommendations for Gradient-Based Training of Deep Architectures
Lecture 10	Sep 21	Training Neural Network IV: Learning and Evaluation, Parameter Updates, Hyperparameter Optimization	A Visual Explanation of Gradient Descent Methods (Momentum, AdaGrad, RMSProp, Adam), Momentum and Learning Rate Decay, Gradient Descent Visualization
	Sep 26	Quiz 1, Course Feedback, Minimal Neural Network Case Study: 2D toy data example	Minimal Neural Network Case Study: 2D toy data example
Lecture 11	Sep 28	Convolutional Neural Networks I	Demo, CIFAR-10 Demo
Lecture 12	Oct 3	Convolutional Neural Networks II	ImageNet Large Scale Visual Recognition Challenge
Lecture 13	Oct 5	Convolutional Neural Networks III, Data Augmentation	LeNet-5, AlexNet, ZFNet, VGGNet, GoogleNet, ResNet, AlphaGo
Lecture 14	Oct 17	Recurrent Neural Networks (RNN)	RNN Book Chapter, More reading, RNN Illustration
Lecture 15	Oct 19	Long Short Term Memory (LSTM), Generative Adversarial Networks (GAN)	Tutorial on LSTM, Understanding LSTM, Style-GAN, Alias-free GAN
	Oct 24	Quiz 2, Project discussion (report writing)	Taking a project to a paper
	Oct 26	Midterm Review
	Oct 31	Mid Term	Sample Mid, Solution
	Nov 2	Guest Lecture (Shraddha Barke, UCSD), How Large Language Models Revolutionized Program Synthesis	DocPrompting, MuseNet, AlphaGo, Github Copilot, OpenAI GPT-4, Stable Diffusion, Dall-E-2, Chain-of-Thought Reasoning in LLMs

Course Description

Course Type: In Person
Description: This course will focus on modern, practical methods for deep learning, with an emphasis on computer vision. Students will learn to implement, train and debug their own neural networks and be introduced to the ideas underlying state-of-the-art research in computer vision and natural language processing. We will cover learning algorithms, optimization, neural network architectures, and techniques for training and fine-tuning networks for tasks such as object recognition, image captioning, natural language processing, data management, etc.

The course will begin with a description of simple classifiers such as perceptrons and logistic regression classifiers, and move on to standard neural networks, convolutional neural networks, and some elements of recurrent neural networks, such as long short-term memory networks (LSTMs). The emphasis will be on understanding the basics and on practical application more than on theory. Most applications will be in computer vision, but we will make an effort to cover some natural language processing (NLP) applications as well. The current plan is to use Python and associated packages such as Numpy. Prerequisites include Linear Algebra, Probability and Statistics, and Multivariate Calculus. Assignments will be in Python and potentially some in C++. This is a required course for the Deep Learning in AI & Robotics certificate program.

Prerequisites

Python (e.g. numpy and Jupyter notebooks, tutorial)
Calculus and linear algebra (e.g. MATH 2210 & 2270, review)
Basic probability and statistics (e.g. MATH 1040, review)
Familiarity with machine learning would be really helpful (e.g. CS 5350, Stanford’s CS 229)

Course Materials

All course materials will be available on Canvas. All materials for this course are copyrighted. Do not distribute or share course resources without instructor permission.

Slides used in lectures will be made available on Canvas.

There is no required textbook, however the following are some of the many online references you may find useful:

Deep Learning by Ian Goodfellow, Yoshua Bengio and Aaron Courville
Neural Networks and Deep Learning by Michael Nielsen

Course Outcomes

By the end of the course, you will:

understand the key concepts of deep learning, such as neural networks, loss functions, backpropagation, stochastic optimization, regularization, data augmentation, etc.
be familiar with important neural networks in computer vision and natural language processing.
be able to use deep learning in research and other applications.

Teaching and Learning Methods

The course lectures will be held in-person during regularly-scheduled class periods. We will cover both theoretical and practical aspects of deep learning, so the ability to both do math (calculus, linear algebra) and program (python, pytorch) are critical. Lectures will mostly use slides, though there will be an occasional experiential opportunity. Homeworks will be done outside of class and focus on gaining both theoretical understanding and practical experience.

As with all learning, the more time and thought you put into this course, the more you will get out of it. Deep learning is an enormous and rapidly growing subject and research area. We can only cover a small part of it in a course like this. However, if you put in the time, by the end of the course you should be familiar enough with deep learning to use it in research and industrial applications.

Lectures (PDF)

Homeworks

Programming Languages

rahatzamancse@gmail.com (Rahat Zaman) — Mon, 21 Aug 2023 00:00:00 +0000

CS 3520/6520: Programming Languages

Ideas behind the design and implementation of programming languages. Syntactic description; scope and lifetime of variables; runtime stack organization; parsing and abstract syntax; semantic issues; type systems; programming paradigms; interpreters and compilers.

Goal and Objectives

This course cover concepts of programming languages generally and functional languages in particular, including functions, continuations, syntactic sugar, and type systems. These concepts are explained primarily though a sequence of interpreters and type checkers.

At the end of this course, students will be able to:

employ a recipe for functional programming: data, examples, template (including natural recursions), implementation, and tests
use and implement lexical scope, closures, records, objects, and classes
encode language constructs using constructs that are more primitive, especially lambda-calculus terms
represent continuations and state explicitly, instead of relying on host-language implementations
use and implement different evaluation orders: eager and lazy
explain type soundness and implement sound type checkers for functional and object-oriented languages that include subtyping and parametric polymorphism

Materials for this course:

Programming Languages: Application and Interpretation, Second EditionLinks to an external site., Shriram Krishnamurthi (PDFLinks to an external site.)
DrRacket: https://download.racket-lang.org

Syllabus

CTIHB 109 MW 11:50-1:10 (livestreamed and recorded via Zoom)

Instructors

Co-Instructors:
Ben Greenman <blg@cs.utah.edu> MEB 3252
Matthew Flatt <mflatt@cs.utah.edu> MEB 3256
<help-cs3520@lists.utah.edu>

Teaching Assistant:
Alec Mills <help-cs3520@lists.utah.edu>

Required Materials

Materials for this course:

Programming Languages: Application and Interpretation, Second Edition, Shriram Krishnamurthi (PDF)
DrRacket: https://download.racket-lang.org

Communication

Preferred Contact Methods

The easiest way to contact your instructor directly is to use the Inbox, located in the far left Canvas menu.
You can also contact your instructor in the following ways:

Asking for Help

When asking a question in a place where it makes sense to show your code (i.e., in a direct message to the instructor or a TA):

Do include the full source of your program as an attachment.
Do point the instructor/TA to a particular part of the program (e.g., by line number) where you have a question or where you think there’s a problem.
Don’t send just a fragment of your code. The instructor/TA probably needs more context. Also, If you don’t understand why a fragment of code has problems, then maybe you’re looking at the wrong fragment.
Don’t include just a screen shot of the program text. Sometimes, the instructor/TA needs to try running your program to see what happens, and screenshots don’t compile. A screen shot is useful sometimes, but in that case, include both program text and a screen image.
Don’t copy and paste the text into your mail message, because mail transport mangles text. Provide a program as an attachment.

Evaluation

Your performance in this course will be evaluated by:

Homework assignments (55%)
Two midterm exams (15% each)
Final programming assignment (10%)
Video-lecture quizzes (5%)

Course Policies

Submitting Assignments

All assignments must be submitted via the “Handin” button in DrRacket. Install the uu-cs3520 package and restart DrRacket to get the “Handin” button. See DrRacket and the Handin Button for more information. You can check your handin status and get feedback from the Handin status server.
Each set of lecture videos has an associated quiz on Canvas. Quizzes are due before the corresponding class meeting.

Late Assignments

Late quizzes are not accepted. Homework submissions will be accepted up to 48 hours after the deadline. For each student, up to two late homework submissons (each up to 48 hours late) will be accepted without penalty. After a student’s first two late submissions, a late submission within 24 hours of the deadline will be penalized 25%. A submission more than 24 hours late but less than 48 hours late will be penalized 50%.

Large Language Models

The use of large language models (LLMs) such as ChatGPT is permitted on homework assignments. An LLM’s contribution to your homework submission must be acknowledged in a comment. Students should take care to use LLMs in a way that fosters their own learning — perhaps, for example, relying on ChatGPT as a way of understanding existing code rather than having it change code or write new code for you. The course staff will not provide technical or financial support to help students use LLMs. Do not rely on LLMs to answer course-related questions (grading, due dates, etc.); ask the course staff instead. The use of LLMs, program interpreters, or remote resources is not permitted during in-class midterm exams.

Some general disclaimers: LLMs may output text that is grossly incorrect, subtly incorrect, or otherwise misleading. LLM companies may track the queries you submit. LLMs may have, in the aggregate, a large cost to the environment that companies do not (or, cannot) fully account for.

Grading

Grading for this course

Each quiz associated with a set of lecture videos is worth a number of points corresponding to the number of questions on the quiz, where each correct answer is worth 1 point. The intent is that you take the quiz after/during watching the videos. At the end of the semester, any cumulative quiz grade of 60% or more is rounded up to 100%. Consequently, you should not be unduly concerned about missed quiz questions, even though there are no retakes, as long as you are following the videos and answering most questions correctly.

Homework is graded on the following scale: check+ = 100% for perfect or nearly perfect work, check = 80% for somewhat flawed but acceptable work, check- = 50% for seriously flawed work, 0 = 0% for missing or completely unacceptable work, and check++ = 110% for perfect work plus extra credit (when specifically offered). All homework assignments are weighted equally.

Exams are graded on a scale of 0 to 100 points.

A final assignment will be similar to a homework assignment, but larger, and the handin process will include a 1-page report. The final assignment serves much the same role as a final exam.

Accommodations

Disclaimer

Accommodations will be considered on an individual basis and may require documentation.

Please contact your instructor and/or teaching assistant as soon as possible (preferably shortly before the semester begins) to request accommodations of any kind.

Extreme personal circumstances

Please contact your instructor as soon as possible if an extreme personal circumstance
(hospitalization, death of a close relative, natural disaster, etc.) is interfering with your ability to
complete your work.

Religious Practice

To request an accommodation for religious practices, contact your instructor at the beginning of the semester.

Active Duty Military

If you are student on active duty with the military and experience issues that prevent you from participating in the course because of deployment or service responsibilities, contact your instructor as soon as possible to discuss appropriate accommodations.

Disability Access

All written information in this course can be made available in an alternative format with prior notification to the Center for Disability Services (CDS). CDS will work with you and the instructor to make arrangements for accommodations. Prior notice is appreciated. To read the full accommodations policy for the University of Utah, please see Section Q of the Instruction & Evaluation regulations.

If you will need accommodations in this class, contact:

Center for Disability Services
801-581-5020
disability.utah.edu
162 Union Building
200 S. Central Campus Dr.
Salt Lake City, UT 84112

Changes to the Syllabus

This syllabus is not a contract. It is meant to serve as an outline and guide for your course. Please note that your instructor may modify it to accommodate the needs of your class.
You will be notified of any changes to the Syllabus.

Lectures

Homework Assignments

My website does not have Shplait language syntax highlighting, so the following code snippets are not syntax highlighted. As shplait is a descendant of Rhombus that is built on Racket, I am using Racket syntax highlighting as backup.

HW0

Difficulty: ★☆☆☆

Part 0 — Create Handin Account

After installing the uu-cs3520 package as described in DrRacket and the Handin Button, select the Manage CS 3520 Handin… menu item from DrRacket’s File menu. Change to the New User panel, and pick a username and password. (Use your real name and real Utah student ID, so that we can connect your homework submissions with you.)

You will have to install uu-cs3520 for DrRacket on each different filesystem that you use to get a Handin button. However, after creating a handin account once from any machine, you can use DrRacket’s Handin button on any other machine.

Use #lang shplait at the start of your program, so that it’s implemented in the Plait language.

Part 1 — Implement `to_the_3rd`

Define the function to_the_3rd, which takes a number and raises it to the 3rd power.

Your program should include check forms to check to_the_3rd on a few inputs.

Example use: to_the_3rd(17) should produce 4913.

Part 2 — Implement `to_the_42nd`

Define the function to_the_42nd (in the same program), which takes a number and raises it to the 42nd power.

It’s probably a good idea to use functions like to_the_3rd to build up to to_the_42nd.

Your program should include check forms to check to_the_42nd on a few inputs.

Example use: to_the_42nd(17) should produce 4773695331839566234818968439734627784374274207965089.

Part 3 — Implement `plural`

Define plural, which takes a string and returns a string. If the given string ends in “y”, the result should be the same as the input but with the “y” replaced by “ies”. Otherwise, the result should be the same as the given string with “s” added to the end.

Your program should include check forms to check plural on a few inputs.

Example uses: plural("baby") should produce "babies", while plural("fish") should produce "fishs".

See the documentation for Shplait to find functions that you need to work with strings.

Part 4 — Implement `electricity-usage`

Use the following type definition (add it to your program):

 type Light
| bulb(watts :: Int,
technology :: Symbol)
| candle(inches :: Int)

Implement the function electricity_usage, which takes a Light and produces the number of watthours of electricity that the light uses in 24 hours. Your function will need to use match.

As always, include relevant check forms.

Example uses: electricity_usage(bulb(100, #'halogen)) should produce 2400, while electricity_usage(candle(10)) should produce 0.

Part 5 — Implement `use-for-one-hour`

Implement the function use_for_one_hour, which takes a Light and produces another Light that represents the given light source after it is used for another hour. Assume that a candle burns one inch per hour (unless it is already gone), and assume that a light bulb is the same after one hour of use.

Example uses: use_for_one_hour(bulb(100, #'halogen)) should produce bulb(100, #'halogen), while use_for_one_hour(candle(10)) should produce candle(9).

Part 6 — Handin

Click the Handin button in DrRacket to submit your homework. The Handin button submits whatever is in DrRacket’s definitions area, so click Handin after you have defined to_the_3rd, to_the_42nd, plural, electricity_usage, and use_for_one_hour, all in the same program.

The handin process will check that you have defined the right names. It will also run some tests on your programs. If tests fail, then your handin will not be accepted—but you can override that by clicking Submit even if server reports problems. That checkbox won’t override very basic problems, however, such as not using #lang shplait or submitting a program that doesn’t compile.

You can double-check that handin was successful by visiting the Handin status server. Log in with the account that you created for handin. You can check whether a submission has been uploaded, you can check the time of the upload, and you can download your submission. Solutions and grades for your assignments will appear later in that same place.

Solution

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112


#lang shplait

// Part 1
fun to_the_3rd(n :: Int):
 n * n * n

check: to_the_3rd(0)
 ~is 0
check: to_the_3rd(2)
 ~is 8
check: to_the_3rd(17)
 ~is 4913
check: to_the_3rd(-4)
 ~is -64

// Part 2
fun to_the_15th(n :: Int): // (n^3)^3 * n^3 * n^3 = n^15
 to_the_3rd(to_the_3rd(n)) * to_the_3rd(n) * to_the_3rd(n)

fun to_the_27th(n :: Int): // ((n^3)^3)^3 = n^27
 to_the_3rd(
 to_the_3rd(
 to_the_3rd(n)
 )
 )

fun to_the_42nd(n :: Int): // n^27 * n^15 = n^42
 to_the_27th(n) * to_the_15th(n)


check: to_the_15th(0)
 ~is 0
check: to_the_15th(2)
 ~is 32768
check: to_the_15th(17)
 ~is 2862423051509815793
check: to_the_15th(-3)
 ~is -14348907

check: to_the_27th(2)
 ~is 134217728
check: to_the_27th(7)
 ~is 65712362363534280139543
check: to_the_27th(-6)
 ~is -1023490369077469249536

check: to_the_42nd(0)
 ~is 0
check: to_the_42nd(1)
 ~is 1
check: to_the_42nd(17)
 ~is 4773695331839566234818968439734627784374274207965089
check: to_the_42nd(2)
 ~is 4398046511104
check: to_the_42nd(-5)
 ~is 227373675443232059478759765625


// Part 3
fun plural(str :: String):
 cond
 | string_length(str) == 0: "s" // I thought this should be empty string, but the submission test fails.
 | string_get(str, string_length(str)-1) == #{#\y}: substring(str, 0, string_length(str)-1) +& "ies"
 | ~else: str +& "s"


check: plural("baby")
 ~is "babies"
check: plural("fish")
 ~is "fishs"
check: plural("")
 ~is "s"

// Part 4
type Light
| bulb(watts :: Int,
 technology :: Symbol)
| candle(inches :: Int)


fun electricity_usage(l :: Light):
 match l:
 | bulb(w, t): w * 24
 | candle(i): 0


check: electricity_usage(bulb(100, #'halogen))
 ~is 2400
check: electricity_usage(bulb(0, #'free_energy))
 ~is 0
check: electricity_usage(bulb(-30, #'somehow_this_bulb_produces_energy))
 ~is -720
check: electricity_usage(candle(10))
 ~is 0


// Part 5

fun use_for_one_hour(l :: Light):
 match l:
 | bulb(w,t): l
 | candle(i):
 if i > 0
 | candle(i-1)
 | candle(0)

check: use_for_one_hour(bulb(100, #'halogen))
 ~is bulb(100, #'halogen)
check: use_for_one_hour(candle(10))
 ~is candle(9)
check: use_for_one_hour(candle(0))
 ~is candle(0)

HW1

Difficulty: ★★☆☆

The following Tree datatype implements a binary tree with a number in each node and leaf:

 type Tree
| leaf(val :: Int)
| node(val :: Int,
left :: Tree,
right :: Tree)

Part 1 — Sum

Implement a sum function that takes a tree and returns the sum of the numbers in the tree.

Example:
sum(node(5, leaf(6), leaf(7))) should produce 18.

Part 2 — Negate

Implement the function negate, which takes a tree and returns a tree that has the same shape, but with all the numbers negated.

Example:
negate(node(5, leaf(6), leaf(7))) should produce node(-5, leaf(-6), leaf(-7)).

Part 3 — Contains

Implement the function contains, which takes a tree and a number and returns #true if the number is in the tree, #false otherwise.

Example:
contains(node(5, leaf(6), leaf(7)), 6) should produce #true.

Part 4 — Big Leaves?

Implement the function has_big_leaves, which takes a tree and returns #true if every leaf is bigger than the sum of numbers in the path of nodes from the root that reaches the leaf.

Examples:
has_big_leaves(node(5, leaf(6), leaf(7))) should produce #true, while has_big_leaves(node(5, node(2, leaf(8), leaf(6)), leaf(7))) should produce #false (since 6 is smaller than 5 plus 2).

The has_big_leaves function should be a thin wrapper on another function, perhaps has_bigger_leaves, that accumulates a sum of node values.

A tree that is just a leaf has no nodes between the leaf and the root, which means that the path from the root corresponds to an empty sequence of numbers. Conventionally, the sum of an empty sequence of numbers is defined to be 0, because it’s convenient and consistent; that’s the intent here, too.

Part 5 — Positive Trees

Implement the function positive_trees, which takes a list of trees and returns #true if every member of the list is a positive tree, where a positive tree is one whose numbers sum to a positive value.

Hint 1: This function takes a list, not a tree, so don’t try to use the template for a tree function.
Hint 2: Use your sum function as a helper.
Hint 3: positive_trees([]) should produce #true, because there’s no tree in the empty list whose numbers sum to 0 or less.

More examples:

 check: positive_trees(cons(leaf(6), []))
~is #true
check: positive_trees(cons(leaf(-6), []))
~is #false
check: positive_trees(cons(node(1, leaf(6), leaf(-6)), []))
~is #true
check: positive_trees(cons(node(1, leaf(6), leaf(-6)),
(cons(node(0, leaf(0), leaf(1)), []))))
~is #true
check: positive_trees(cons(node(-1, leaf(6), leaf(-6)),
cons(node(0, leaf(0), leaf(1)), [])))
~is #false

Part 6 — Optional challenge: Flatten

CS 3520 and CS 6520 students are welcome to complete the exercise, but it does not count for extra credit.

Implement the function flatten, which takes a tree and returns a list that has all numbers in the tree’s nodes and leaves. The numbers should be ordered to match an inorder traversal of the tree, and a number that appears multiple times in the tree should appear the same number of times in the list.

Your function should run in time proportional to the size of the tree, which rules out making a list of the tree numbers using append on recursive calls. You may find it helpful to recur on a right subtree before a left subtree.

Hint: Does the function take a list or a tree? Which template should you use?

Submit

Submissions in this class are directly supported by the programming environment, DrRacket. Submit your work using the handin button in DrRacket.

Solution

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129


#lang shplait

type Tree
| leaf(val :: Int)
| node(val :: Int,
 left :: Tree,
 right :: Tree)

// Part 1

fun sum(t :: Tree):
 match t
 | leaf(v): v
 | node(v, l, r): v + sum(l) + sum(r)

check: sum(node(5, leaf(6), leaf(7)))
 ~is 18
check: sum(leaf(-10))
 ~is -10
check: sum(node(5, leaf(2), node(4, leaf(6), leaf(8))))
 ~is 5+2+4+6+8

// Part 2

fun negate(t :: Tree):
 match t
 | leaf(v): leaf(-v)
 | node(v, l, r): node(-v, negate(l), negate(r))

check: negate(node(5, leaf(6), leaf(7)))
 ~is node(-5, leaf(-6), leaf(-7))
check: negate(leaf(-10))
 ~is leaf(10)
check: negate(node(5, leaf(2), node(4, leaf(6), leaf(8))))
 ~is node(-5, leaf(-2), node(-4, leaf(-6), leaf(-8)))


// Part 3

fun contains(t :: Tree, n :: Int):
 match t
 | leaf(v): v == n
 | node(v, l, r): v == n || contains(l, n) || contains(r, n)


check: contains(node(5, leaf(6), leaf(7)), 6)
 ~is #true
check: contains(node(5, leaf(2), node(4, leaf(6), leaf(8))), 8)
 ~is #true
check: contains(node(5, leaf(2), node(4, leaf(6), leaf(8))), 3)
 ~is #false
check: contains(leaf(1), 2)
 ~is #false


// Part 4

fun has_bigger_leaves(t :: Tree, total :: Int):
 match t
 | leaf(v): v > total
 | node(v, l, r): has_bigger_leaves(l, total + v) && has_bigger_leaves(r, total + v)

fun has_big_leaves(t :: Tree):
 has_bigger_leaves(t, 0)


check: has_bigger_leaves(leaf(10), 9)
 ~is #true
check: has_bigger_leaves(leaf(10), 11)
 ~is #false
check: has_bigger_leaves(leaf(10), 10)
 ~is #false
check: has_bigger_leaves(node(5, node(2, leaf(8), leaf(6)), leaf(7)), 0)
 ~is #false
check: has_bigger_leaves(node(5, leaf(6), leaf(7)), 0)
 ~is #true


check: has_big_leaves(node(5, leaf(6), leaf(7)))
 ~is #true
check: has_big_leaves(node(5, node(2, leaf(8), leaf(6)), leaf(7)))
 ~is #false
check: has_big_leaves(leaf(5))
 ~is #true


// Part 5

fun positive_trees(ts :: Listof(Tree)):
 match ts
 | []: #true
 | cons(t, rest_t): sum(t) > 0 && positive_trees(rest_t)

check: positive_trees(cons(leaf(6),
 []))
 ~is #true

check: positive_trees(cons(leaf(-6),
 []))
 ~is #false

check: positive_trees(cons(node(1, leaf(6), leaf(-6)),
 []))
 ~is #true

check: positive_trees(cons(node(1, leaf(6), leaf(-6)),
 (cons(node(0, leaf(0), leaf(1)),
 []))))
 ~is #true

check: positive_trees(cons(node(-1, leaf(6), leaf(-6)),
 cons(node(0, leaf(0), leaf(1)),
 [])))
 ~is #false


// Part 6: Optional

fun flatten(t :: Tree):
 match t
 | node(v, l, r): append(append(flatten(l), cons(v, [])), flatten(r))
 | leaf(v): cons(v, [])

check: flatten(leaf(0))
 ~is [0]
check: flatten(node(5, node(2, leaf(8), leaf(6)), leaf(7)))
 ~is [8, 2, 6, 5, 7]
check: flatten(node(6, node(4, node(2, leaf(1), leaf(3)), leaf(5)), node(8, leaf(7), node(10, leaf(9), leaf(11)))))
 ~is [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11]

HW2

Difficulty: ★★★☆

Part 1 — Maximum

Start with the interpreter with functions, and add a max operator that takes two numbers and returns the larger of them. The syntax for max should be similar to a function call.

Since you must change the Exp datatype, and since different people may change it in different ways, you must update the parse function, which accepts a syntax object and produces an Exp value.

Examples:

 check: interp(parse('max(1, 2)'),
[])
~is 2
check: interp(parse('max(4+5, 2+3)'),
[])
~is 9

Part 2 — Functions that Accept Multiple Arguments

Extend the interpreter to support multiple or zero arguments to a function, and multiple or zero arguments in a function call.

For example,

fun area(w, h): w * h

defines a function that takes two arguments, while

fun five(): 5

defines a function that takes zero arguments. Similarly,

area(3, 4)

calls the function area with two arguments, while

five()

calls the function five with zero arguments.

At run-time, a new error is now possible: function application with the wrong number of arguments. Your interp function should detect the mismatch and report an error that includes the words “wrong arity”.

To support functions with multiple arguments, you’ll have to change fd and appE and all tests that use them. When you update the parse function, note that match supports ... in a pattern to indicate zero or more repetitions of the preceding pattern, and so do templates, and syntax_to_list recognizes []-shaped syntax. So '$sym($arg, ...)' matches any number of arguments, and syntax_to_list('[$arg, ...]') converts the arguments into a list of syntax objects.

Beware of putting the multi-argument application pattern too early in parse, since that pattern is likely to match other forms. In addition, you’ll need to update the parse_fundef function that takes one quoted fun form and produces a FunDef value.

Preserve the starting behavior that an argument expression is always evaluated before it is passed to a function. That is, only numbers should be substituted into a function body for a function call.

Examples:

 check: interp(parse('f(1, 2)'),
[parse_fundef('fun f(x, y): x + y')])
~is 3
check: interp(parse('f() + f()'),
[parse_fundef('fun f(): 5')])
~is 10
check: interp(parse('f(2, 3)'),
[parse_fundef('fun f(x, y): y + x + x')])
~is 7
check: interp(parse('f(1)'),
[parse_fundef('fun f(x, y): x+y')])
~raises "wrong arity"

Remember that Shplait provides map, which takes a function and a list, and applies the function to each element in the list, returning a list of results. For example, if ars is a list of syntax objects to parse, map(parse, ars) produces a list of Exps by parsing each S-expression.

But also remember that map doesn’t work for everything. Sometimes, when you have a list to process (or maybe two lists in parallel), then you need to write a new function using the template for lists.

If you get stuck here, then see HW 2 Hint (but you should try this part before you look at the hint).

Part 3 — Function Argument Checking (CS 6520)

This exercise is required only for CS 6520 students. CS 3520 students are welcome to complete the exercise, but it does not count for extra credit.

A function is ill-defined if two of its argument names are the same. To prevent this problem, update your parse_fundef function to detect this problem and report a “bad syntax” error.

For example, parse_fundef('fun f(x, x): x') must report a “bad syntax” error, while parse_fundef('fun f(x, y): x') should produce a FunDef value.

Solution

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222


#lang shplait

type Exp
| intE(n :: Int)
| idE(s :: Symbol)
| plusE(l :: Exp,
 r :: Exp)
| multE(l :: Exp,
 r :: Exp)
| appE(s :: Symbol,
 args :: Listof(Exp))
| maxE(l :: Exp,
 r :: Exp)

type FunDef
| fd(name :: Symbol,
 args :: Listof(Symbol),
 body :: Exp)

// An EXP is either
// - 'NUMBER'
// - 'SYMBOL'
// - 'EXP + EXP'
// - 'EXP * EXP'
// - 'SYMBOL(EXP)'
// - '(EXP)'

fun parse(s :: Syntax) :: Exp:
 cond
 | syntax_is_integer(s):
 intE(syntax_to_integer(s))
 | syntax_is_symbol(s):
 idE(syntax_to_symbol(s))
 | ~else:
 match s
 | '$left + $right':
 plusE(parse(left),
 parse(right))
 | '$left * $right':
 multE(parse(left),
 parse(right))
 | 'max($left, $right)':
 maxE(parse(left),
 parse(right))
 | '$sym($arg, ...)':
 appE(syntax_to_symbol(sym),
 map(parse, syntax_to_list('[$arg, ...]')))
 | '($e)':
 parse(e)
 | ~else:
 error(#'parse, "invalid input: " +& s)

fun parse_fundef(s :: Syntax) :: FunDef:
 match s
 | 'fun $name($arg, ...): $body':
 fd(syntax_to_symbol(name),
 check_unique(map(syntax_to_symbol,
 syntax_to_list('[$arg, ...]'))),
 parse(body))
 | ~else:
 error(#'parse, "invalid input: " +& s)

module test:
 check: parse('2')
 ~is intE(2)
 check: parse('2 + 1')
 ~is plusE(intE(2), intE (1))
 check: parse('3 * 4')
 ~is multE(intE(3), intE(4))
 check: parse('3 * 4 + 8')
 ~is plusE(multE(intE(3), intE(4)),
 intE(8))
 check: parse('max(1, 9)')
 ~is maxE(intE(1), intE(9))
 check: parse('double(9)')
 ~is appE(#'double, [intE(9)])
 check: parse('1 + double(9)')
 ~is plusE(intE(1),
 appE(#'double, [intE(9)]))
 check: parse('3 * (4 + 8)')
 ~is multE(intE(3),
 plusE(intE(4), intE(8)))
 check: parse('1 2')
 ~raises "invalid input"

 check: parse_fundef('fun double(x): x + x')
 ~is fd(#'double, [#'x], plusE(idE(#'x), idE(#'x)))
 check: parse_fundef('fun f: 1')
 ~raises "invalid input"

 def double_def = parse_fundef('fun double(x): x + x')
 def quadruple_def = parse_fundef('fun quadruple(x): double(double(x))')

// check_unique ----------------------------------------
fun check_unique(syms :: Listof(Symbol)):
 match syms
 | []: []
 | cons(sym, rst_syms):
 if member(sym, rst_syms)
 | error(#'parse, "bad syntax, duplicate argument: " +& sym)
 | cons(sym, check_unique(rst_syms))

module test:
 check: check_unique([])
 ~is []
 check: check_unique([#'a, #'b, #'c])
 ~is [#'a, #'b, #'c]
 check: check_unique([#'a, #'b, #'b])
 ~raises "bad syntax"
 check: check_unique([#'a, #'b, #'a])
 ~raises "bad syntax"

// interp ----------------------------------------
fun interp(a :: Exp, defs :: Listof(FunDef)) :: Int:
 match a
 | intE(n): n
 | idE(s): error(#'interp, "free variable: " +& s)
 | plusE(l, r): interp(l, defs) + interp(r, defs)
 | multE(l, r): interp(l, defs) * interp(r, defs)
 | appE(s, args):
 block:
 def a_def = get_fundef(s, defs)
 if length(fd.args(a_def)) == length(args)
 | interp(substs(map(fun (arg): intE(interp(arg, defs)),
 args),
 fd.args(a_def),
 fd.body(a_def)),
 defs)
 | error(#'interp, "wrong arity")
 | maxE(l, r): max(interp(l, defs), interp(r, defs))

module test:
 check: interp(parse('2'), [])
 ~is 2
 check: interp(parse('x'), [])
 ~raises "free variable"
 check: interp(parse('2 + 1'), [])
 ~is 3
 check: interp(parse('2 * 1'), [])
 ~is 2
 check: interp(parse('(2 * 3) + (5 + 8)'), [])
 ~is 19
 check: interp(parse('max(2 * 3, 4 * 2)'), [])
 ~is 8
 check: interp(parse('double(8)'),
 [double_def])
 ~is 16
 check: interp(parse('quadruple(8)'),
 [double_def, quadruple_def])
 ~is 32
 check: interp(parse('quadruple(8, 9)'),
 [double_def, quadruple_def])
 ~raises "wrong arity"

// get_fundef ----------------------------------------
fun get_fundef(s :: Symbol, defs :: Listof(FunDef)) :: FunDef:
 match defs
 | []: error(#'get_fundef, "undefined function: " +& s)
 | cons(a_def, rst_defs):
 if s == fd.name(a_def)
 | a_def
 | get_fundef(s, rst_defs)

module test:
 check: get_fundef(#'double, [double_def])
 ~is double_def
 check: get_fundef(#'double, [double_def, quadruple_def])
 ~is double_def
 check: get_fundef(#'double, [quadruple_def, double_def])
 ~is double_def
 check: get_fundef(#'quadruple, [quadruple_def, double_def])
 ~is quadruple_def
 check: get_fundef(#'double, [])
 ~raises "undefined function"

// subst ----------------------------------------
fun subst(what :: Exp, for :: Symbol, in :: Exp):
 match in
 | intE(n): in
 | idE(s): (if for == s | what | in)
 | plusE(l, r): plusE(subst(what, for, l),
 subst(what, for, r))
 | multE(l, r): multE(subst(what, for, l),
 subst(what, for, r))
 | appE(s, args): appE(s, map(fun (arg):
 subst(what, for, arg),
 args))
 | maxE(l, r): maxE(subst(what, for, l),
 subst(what, for, r))

module test:
 check: subst(parse('8'), #'x, parse('9'))
 ~is parse('9')
 check: subst(parse('8'), #'x, parse('x'))
 ~is parse('8')
 check: subst(parse('8'), #'x, parse('y'))
 ~is idE(#'y)
 check: subst(parse('8'), #'x, parse('x + y'))
 ~is plusE(parse('8'), idE(#'y))
 check: subst(parse('8'), #'x, parse('y * x'))
 ~is multE(idE(#'y), parse('8'))
 check: subst(parse('8'), #'x, parse('double(x)'))
 ~is parse('double(8)')
 check: subst(parse('8'), #'x, parse('max(x, y)'))
 ~is parse('max(8, y)')

// subst ----------------------------------------
fun substs(whats :: Listof(Exp), fors :: Listof(Symbol), in :: Exp):
 match whats
 | []: in
 | cons(what, rst_whats):
 subst(what,
 first(fors),
 substs(rst_whats,
 rest(fors),
 in))

module test:
 check: substs([], [], intE(0))
 ~is intE(0)
 check: substs([parse('8'), parse('9')], [#'x, #'y], parse('x + y'))
 ~is parse('8 + 9')

HW3

Difficulty: ★★☆☆

Part 1 — Booleans

Start with the interpreter with function values, and extend the implementation to support boolean literals, an equality test, and a conditional form:

 <Exp> = ....
| #true
| #false
| <Exp> == <Exp>
| if <Exp> | <Exp> | <Exp>

The == operator should only work on number values, and if should only work when the value of the first subexpression is a boolean. Report a “not a number” error if a subexpression of == produces a non-number value, and report a “not a boolean” error when the first subexpression of if does not produce a boolean. The if form should evaluate its second subexpression only when the first subexpression’s value is true, and it should evaluate its third subexpression only when the first subexpression’s value is false. The precedence of == should be lower than +, and if should have the lowest precedence like let.

Note that you not only need to extend Exp with new kinds of expressions, you will also need to add booleans to Value.

For example,

#true should produce a true value, while

if #true
| 1 + 2
| 5

should produce 3, and

if 1
| 2
| 3

should report a “not a boolean” error.

As usual, update parse to support the extended language.

More examples:

 check: interp(parse('1 + 2 == 3'),
mt_env)
~is interp(parse('#true'),
mt_env)
check: interp(parse('if 2 == 1 + 1
| 7
| 8'),
mt_env)
~is interp(parse('7'),
mt_env)
check: interp(parse('if #false
| 1 + (fun (x): x)
| 9'),
mt_env)
~is interp(parse('9'),
mt_env)
check: interp(parse('if #true
| 10
| 1 + (fun (x): x)'),
mt_env)
~is interp(parse('10'),
mt_env)
check: interp(parse('if 1 | 2 | 3'),
mt_env)
~raises "not a boolean"

Part 2 — Hiding Variables

Add an unlet form (lowest precedence) that hides the nearest visible binding (if any) of a specified variable, but lets other bindings through. For example,

let x = 1:
unlet x:
x

should raise a “free variable” exception, but

let x = 1:
let x = 2:
unlet x:
x

should produce 1. If there’s no visible binding of a variable around an unlet of the variable, the unlet does not hide anything (but it’s not an error).

As before, you must update the parse function.

Examples:

 check: interp(parse('let x = 1:
unlet x:
x'),
mt_env)
~raises "free variable"
check: interp(parse('let x = 1:
x + (unlet x:
1)'),
mt_env)
~is interp(parse('2'), mt_env)
check: interp(parse('let x = 1:
let x = 2:
x + (unlet x:
x)'),
mt_env)
~is interp(parse('3'), mt_env)
check: interp(parse('let x = 1:
let x = 2:
let z = 3:
x + (unlet x:
x + z)'),
mt_env)
~is interp(parse('6'), mt_env)
check: interp(parse('let f = (fun (z):
let z = 8:
unlet z:
z):
f(2)'),
mt_env)
~is interp(parse('2'), mt_env)

Part 3 — Thunks

A thunk is like a function of zero arguments, whose purpose is to delay a computation. Extend your interpreter with a delay form that creates a thunk, and a force form that causes a thunk’s expression to be evaluated:

 <Exp> = ....
| delay: <Exp>
| force(<Exp>)

A thunk is a new kind of value, like a number, function, or boolean. For parsing, delay has lowest precedence. The force form has a precedence like function calls, but it should be preferred by the parser over a function-call form, so it can be matched just before a function-call form in parse.

Examples:

delay: 1 + (fun (x): x)

produces a thunk value without complaining that a function is not a number, while

force(delay: 1 + (fun (x): x))

triggers a “not a number” error. As another example,

let ok = (delay: 1 + 2):
let bad = (delay: 1 + #false):
force(ok)

produces 3, while

let ok = (delay: 1 + 2):
let bad = (delay: 1 + #false):
force(bad)

triggers a “not a number” error.

More examples:

 check: interp(parse('force(1)'),
mt_env)
~raises "not a thunk"
check: interp(parse('force(if 8 == 8 | (delay: 7) | (delay: 9))'),
mt_env)
~is interp(parse('7'),
mt_env)
check: interp(parse('let d = (let y = 8:
delay: y + 7):
let y = 9:
force(d)'),
mt_env)
~is interp(parse('15'),
mt_env)

Note: In some languages, delay creates a promise. A promise is like a thunk, but when a promise is forced multiple times, the result from the first time is remembered and returned all the other times, so that the expression in a promise is evaluated at most once. We’re not concerned with that facet of delay and force, for now.

Solution

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394


#lang shplait

type Value
| intV(n :: Int)
| closV(arg :: Symbol,
 body :: Exp,
 env :: Env)
| boolV(v :: Boolean)
// We need to remember what was in the environment when thunk was defined.
// This is so that later defined variables will not override free variables inside thunk
// So each thunk will have it's own saved snapshot of environment
| thunkV(v :: Exp, env :: Env)

type Exp
| boolE(v :: Boolean)
| compE(l :: Exp,
 r :: Exp)
| intE(n :: Int)
| idE(s :: Symbol)
| plusE(l :: Exp,
 r :: Exp)
| multE(l :: Exp,
 r :: Exp)
| letE(n :: Symbol,
 rhs :: Exp,
 body :: Exp)
| unletE(n :: Symbol,
 body :: Exp)
| funE(n :: Symbol,
 body :: Exp)
| appE(fn :: Exp,
 arg :: Exp)
| ifE(condition :: Exp,
 trueE :: Exp,
 falseE :: Exp)
| delayE(body :: Exp)
| forceE(body :: Exp)

type Binding
| bind(name :: Symbol,
 val :: Value)

type Env = Listof(Binding)

def mt_env = []
def extend_env = cons
fun remove_env(name :: Symbol, env :: Env):: Env:
 match env
 | []: []
 | cons(b, b_rest): if bind.name(b) == name:
 | b_rest
 | cons(b, remove_env(name, b_rest))


// parse ----------------------------------------
fun parse(s :: Syntax) :: Exp:
 cond
 | syntax_is_integer(s):
 intE(syntax_to_integer(s))
 | s == '#true':
 boolE(#true)
 | s == '#false':
 boolE(#false)
 | syntax_is_symbol(s):
 idE(syntax_to_symbol(s))
 | ~else:
 match s
 | 'delay: $body':
 delayE(parse(body))
 | 'force($body)':
 forceE(parse(body))
 | 'let $name = $rhs:
 $body':
 letE(syntax_to_symbol(name),
 parse(rhs),
 parse(body))
 | 'unlet $name:
 $body':
 unletE(syntax_to_symbol(name),
 parse(body))
 | 'if $condition | $left | $right':
 ifE(parse(condition), parse(left), parse(right))
 | '$left == $right':
 compE(parse(left),
 parse(right))
 | '$left + $right':
 plusE(parse(left),
 parse(right))
 | '$left * $right':
 multE(parse(left),
 parse(right))
 | 'fun ($id): $body':
 funE(syntax_to_symbol(id),
 parse(body))
 | '$fn($arg)':
 appE(parse(fn),
 parse(arg))
 | '($e)':
 parse(e)
 | ~else:
 error(#'parse, "invalid input: " +& s)

module test:
 check: parse('2')
 ~is intE(2)
 check: parse('x')
 ~is idE(#'x)
 check: parse('2 + 1')
 ~is plusE(intE(2), intE (1))
 check: parse('3 * 4')
 ~is multE(intE(3), intE(4))
 check: parse('3 * 4 + 8')
 ~is plusE(multE(intE(3), intE(4)),
 intE(8))
 check: parse('fun (x): 9')
 ~is funE(#'x, intE(9))
 check: parse('double(9)')
 ~is appE(idE(#'double), intE(9))
 check: parse('1 + double(9)')
 ~is plusE(intE(1),
 appE(idE(#'double), intE(9)))
 check: parse('3 * (4 + 8)')
 ~is multE(intE(3),
 plusE(intE(4), intE(8)))
 check: parse('let x = 1 + 2:
 y')
 ~is letE(#'x,
 plusE(intE(1), intE(2)),
 idE(#'y))
 check: parse('1 2')
 ~raises "invalid input"

 check: parse('if 2 == 1 + 1
 | 7
 | 8')
 ~is ifE(compE(intE(2),plusE(intE(1),intE(1))), intE(7), intE(8))

// interp ----------------------------------------
fun interp(a :: Exp, env :: Env) :: Value:
 match a
 | intE(n): intV(n)
 | boolE(v): boolV(v)
 | compE(l, r): bool_equal(interp(l, env), interp(r, env))
 | idE(s): lookup(s, env)
 | plusE(l, r): num_plus(interp(l, env), interp(r, env))
 | multE(l, r): num_mult(interp(l, env), interp(r, env))
 | letE(n, rhs, body):
 def rhs_v = interp(rhs, env)
 interp(body,
 extend_env(bind(n, rhs_v),
 env))
 | unletE(n, body):
 interp(body,
 remove_env(n, env))
 | funE(n, body): closV(n, body, env)
 | ifE(condition, l, r):
 match interp(condition, env)
 | boolV(v): if v:
 | interp(l, env)
 | interp(r, env)
 | ~else: error(#'interp, "not a boolean")

 | appE(fn, arg):
 match interp(fn, env)
 | closV(n, body, c_env):
 interp(body,
 extend_env(bind(n, interp(arg, env)),
 c_env))
 | ~else: error(#'interp, "not a function")
 | forceE(body):
 match interp(body, env)
 | thunkV(e, thunk_env): interp(e, thunk_env)
 | ~else: error(#'interp, "not a thunk")
 | delayE(body):
 thunkV(body, env)



module test:
 check: interp(parse('2'), mt_env)
 ~is intV(2)
 check: interp(parse('x'), mt_env)
 ~raises "free variable"
 check: interp(parse('x'),
 extend_env(bind(#'x, intV(9)), mt_env))
 ~is intV(9)
 check: interp(parse('2 + 1'), mt_env)
 ~is intV(3)
 check: interp(parse('2 * 1'), mt_env)
 ~is intV(2)
 check: interp(parse('(2 * 3) + (5 + 8)'), mt_env)
 ~is intV(19)
 check: interp(parse('fun (x): x + x'),
 mt_env)
 ~is closV(#'x, plusE(idE(#'x), idE(#'x)), mt_env)
 check: interp(parse('let x = 5: x + x'),
 mt_env)
 ~is intV(10)
 check: interp(parse('let x = 5:
 let x = x + 1:
 x + x'),
 mt_env)
 ~is intV(12)
 check: interp(parse('let x = 5:
 let y = 6:
 x'),
 mt_env)
 ~is intV(5)
 check: interp(parse('(fun (x): x + x)(8)'),
 mt_env)
 ~is intV(16)
 check: interp(parse('1(2)'), mt_env)
 ~raises "not a function"
 check: interp(parse('1 + (fun (x): x)'), mt_env)
 ~raises "not a number"
 check: interp(parse('let bad = (fun (x): x + y):
 let y = 5:
 bad(2)'),
 mt_env)
 ~raises "free variable"

 #//
 time:
 interp(parse('let x2 = (fun (n): n + n):
 let x4 = (fun (n): x2(x2(n))):
 let x16 = (fun (n): x4(x4(n))):
 let x256 = (fun (n): x16(x16(n))):
 let x65536 = (fun (n): x256(x256(n))):
 x65536(1)'),
 mt_env)

// num_plus and num_mult ----------------------------------------
fun num_op(op :: (Int, Int) -> Int, l :: Value, r :: Value) :: Value:
 cond
 | l is_a intV && r is_a intV:
 intV(op(intV.n(l), intV.n(r)))
 | ~else:
 error(#'interp, "not a number")
fun num_plus(l :: Value, r :: Value) :: Value:
 num_op(fun (a, b): a+b, l, r)
fun num_mult(l :: Value, r :: Value) :: Value:
 num_op(fun (a, b): a*b, l, r)

fun bool_op(op :: (Int, Int) -> Boolean, l :: Value, r :: Value) :: Value:
 cond
 | l is_a intV && r is_a intV:
 boolV(op(intV.n(l), intV.n(r)))
 | ~else:
 error(#'interp, "not a number")
fun bool_equal(l :: Value, r :: Value) :: Value:
 bool_op(fun (a, b): a == b, l, r)

module test:
 check: num_plus(intV(1), intV(2))
 ~is intV(3)
 check: num_mult(intV(3), intV(2))
 ~is intV(6)

// lookup ----------------------------------------
fun lookup(n :: Symbol, env :: Env) :: Value:
 match env
 | []: error(#'lookup, "free variable")
 | cons(b, rst_env):
 cond
 | n == bind.name(b):
 bind.val(b)
 | ~else:
 lookup(n, rst_env)

module test:
 check: lookup(#'x, mt_env)
 ~raises "free variable"
 check: lookup(#'x, extend_env(bind(#'x, intV(8)), mt_env))
 ~is intV(8)
 check: lookup(#'x, extend_env(bind(#'x, intV(9)),
 extend_env(bind(#'x, intV(8)),
 mt_env)))
 ~is intV(9)
 check: lookup(#'y, extend_env(bind(#'x, intV(9)),
 extend_env(bind(#'y, intV(8)),
 mt_env)))
 ~is intV(8)

 check: interp(parse('x + 3'),
 extend_env(bind(#'x, intV(2)),
 mt_env))
 ~is intV(5)


// Part 1
module test:
 check: interp(parse('1 + 2 == 3'),
 mt_env)
 ~is interp(parse('#true'),
 mt_env)
 check: interp(parse('if 2 == 1 + 1
 | 7
 | 8'),
 mt_env)
 ~is interp(parse('7'),
 mt_env)
 check: interp(parse('if #false
 | 1 + (fun (x): x)
 | 9'),
 mt_env)
 ~is interp(parse('9'),
 mt_env)
 check: interp(parse('if #true
 | 10
 | 1 + (fun (x): x)'),
 mt_env)
 ~is interp(parse('10'),
 mt_env)
 check: interp(parse('if 1 | 2 | 3'),
 mt_env)
 ~raises "not a boolean"
 check: interp(parse('if #true == 5 | 6 | 7'),
 mt_env)
 ~raises "not a number"
 check: interp(parse('if (5 == 6) == 5 | 6 | 7'),
 mt_env)
 ~raises "not a number"

// Part 2
module test:
 check: interp(parse('let x = 1:
 unlet x:
 x'),
 mt_env)
 ~raises "free variable"
 check: interp(parse('let x = 1:
 x + (unlet x:
 1)'),
 mt_env)
 ~is interp(parse('2'), mt_env)
 check: interp(parse('let x = 1:
 let x = 2:
 x + (unlet x:
 x)'),
 mt_env)
 ~is interp(parse('3'), mt_env)
 check: interp(parse('let x = 1:
 let x = 2:
 let z = 3:
 x + (unlet x:
 x + z)'),
 mt_env)
 ~is interp(parse('6'), mt_env)
 check: interp(parse('let f = (fun (z):
 let z = 8:
 unlet z:
 z):
 f(2)'),
 mt_env)
 ~is interp(parse('2'), mt_env)
 check: interp(parse('unlet x:
 x'), mt_env)
 ~raises "free variable"

// Part 3
module test:
 check: interp(parse('force(1)'), mt_env)
 ~raises "not a thunk"
 check: interp(parse('force(if 8 == 8 | (delay: 7) | (delay: 9))'), mt_env)
 ~is interp(parse('7'), mt_env)
 check: interp(parse('let d = (let y = 8:
 delay: y + 7):
 let y = 9:
 force(d)'),
 mt_env)
 ~is interp(parse('15'),
 mt_env)
 // Got some of these from discord
 check: interp(parse('let add = (fun (y): delay: x+y):
 let x = 5:
 force(add(5) + 10)'), mt_env)
 ~raises "not a number"
 check: interp(parse('let d = (let y = 1:
 delay: x + y + 2):
 let x = 3:
 force(d)'), mt_env)
 ~raises "free variable"
 check: interp(parse('delay: 1 + (fun (x): x)'), mt_env)
 ~is thunkV(plusE(intE(1), funE(#'x, idE(#'x))), mt_env)
 check: interp(parse('let add = (fun (y): delay: x+y):
 let x = 5:
 force(add(5) + 10)'), mt_env)
 ~raises "not a number"
 check: interp(parse('let x = (if 0 == 1 | 1 | 2):
 3'), mt_env)
 ~is interp(parse('3'), mt_env)
 check: interp(parse('let x = (if 0 | 1 | 2):
 3'), mt_env)
 ~raises "not a boolean"

HW4

Difficulty: ★★★★

Part 1 — Improving Assignment

Start with store_reslet.rhm. In the starting program, the representation of the store grows every time that a box’s content is modified with set_box. Change the implementation of set_box so that the old value of the box is dropped (i.e., replaced with the new value) instead of merely hidden by the outside-in search order of fetch.

Example:

check: interp(parse('let b = box(1):
begin:
set_box(b, 2)
unbox(b)'),
mt_env,
mt_store)
~is res(intV(2),
override_store(cell(1, intV(2)),
mt_store))

Part 2 — Sequences

Generalize begin to allow one or more sub-expressions, instead of exactly two sub-expressions.

 <Exp> = ....
| begin:
<Exp>
<Exp>
...

Example:

check: interp(parse('let b = box(1):
begin:
set_box(b, 2 + unbox(b))
set_box(b, 3 + unbox(b))
set_box(b, 4 + unbox(b))
unbox(b)'),
mt_env,
mt_store)
~is res(intV(10),
override_store(cell(1, intV(10)),
mt_store))

A note on pattern matching: To match a begin form with one or more expressions, each on its own line, you can use this Shplait pattern:

 'begin:
$exp0
$exp
...'

After matching that pattern, exp0 stands for one line/group, and exp is a sequence of additional lines/groups. Although the exp repetition is created from separate lines, the repetition doesn’t have to be used in a template as different lines. You can use syntax_to_list('[$exp0, $exp, ...]') to put the matches together in a list syntax object and convert it to a list of syntax objects.

A tip on dealing with nonempty lists: As you know, a list has two cases: [] and cons(<item>, <list>). A nonempty_list has two different cases: it is always a cons pair and its rest may or may not be empty. A match cannot easily follow the shape of nonempty lists (it needs a case for [] and a nested match), so we recommend cond instead, which can check for the first nonempty-list case with the test is_empty(rest(nonempty_list)).

Part 3 — Records

Extend the interpreter to support the construction of records with named fields, to support field selection from a record (as in record.rhm):

 <Exp> = ....
| {<Sym> : <Exp>, ...}
| <Exp> . <Sym>

Adding records means that the language now has four kinds of values: numbers, functions, boxes, and records. At run-time, an error may occur because a record is misused as a number or function, a number or function is supplied to ., or a record supplied to . does not have the named field, and so on. Your error message for the last case should include the words “no such field”, but beyond that constraint, you can make up your own error messages.

Expressions within a {} form should be evaluated when the {} form itself is evaluated, and in the order that the expressions appear in the {} form. For example,

let b = box(0):
let r = { a: unbox(b) }:
begin:
set_box(b, 1)
r.a

should produce 0, not 1, because unbox(b) is evaluated when the {} expression is evaluated, not when the . expression is evaluated.

Note that you will not be able to use map to interp field values, since a store must be carried from one field’s evaluation to the next. Instead, interping the field value will be more like interping a sequence of expressions for begin.

You can assume (without checking) that all field names in a {} form are distinct.

For homework purposes, we don’t want to nail down the representation of a record value, because there are many choices. The examples below therefore use interp_expr, which you must define as a wrapper on interp that takes just an Exp and produces just a syntax object: a syntax number if interp produces any number, the syntax object 'function' if interp produces a closure, the syntax object 'box' if interp produces a box, or the syntax object 'record' if interp produces a record value.

Examples:

check: interp_expr(parse('1 + 4'))
~is '5'
check: interp_expr(parse('{ a: 10, b: 1 + 2 }'))
~is 'record'
check: interp_expr(parse('{ a: 10, b: 1 + 2 }.b'))
~is '1'
check: interp_expr(parse('{ a: 10 }.b'))
~raises "no such field"
check: interp_expr(parse('{ r : { z: 0 } }.r'))
~is 'record'
check: interp_expr(parse('{ r : { z: 0 } }.r.z'))
~is '0'
check: interp_expr(parse('let b = box(0):
let r = { a: unbox(b) }:
begin:
set_box(b, 1)
r.a'))
~is '0'

Part 4 — Mutating Records (extra credit for CS 3520; required for CS 6520)

This exercise is required for CS 6520 students, but it counts as extra credit for CS 3520 students.

Add an assignment form that modifies the value of a record field imperatively (as opposed to functional update):

 <Exp> = ....
| <Exp> . <Sym> := <Exp>

Evaluation of a {} expression allocates a location for each of its fields. A . expression without := accesses from the record produced by the sub-expression the value in the location of the field named by the identifier. A . with := form changes the value in the location for a field; the value of the sub-expression after := determines the field’s new value, and that value is also the result of the assignment expression.

Note: Making record fields mutable has the same effect as forcing every field of a record to be a Moe box, where the box contains the proper value of the field. Internal to the interpreter implementation, you could use Moe boxes in your implementation of mutable records, or you could use addresses more directly. You should not use Shplait boxes at all.

Examples:

check: interp_expr(parse('let r = { x: 1 }:
r.x'))
~is '1'
check: interp_expr(parse('let r = { x: 1 }:
begin:
r.x := 5
r.x'))
~is '5'
check: interp_expr(parse('let r = { x: 1 }:
let get_r = (fun (d): r):
begin:
(get_r(0)).x := 6
(get_r(0)).x'))
~is '6'
check: interp_expr(parse('let g = (fun (r): r.a:
let s = (fun (r): fun (v): r.b := v:
let r1 = { a: 0, b: 2 }:
let r2 = { a: 3, b: 4 }:
r1.b + (begin:
s(r1)(g(r2))
(begin:
s(r2)(g(r1))
r1.b) + r2.b)'))
~is '5'

Solution

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634


#lang shplait

type Location = Int

type Value
| intV(n :: Int)
| closV(arg :: Symbol,
 body :: Exp,
 env :: Env)
| boxV(l :: Location)
// took the second approach:
// Records are symbols to locations of store
| recV(ns :: Listof(Symbol),
 vs :: Listof(Location))

type Exp
| intE(n :: Int)
| idE(s :: Symbol)
| plusE(l :: Exp,
 r :: Exp)
| multE(l :: Exp,
 r :: Exp)
| letE(n :: Symbol,
 rhs :: Exp,
 body :: Exp)
| funE(n :: Symbol,
 body :: Exp)
| appE(fn :: Exp,
 arg :: Exp)
| boxE(arg :: Exp)
| unboxE(arg :: Exp)
| setboxE(bx :: Exp,
 val :: Exp)
| beginE(es :: Listof(Exp))
| recordE(s :: Listof(Symbol),
 args :: Listof(Exp))
| getE(rec :: Exp,
 n :: Symbol)
| setE(rec :: Exp,
 n :: Symbol,
 val :: Exp)

type Binding
| bind(name :: Symbol,
 val :: Value)

type Env = Listof(Binding)

def mt_env = []
def extend_env = cons

type Storage
| cell(location :: Location,
 val :: Value)

type Store = Listof(Storage)
def mt_store = []
def override_store = cons

type Result
| res(v :: Value,
 s :: Store)

// parse ----------------------------------------
fun parse(s :: Syntax) :: Exp:
 cond
 | syntax_is_integer(s):
 intE(syntax_to_integer(s))
 | syntax_is_symbol(s):
 idE(syntax_to_symbol(s))
 | ~else:
 match s
 | '{ $name: $field_exp, ...}':
 recordE(map(syntax_to_symbol, syntax_to_list('[$name, ...]')),
 map(parse, syntax_to_list('[$field_exp, ...]')))
 | 'let $name = $rhs:
 $body':
 letE(syntax_to_symbol(name),
 parse(rhs),
 parse(body))
 | '$left + $right':
 plusE(parse(left),
 parse(right))
 | '$left * $right':
 multE(parse(left),
 parse(right))
 // Putting this before record.exp as this should match first
 | '$rec . $name := $exp':
 if syntax_is_symbol(name)
 | setE(parse(rec), syntax_to_symbol(name), parse(exp))
 | error(#'parse, "key must be symbol, got " +& exp +& " . " +& name)
 | '$exp . $name':
 if syntax_is_symbol(name)
 | getE(parse(exp), syntax_to_symbol(name))
 | error(#'parse, "key must be symbol, got " +& exp +& " . " +& name)
 | 'fun ($id): $body':
 funE(syntax_to_symbol(id),
 parse(body))
 | 'box($val_arg)':
 boxE(parse(val_arg))
 | 'unbox($bx_arg)':
 unboxE(parse(bx_arg))
 | 'set_box($bx_arg, $val_arg)':
 setboxE(parse(bx_arg), parse(val_arg))
 | '$fn($arg)':
 appE(parse(fn),
 parse(arg))
 | 'begin:
 $exp0
 $exp
 ...':
 beginE(map(parse, syntax_to_list('[$exp0, $exp, ...]')))
 | '($e)':
 parse(e)
 | ~else:
 error(#'parse, "invalid input: " +& s)

module test:
 check: parse('2')
 ~is intE(2)
 check: parse('x')
 ~is idE(#'x)
 check: parse('2 + 1')
 ~is plusE(intE(2), intE (1))
 check: parse('3 * 4')
 ~is multE(intE(3), intE(4))
 check: parse('3 * 4 + 8')
 ~is plusE(multE(intE(3), intE(4)),
 intE(8))
 check: parse('fun (x): 9')
 ~is funE(#'x, intE(9))
 check: parse('double(9)')
 ~is appE(idE(#'double), intE(9))
 check: parse('1 + double(9)')
 ~is plusE(intE(1),
 appE(idE(#'double), intE(9)))
 check: parse('3 * (4 + 8)')
 ~is multE(intE(3),
 plusE(intE(4), intE(8)))
 check: parse('let x = 1 + 2:
 y')
 ~is letE(#'x,
 plusE(intE(1), intE(2)),
 idE(#'y))
 check: parse('box(0)')
 ~is boxE(intE(0))
 check: parse('unbox(b)')
 ~is unboxE(idE(#'b))
 check: parse('set_box(b, 0)')
 ~is setboxE(idE(#'b), intE(0))
 check: parse('begin:
 1
 2')
 ~is beginE([intE(1), intE(2)])
 check: parse('{ x: 2, y: 3 }')
 ~is recordE([#'x, #'y],
 [intE(2), intE(3)])
 check: parse('(1 + 2).a')
 ~is getE(plusE(intE(1), intE(2)), #'a)
 check: parse('{ x: 2, y: 3 }')
 ~is recordE([#'x, #'y],
 [intE(2), intE(3)])
 check: parse('(1 + 2).a')
 ~is getE(plusE(intE(1), intE(2)), #'a)
 check: parse('1 2')
 ~raises "invalid input"

// reslet form ----------------------------------------
macro 'reslet ($v_id, $sto_id) = $call:
 $body':
 'match $call
 | res($v_id, $sto_id):
 $body'


fun update_box(loc:: Location, val:: Value, store:: Store):: Store:
 match store
 | []: error(#'update_box, "location not found")
 | cons(store, rest_store): match store
 | cell(l, v): if l == loc
 | cons(cell(l, val), rest_store)
 | cons(store, update_box(loc, val, rest_store))

// This is a type that contains
// 1. Whats the last location that is added/updates
// 2. Current store
type LocationStore
| locstore(loc :: Location, sto :: Store)

// For a list of exps, create a new location in store for each exps and put the value in it. O(n)
// returns the list of store after each location added.
fun create_exp_store(es :: Listof(Exp), env :: Env, sto :: Store) :: Listof(LocationStore):
 match es
 | []: []
 | cons(e, e_rst):
 reslet (v_v, sto_v) = interp(e, env, sto):
 block:
 def l = new_loc(sto_v)
 def new_sto = override_store(cell(l, v_v),
 sto_v)
 cons(locstore(l, new_sto), create_exp_store(e_rst, env, new_sto))


// interprets the record (O(n))
fun interp_rec(ns :: Listof(Symbol), es :: Listof(Exp), env :: Env, sto :: Store) :: Result:
 if is_empty(ns)
 | res(recV([], []), sto)
 | block:
 def locationStores = create_exp_store(es, env, sto)
 def locs = map(fun (x): locstore.loc(x), locationStores)
 def latest_sto = locstore.sto(last_of(locationStores))
 res(recV(ns, locs), latest_sto)

// gets the last element of array (O(n))
fun last_of(items :: Listof(?a)):: ?a:
 match items
 | []: error(#'last_of, "list is empty")
 | cons(i, i_rst): if is_empty(i_rst)
 | i
 | last_of(i_rst)

// interp ----------------------------------------
fun interp(a :: Exp, env :: Env, sto :: Store) :: Result:
 match a
 | intE(n): res(intV(n), sto)
 | idE(s): res(lookup(s, env), sto)
 | plusE(l, r): reslet (v_l, sto_l) = interp(l, env, sto):
 reslet (v_r, sto_r) = interp(r, env, sto_l):
 res(num_plus(v_l, v_r), sto_r)
 | multE(l, r): reslet (v_l, sto_l) = interp(l, env, sto):
 reslet (v_r, sto_r) = interp(r, env, sto_l):
 res(num_mult(v_l, v_r), sto_r)
 | letE(n, rhs, body):
 reslet (v_rhs, sto_rhs) = interp(rhs, env, sto):
 interp(body,
 extend_env(bind(n, v_rhs),
 env),
 sto_rhs)
 | funE(n, body): res(closV(n, body, env), sto)
 | appE(fn, arg):
 reslet (v_fn, sto_fn) = interp(fn, env, sto):
 match v_fn
 | closV(n, body, c_env):
 reslet (v_arg, sto_arg) = interp(arg, env, sto_fn):
 interp(body,
 extend_env(bind(n, v_arg),
 c_env),
 sto_arg)
 | ~else: error(#'interp, "not a function")
 | boxE(a):
 reslet (v, sto_v) = interp(a, env, sto):
 block:
 def l = new_loc(sto_v)
 res(boxV(l),
 override_store(cell(l, v),
 sto_v))
 | unboxE(a):
 reslet (v, sto_v) = interp(a, env, sto):
 match v
 | boxV(l): res(fetch(l, sto_v),
 sto_v)
 | ~else: error(#'interp, "not a box")
 | setboxE(bx, val):
 reslet (b_b, sto_b) = interp(bx, env, sto):
 reslet (v_v, sto_v) = interp(val, env, sto_b):
 match b_b
 | boxV(l):
 res(v_v, update_box(l, v_v, sto_v))
 | ~else: error(#'interp, "not a box")
 | beginE(exps):
 if length(exps) == 0
 | error(#'interp, "begin expressions cannot be empty")
 | reslet (v_e, sto_e) = interp(first(exps), env, sto):
 if is_empty(rest(exps))
 | res(v_e, sto_e)
 | interp(beginE(rest(exps)), env, sto_e)
 | recordE(ns, as):
 interp_rec(ns, as, env, sto)
 | getE(a, n):
 reslet (v_v, sto_v) = interp(a, env, sto):
 match v_v
 | recV(ns, vs): res(fetch(find(n, ns, vs), sto_v),
 sto_v)
 | ~else: error(#'interp, "not a record")
 | setE(rec, name, exp):
 reslet (rec_v, sto_rec) = interp(rec, env, sto):
 reslet (v_v, sto_v) = interp(exp, env, sto_rec):
 res(v_v, mutateRecord(name,
 v_v,
 rec_v,
 sto_v))

// Update the location with new value(v) in store from the name of record.
fun mutateRecord(name :: Symbol, v :: Value, rec :: Value, sto :: Store):: Store:
 match sto
 | []: error(#'mutateRecord, "record is empty: " +& name)
 | cons(c1, c_rst): match c1
 | cell(li, vali): if li == find(name, recV.ns(rec), recV.vs(rec))
 | cons(cell(li, v), c_rst)
 | cons(cell(li, vali), mutateRecord(name, v, rec, c_rst))



// find & update ----------------------------------------

// Takes a name and two parallel lists, returning an item from the
// second list where the name matches the item from the first list.
// I updated this to get any second type of parallel list
fun find(n :: Symbol,
 ns :: Listof(Symbol),
 vs :: Listof(?a)) :: ?a:
 match ns
 | []: error(#'interp, "no such field: " +& n)
 | cons(ns_n, ns_rst): if n == ns_n
 | first(vs)
 | find(n, ns_rst, rest(vs))


module test:
 check: find(#'a, [#'a, #'b], [intV(1), intV(2)])
 ~is intV(1)
 check: find(#'b, [#'a, #'b], [intV(1), intV(2)])
 ~is intV(2)
 check: find(#'a, [], [])
 ~raises "no such field"

module test:
 check: interp(parse('2'), mt_env, mt_store)
 ~is res(intV(2), mt_store)
 check: interp(parse('x'), mt_env, mt_store)
 ~raises "free variable"
 check: interp(parse('x'),
 extend_env(bind(#'x, intV(9)), mt_env),
 mt_store)
 ~is res(intV(9), mt_store)
 check: interp(parse('2 + 1'), mt_env, mt_store)
 ~is res(intV(3), mt_store)
 check: interp(parse('2 * 1'), mt_env, mt_store)
 ~is res(intV(2), mt_store)
 check: interp(parse('(2 * 3) + (5 + 8)'), mt_env, mt_store)
 ~is res(intV(19), mt_store)
 check: interp(parse('fun (x): x + x'),
 mt_env,
 mt_store)
 ~is res(closV(#'x, plusE(idE(#'x), idE(#'x)), mt_env),
 mt_store)
 check: interp(parse('let x = 5: x + x'),
 mt_env,
 mt_store)
 ~is res(intV(10), mt_store)
 check: interp(parse('let x = 5:
 let x = x + 1:
 x + x'),
 mt_env,
 mt_store)
 ~is res(intV(12), mt_store)
 check: interp(parse('let x = 5:
 let y = 6:
 x'),
 mt_env,
 mt_store)
 ~is res(intV(5), mt_store)
 check: interp(parse('(fun (x): x + x)(8)'),
 mt_env,
 mt_store)
 ~is res(intV(16), mt_store)

 check: interp(parse('box(5)'),
 mt_env,
 mt_store)
 ~is res(boxV(1),
 override_store(cell(1, intV(5)),
 mt_store))
 check: interp(parse('unbox(box(5))'),
 mt_env,
 mt_store)
 ~is res(intV(5),
 override_store(cell(1, intV(5)),
 mt_store))
 check: interp(parse('set_box(box(5), 6)'),
 mt_env,
 mt_store)
 ~is res(intV(6),
 override_store(cell(1, intV(6)),
 mt_store))
 check: interp(parse('begin:
 1
 2'),
 mt_env,
 mt_store)
 ~is res(intV(2), mt_store)
 check: interp(parse('let b = box(5):
 begin:
 set_box(b, 6)
 unbox(b)'),
 mt_env,
 mt_store)
 ~is res(intV(6),
 override_store(cell(1, intV(6)),
 mt_store))

 check: interp(parse('1(2)'), mt_env, mt_store)
 ~raises "not a function"
 check: interp(parse('1 + (fun (x): x)'), mt_env, mt_store)
 ~raises "not a number"
 check: interp(parse('let bad = (fun (x): x + y):
 let y = 5:
 bad(2)'),
 mt_env,
 mt_store)
 ~raises "free variable"

 check: interp(parse('unbox(2)'), mt_env, mt_store)
 ~raises "not a box"
 check: interp(parse('set_box(2, 3)'), mt_env, mt_store)
 ~raises "not a box"

// num_plus and num_mult ----------------------------------------
fun num_op(op :: (Int, Int) -> Int, l :: Value, r :: Value) :: Value:
 cond
 | l is_a intV && r is_a intV:
 intV(op(intV.n(l), intV.n(r)))
 | ~else:
 error(#'interp, "not a number")
fun num_plus(l :: Value, r :: Value) :: Value:
 num_op(fun (a, b): a+b, l, r)
fun num_mult(l :: Value, r :: Value) :: Value:
 num_op(fun (a, b): a*b, l, r)

module test:
 check: num_plus(intV(1), intV(2))
 ~is intV(3)
 check: num_mult(intV(3), intV(2))
 ~is intV(6)

// lookup ----------------------------------------
fun lookup(n :: Symbol, env :: Env) :: Value:
 match env
 | []: error(#'lookup, "free variable: " +& n)
 | cons(b, rst_env):
 cond
 | n == bind.name(b):
 bind.val(b)
 | ~else:
 lookup(n, rst_env)

module test:
 check: lookup(#'x, mt_env)
 ~raises "free variable"
 check: lookup(#'x, extend_env(bind(#'x, intV(8)), mt_env))
 ~is intV(8)
 check: lookup(#'x, extend_env(bind(#'x, intV(9)),
 extend_env(bind(#'x, intV(8)),
 mt_env)))
 ~is intV(9)
 check: lookup(#'y, extend_env(bind(#'x, intV(9)),
 extend_env(bind(#'y, intV(8)),
 mt_env)))
 ~is intV(8)

// store operations ----------------------------------------

fun new_loc(sto :: Store) :: Location:
 1 + max_address(sto)

fun max_address(sto :: Store) :: Location:
 match sto
 | []: 0
 | cons(c, rst_sto): max(cell.location(c),
 max_address(rst_sto))

fun fetch(l :: Location, sto :: Store) :: Value:
 match sto
 | []: error(#'interp, "unallocated location")
 | cons(c, rst_sto): if l == cell.location(c)
 | cell.val(c)
 | fetch(l, rst_sto)

module test:
 check: new_loc(mt_store)
 ~is 1

 check: max_address(mt_store)
 ~is 0
 check: max_address(override_store(cell(2, intV(9)),
 mt_store))
 ~is 2
 check: fetch(2, override_store(cell(2, intV(9)),
 mt_store))
 ~is intV(9)
 check: fetch(2, override_store(cell(2, intV(10)),
 override_store(cell(2, intV(9)),
 mt_store)))
 ~is intV(10)
 check: fetch(3, override_store(cell(2, intV(10)),
 override_store(cell(3, intV(9)),
 mt_store)))
 ~is intV(9)
 check: fetch(2, mt_store)
 ~raises "unallocated location"

// Part 1
module test:
 check: update_box(2, intV(1),
 override_store(cell(1, intV(10)), mt_store))
 ~raises "location not found"
 check: interp(parse('let b1 = box(1):
 let b2 = box(2):
 let b3 = box(3):
 begin:
 begin:
 set_box(b3, 1)
 set_box(b2, 3)
 set_box(b1, 2)'),
 mt_env, mt_store)
 ~is res(intV(2),
 override_store(cell(3, intV(1)),
 override_store(cell(2, intV(3)),
 override_store(cell(1, intV(2)),
 mt_store))))
 check: interp(parse('let b = box(1):
 begin:
 set_box(b, 2)
 unbox(b)'),
 mt_env,
 mt_store)
 ~is res(intV(2),
 override_store(cell(1, intV(2)),
 mt_store))

// Part 2
module test:
 // This syntax 'abc:' is not even allowed in shplait.
 // So passing a PARSED expression type to interp
 check: interp(beginE([]), mt_env, mt_store)
 ~raises "begin expressions cannot be empty"
 check: parse('begin:
 1
 2
 3
 4
 5')
 ~is beginE([intE(1), intE(2), intE(3), intE(4), intE(5)])

 check: interp(parse('let b = box(1):
 begin:
 set_box(b, 2 + unbox(b))
 set_box(b, 3 + unbox(b))
 set_box(b, 4 + unbox(b))
 unbox(b)'),
 mt_env,
 mt_store)
 ~is res(intV(10),
 override_store(cell(1, intV(10)),
 mt_store))
 check: interp(parse('5 . x'), mt_env, mt_store)
 ~raises "not a record"
 check: last_of([1, 2, 3, 4])
 ~is 4
 check: last_of([])
 ~raises "list is empty"

// Part 3
fun interp_expr(e :: Exp):: Syntax:
 reslet (v, sto) = interp(e, mt_env, mt_store):
 match v
 | intV(val): integer_to_syntax(val)
 | closV(arg, body, env): 'function'
 | boxV(l): 'box'
 | recV(ns, as): 'record'

module test:
 check: interp_expr(parse('1 + 4'))
 ~is '5'
 check: interp_expr(parse('{ a: 10 }.10'))
 ~raises "key must be symbol"
 check: interp_expr(parse('{ a: 10, b: 1 + 2 }'))
 ~is 'record'
 check: interp_expr(parse('{ a: 10, b: 1 + 0 }.b'))
 ~is '1'
 check: interp_expr(parse('{ a: 10 }.b'))
 ~raises "no such field"
 check: interp_expr(parse('{ r : { z: 0 } }.r'))
 ~is 'record'
 check: interp_expr(parse('{ r : { z: 0 } }.r.z'))
 ~is '0'
 check: interp_expr(parse('let b = box(0):
 let r = { a: unbox(b) }:
 begin:
 set_box(b, 1)
 r.a'))
 ~is '0'
 check: interp_expr(parse('(fun (x): x + 2)'))
 ~is 'function'
 check: interp_expr(parse('box(1)'))
 ~is 'box'

// Part 4
module test:
 check: interp_expr(parse('let r = { x: 1 }:
 r.x'))
 ~is '1'

 check: interp_expr(parse('let r = { x: 1 }:
 begin:
 r.x := 5
 r.x'))
 ~is '5'

 check: interp_expr(parse('let r = { x: 1 }:
 let get_r = (fun (d): r):
 begin:
 (get_r(0)).x := 6
 (get_r(0)).x'))
 ~is '6'

 check: interp_expr(parse('let g = (fun (r): r.a):
 let s = (fun (r): fun (v): r.b := v):
 let r1 = { a: 0, b: 2 }:
 let r2 = { a: 3, b: 4 }:
 r1.b + (begin:
 s(r1)(g(r2))
 (begin:
 s(r2)(g(r1))
 r1.b) + r2.b)'))
 ~is '5'
 check: interp_expr(parse('{ x:10, y:20 }.z := 30'))
 ~raises "no such field"
 check: interp_expr(parse('{ x:10 }.5 := 5'))
 ~raises "key must be symbol"
 check: interp_expr(parse('{}'))
 ~is 'record'
 check: interp_expr(parse('{}.a := 5'))
 ~raises "record is empty"

HW5

Difficulty: ★★☆☆

Start with lambda_if0.rhm, which doesn’t already include recursive binding and also doesn’t include * for multiplication.

Part 1 — Syntactic Sugar for Recursive Bindings

Extend the parse function so that it supports a letrec form for recursive function bindings. The parsing precedence for letrec should be lowest.

 <Exp> = ...
| letrec <Symbol> = <Exp>:
<Exp>

You must not change the interp function at all.

The Encoding Recursion slides spell out how to extend the parser to make letrec work, especially at the end of part 4. You may find the following definition useful:

 def mk_rec_fun:
'(fun (body_proc):
let fX = (fun (fX):
let f = (fun (x):
fX(fX)(x)):
body_proc(f)):
fX(fX))'

The above definition makes sense only if you can keep track of different languages and how they interact. The mk_rec_fun definition above is a Shplait definition. The value of mk_rec_fun is a representation of the concrete syntax of a Moe expression. If you pass mk_rec_fun to parse, you get a Shplait value that is an interp retable representation of a Moe expression.

Example:

 check: interp(parse('letrec f = (fun (n):
if n == 0
| 0
| f(n + -1) + -1):
f(10)'),
mt_env)
~is intV(-10)

Note on testing: Normally, when you modify parse, you should add an example/test to illustrate and check the addition. This exercise, however, is one of the rare cases where a parse example/test doesn’t really help, because the expected value for even a simple input is unwieldy, and a test can do little more than repeat the implementation. So, you are excused from adding a parse test in this case. An interp test like the one above is more useful.

Part 2 — Implementing a Two-Argument Function in Moe

Define the Shplait constant plus as a representation of the concrete syntax of a Moe expression such that

 interp(parse('($plus)(n)(m)'), mt_env)

produces the same value as

 interp(parse('n + m'), mt_env)

for any Moe numbers n and m.

In other words, you add a Shplait definition:

 def plus = 'fun ....'

to the interpreter program, replacing the .... with something that creates the desired Moe function.

You should not change the interp or parse function for this part.

The suggested shape of plus above uses parentheses around the function. Those parentheses are not required, but they avoid errors if you try using $plus in a template and omit parentheses around the use. We will only try your plus in a context with parentheses around it, though, like in '($plus)(n)(m)'.

Part 3 — Implementing a Recursive Function in Moe

Define the Shplait constant times such that

 interp(parse('($times)(n)(m)'), mt_env)

produces the same value as

 intV(n * m)

for any non-negative integers n and m.

You should not change the interp or parse function for this part.

Solution

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273


#lang shplait

type Value
| intV(n :: Int)
| closV(arg :: Symbol,
 body :: Exp,
 env :: Env)

type Exp
| intE(n :: Int)
| idE(s :: Symbol)
| plusE(l :: Exp,
 r :: Exp)
| funE(n :: Symbol,
 body :: Exp)
| appE(fn :: Exp,
 arg :: Exp)
| if0E(tst :: Exp,
 thn :: Exp,
 els :: Exp)

type Binding
| bind(name :: Symbol,
 val :: Value)

type Env = Listof(Binding)

def mt_env = []
def extend_env = cons

// parse ----------------------------------------
fun parse(s :: Syntax) :: Exp:
 cond
 | syntax_is_integer(s):
 intE(syntax_to_integer(s))
 | syntax_is_symbol(s):
 idE(syntax_to_symbol(s))
 | ~else:
 match s
 // For being the lowest precedence, putting it in top
 | 'letrec $name = $rhs:
 $body':
 // No need to convolute the environment with variables
 // So letting mk_rec_fun here (also suggested not to edit anything except parse())
 let mk_rec_fun = '(fun (body_proc):
 let fX = (fun (fX):
 let f = (fun (x):
 fX(fX)(x)):
 body_proc(f)):
 fX(fX))':
 parse('let $(name) = $(mk_rec_fun)(fun ($(name)):
 $(rhs)):
 $(body)')
 | 'if $tst == 0
 | $thn
 | $els':
 if0E(parse(tst), parse(thn), parse(els))
 | 'let $name = $rhs:
 $body':
 appE(funE(syntax_to_symbol(name),
 parse(body)),
 parse(rhs))
 | '$left + $right':
 plusE(parse(left),
 parse(right))
 | 'fun ($id): $body':
 funE(syntax_to_symbol(id),
 parse(body))
 | '$fn($arg)':
 appE(parse(fn),
 parse(arg))
 | '($e)':
 parse(e)
 | ~else:
 error(#'parse, "invalid input: " +& s)

module test:
 check: parse('2')
 ~is intE(2)
 check: parse('x')
 ~is idE(#'x)
 check: parse('2 + 1')
 ~is plusE(intE(2), intE (1))
 check: parse('fun (x): 9')
 ~is funE(#'x, intE(9))
 check: parse('double(9)')
 ~is appE(idE(#'double), intE(9))
 check: parse('1 + double(9)')
 ~is plusE(intE(1),
 appE(idE(#'double), intE(9)))
 check: parse('3 + (4 + 8)')
 ~is plusE(intE(3),
 plusE(intE(4), intE(8)))
 check: parse('let x = 1 + 2:
 y')
 ~is appE(funE(#'x,
 idE(#'y)),
 plusE(intE(1), intE(2)))
 check: parse('if 1 == 0 | 2 | 3')
 ~is if0E(intE(1), intE(2), intE(3))

 check: parse('1 2')
 ~raises "invalid input"

// interp ----------------------------------------
fun interp(a :: Exp, env :: Env) :: Value:
 match a
 | intE(n): intV(n)
 | idE(s): lookup(s, env)
 | plusE(l, r): num_plus(interp(l, env), interp(r, env))
 | funE(n, body): closV(n, body, env)
 | appE(fn, arg):
 match interp(fn, env)
 | closV(n, body, c_env):
 interp(body,
 extend_env(bind(n, interp(arg, env)),
 c_env))
 | ~else: error(#'interp, "not a function")
 | if0E(tst, thn, els):
 interp(if num_is_zero(interp(tst, env))
 | thn
 | els,
 env)

module test:
 check: interp(parse('2'), mt_env)
 ~is intV(2)
 check: interp(parse('x'), mt_env)
 ~raises "free variable"
 check: interp(parse('x'),
 extend_env(bind(#'x, intV(9)), mt_env))
 ~is intV(9)
 check: interp(parse('2 + 1'), mt_env)
 ~is intV(3)
 check: interp(parse('(2 + 3) + (5 + 8)'), mt_env)
 ~is intV(18)
 check: interp(parse('fun (x): x + x'),
 mt_env)
 ~is closV(#'x, plusE(idE(#'x), idE(#'x)), mt_env)
 check: interp(parse('let x = 5: x + x'),
 mt_env)
 ~is intV(10)
 check: interp(parse('let x = 5:
 let x = x + 1:
 x + x'),
 mt_env)
 ~is intV(12)
 check: interp(parse('let x = 5:
 let y = 6:
 x'),
 mt_env)
 ~is intV(5)
 check: interp(parse('(fun (x): x + x)(8)'),
 mt_env)
 ~is intV(16)
 check: interp(parse('if 0 == 0 | 2 | 3'),
 mt_env)
 ~is intV(2)
 check: interp(parse('if 1 == 0 | 2 | 3'),
 mt_env)
 ~is intV(3)
 check: interp(parse('1(2)'), mt_env)
 ~raises "not a function"
 check: interp(parse('1 + (fun (x): x)'), mt_env)
 ~raises "not a number"
 check: interp(parse('let bad = (fun (x): x + y):
 let y = 5:
 bad(2)'),
 mt_env)
 ~raises "free variable"
 check: interp(parse('if (fun (x): x) == 0 | 2 | 3'),
 mt_env)
 ~raises "not a number"

// num_plus ----------------------------------------
fun num_op(op :: (Int, Int) -> Int, l :: Value, r :: Value) :: Value:
 cond
 | l is_a intV && r is_a intV:
 intV(op(intV.n(l), intV.n(r)))
 | ~else:
 error(#'interp, "not a number")
fun num_plus(l :: Value, r :: Value) :: Value:
 num_op(fun (a, b): a+b, l, r)
fun num_is_zero(v :: Value) :: Boolean:
 match v
 | intV(n): n == 0
 | ~else: error(#'interp, "not a number")

module test:
 check: num_plus(intV(1), intV(2))
 ~is intV(3)
 check: num_is_zero(intV(0))
 ~is #true
 check: num_is_zero(intV(1))
 ~is #false

// lookup ----------------------------------------
fun lookup(n :: Symbol, env :: Env) :: Value:
 match env
 | []: error(#'lookup, "free variable: " +& n)
 | cons(b, rst_env):
 cond
 | n == bind.name(b):
 bind.val(b)
 | ~else:
 lookup(n, rst_env)

module test:
 check: lookup(#'x, mt_env)
 ~raises "free variable"
 check: lookup(#'x, extend_env(bind(#'x, intV(8)), mt_env))
 ~is intV(8)
 check: lookup(#'x, extend_env(bind(#'x, intV(9)),
 extend_env(bind(#'x, intV(8)),
 mt_env)))
 ~is intV(9)
 check: lookup(#'y, extend_env(bind(#'x, intV(9)),
 extend_env(bind(#'y, intV(8)),
 mt_env)))
 ~is intV(8)

// Part 1
module test:
 check: interp(parse('letrec f = (fun (n):
 if n == 0
 | 0
 | f(n + -1) + -1):
 f(10)'),
 mt_env)
 ~is intV(-10)
 check: interp(parse('letrec sum = (fun (n):
 if n == 0
 | 0
 | n + sum(n + -1)):
 sum(10)'),
 mt_env)
 ~is intV(55)
 check: interp(parse('letrec fac = (fun (n):
 if n == 0
 | 1
 | ($times)(n)(fac(n + -1))):
 fac(5)'),
 mt_env)
 ~is intV(120)

// Part 2
def plus = '(fun (x):
 fun (y):
 x + y)'

module test:
 check: interp(parse('($plus)(5)(10)'), mt_env)
 ~is interp(parse('5 + 10'), mt_env)
 check: interp(parse('($plus(0)(0))'), mt_env)
 ~is intV(0)

// Part 3
def times = 'letrec multiply = (fun (n):
 fun (m):
 if m == 0
 | 0
 | n + multiply(n)(m + -1)):
 multiply'

module test:
 check: interp(parse('($times)(10)(20)'), mt_env)
 ~is intV(10 * 20)
 check: interp(parse('($times)(0)(20)'), mt_env)
 ~is intV(0)
 check: interp(parse('($times)(20)(0)'), mt_env)
 ~is intV(0)
 check: interp(parse('($times)(0)(0)'), mt_env)
 ~is intV(0)

HW6

Difficulty: ★★☆☆

Part 1 — Conditional and Lazy Pairs

Implement an interpreter with lazy evaluation and the following grammar:

 <Exp> = <Number>
| <Symbol>
| <Exp> + <Exp>
| <Exp> * <Exp>
| fun (<Symbol>): <Exp>
| <Exp>(<Exp>)
| let <Symbol> = <Exp>: <Exp>
| (<Exp>)
| if <Exp> == 0 | <Exp> | <Exp>
| pair(<Exp>, <Exp>)
| fst(<Exp>)
| snd(<Exp>)

That is, a language with single-argument functions and application, an if-zero conditional, and pair, fst, and snd operations. (The language does not include recursive bindings or records.) Unlike cons, the pair operation does not require its second argument to be a list (and we do not have an empty-list value, anyway). The if form has weakest precedence. The pair, fst, and snd forms have a precedence like function calls, but should be preferred by the parser over a function-call form, so they can be matched just before a function-call form in parse.

Implement your interpreter with the eager Shplait language, not a lazy language.

Evaluation of the interpreted langauge must be lazy. In particular, if a function never uses the value of an argument, then the argument expression should not be evaluated. Similarly, if the first or second part of a pair is never needed, then the first or second expression should not be evaluated. Even if the first or second part of a particular pair is used multiple times, the expression to compute the first or second part should be evaluated only once.

From the starting code, expand the parse function to support the new forms: if, pair, fst, and snd. Also, as in HW 4, provide an interp_expr function; the interp_expr wrapper for interp should take an expression and return either a number syntax object, ‘function’ for a function result, or ‘pair’ for a pair result. (Meanwhile, the interp function should never return the syntax object ‘pair’, just like the starting interp function never returns the syntax object ‘function’.) Note that pair results must be distinct from function results, so you will need to modify interp and not just use encodings via parse.

check: interp_expr(parse('10'))
~is '10'
check: interp_expr(parse('10 + 17'))
~is '27'
check: interp_expr(parse('10 * 7'))
~is '70'
check: interp_expr(parse('(fun (x): x + 12)(1 + 17)'))
~is '30'
check: interp_expr(parse('let x = 0:
let f = (fun (y): x + y):
f(1) + (let x = 3:
f(2))'))
~is '3'
check: interp_expr(parse('if 0 == 0 | 1 | 2'))
~is '1'
check: interp_expr(parse('if 1 == 0 | 1 | 2'))
~is '2'
check: interp_expr(parse('pair(1, 2)'))
~is 'pair'
check: interp_expr(parse('fst(pair(1, 2))'))
~is '1'
check: interp_expr(parse('snd(pair(1, 2))'))
~is '2'
check: interp_expr(parse('let p = pair(1, 2):
fst(p) + snd(p)'))
~is '3'
check: interp_expr(parse('let f = (fun (x):
pair(x, x)):
fst(f(3)) + snd(f(4))'))
~is '7'
// Lazy evaluation:
check: interp_expr(parse('(fun (x): 0)(1 + (fun (y): y))'))
~is '0'
check: interp_expr(parse('let x = (1 + (fun (y): y)):
0'))
~is '0'
check: interp_expr(parse('fst(pair(3,
1 + (fun (y): y)))'))
~is '3'
check: interp_expr(parse('snd(pair(1 + (fun (y): y),
4))'))
~is '4'
check: interp_expr(parse('fst(pair(5,
// Infinite loop:
(fun (x): x(x))(fun (x): x(x))))'))
~is '5'
check: interp_expr(
parse(
// Use call-by-name mkrec, which
// is simpler than call-by-value:
'let mkrec = (fun (body_proc):
let fX = (fun (fX):
body_proc(fX(fX))):
fX(fX)):
let fib = mkrec(fun (fib):
// Fib:
fun (n):
if n == 0
| 1
| if (n + -1) == 0
| 1
| fib(n + -1) + fib(n + -2)):
// Call fib on 4:
fib(4)'
)
)
~is '5'
check: interp_expr(
parse(
// Use call-by-name mkrec, which
// is simpler than call-by-value:
'let mkrec = (fun (body_proc):
let fX = (fun (fX):
body_proc(fX(fX))):
fX(fX)):
let nats_from = mkrec(fun (nats_from):
// nats-from:
fun (n):
pair(n, nats_from(n + 1))):
let list_ref = mkrec(fun (list_ref):
// list_ref:
fun (n):
fun (l):
if n == 0
| fst(l)
| list_ref(n + -1)(snd(l))):
// Call list-ref on infinite list:
list_ref(4)(nats_from(2))'
)
)
~is '6'

Part 2 — Stress Test

There’s no new implementation for this part. Just make sure that your interpreter is able to run the following two tests within a few seconds. If it takes tens of seconds or even more than a minute, then your interpreter is not lazy enough—probably because it re-interps the expression for a pair’s first or second part every time the first or second part is accessed, which turns the linear-time program into a quadratic-time program.

The handin server will not run this test, but we will check your implementation against this test when grading. It must produce the right answer within a few seconds.

check: interp_expr(
parse(
'let mkrec = (fun (body_proc):
let fX = (fun (fX):
body_proc(fX(fX))):
fX(fX)):
let nats_to = mkrec(fun (nats_to):
fun (n):
if n == 0
| pair(0, 0)
| let l = nats_to(n + -1):
pair(fst(l) + 1,
l)):
let sum = mkrec(fun (sum):
fun (n):
fun (l):
if n == 0
| 0
| fst(l) + sum(n + -1)(snd(l))):
sum(10000)(nats_to(10000))'
)
)
~is '50005000'
check: interp_expr(
parse(
'let mkrec = (fun (body_proc):
let fX = (fun (fX):
body_proc(fX(fX))):
fX(fX)):
let nats_to = mkrec(fun (nats_to):
fun (n):
if n == 0
| pair(0, 0)
| let l = nats_to(n + -1):
pair(l,
snd(l) + 1)):
let sum = mkrec(fun (sum):
fun (n):
fun (l):
if n == 0
| 0
| snd(l) + sum(n + -1)(fst(l))):
sum(10000)(nats_to(10000))'
)
)
~is '50005000'

Make sure your implementation handles these tests efficiently.

Solution

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436


#lang shplait

type Value
| intV(n :: Int)
| closV(arg :: Symbol,
 body :: Exp,
 env :: Env)
| pairV(p1 :: Thunk,
 p2 :: Thunk)

type Thunk
| delay(arg :: Exp,
 env :: Env,
 done :: Boxof(Optionof(Value)))

type Exp
| intE(n :: Int)
| idE(s :: Symbol)
| plusE(l :: Exp,
 r :: Exp)
| multE(l :: Exp,
 r :: Exp)
| funE(n :: Symbol,
 body :: Exp)
| appE(fn :: Exp,
 arg :: Exp)
| if0E(e :: Exp,
 true :: Exp,
 false :: Exp)
| pairE(e1 :: Exp,
 e2 :: Exp)
| fstE(p :: Exp)
| sndE(p :: Exp)

type Binding
| bind(name :: Symbol,
 val :: Thunk)

type Env = Listof(Binding)

def mt_env = []
def extend_env = cons

// parse ----------------------------------------
fun parse(s :: Syntax) :: Exp:
 cond
 | syntax_is_integer(s):
 intE(syntax_to_integer(s))
 | syntax_is_symbol(s):
 idE(syntax_to_symbol(s))
 | ~else:
 match s
 | 'if $exp == 0 | $true | $false':
 if0E(parse(exp), parse(true), parse(false))
 | 'let $name = $rhs:
 $body':
 appE(funE(syntax_to_symbol(name),
 parse(body)),
 parse(rhs))
 | '$left + $right':
 plusE(parse(left),
 parse(right))
 | '$left * $right':
 multE(parse(left),
 parse(right))
 | 'fun ($id): $body':
 funE(syntax_to_symbol(id),
 parse(body))
 | 'pair($e1, $e2)':
 pairE(parse(e1), parse(e2))
 | 'fst($p)':
 fstE(parse(p))
 | 'snd($p)':
 sndE(parse(p))
 | '$fn($arg)':
 appE(parse(fn),
 parse(arg))
 | '($e)':
 parse(e)
 | ~else:
 error(#'parse, "invalid input: " +& s)

module test:
 check: parse('2')
 ~is intE(2)
 check: parse('x')
 ~is idE(#'x)
 check: parse('2 + 1')
 ~is plusE(intE(2), intE (1))
 check: parse('3 * 4')
 ~is multE(intE(3), intE(4))
 check: parse('3 * 4 + 8')
 ~is plusE(multE(intE(3), intE(4)),
 intE(8))
 check: parse('fun (x): 9')
 ~is funE(#'x, intE(9))
 check: parse('double(9)')
 ~is appE(idE(#'double), intE(9))
 check: parse('1 + double(9)')
 ~is plusE(intE(1),
 appE(idE(#'double), intE(9)))
 check: parse('3 * (4 + 8)')
 ~is multE(intE(3),
 plusE(intE(4), intE(8)))
 check: parse('let x = 1 + 2:
 y')
 ~is appE(funE(#'x,
 idE(#'y)),
 plusE(intE(1), intE(2)))
 check: parse('1 2')
 ~raises "invalid input"

// interp ----------------------------------------
fun interp(a :: Exp, env :: Env) :: Value:
 match a
 | intE(n): intV(n)
 | idE(s): force(lookup(s, env))
 | plusE(l, r): num_plus(interp(l, env), interp(r, env))
 | multE(l, r): num_mult(interp(l, env), interp(r, env))
 | funE(n, body): closV(n, body, env)
 | if0E(e, t, f): if interp(e, env) == intV(0)
 | interp(t, env)
 | interp(f, env)
 | pairE(p1, p2): pairV(delay(p1, env, box(none())), delay(p2, env, box(none())))
 | fstE(p): match interp(p, env)
 | pairV(p1, p2): force(p1)
 | ~else: error(#'interp, "not a pair")
 | sndE(p): match interp(p, env)
 | pairV(p1, p2): force(p2)
 | ~else: error(#'interp, "not a pair")
 | appE(fn, arg):
 match interp(fn, env)
 | closV(n, body, c_env):
 interp(body,
 extend_env(bind(n, delay(arg, env, box(none()))),
 c_env))
 | ~else: error(#'interp, "not a function")

module test:
 check: interp(parse('2'), mt_env)
 ~is intV(2)
 check: interp(parse('x'), mt_env)
 ~raises "free variable"
 check: interp(parse('x'),
 extend_env(bind(#'x, delay(intE(9), mt_env, box(none()))),
 mt_env))
 ~is intV(9)
 check: interp(parse('2 + 1'), mt_env)
 ~is intV(3)
 check: interp(parse('2 * 1'), mt_env)
 ~is intV(2)
 check: interp(parse('(2 * 3) + (5 + 8)'), mt_env)
 ~is intV(19)
 check: interp(parse('fun (x): x + x'),
 mt_env)
 ~is closV(#'x, plusE(idE(#'x), idE(#'x)), mt_env)
 check: interp(parse('let x = 5: x + x'),
 mt_env)
 ~is intV(10)
 check: interp(parse('let x = 5:
 let x = x + 1:
 x + x'),
 mt_env)
 ~is intV(12)
 check: interp(parse('let x = 5:
 let y = 6:
 x'),
 mt_env)
 ~is intV(5)
 check: interp(parse('(fun (x): x + x)(8)'),
 mt_env)
 ~is intV(16)
 check: interp(parse('1(2)'), mt_env)
 ~raises "not a function"
 check: interp(parse('1 + (fun (x): x)'), mt_env)
 ~raises "not a number"
 check: interp(parse('let bad = (fun (x): x + y):
 let y = 5:
 bad(2)'),
 mt_env)
 ~raises "free variable"

 time:
 interp(parse('let x2 = (fun (n): n + n):
 let x4 = (fun (n): x2(x2(n))):
 let x16 = (fun (n): x4(x4(n))):
 let x256 = (fun (n): x16(x16(n))):
 let x65536 = (fun (n): x256(x256(n))):
 x65536(1)'),
 mt_env)

// force ----------------------------------------

fun force(t :: Thunk) :: Value:
 match t
 | delay(a, e, done):
 match unbox(done)
 | none():
 let v = interp(a, e):
 set_box(done, some(v))
 v
 | some(v):
 v

module test:
 check: force(delay(intE(8), mt_env, box(none())))
 ~is intV(8)
 check: block:
 def d = delay(intE(8), mt_env, box(none()))
 begin:
 force(d)
 force(d)
 ~is intV(8)
 check: force(delay(intE(8), mt_env, box(some(intV(9)))))
 ~is intV(9)
 check: force(delay(idE(#'x),
 extend_env(bind(#'x, delay(intE(9), mt_env, box(none()))),
 mt_env),
 box(none())))
 ~is intV(9)

// num_plus and num_mult ----------------------------------------
fun num_op(op :: (Int, Int) -> Int, l :: Value, r :: Value) :: Value:
 cond
 | l is_a intV && r is_a intV:
 intV(op(intV.n(l), intV.n(r)))
 | ~else:
 error(#'interp, "not a number")
fun num_plus(l :: Value, r :: Value) :: Value:
 num_op(fun (a, b): a+b, l, r)
fun num_mult(l :: Value, r :: Value) :: Value:
 num_op(fun (a, b): a*b, l, r)

module test:
 check: num_plus(intV(1), intV(2))
 ~is intV(3)
 check: num_mult(intV(3), intV(2))
 ~is intV(6)

// lookup ----------------------------------------
fun lookup(n :: Symbol, env :: Env) :: Thunk:
 match env
 | []: error(#'lookup, "free variable: " +& n)
 | cons(b, rst_env):
 cond
 | n == bind.name(b):
 bind.val(b)
 | ~else:
 lookup(n, rst_env)

module test:
 check: lookup(#'x, mt_env)
 ~raises "free variable"
 check: lookup(#'x, extend_env(bind(#'x, delay(intE(8), mt_env, box(none()))),
 mt_env))
 ~is delay(intE(8), mt_env, box(none()))
 check: lookup(#'x, extend_env(bind(#'x, delay(intE(9), mt_env, box(none()))),
 extend_env(bind(#'x, delay(intE(8), mt_env, box(none()))),
 mt_env)))
 ~is delay(intE(9), mt_env, box(none()))
 check: lookup(#'y, extend_env(bind(#'x, delay(intE(9), mt_env, box(none()))),
 extend_env(bind(#'y, delay(intE(8), mt_env, box(none()))),
 mt_env)))
 ~is delay(intE(8), mt_env, box(none()))


// Part 1
fun interp_expr(e :: Exp):: Syntax:
 match interp(e, mt_env)
 | intV(val): integer_to_syntax(val)
 | closV(arg, body, env): 'function'
 | pairV(p1, p2): 'pair'

module test:
 check: interp_expr(parse('10'))
 ~is '10'
 check: interp_expr(parse('10 + 17'))
 ~is '27'
 check: interp_expr(parse('10 * 7'))
 ~is '70'
 check: interp_expr(parse('(fun (x): x + 12)(1 + 17)'))
 ~is '30'

 check: interp_expr(parse('let x = 0:
 let f = (fun (y): x + y):
 f(1) + (let x = 3:
 f(2))'))
 ~is '3'

 check: interp_expr(parse('if 0 == 0 | 1 | 2'))
 ~is '1'
 check: interp_expr(parse('if 1 == 0 | 1 | 2'))
 ~is '2'

 check: interp_expr(parse('pair(1, 2)'))
 ~is 'pair'
 check: interp_expr(parse('fst(pair(1, 2))'))
 ~is '1'
 check: interp_expr(parse('snd(pair(1, 2))'))
 ~is '2'
 check: interp_expr(parse('let p = pair(1, 2):
 fst(p) + snd(p)'))
 ~is '3'
 check: interp_expr(parse('let f = (fun (x):
 pair(x, x)):
 fst(f(3)) + snd(f(4))'))
 ~is '7'

 // Lazy evaluation:
 check: interp_expr(parse('(fun (x): 0)(1 + (fun (y): y))'))
 ~is '0'
 check: interp_expr(parse('let x = (1 + (fun (y): y)):
 0'))
 ~is '0'
 check: interp_expr(parse('fst(pair(3,
 1 + (fun (y): y)))'))
 ~is '3'
 check: interp_expr(parse('snd(pair(1 + (fun (y): y),
 4))'))
 ~is '4'
 check: interp_expr(parse('fst(pair(5,
 // Infinite loop:
 (fun (x): x(x))(fun (x): x(x))))'))
 ~is '5'

 check: interp_expr(
 parse(
 // Use call-by-name mkrec, which
 // is simpler than call-by-value:
 'let mkrec = (fun (body_proc):
 let fX = (fun (fX):
 body_proc(fX(fX))):
 fX(fX)):
 let fib = mkrec(fun (fib):
 // Fib:
 fun (n):
 if n == 0
 | 1
 | if (n + -1) == 0
 | 1
 | fib(n + -1) + fib(n + -2)):
 // Call fib on 4:
 fib(4)'
 )
 )
 ~is '5'

 check: interp_expr(
 parse(
 // Use call-by-name mkrec, which
 // is simpler than call-by-value:
 'let mkrec = (fun (body_proc):
 let fX = (fun (fX):
 body_proc(fX(fX))):
 fX(fX)):
 let nats_from = mkrec(fun (nats_from):
 // nats-from:
 fun (n):
 pair(n, nats_from(n + 1))):
 let list_ref = mkrec(fun (list_ref):
 // list_ref:
 fun (n):
 fun (l):
 if n == 0
 | fst(l)
 | list_ref(n + -1)(snd(l))):
 // Call list-ref on infinite list:
 list_ref(4)(nats_from(2))'
 )
 )
 ~is '6'

 // to cover all code
 check: interp_expr(
 parse(
 'fun (x): pair(x,x)'))
 ~is 'function'
 check: interp_expr(
 parse(
 'fst(5)'))
 ~raises "not a pair"
 check: interp_expr(
 parse(
 'snd(5)'))
 ~raises "not a pair"

// Part 2
module test:
 time:
 check: interp_expr(
 parse(
 'let mkrec = (fun (body_proc):
 let fX = (fun (fX):
 body_proc(fX(fX))):
 fX(fX)):
 let nats_to = mkrec(fun (nats_to):
 fun (n):
 if n == 0
 | pair(0, 0)
 | let l = nats_to(n + -1):
 pair(fst(l) + 1,
 l)):
 let sum = mkrec(fun (sum):
 fun (n):
 fun (l):
 if n == 0
 | 0
 | fst(l) + sum(n + -1)(snd(l))):
 sum(10000)(nats_to(10000))'
 )
 )
 ~is '50005000'
 time:
 check: interp_expr(
 parse(
 'let mkrec = (fun (body_proc):
 let fX = (fun (fX):
 body_proc(fX(fX))):
 fX(fX)):
 let nats_to = mkrec(fun (nats_to):
 fun (n):
 if n == 0
 | pair(0, 0)
 | let l = nats_to(n + -1):
 pair(l,
 snd(l) + 1)):
 let sum = mkrec(fun (sum):
 fun (n):
 fun (l):
 if n == 0
 | 0
 | snd(l) + sum(n + -1)(fst(l))):
 sum(10000)(nats_to(10000))'
 )
 )
 ~is '50005000'

HW7

Difficulty: ★★★☆

Start with let_cc2.rhm, which is like let_cc.rhm, but it changes the representation of function expressions, application expressions, and closure values to support a list of arguments—which is the boring work behind part 2 below. The parse function in let_cc2.rhm still matches only single-argument functions and applications, so you’ll have to change that when you’re ready to work on part 2.

Part 1 — More Arithmetic Operators

Add two new arithmetic operators: neg and avg. The neg form takes a single number and returns its negation; the avg form takes three numbers (evaluated left to right) and returns their average. Also, add if constrained to == 0 as usual.

 <Exp> = <Number>
| <Symbol>
| <Exp> + <Exp>
| <Exp> * <Exp>
| fun (<Symbol>): <Exp>
| <Exp>(<Exp>)
| let <Symbol> = <Exp>: <Exp>
| (<Exp>)
| neg(<Exp>)
| avg(<Exp>, <Exp>, <Exp>)
| if <Exp> == 0 | <Exp> | <Exp>

The if form has the weakest precedence. The neg and avg forms have a precedence like function calls, but should be preferred by the parser over a function-call form in parse.

Implement neg and avg as core forms without relying on the interpreter’s existing implementation of addition and multiplication (e.g., don’t generate a doPlusK continuation while interpreting them).

As in previous homeworks, provide interp_expr, which takes an expression, interprets it with an empty environment, and produces either a number syntax object or 'function' for a closure or continuation result.

Examples:

 check: interp_expr(parse('neg(2)'))
~is '-2'
check: interp_expr(parse('avg(0, 6, 6)'))
~is '4'
check: interp_expr(parse('let_cc k: neg(k(3))'))
~is '3'
check: interp_expr(parse('let_cc k: avg(0, k(3), 0)'))
~is '3'
check: interp_expr(parse('let_cc k: avg(k(2), k(3), 0)'))
~is '2'
check: interp_expr(parse('if 1 == 0 | 2 | 3'))
~is '3'
check: interp_expr(parse('if 0 == 0 | 2 | 3'))
~is '2'
check: interp_expr(parse('let_cc k: if k(9) == 0 | 2 | 3'))
~is '9'

The use of let_cc in these examples ensures that your continuation-passing style rules are not broken. The functions interp and continue should only call each other via tail calls.

Part 2 — Functions that Accept Multiple Arguments, Again

Change your interpreter to support functions with multiple or zero arguments and corresponding function calls:

 <Exp> = <Number>
| <Symbol>
| <Exp> + <Exp>
| <Exp> * <Exp>
| fun (<Symbol>, ...): <Exp>
| <Exp>(<Exp>, ...)
| let <Symbol> = <Exp>: <Exp>
| (<Exp>)
| neg(<Exp>)
| avg(<Exp>, <Exp>, <Exp>)
| if <Exp> == 0 | <Exp> | <Exp>

Assume that each argument is distinct for a fun expression (i.e., your parser does not need to check). If the wrong number of arguments are provided, then a clear error message should be reported. Implement support for multiple arguments as part of the interpreter, not as sugar.

When a Moe program calls a continuation value (instead of a closure), the continuation value should still always take a single argument, and the interpreter should report a clear error if zero or multiple arguments are provided to a continuation.

If you’d like a hint, see HW 7 part 2 Hint. (Working without the hint makes this assignment ★★★★ instead of ★★★☆.)

 check: interp_expr(parse('(fun(x, y): y + neg(x))(10, 12)'))
~is '2'
check: interp_expr(parse('fun (): 12'))
~is 'function'
check: interp_expr(parse('fun (x): fun (): x'))
~is 'function'
check: interp_expr(parse('(fun (x): fun (): x)(13)()'))
~is '13'
check: interp_expr(parse('let_cc esc: (fun (x, y): x)(1, esc(3))'))
~is '3'
check: interp_expr(parse('let f = (fun (x, y): fun (z): z + y):
(let_cc esc: f(1, let_cc k: esc(k)))(10)'))
~is '20'
check: interp_expr(parse('(fun (x, y): 1)(1, 2, 3)'))
// error because function is given too many arguments
~raises ""
check: interp_expr(parse('let_cc esc: esc()'))
// error because continuation is given 0 arguments
~raises ""
check: interp_expr(parse('let_cc esc: esc(1, 2)'))
// error because continuation is given 2 arguments
~raises ""

Part 3 — Faster Exceptions (Extra Credit)

This part is extra credit for CS 3520 and CS 6520 students.

Extend your interpreter to support a try form for exception handling:

 <Exp> = ...
| try:
<Exp>
~catch: <Exp>

When raising an exception, instead of searching the continuation for a tryK continuation, arrange for the interpreter to keep track of the current handler so that exceptions are raised in constant time, regardless of how long the continuation is.

Solution

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617


#lang shplait

type Value
| intV(n :: Int)
| closV(arg :: Listof(Symbol),
 body :: Exp,
 env :: Env)
| contV(k :: Cont)
| errorV(message :: String)

type Exp
| intE(n :: Int)
| idE(s :: Symbol)
| plusE(l :: Exp,
 r :: Exp)
| multE(l :: Exp,
 r :: Exp)
| divE(l :: Exp,
 r :: Exp)
| funE(n :: Listof(Symbol),
 body :: Exp)
| appE(fn :: Exp,
 arg :: Listof(Exp))
| letccE(n :: Symbol,
 body :: Exp)
| negE(e :: Exp)
| avgE(e1 :: Exp,
 e2 :: Exp,
 e3 :: Exp)
| if0E(e :: Exp,
 true :: Exp,
 false :: Exp)
| tryE(body :: Exp,
 handle :: Exp)

type Binding
| bind(name :: Symbol,
 val :: Value)

type Env = Listof(Binding)

def mt_env = []
def extend_env = cons

type Cont
| doneK()
| ifK(true :: Exp,
 false :: Exp,
 e :: Env,
 k :: Cont)
| negK(e :: Env,
 k :: Cont)
// Everytime we do cumulative sum
| avg3K(e2 :: Exp,
 e3 :: Exp,
 env :: Env,
 k :: Cont)
| avg2K(v1 :: Value,
 e3 :: Exp,
 env :: Env,
 k :: Cont)
| avg1K(e3 :: Exp,
 env :: Env,
 k :: Cont)
| avg0K(v12 :: Value,
 env :: Env,
 k :: Cont)
// And finally divide by 3
| doAvgK(k :: Cont)
| plusSecondK(r :: Exp,
 e :: Env,
 k :: Cont)
| doPlusK(v :: Value,
 k :: Cont)
// To make Moe independent of Shplaits div-by-0 exception,
// I implemented division in moe with div-by-0 exception
| divSecondK(r :: Exp,
 e :: Env,
 k :: Cont)
| doDivK(v :: Value,
 k :: Cont)
| multSecondK(r :: Exp,
 e :: Env,
 k :: Cont)
| doMultK(v :: Value,
 k :: Cont)
// First I have tried not to use hint, and was successful
// Later I looked at the hint and found it to be much better solution
// | appArgFirstK(args :: Listof(Exp),
// env :: Env,
// k :: Cont)
// | appArgK(fn :: Value,
// fn_env :: Env,
// env :: Env,
// ns :: Listof(Symbol),
// nextArgs :: Listof(Exp),
// k :: Cont)
// | doAppK(fn_env :: Env,
// k :: Cont)
// Using hint below
| appArgsK(as :: Listof(Exp),
 env :: Env,
 k :: Cont)
| appK(f :: Value,
 vs :: Listof(Value),
 as :: Listof(Exp),
 env :: Env,
 k :: Cont)

// parse ----------------------------------------
fun parse(s :: Syntax) :: Exp:
 cond
 | syntax_is_integer(s):
 intE(syntax_to_integer(s))
 | syntax_is_symbol(s):
 idE(syntax_to_symbol(s))
 | ~else:
 match s
 | 'if $e == 0 | $true | $false':
 if0E(parse(e),
 parse(true),
 parse(false))
 | 'let_cc $name:
 $body':
 letccE(syntax_to_symbol(name),
 parse(body))
 | 'let $name = $rhs:
 $body':
 appE(funE([syntax_to_symbol(name)],
 parse(body)),
 [parse(rhs)])
 | '$left + $right':
 plusE(parse(left),
 parse(right))
 | '$left / $right':
 divE(parse(left),
 parse(right))
 | '$left * $right':
 multE(parse(left),
 parse(right))
 | 'fun ($ids, ...): $body':
 funE(map(syntax_to_symbol, syntax_to_list('[$ids, ...]')),
 parse(body))
 | 'neg($e)':
 negE(parse(e))
 | 'avg($e1, $e2, $e3)':
 avgE(parse(e1),
 parse(e2),
 parse(e3))
 | '$fn($args, ...)':
 appE(parse(fn),
 map(parse, syntax_to_list('[$args, ...]')))
 | '($e)':
 parse(e)
 | 'try:
 $body
 ~catch: $handle':
 tryE(parse(body), parse(handle))
 | ~else:
 error(#'parse, "invalid input: " +& s)


module test:
 check: parse('2')
 ~is intE(2)
 check: parse('x')
 ~is idE(#'x)
 check: parse('2 + 1')
 ~is plusE(intE(2), intE (1))
 check: parse('3 * 4')
 ~is multE(intE(3), intE(4))
 check: parse('3 / 4')
 ~is divE(intE(3), intE(4))
 check: parse('3 * 4 + 8')
 ~is plusE(multE(intE(3), intE(4)),
 intE(8))
 check: parse('3 / 4 + 8')
 ~is plusE(divE(intE(3), intE(4)),
 intE(8))
 check: parse('fun (x): 9')
 ~is funE([#'x], intE(9))
 check: parse('double(9)')
 ~is appE(idE(#'double), [intE(9)])
 check: parse('1 + double(9)')
 ~is plusE(intE(1),
 appE(idE(#'double), [intE(9)]))
 check: parse('3 * (4 + 8)')
 ~is multE(intE(3),
 plusE(intE(4), intE(8)))
 check: parse('let x = 1 + 2:
 y')
 ~is appE(funE([#'x],
 idE(#'y)),
 [plusE(intE(1), intE(2))])
 check: parse('let_cc k: 0')
 ~is letccE(#'k, intE(0))
 check: parse('1 2')
 ~raises "invalid input"
 check: parse('fun (x, y, z): x + y + z')
 ~is funE([#'x, #'y, #'z], plusE(plusE(idE(#'x), idE(#'y)), idE(#'z)))
 check: parse('try:
 0
 ~catch: 8')
 ~is tryE(intE(0), intE(8))
 check: parse('try:
 neg(10)
 ~catch: 5')
 ~is tryE(negE(intE(10)), intE(5))

// Like env, we are keeping track of the stack of handlers for each try cases
type Handler
| handlerE(e :: Exp, env :: Env, k :: Cont)
type HandlerStack = Listof(Handler)
def mt_handler = []
def extend_handler = cons

// Whenever we escape from exception, we continue the continuation before the try-catch
// with the catch value. If there is no try-catch wrapped, we simply return the errorV
fun escape(hs :: HandlerStack, e_v :: Value) :: Value:
 match hs
 | []: e_v
 | cons(h, h_rest): match h
 | handlerE(e, h_env, h_k): interp(e, h_env, h_k, h_rest)

// interp ----------------------------------------
fun interp(a :: Exp, env :: Env, k :: Cont, hs :: HandlerStack) :: Value:
 match a
 | if0E(e, true, false): interp(e, env,
 ifK(true, false, env, k), hs)
 | negE(e): interp(e, env,
 negK(env, k), hs)
 | avgE(e1, e2, e3): interp(e1, env,
 avg3K(e2, e3, env, k), hs)
 | intE(n): continue(k, intV(n), hs)
 | idE(s): lookup(s, env, k, hs)
 | plusE(l, r): interp(l, env,
 plusSecondK(r, env, k), hs)
 | multE(l, r): interp(l, env,
 multSecondK(r, env, k), hs)
 | divE(l, r): interp(l, env,
 divSecondK(r, env, k), hs)
 | funE(ns, body): continue(k, closV(ns, body, env), hs)
// | appE(fn, args): interp(fn, env,
// appArgFirstK(args, env, k), hs)
 | appE(fn, args): interp(fn, env, appArgsK(args, env, k), hs)
 | letccE(n, body):
 interp(body,
 extend_env(bind(n, contV(k)),
 env),
 k, hs)
 | tryE(body, handler):
 interp(body, env, k, extend_handler(handlerE(handler, env, k), hs))

fun continue(k :: Cont, v :: Value, hs :: HandlerStack) :: Value:
 match k
 | doneK(): v
 | ifK(true, false, env, next_k):
 match v
 | intV(val):
 if val == 0
 | interp(true, env, next_k, hs)
 | interp(false, env, next_k, hs)
 | ~else: escape(hs, errorV("not a number"))
 | negK(env, next_k): num_mult(v, intV(-1), next_k, hs)
 | avg3K(e2, e3, env, next_k):
 interp(e2, env,
 avg2K(v, e3, env, next_k), hs)
 | avg2K(v1, e3, env, next_k):
 num_plus(v1, v, avg1K(e3, env, next_k), hs)
 | avg1K(e3, env, next_k):
 interp(e3, env,
 avg0K(v, env, next_k), hs)
 | avg0K(v12, env, next_k):
 num_plus(v12, v, doAvgK(next_k), hs)
 | doAvgK(next_k): num_div(v, intV(3), next_k, hs)
 | plusSecondK(r, env, next_k):
 interp(r, env,
 doPlusK(v, next_k), hs)
 | doPlusK(v_l, next_k):
 num_plus(v_l, v, next_k, hs)
 | multSecondK(r, env, next_k):
 interp(r, env,
 doMultK(v, next_k), hs)
 | divSecondK(r, env, next_k):
 interp(r, env,
 doDivK(v, next_k), hs)
 | doDivK(v_l, next_k):
 num_div(v_l, v, next_k, hs)
 | doMultK(v_l, next_k):
 num_mult(v_l, v, next_k, hs)
// | appArgFirstK(args, env, next_k):
// match args
// | []: match v
// | closV(ns, body, c_env): if length(ns) == length(args)
// | continue(doAppK(env, next_k), v)
// | error(#'interp, "function argument mismatch")
// | contV(k): error(#'interp, "continuation must have exactly 1 argument")
// | ~else: error(#'interp, "not a function or continuation")
// | cons(arg, rest_args):
// match v
// | closV(ns, body, c_env): interp(arg, env,
// appArgK(v, c_env, env, ns, rest_args, next_k))
// | contV(k_v): interp(arg, env,
// appArgK(v, env, env, [], [], next_k))
// | appArgK(fn, fn_env, env, ns, next_args, next_k):
// match next_args
// | []: match fn
// | closV(c_ns, body, c_env): continue(doAppK(extend_env(bind(first(ns), v)), next_k), fn)
// | contV(k_v): continue(doAppK
// | cons(arg, rest_args): interp(arg, env,
// appArgK(fn, extend_env(bind(first(ns), v), fn_env),
// env, rest(ns), rest_args, next_k))
// | doAppK(fn_env, next_k):
// match v:
// | closV(ns, body, env): interp(body, fn_env, next_k)
// | contV(k): continue(k, v)
// | ~else: error(#'interp, "not a function or continuation")
 | appArgsK(as, env, next_k):
 match as
 | []: match v
 | closV(ns, body, c_env): if length(ns) == 0
 | interp(body, c_env, next_k, hs)
 | escape(hs, errorV("wrong number of arguments"))
 | contV(k_v): escape(hs, errorV("continuations must have exactly 1 value"))
 | ~else: escape(hs, errorV("not a function"))
 | cons(a, ra): interp(a, env,
 appK(v, [], ra, env, next_k), hs)
 | appK(f, vs, as, env, next_k):
 match as
 | []: match f
 | closV(ns, body, c_env): let vs = reverse(cons(v, vs)):
 if length(ns) == length(vs)
 | interp(body,
 append(map2(fun (x, y): bind(x, y), ns, vs), c_env),
 next_k, hs)
 | escape(hs, errorV("wrong number of arguments"))
 | contV(k_v): if length(vs) == 0
 | continue(k_v, v, hs)
 | escape(hs, errorV("continuations must have exactly 1 value"))
 | ~else: escape(hs, errorV("not a function"))
 | cons(a, ra): interp(a, env, appK(f, cons(v, vs), ra, env, next_k), hs)

check: map2(fun (x, y): bind(x, y), [#'a, #'b, #'c], reverse(cons(intV(3), [intV(2), intV(1)])))
 ~is [bind(#'a, intV(1)), bind(#'b, intV(2)), bind(#'c, intV(3))]

module test:
 check: interp(parse('2'), mt_env, doneK(), mt_handler)
 ~is intV(2)
 check: interp(parse('x'), mt_env, doneK(), mt_handler)
 ~is errorV("free variable")
 check: interp(parse('x'),
 extend_env(bind(#'x, intV(9)), mt_env),
 doneK(), mt_handler)
 ~is intV(9)
 check: interp(parse('2 + 1'), mt_env, doneK(), mt_handler)
 ~is intV(3)
 check: interp(parse('2 * 1'), mt_env, doneK(), mt_handler)
 ~is intV(2)
 check: interp(parse('10 / 2'), mt_env, doneK(), mt_handler)
 ~is intV(5)
 check: interp(parse('(2 * 3) + (5 + 8)'), mt_env, doneK(), mt_handler)
 ~is intV(19)
 check: interp(parse('(15 / 5) + (5 + 8)'), mt_env, doneK(), mt_handler)
 ~is intV(16)
 check: interp(parse('1 / 0'), mt_env, doneK(), mt_handler)
 ~is errorV("div by zero")
 check: interp(parse('fun (x): x + x'),
 mt_env,
 doneK(), mt_handler)
 ~is closV([#'x], plusE(idE(#'x), idE(#'x)), mt_env)
 check: interp(parse('5 + 10'), mt_env, doneK(), mt_handler)
 ~is intV(15)
 check: interp(appE(funE([#'x], plusE(intE(1), idE(#'x))), [intE(5)]),
 mt_env,
 doneK(), mt_handler)
 ~is intV(6)
 check: interp(parse('let x = 5:
 let x = x + 1:
 x + x'),
 mt_env,
 doneK(), mt_handler)
 ~is intV(12)
 check: interp(parse('let x = 5:
 let y = 6:
 x'),
 mt_env,
 doneK(), mt_handler)
 ~is intV(5)
 check: interp(parse('(fun (x): x + x)(8)'),
 mt_env,
 doneK(), mt_handler)
 ~is intV(16)
 check: interp(parse('1(2)'), mt_env, doneK(), mt_handler)
 ~is errorV("not a function")
 check: interp(parse('1 + (fun (x): x)'), mt_env, doneK(), mt_handler)
 ~is errorV("not a number")
 check: interp(parse('let bad = (fun (x): x + y):
 let y = 5:
 bad(2)'),
 mt_env,
 doneK(), mt_handler)
 ~is errorV("free variable")
 check: interp(parse('let_cc k: k(0)'), mt_env, doneK(), mt_handler)
 ~is intV(0)
 check: interp(parse('let_cc k: 1 + k(0)'),
 mt_env,
 doneK(), mt_handler)
 ~is intV(0)
 check: interp(parse('let f = (let_cc k: k):
 f(fun (x): 10)'),
 mt_env,
 doneK(), mt_handler)
 ~is intV(10)

 // Eager:
 check: interp(parse('(fun (x): 0)(1(2))'), mt_env, doneK(), mt_handler)
 ~is errorV("not a function")

 check: continue(doneK(), intV(5), mt_handler)
 ~is intV(5)
 check: continue(plusSecondK(intE(6), mt_env, doneK()), intV(5), mt_handler)
 ~is intV(11)
 check: continue(doPlusK(intV(7), doneK()), intV(5), mt_handler)
 ~is intV(12)
 check: continue(multSecondK(intE(6), mt_env, doneK()), intV(5), mt_handler)
 ~is intV(30)
 check: continue(doMultK(intV(7), doneK()), intV(5), mt_handler)
 ~is intV(35)

// num_plus and num_mult ----------------------------------------
fun num_op(op :: (Int, Int) -> Int, l :: Value, r :: Value, k :: Cont, hs :: HandlerStack) :: Value:
 cond
 | l is_a intV && r is_a intV:
 continue(k, intV(op(intV.n(l), intV.n(r))), hs)
 | ~else:
 escape(hs, errorV("not a number"))
fun num_plus(l :: Value, r :: Value, k :: Cont, hs :: HandlerStack) :: Value:
 num_op(fun (a, b): a+b, l, r, k, hs)
fun num_mult(l :: Value, r :: Value, k :: Cont, hs :: HandlerStack) :: Value:
 num_op(fun (a, b): a*b, l, r, k, hs)
fun num_div(l :: Value, r :: Value, k :: Cont, hs :: HandlerStack) :: Value:
 if intV.n(r) == 0
 | escape(hs, errorV("div by zero"))
 | num_op(fun (a, b): a / b, l, r, k, hs)

module test:
 check: num_plus(intV(1), intV(2), doneK(), mt_handler)
 ~is intV(3)
 check: num_mult(intV(3), intV(2), doneK(), mt_handler)
 ~is intV(6)
 check: num_div(intV(6), intV(2), doneK(), mt_handler)
 ~is intV(3)
 check: num_div(intV(5), intV(0), doneK(), mt_handler)
 ~is errorV("div by zero")

// lookup ----------------------------------------
fun lookup(n :: Symbol, env :: Env, k :: Cont, hs :: HandlerStack) :: Value:
 match env
 | []: escape(hs, errorV("free variable"))
 | cons(b, rst_env):
 cond
 | n == bind.name(b):
 continue(k, bind.val(b), hs)
 | ~else:
 lookup(n, rst_env, k, hs)

module test:
 check: lookup(#'x, mt_env, doneK(), mt_handler)
 ~is errorV("free variable")
 check: lookup(#'x, extend_env(bind(#'x, intV(8)), mt_env), doneK(), mt_handler)
 ~is intV(8)
 check: lookup(#'x, extend_env(bind(#'x, intV(9)),
 extend_env(bind(#'x, intV(8)),
 mt_env)), doneK(), mt_handler)
 ~is intV(9)
 check: lookup(#'y, extend_env(bind(#'x, intV(9)),
 extend_env(bind(#'y, intV(8)),
 mt_env)), doneK(), mt_handler)
 ~is intV(8)

// Part 1
fun interp_expr(e :: Exp) :: Syntax:
 match interp(e, mt_env, doneK(), mt_handler)
 | intV(v): integer_to_syntax(v)
 | closV(arg, body, env): 'function'
 | contV(k): 'function'
 | errorV(message): 'error'

module test:
 check: interp_expr(parse('neg(2)'))
 ~is '-2'
 check: interp_expr(parse('avg(0, 6, 6)'))
 ~is '4'
 check: interp_expr(parse('let_cc k: neg(k(3))'))
 ~is '3'
 check: interp_expr(parse('let_cc k: avg(0, k(3), 0)'))
 ~is '3'
 check: interp_expr(parse('let_cc k: avg(k(2), k(3), 0)'))
 ~is '2'
 check: interp_expr(parse('if 1 == 0 | 2 | 3'))
 ~is '3'
 check: interp_expr(parse('if 0 == 0 | 2 | 3'))
 ~is '2'
 check: interp_expr(parse('let_cc k: if k(9) == 0 | 2 | 3'))
 ~is '9'

 // Additional checks to cover
 check: interp_expr(parse('if (fun (x): x) == 0 | 2 | 3'))
 ~is 'error'
 check: interp_expr(parse('fun (x): x'))
 ~is 'function'
 check: interp_expr(parse('let_cc foo: foo'))
 ~is 'function'

// Part 2
module test:
 check: interp_expr(parse('fun(x, y): x + neg(y)'))
 ~is 'function'
 check: interp_expr(parse('(fun(x, y): y + neg(x))(10, 12)'))
 ~is '2'
 check: interp_expr(parse('fun (): 12'))
 ~is 'function'
 check: interp_expr(parse('fun (x): fun (): x'))
 ~is 'function'
 check: interp_expr(parse('(fun (x): fun (): x)(13)()'))
 ~is '13'

 check: interp_expr(parse('let_cc esc: (fun (x, y): x)(1, esc(3))'))
 ~is '3'
 check: interp_expr(parse('let f = (fun (x, y): fun (z): z + y):
 (let_cc esc: f(1, let_cc k: esc(k)))(10)'))
 ~is '20'

 check: interp(parse('(fun (x, y): 1)(1, 2, 3)'), mt_env, doneK(), mt_handler)
 // error because function is given too many arguments,
 // but the specific error message is not specified
 ~is errorV("wrong number of arguments")
 check: interp(parse('let_cc esc: esc()'), mt_env, doneK(), mt_handler)
 // error because continuation is given 0 arguments
 ~is errorV("continuations must have exactly 1 value")
 check: interp(parse('let_cc esc: esc(1, 2)'), mt_env, doneK(), mt_handler)
 // error because continuation is given 2 arguments
 ~is errorV("continuations must have exactly 1 value")
 // To cover the code
 check: interp(parse('(fun (x): 5)()'), mt_env, doneK(), mt_handler)
 ~is errorV("wrong number of arguments")
 check: interp(parse('5()'), mt_env, doneK(), mt_handler)
 ~is errorV("not a function")

// Part 3 (bonus: O(1) try-catch)
module test:
 check: parse('try:
 neg(fun (x): x)
 ~catch: 10')
 ~is tryE(negE(funE([#'x], idE(#'x))),
 intE(10))
 check: interp(parse('x'), mt_env, doneK(), mt_handler)
 ~is errorV("free variable")
 check: interp(parse('1 + x'), mt_env, doneK(), mt_handler)
 ~is errorV("free variable")
 check: interp(parse('1 + (fun (x): x)'), mt_env, doneK(), mt_handler)
 ~is errorV("not a number")
 check: interp(parse('(1 + (fun (x): x))(3)'), mt_env, doneK(), mt_handler)
 ~is errorV("not a number")
 check: interp(parse('try:
 0
 ~catch: 8'),
 mt_env,
 doneK(), mt_handler)
 ~is intV(0)
 check: interp(parse('try:
 0(0)
 ~catch: 8'),
 mt_env,
 doneK(), mt_handler)
 ~is intV(8)
 check: interp(parse('try: neg((fun (x): x))
 ~catch: 10'), mt_env, doneK(), mt_handler)
 ~is intV(10)
 check: interp_expr(parse('try:
 avg(fun (x): x, 2, 3)
 ~catch: 1'))
 ~is '1'
 check: interp_expr(parse('try:
 avg(1, fun (x): x, 3)
 ~catch: 1'))
 ~is '1'
 check: interp_expr(parse('try:
 avg(1, 2, fun (x): x)
 ~catch: 1'))
 ~is '1'
 check: interp_expr(parse('try:
 2 * (fun(x): x)
 ~catch: 5
 + 5'))
 ~is '10'
 check: interp_expr(parse('try:
 neg(5 + fun(x): x)
 ~catch: 10'))
 ~is '10'
 check: interp_expr(parse('try:
 (fun (x): 20) + 10
 ~catch: 15'))
 ~is '15'
 // testing nested trys
 check: interp_expr(parse('try:
 5 + try:
 10 + (fun (x): 20)
 ~catch: 1
 ~catch: 2'))
 ~is '6'
 check: interp_expr(parse('5 + try:
 (fun (x): x + 1)(try:
 20 + x
 ~catch: 30)
 ~catch: 10'))
 ~is '36'

HW8

Difficulty: ★★★☆

Your solution will start with 5.rhm. However, you should think of an addition to 5.rhm as being a translation of an addition to lambda_k.rhm. So, it’s a good idea to first implement part 1 in lambda_k.rhm, and then translate to 5.rhm.

Part 1 — Boxes

Add box, unbox, and is_box:

 <Exp> = ....
| box(<Exp>)
| unbox(<Exp>)
| is_box(<Exp>)

The is_box form returns 0 if the result of its argument expression is a box, 1 if it’s not a box. Even so, your interpreter can assume that the argument to unbox is always a box (which is consistent with other forms in the initial interpreter, such as the way that + assumes that its arguments are numbers).

Test coverage: To achieve test coverage, you are allowed to simply comment out the error cases in move and update, since triggering those requires extreme measures. If you need a program that runs out of memory, you can use the Moe program let f = (fun (f): 1 + f(f)): f(f).

Examples:

 reset()
N check: interpx(compile(parse('unbox(unbox(box(box(3))))'),
mt_env),
empty_env,
init_k())
~is 3
reset()
N check: interpx(compile(parse('is_box(3)'),
mt_env),
empty_env,
init_k())
~is 1
reset()
N check: interpx(compile(parse('is_box(box(3))'),
mt_env),
empty_env,
init_k())
~is 0
reset()
N check: interpx(compile(parse('is_box(fun (x): box(x))'),
mt_env),
empty_env,
init_k())
~is 1
N check: interpx(compile(
parse(
'let mkrec = (fun (body_proc):
(fun (fX):
fX(fX))(fun (fX):
body_proc(fun (x):
fX(fX)(x)))):
let chain = mkrec(fun (chain):
fun (n):
if n == 0
| 1
| box(chain(n + -1))):
let unchain = mkrec(fun (unchain):
fun (n):
fun (b):
if n == 0
| b
| unchain(n + -1)(unbox(b))):
unchain(13)(chain(13))'
),
mt_env),
empty_env,
init_k())
~is 1

Part 2 — Extra Credit: Box Assignment

CS 3520 and CS 6520 students can complete this exercise for extra credit, but it is not required.

Add set_box:

 <Exp> = ....
| set_box(<Exp>, <Exp>)

You can make set_box return whatever you like, and your interpreter can assume that the first argument to set_box is always a box.

 reset()
N check: interpx(compile(parse('let b = box(3):
let dummy = set_box(b, 4):
unbox(b)'),
mt_env),
empty_env,
init_k())
~is 4
reset()
N check: interpx(
compile(
parse(
'let mkrec = (fun (body_proc):
(fun (fX):
fX(fX))(fun (fX):
body_proc(fun (x):
fX(fX)(x)))):
let chain = mkrec(fun (chain):
fun (n):
if n == 0
| 1
| box(chain(n + -1))):
let bx = box(chain(13)):
let unchain = mkrec(
fun (unchain):
fun (n):
if n == 0
| unbox(bx)
| let dummy = set_box(bx, unbox(unbox(bx))):
unchain(n + -1)):
unchain(13)'
),
mt_env),
empty_env,
init_k())
~is 1

Solution

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767


#lang shplait

// Garbage collection for run-time memory

type Exp
| intE(n :: Int)
| idE(s :: Symbol)
| plusE(l :: Exp,
 r :: Exp)
| multE(l :: Exp,
 r :: Exp)
| funE(n :: Symbol,
 body :: Exp)
| appE(fn :: Exp,
 arg :: Exp)
| if0E(tst :: Exp,
 thn :: Exp,
 els :: Exp)
| boxE(e :: Exp)
| unboxE(e :: Exp)
| isBoxE(e :: Exp)
| setBoxE(b :: Exp,
 val :: Exp)
/*
 type ExpD
 8 | intD(n :: Int)
 9 | atD(n :: Int)
 10 | plusD(l :: ExpD,
 r :: ExpD)
 11 | multD(l :: ExpD,
 r :: ExpD)
 12 | funD(body :: ExpD)
 13 | appD(fn :: ExpD,
 arg :: ExpD)
 14 | if0D(tst :: ExpD,
 thn :: ExpD,
 els :: ExpD)
 18 | boxD(e :: ExpD)
 19 | unboxD(e :: ExpD)
 20 | isBoxD(e :: ExpD)
*/

def doneK = 0
def plusSecondK = 1
def doPlusK = 2
def multSecondK = 3
def doMultK = 4
def appArgK = 5
def doAppK = 6
def doIf0K = 7

def intD = 8
def atD = 9
def plusD = 10
def multD = 11
def funD = 12
def appD = 13
def if0D = 14

def intV = 15
def closV = 16
def boxV = 21

def CONS = 17
def MOVED = 99

def boxD = 18
def unboxD = 19
def isBoxD = 20
def setBoxD = 25

def boxK = 22
def isBoxK = 23
def unboxK = 24
def boxValK = 26
def setBoxK = 27

/*
 type Value
 15 | intV(n :: Int)
 16 | closV(body :: ExpD,
 env :: Env)
 21 | boxV(l :: Location) // Location is just an Int
*/

type BindingC
| bindC(name :: Symbol)

type EnvC = Listof(BindingC)

def mt_env = []
def extend_env = cons

/*
 type Cont
 0 | doneK()
 1 | plusSecondK(r :: ExpD,
 env :: Env,
 k :: Cont)
 2 | doPlusK(v1 :: Value,
 k :: Cont)
 3 | multSecondK(r :: ExpD,
 env :: Env,
 k :: Cont)
 4 | doMultK(v1 :: Value,
 k :: Cont)
 5 | appArgK(arg :: ExpD,
 env :: Env,
 k :: Cont)
 6 | doAppK(fun_val :: Value,
 k :: Cont)
 7 | doIf0K(thn :: ExpD,
 els :: ExpD,
 env :: Env,
 k :: Cont)
*/

/*
 17 cons for env
 99 moved
*/

// parse ----------------------------------------
fun parse(s :: Syntax) :: Exp:
 cond
 | syntax_is_integer(s):
 intE(syntax_to_integer(s))
 | syntax_is_symbol(s):
 idE(syntax_to_symbol(s))
 | ~else:
 match s
 | 'if $tst == 0 | $thn | $els':
 if0E(parse(tst), parse(thn), parse(els))
 | 'let $name = $rhs: $body':
 appE(funE(syntax_to_symbol(name), parse(body)),
 parse(rhs))
 | '$left + $right': plusE(parse(left), parse(right))
 | '$left * $right': multE(parse(left), parse(right))
 | 'fun ($id): $body': funE(syntax_to_symbol(id),
 parse(body))
 | 'box($exp)': boxE(parse(exp))
 | 'unbox($exp)': unboxE(parse(exp))
 | 'is_box($exp)': isBoxE(parse(exp))
 | 'set_box($b, $val)': setBoxE(parse(b), parse(val))
 | '$fn($arg)': appE(parse(fn), parse(arg))
 | '($e)': parse(e)
 | ~else: error(#'parse, "invalid input: " +& s)

module test:
 check: parse('2')
 ~is intE(2)
 check: parse('x')
 ~is idE(#'x)
 check: parse('2 + 1')
 ~is plusE(intE(2), intE (1))
 check: parse('3 * 4')
 ~is multE(intE(3), intE(4))
 check: parse('3 * 4 + 8')
 ~is plusE(multE(intE(3), intE(4)), intE(8))
 check: parse('fun (x): 9')
 ~is funE(#'x, intE(9))
 check: parse('double(9)')
 ~is appE(idE(#'double), intE(9))
 check: parse('1 + double(9)')
 ~is plusE(intE(1), appE(idE(#'double), intE(9)))
 check: parse('3 * (4 + 8)')
 ~is multE(intE(3), plusE(intE(4), intE(8)))
 check: parse('let x = 1 + 2: y')
 ~is appE(funE(#'x, idE(#'y)), plusE(intE(1), intE(2)))
 check: parse('if 1 == 0 | 2 | 3')
 ~is if0E(intE(1), intE(2), intE(3))
 check: parse('1 2')
 ~raises "invalid input"
 check: parse('box(box(5))')
 ~is boxE(boxE(intE(5)))
 check: parse('unbox(box(5))')
 ~is unboxE(boxE(intE(5)))
 check: parse('is_box(box(5))')
 ~is isBoxE(boxE(intE(5)))

// ----------------------------------------
// Allocator for code, which is never freed;
// use `code_ref` instead of `ref` to refer to code

def code_memory = make_array(2048, 0)
def mutable code_ptr = 0

fun code_incptr(n):
 code_ptr := code_ptr + n
 code_ptr - n

fun code_malloc1(tag, a):
 code_memory[code_ptr] := tag
 code_memory[code_ptr + 1] := a
 code_incptr(2)

fun code_malloc2(tag, a, b):
 code_memory[code_ptr] := tag
 code_memory[code_ptr + 1] := a
 code_memory[code_ptr + 2] := b
 code_incptr(3)

fun code_malloc3(tag, a, b, c):
 code_memory[code_ptr] := tag
 code_memory[code_ptr + 1] := a
 code_memory[code_ptr + 2] := b
 code_memory[code_ptr + 3] := c
 code_incptr(4)

fun code_ref(n, d):
 code_memory[n+d]

// ----------------------------------------

fun compile(a, env):
 match a
 | intE(n): code_malloc1(intD, n)
 | idE(name): code_malloc1(atD, locate(name, env))
 | plusE(l, r): code_malloc2(plusD, compile(l, env), compile(r, env))
 | multE(l, r): code_malloc2(multD, compile(l, env), compile(r, env))
 | funE(n, body_expr): code_malloc1(funD,
 compile(body_expr,
 extend_env(bindC(n), env)))
 | appE(fn, arg): code_malloc2(appD,
 compile(fn, env),
 compile(arg, env))
 | if0E(tst, thn, els): code_malloc3(if0D,
 compile(tst, env),
 compile(thn, env),
 compile(els, env))
 | boxE(exp): code_malloc1(boxD, compile(exp, env))
 | unboxE(exp): code_malloc1(unboxD, compile(exp, env))
 | isBoxE(exp): code_malloc1(isBoxD, compile(exp, env))
 | setBoxE(b, val): code_malloc2(setBoxD,
 compile(b, env),
 compile(val, env))

fun locate(name, env):
 match env
 | []: error(#'locate, "free variable: " +& name)
 | cons(fst_b, rst_env): if name == bindC.name(fst_b)
 | 0
 | 1 + locate(name, rst_env)

// ----------------------------------------
// Memory allocator with a 2-space collector
// for run-time allocation

def MEMORY_SIZE = 128

def space1 = make_array(MEMORY_SIZE, 0)
def space2 = make_array(MEMORY_SIZE, 0)

def mutable memory = space1
def mutable ptr_reg = 0

def empty_memory = make_array(0, 0)
def mutable from_memory = empty_memory

def mutable result_reg = 0

fun incptr(n):
 // Increment the allocation pointer, and
 // if there's not enough room for the next
 // allocation, then collect garbage
 ptr_reg := ptr_reg + n
 if ptr_reg + 5 >= MEMORY_SIZE
 | result_reg := ptr_reg - n
 if from_memory == empty_memory
 | gc()
 | // Ran out of space while GCing
 // => GCing didn't reclaim anything,
 // so we're really out of space
 error(#'malloc, "out of memory")
 | ptr_reg - n

fun malloc1(tag, a):
 memory[ptr_reg] := tag
 memory[ptr_reg + 1] := a
 incptr(2)

fun malloc2(tag, a, b):
 memory[ptr_reg] := tag
 memory[ptr_reg + 1] := a
 memory[ptr_reg + 2] := b
 incptr(3)

fun malloc3(tag, a, b, c):
 memory[ptr_reg] := tag
 memory[ptr_reg + 1] := a
 memory[ptr_reg + 2] := b
 memory[ptr_reg + 3] := c
 incptr(4)

fun malloc4(tag, a, b, c, d):
 memory[ptr_reg] := tag
 memory[ptr_reg + 1] := a
 memory[ptr_reg + 2] := b
 memory[ptr_reg + 3] := c
 memory[ptr_reg + 4] := d
 incptr(5)

fun ref(n, d):
 memory[n+d]

// Pointer in to space; objects before the
// pointer are "black", and object after are "gray"
def mutable updated_ptr_reg = 0

fun gc() :: Int:
 println("GCing")
 // Swap to and from space:
 from_memory := memory
 if memory === space1
 | memory := space2
 | memory := space1
 ptr_reg := 0
 // Update registers to start:
 v_reg := move(v_reg)
 env_reg := move(env_reg)
 k_reg := move(k_reg)
 result_reg := move(result_reg)
 updated_ptr_reg := 0
 // Loop until there are no gray objects:
 update()

fun update():
 if updated_ptr_reg == ptr_reg
 | // No more gray objects:
 from_memory := empty_memory
 result_reg
 | // updated-ptr points to first gray object:
 match ref(updated_ptr_reg, 0)
 | 0 || 15:
 // Record has just an integer
 done(1)
 | 1 || 3 || 5:
 // Record has two run-time pointers
 // in slots 2 and 3 (and an integer in 1)
 move_do(2)
 move_do(3)
 done(3)
 | 2 || 4 || 6 || 17:
 // Etc.
 move_do(1)
 move_do(2)
 done(2)
 | 16:
 move_do(2)
 done(2)
 | 21 || 22 || 23 || 24:
 // box continuations and values on have 1 pointer
 move_do(1)
 done(1)
 | 7:
 move_do(3)
 move_do(4)
 done(4)
// | ~else:
// error(#'update, "internal error, unknown tag: " +& ref(updated_ptr_reg, 0))

fun done(n):
 updated_ptr_reg := updated_ptr_reg + n + 1
 update()

// move_do :: Int -> Void
// Updates pointer at updated-ptr+n, moving the
// target as necessary:
fun move_do(n):
 memory[updated_ptr_reg + n] := move(memory[updated_ptr_reg + n])

// move :: Int -> Int
// If n refers to a white record, copy it to to-space and
// insert a forwarding pointer, so now it's gray
// If n refers to a gray/black record, return the forwarding
// pointer.
fun move(n):
 if from_memory[n] == 99
 | // Gray/black, get forwarded pointer:
 from_memory[n+1]
 | // White:
 match from_memory[n]
 | 0 || 15:
 // size 1
 from_memory[n+1] := malloc1(from_memory[n],
 from_memory[n+1])
 | 2 || 4 || 6 || 16 || 17:
 // size 2
 from_memory[n+1] := malloc2(from_memory[n],
 from_memory[n+1],
 from_memory[n+2])
 | 1 || 3 || 5:
 // size 3
 from_memory[n+1] := malloc3(from_memory[n],
 from_memory[n+1],
 from_memory[n+2],
 from_memory[n+3])
 | 7:
 // size 4
 from_memory[n+1] := malloc4(from_memory[n],
 from_memory[n+1],
 from_memory[n+2],
 from_memory[n+3],
 from_memory[n+4])
 | 21 || 22 || 23 || 24:
 // size 1
 from_memory[n+1] := malloc1(from_memory[n],
 from_memory[n+1])
// | ~else:
// error(#'move, "internal error, unknown tag: " +& from_memory[n])
 // Change to gray:
 from_memory[n] := 99
 // Return forwarding porter (that we just installed):
 from_memory[n+1]

// ----------------------------------------

def mutable exp_reg = 0
def mutable env_reg = 0

// interp :: (ExpD, Env, Cont) -> Value
fun interp():
 match code_ref(exp_reg, 0)
 | 8: // intD
 v_reg := malloc1(intV, code_ref(exp_reg, 1))
 continue()
 | 9: // atD
 env2_reg := env_reg
 n_reg := code_ref(exp_reg, 1)
 env_ref()
 | 10: // plusD
 k_reg := malloc3(plusSecondK, code_ref(exp_reg, 2), env_reg, k_reg)
 exp_reg := code_ref(exp_reg, 1)
 interp()
 | 11: // multD
 k_reg := malloc3(multSecondK, code_ref(exp_reg, 2), env_reg, k_reg)
 exp_reg := code_ref(exp_reg, 1)
 interp()
 | 12: // funD
 v_reg := malloc2(closV, code_ref(exp_reg, 1), env_reg)
 continue()
 | 13: // appD
 k_reg := malloc3(appArgK, code_ref(exp_reg, 2), env_reg, k_reg)
 exp_reg := code_ref(exp_reg, 1)
 interp()
 | 14: // if0D
 k_reg := malloc4(doIf0K, code_ref(exp_reg, 2), code_ref(exp_reg, 3), env_reg, k_reg)
 exp_reg := code_ref(exp_reg, 1)
 interp()
 | 18: // boxD
 exp_reg := code_ref(exp_reg, 1)
 k_reg := malloc1(boxK, k_reg)
 interp()
 | 19: // unboxD
 exp_reg := code_ref(exp_reg, 1)
 k_reg := malloc1(unboxK, k_reg)
 interp()
 | 20: // isBoxD
 exp_reg := code_ref(exp_reg, 1)
 k_reg := malloc1(isBoxK, k_reg)
 interp()
 | 25: // setBoxD
 k_reg := malloc3(boxValK,
 code_ref(exp_reg, 2),
 env_reg,
 k_reg)
 exp_reg := code_ref(exp_reg, 1)
 interp()
 | ~else: error(#'interp, "bad expression " +& code_ref(exp_reg, 0))

def mutable k_reg = 0
def mutable v_reg = 0

// continue :: (Cont, Value) -> Value
fun continue():
 match ref(k_reg, 0)
 | 0: // doneK
 v_reg
 | 1: // plusSecondK
 exp_reg := ref(k_reg, 1)
 env_reg := ref(k_reg, 2)
 k_reg := malloc2(doPlusK, v_reg, ref(k_reg, 3))
 interp()
 | 2: // doPlusK
 v_reg := num_plus(ref(k_reg, 1), v_reg)
 k_reg := ref(k_reg, 2)
 continue()
 | 3: // multSecondK
 exp_reg := ref(k_reg, 1)
 env_reg := ref(k_reg, 2)
 k_reg := malloc2(doMultK, v_reg, ref(k_reg, 3))
 interp()
 | 4: // doMultK
 v_reg := num_mult(ref(k_reg, 1), v_reg)
 k_reg := ref(k_reg, 2)
 continue()
 | 5: // appArgK
 exp_reg := ref(k_reg, 1)
 env_reg := ref(k_reg, 2)
 k_reg := malloc2(doAppK, v_reg, ref(k_reg, 3))
 interp()
 | 6: // doAppK
 exp_reg := ref(ref(k_reg, 1), 1)
 env_reg := malloc2(CONS, v_reg, ref(ref(k_reg, 1), 2))
 k_reg := ref(k_reg, 2)
 interp()
 | 7: // doIf0K
 if num_is_zero(v_reg)
 | exp_reg := ref(k_reg, 1)
 | exp_reg := ref(k_reg, 2)
 env_reg := ref(k_reg, 3)
 k_reg := ref(k_reg, 4)
 interp()
 | 22: // boxK
 v_reg := malloc1(boxV, v_reg)
 k_reg := ref(k_reg, 1)
 continue()
 | 23: // isBoxK
 if ref(v_reg, 0) == boxV
 | v_reg := malloc1(intV, 0)
 | v_reg := malloc1(intV, 1)
 k_reg := ref(k_reg, 1)
 continue()
 | 24: // unboxK
 v_reg := ref(v_reg, 1)
 k_reg := ref(k_reg, 1)
 continue()
 | 26: // boxValK
 exp_reg := ref(k_reg, 1)
 env_reg := ref(k_reg, 2)
 k_reg := malloc2(setBoxK, v_reg, k_reg)
 interp()
 | 27: // setBoxK
 // val: v_reg
 // box: k_reg+1
 memory[ref(k_reg, 1)] := v_reg
 k_reg := ref(k_reg, 2)
 continue()
 | ~else:
 error(#'continue, "bad continuation " +& ref(k_reg, 0))

fun num_op(op :: (Int, Int) -> Int):
 fun (l, r):
 malloc1(15, op(ref(l, 1), ref(r, 1)))
def num_plus = num_op(fun (a, b): a+b)
def num_mult = num_op(fun (a, b): a*b)

fun num_is_zero(v):
 ref(v, 1) == 0

def mutable env2_reg = 0
def mutable n_reg = 0

fun env_ref():
 if n_reg == 0
 | v_reg := ref(env2_reg, 1)
 continue()
 | env2_reg := ref(env2_reg, 2)
 n_reg := n_reg - 1
 env_ref()

// ----------------------------------------

fun init_k(): malloc1(0, 0)

fun interpx(a, env, k):
 exp_reg := a
 env_reg := env
 k_reg := k
 interp()

def empty_env = malloc1(0, 0)

macro 'N $check: $expr
 ~is $n':
 '$check: ref($expr, 1)
 ~is $n'

fun reset():
 code_ptr := 0
 ptr_reg := 0
 v_reg := 0
 exp_reg := 0
 k_reg := 0
 env_reg := 0
 result_reg := 0
 from_memory := empty_memory

module test:
 N check: interpx(compile(parse('2'), mt_env),
 empty_env,
 init_k())
 ~is 2
 reset()
 check: compile(parse('x'), mt_env)
 ~raises "free variable"
 reset()
 N check: interpx(compile(parse('2 + 1'), mt_env),
 empty_env,
 init_k())
 ~is 3
 reset()
 N check: interpx(compile(parse('2 * 1'), mt_env),
 empty_env,
 init_k())
 ~is 2
 reset()
 N check: interpx(compile(parse('(2 * 3) + (5 + 8)'), mt_env),
 empty_env,
 init_k())
 ~is 19
 reset()
 N check: interpx(compile(parse('(fun (x): x + x)(17)'),
 mt_env),
 empty_env,
 init_k())
 ~is 34
 reset()
 N check: interpx(compile(parse('let x = 5: x + x'),
 mt_env),
 empty_env,
 init_k())
 ~is 10
 reset()
 N check: interpx(compile(parse('let x = 5:
 let y = 6:
 x'),
 mt_env),
 empty_env,
 init_k())
 ~is 5
 reset()
 N check: interpx(compile(parse('(fun (x): x + x)(8)'),
 mt_env),
 empty_env,
 init_k())
 ~is 16
 reset()
 N check: interpx(compile(parse('if 0 == 0 | 1 | 2'),
 mt_env),
 empty_env,
 init_k())
 ~is 1
 reset()
 N check: interpx(compile(parse('if 1 == 0 | 1 | 2'),
 mt_env),
 empty_env,
 init_k())
 ~is 2
 reset()
 N check: interpx(compile(
 parse(
 'let mkrec = (fun (body_proc):
 (fun (fX):
 fX(fX))(fun (fX):
 body_proc(fun (x):
 fX(fX)(x)))):
 let fib = mkrec(fun (fib):
 fun (n):
 if n == 0:
 | 1
 | if (n + -1) == 0
 | 1
 | fib(n + -1) + fib(n + -2)):
 fib(4)'
 ),
 mt_env),
 empty_env,
 init_k())
 ~is 5

 // coverage for error cases:
 reset()
 check: block:
 def exp = compile(parse('1'), mt_env)
 interpx(exp + 1, empty_env, init_k())
 ~raises "bad expression"
 check: block:
 def exp = compile(parse('1'), mt_env)
 interpx(exp, empty_env, exp)
 ~raises "bad continuation"
 reset()
 check: interpx(compile(parse('let f = (fun (f): 1 + f(f)):
 f(f)'),
 mt_env),
 empty_env,
 init_k())
 ~raises "out of memory"

// Part 1
module test:
 reset()
 N check: interpx(compile(parse('unbox(unbox(box(box(3))))'),
 mt_env),
 empty_env,
 init_k())
 ~is 3

 reset()
 N check: interpx(compile(parse('is_box(3)'),
 mt_env),
 empty_env,
 init_k())
 ~is 1

 reset()
 N check: interpx(compile(parse('is_box(box(3))'),
 mt_env),
 empty_env,
 init_k())
 ~is 0

 reset()
 N check: interpx(compile(parse('is_box(fun (x): box(x))'),
 mt_env),
 empty_env,
 init_k())
 ~is 1
 reset()
 N check: interpx(compile(parse('unbox(box(unbox(box(5))))'),
 mt_env),
 empty_env,
 init_k())
 ~is 5
 reset()
 N check: interpx(compile(
 parse(
 'let mkrec = (fun (body_proc):
 (fun (fX):
 fX(fX))(fun (fX):
 body_proc(fun (x):
 fX(fX)(x)))):
 let chain = mkrec(fun (chain):
 fun (n):
 if n == 0
 | 1
 | box(chain(n + -1))):
 let unchain = mkrec(fun (unchain):
 fun (n):
 fun (b):
 if n == 0
 | b
 | unchain(n + -1)(unbox(b))):
 // Make a chain of boxes, then traverse them:
 unchain(13)(chain(13))'
 ),
 mt_env),
 empty_env,
 init_k())
 ~is 1

// Part 2 (Bonus Credit)
module test:
 reset()
 N check: interpx(compile(parse('set_box(box(5), 10)'),
 mt_env),
 empty_env,
 init_k())
 ~is 4
 reset()
 N check: interpx(compile(parse('let b = box(3):
 let dummy = set_box(b, 4):
 unbox(b)'),
 mt_env),
 empty_env,
 init_k())
 ~is 4

HW9

Difficulty: ★★★☆

Start with class_inherit.rhm, which combines class.rhm, inherit.rhm, and inherit_parse.rhm into a single file.

You may find it nicer to work with class.rhm, inherit.rhm, and inherit_parse.rhm as separate files, but you must combine them into a single file for handin. To combine the files: append them in the listed order, then remove the second and third #lang shplait lines and remove all import forms.

Part 1 — Instantiating `Object`

In the starting code, new Object() doesn’t work, even though Object is supposed to be a built-in class with no fields and no methods. Fix the implementation so that new Object() produces an instance of Object.

 check: interp_prog([],
'new Object()')
~is 'object'
check: interp_prog(['class Fish(size, color):
extends Object'],
'new Fish(1, 2)')
~is 'object'

Part 2 — Conditional via `select`

Add select:

 <Exp> = ...
| select <Exp>: <Exp>

The first expression in select should produce a number result, while the second expression should produce an object. If the number is 0, select calls the zero method of the object. If the number is not 0, select calls the nonzero method of the object. In each case, select calls the method with the argument 0. The select form has lowest precedence.

 check: interp_prog(['class Snowball(size):
extends Object
method zero(arg): this
method nonzero(arg):
new Snowball(1 + this.size)'],
'(select 0: new Snowball(1)).size')
~is '1'
check: interp_prog(['class Snowball(size):
extends Object
method zero(arg): this
method nonzero(arg):
new Snowball(1 + this.size)'],
'(select 1 + 2: new Snowball(1)).size')
~is '2'

The result is up to you when select gets a non-number result for its first subexpression, but a “not a number” error is sensible. Similarly, the result is up to you when the second subexpression’s result is not an object or does not have a zero or nonzero method.

You will probably find it easiest to extend and test the Exp layer, then the ExpI layer, and then the parse and interp_prog layer.

Part 3 — `instanceof`

Add is_a:

 <Exp> = ...
| <Exp> is_a <Sym>

An expression <Exp> is_a <Sym> produces 0 if the result of <Exp> is an object that is an instance of the class named by <Sym> or any of its subclasses. It should produce 1 if the result of <Exp> is any other object. Note that <Exp> is_a Object should produce 0 as long as the value of <Exp> is an object. The is_a operator’s precedence should be immediately lower than +.

Note that you will have to introduce a notion of superclasses into the Class layer, even though method inheritance remains the job of the ClassI layer.

Example:

 check: interp_prog(['class Fish(size, color):
extends Object'],
'new Fish(1, 2) is_a Object')
~is '0'
check: interp_prog(['class Fish(size, color):
extends Object'],
'new Object() is_a Fish')
~is '1'
check: interp_prog(['class Fish(size, color):
extends Object'],
'new Fish(1, 2) is_a Fish')
~is '0'
check: interp_prog(['class Fish(size, color):
extends Object',
'class Shark(teeth):
extends Fish'],
'new Shark(1, 2, 3) is_a Fish')
~is '0'
check: interp_prog(['class Fish(size, color):
extends Object',
'class Shark(teeth):
extends Fish',
'class Hammerhead():
extends Shark'],
'new Hammerhead(1, 2, 3) is_a Fish')
~is '0'
check: interp_prog(['class PlainFish(size):
extends Object',
'class ColorFish(color):
extends PlainFish',
'class Bear(size, color):
extends Object
method rate_food(arg):
(arg is_a ColorFish) + arg.color'],
'(new Bear(100, 5)).rate_food(new ColorFish(10, 3))')
~is '3'

The result is up to you if <Exp> in <Exp> is_a <Sym> does not produce an object or if <Sym> is not the name of a class.

Solution

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713


#lang shplait

// ----------------------------------------
// "class.rhm"

type Exp
| intE(n :: Int)
| plusE(lhs :: Exp,
 rhs :: Exp)
| multE(lhs :: Exp,
 rhs :: Exp)
| argE()
| thisE()
| newE(class_name :: Symbol,
 args :: Listof(Exp))
| getE(obj_exp :: Exp,
 field_name :: Symbol)
| isaE(exp :: Exp,
 class_name :: Symbol)
| selectE(left :: Exp,
 right :: Exp)
| sendE(obj_exp :: Exp,
 method_name :: Symbol,
 arg_exp :: Exp)
| ssendE(obj_exp :: Exp,
 class_name :: Symbol,
 method_name :: Symbol,
 arg_exp :: Exp)

type Class
| classC(super_name :: Symbol,
 field_names :: Listof(Symbol),
 methods :: Listof(Symbol * Exp))

type Value
| intV(n :: Int)
| objV(class_name :: Symbol,
 fields :: Listof(Value))

// ----------------------------------------

fun find(l :: Listof(Symbol * ?a), name :: Symbol) :: ?a:
 match l
 | []:
 error(#'find, "not found: " +& name)
 | cons(p, rst_l):
 if fst(p) == name
 | snd(p)
 | find(rst_l, name)

module test:
 check: find([values(#'a, 1)], #'a)
 ~is 1
 check: find([values(#'a, "apple")], #'a)
 ~is "apple"
 check: find([values(#'a, 1), values(#'b, 2)], #'b)
 ~is 2
 check: find([], #'a)
 ~raises "not found: a"
 check: find([values(#'a, 1)], #'x)
 ~raises "not found: x"

// ----------------------------------------

fun check_inherited(classes :: Listof(Symbol * Class), class_to_check :: (Symbol * Class), isa_class_name :: Symbol):
 if fst(class_to_check) == isa_class_name
 | #true
 | if fst(class_to_check) == #'Object
 | #false
 | match snd(class_to_check)
 | classC(super_name, field_names, methods):
 def parent = values(super_name, find(classes, super_name))
 check_inherited(classes, parent, isa_class_name)

def object_class: values(#'Object, classC(#'Object, [], []))
def interp :: (Exp, Listof(Symbol * Class), Value, Value) -> Value:
 fun (a, classes, this_val, arg_val):
 fun recur(exp):
 interp(exp, classes, this_val, arg_val)
 match a
 | intE(n): intV(n)
 | plusE(l, r): num_plus(recur(l), recur(r))
 | multE(l, r): num_mult(recur(l), recur(r))
 | thisE(): this_val
 | argE(): arg_val
 | newE(class_name, field_exps):
 def c = find(cons(object_class, classes), class_name)
 def vals = map(recur, field_exps)
 if length(vals) == length(classC.field_names(c))
 | objV(class_name, vals)
 | error(#'interp, "wrong field count")
 | isaE(exp, class_to_check):
 match recur(exp)
 | objV(class_name, fields):
 def classes_with_Object = cons(object_class, classes)
 def c = find(classes_with_Object, class_name)
 if check_inherited(classes_with_Object, values(class_name, c), class_to_check)
 | intV(0)
 | intV(1)
 | ~else: error(#'interp, "exp must resolve to objV")
 | selectE(left, right):
 match recur(left)
 | intV(n): def obj = recur(right)
 match obj
 | objV(class_name, fields):
 if n == 0
 | call_method(class_name, #'zero, classes, obj, intV(0))
 | call_method(class_name, #'nonzero, classes, obj, intV(0))
 | ~else: error(#'interp, "right exp must resolve to objV")
 | ~else: error(#'interp, "left exp must resolve to intV")
 | getE(obj_exp, field_name):
 match recur(obj_exp)
 | objV(class_name, fields):
 match find(classes, class_name)
 | classC(super_name, field_names, methods):
 find(map2(fun (n, v): values(n, v), field_names, fields),
 field_name)
 | ~else:
 error(#'interp, "not an object")
 | sendE(obj_exp, method_name, arg_exp):
 def obj = recur(obj_exp)
 def arg_val = recur(arg_exp)
 match obj
 | objV(class_name, fields):
 call_method(class_name, method_name, classes, obj, arg_val)
 | ~else:
 error(#'interp, "not an object")
 | ssendE(obj_exp, class_name, method_name, arg_exp):
 def obj = recur(obj_exp)
 def arg_val = recur(arg_exp)
 call_method(class_name, method_name, classes, obj, arg_val)

fun call_method(class_name, method_name, classes, obj, arg_val):
 match find(classes, class_name)
 | classC(super_name, field_names, methods):
 let body_exp = find(methods, method_name):
 interp(body_exp, classes, obj, arg_val)

fun num_op(op :: (Int, Int) -> Int, l :: Value, r :: Value) :: Value:
 cond
 | l is_a intV && r is_a intV:
 intV(op(intV.n(l), intV.n(r)))
 | ~else:
 error(#'interp, "not a number")
fun num_plus(l :: Value, r :: Value) :: Value:
 num_op(fun (a, b): a+b, l, r)
fun num_mult(l :: Value, r :: Value) :: Value:
 num_op(fun (a, b): a*b, l, r)

// ----------------------------------------
// Examples

module test:
 def posn_class:
 values(
 #'Posn,
 classC(#'Object,
 [#'x,#'y],
 [
 values(#'mdist,
 plusE(getE(thisE(), #'x), getE(thisE(), #'y))),
 values(#'addDist,
 plusE(sendE(thisE(), #'mdist, intE(0)),
 sendE(argE(), #'mdist, intE(0)))),
 values(#'addX,
 plusE(getE(thisE(), #'x), argE())),
 values(#'multY,
 multE(argE(), getE(thisE(), #'y))),
 values(#'factory12,
 newE(#'Posn, [intE(1), intE(2)]))
 ])
 )

 def posn3D_class:
 values(
 #'Posn3D,
 classC(#'Object,
 [#'x,#'y, #'z],
 [
 values(#'mdist,
 plusE(getE(thisE(), #'z),
 ssendE(thisE(), #'Posn, #'mdist, argE()))),
 values(#'addDist,
 ssendE(thisE(), #'Posn, #'addDist, argE()))
 ])
 )

 def posn27 = newE(#'Posn, [intE(2), intE(7)])
 def posn531 = newE(#'Posn3D, [intE(5), intE(3), intE(1)])
 fun interp_posn(a):
 interp(a, [posn_class, posn3D_class], intV(-1), intV(-1))

// ----------------------------------------

module test:
 check: interp(intE(10),
 [], objV(#'Object, []), intV(0))
 ~is intV(10)
 check: interp(plusE(intE(10), intE(17)),
 [], objV(#'Object, []), intV(0))
 ~is intV(27)
 check: interp(multE(intE(10), intE(7)),
 [], objV(#'Object, []), intV(0))
 ~is intV(70)
 check: interp_posn(newE(#'Posn, [intE(2), intE(7)]))
 ~is objV(#'Posn, [intV(2), intV(7)])

 check: interp_posn(sendE(posn27, #'mdist, intE(0)))
 ~is intV(9)

 check: interp_posn(sendE(posn27, #'addX, intE(10)))
 ~is intV(12)

 check: interp_posn(sendE(ssendE(posn27, #'Posn, #'factory12, intE(0)),
 #'multY,
 intE(15)))
 ~is intV(30)
 check: interp_posn(sendE(posn531, #'addDist, posn27))
 ~is intV(18)

 check: interp_posn(plusE(intE(1), posn27))
 ~raises "not a number"
 check: interp_posn(getE(intE(1), #'x))
 ~raises "not an object"
 check: interp_posn(sendE(intE(1), #'mdist, intE(0)))
 ~raises "not an object"
 check: interp_posn(newE(#'Posn, [intE(0)]))
 ~raises "wrong field count"

// ----------------------------------------
// "inherit.rhm"

type ExpI
| intI(n :: Int)
| plusI(lhs :: ExpI,
 rhs :: ExpI)
| multI(lhs :: ExpI,
 rhs :: ExpI)
| argI()
| thisI()
| newI(class_name :: Symbol,
 args :: Listof(ExpI))
| selectI(left :: ExpI,
 right :: ExpI)
| isaI(exp :: ExpI,
 class_name :: Symbol)
| getI(obj_exp :: ExpI,
 field_name :: Symbol)
| sendI(obj_exp :: ExpI,
 method_name :: Symbol,
 arg_exp :: ExpI)
| superI(method_name :: Symbol,
 arg_exp :: ExpI)

type ClassI
| classI(super_name :: Symbol,
 field_names :: Listof(Symbol),
 methods :: Listof(Symbol * ExpI))

// ----------------------------------------

fun exp_i_to_c(a :: ExpI, super_name :: Symbol) :: Exp:
 block:
 fun recur(exp):
 exp_i_to_c(exp, super_name)
 match a
 | intI(n): intE(n)
 | plusI(l, r): plusE(recur(l), recur(r))
 | multI(l, r): multE(recur(l), recur(r))
 | argI(): argE()
 | thisI(): thisE()
 | newI(class_name, field_exps):
 newE(class_name, map(recur, field_exps))
 | isaI(exp, sym):
 isaE(recur(exp), sym)
 | selectI(left, right):
 selectE(recur(left), recur(right))
 | getI(exp, field_name):
 getE(recur(exp), field_name)
 | sendI(exp, method_name, arg_exp):
 sendE(recur(exp), method_name, recur(arg_exp))
 | superI(method_name, arg_exp):
 ssendE(thisE(), super_name, method_name, recur(arg_exp))

module test:
 check: exp_i_to_c(intI(10), #'Object)
 ~is intE(10)
 check: exp_i_to_c(plusI(intI(10), intI(2)), #'Object)
 ~is plusE(intE(10), intE(2))
 check: exp_i_to_c(multI(intI(10), intI(2)), #'Object)
 ~is multE(intE(10), intE(2))
 check: exp_i_to_c(argI(), #'Object)
 ~is argE()
 check: exp_i_to_c(thisI(), #'Object)
 ~is thisE()
 check: exp_i_to_c (newI(#'Object, [intI(1)]), #'Object)
 ~is newE(#'Object, [intE(1)])
 check: exp_i_to_c(getI(intI(1), #'x), #'Object)
 ~is getE(intE(1), #'x)
 check: exp_i_to_c(sendI(intI(1), #'mdist, intI(2)), #'Object)
 ~is sendE(intE(1), #'mdist, intE(2))
 check: exp_i_to_c(superI(#'mdist, intI(2)), #'Posn)
 ~is ssendE(thisE(), #'Posn, #'mdist, intE(2))

// ----------------------------------------

fun class_i_to_c_not_flat(c :: ClassI) :: Class:
 match c
 | classI(super_name, field_names, methods):
 classC(super_name,
 field_names,
 map(fun (m):
 values(fst(m),
 exp_i_to_c(snd(m), super_name)),
 methods))
module test:
 def posn3d_mdist_i_method:
 values(#'mdist,
 plusI(getI(thisI(), #'z),
 superI(#'mdist, argI())))
 def posn3d_mdist_c_method:
 values(#'mdist,
 plusE(getE(thisE(), #'z),
 ssendE(thisE(), #'Posn, #'mdist, argE())))

 def posn3d_i_class:
 values(#'Posn3D,
 classI(#'Posn,
 [#'z],
 [posn3d_mdist_i_method]))
 def posn3d_c_class_not_flat:
 values(#'Posn3D,
 classC(#'Posn,
 [#'z],
 [posn3d_mdist_c_method]))

 check: class_i_to_c_not_flat(snd(posn3d_i_class))
 ~is snd(posn3d_c_class_not_flat)

// ----------------------------------------

fun flatten_class(name :: Symbol,
 classes_not_flat :: Listof(Symbol * Class),
 i_classes :: Listof(Symbol * ClassI)) :: Class:
 match find(classes_not_flat, name)
 | classC(original_super_name, field_names, methods):
 match flatten_super(name, classes_not_flat, i_classes)
 | classC(super_name, super_field_names, super_methods):
 classC(original_super_name,
 add_fields(super_field_names, field_names),
 add_or_replace_methods(super_methods, methods))

fun flatten_super(name :: Symbol,
 classes_not_flat :: Listof(Symbol * Class),
 i_classes :: Listof(Symbol * ClassI)) :: Class:
 match find(i_classes, name)
 | classI(super_name, field_names, i_methods):
 if super_name == #'Object
 | classC(super_name, [], [])
 | flatten_class(super_name, classes_not_flat, i_classes)

module test:
 def posn_i_class:
 values(#'Posn,
 classI(#'Object,
 [#'x, #'y],
 [values(#'mdist,
 plusI(getI(thisI(), #'x),
 getI(thisI(), #'y))),
 values(#'addDist,
 plusI(sendI(thisI(), #'mdist, intI(0)),
 sendI(argI(), #'mdist, intI(0))))]))
 def addDist_c_method:
 values(#'addDist,
 plusE(sendE(thisE(), #'mdist, intE(0)),
 sendE(argE(), #'mdist, intE(0))))
 def posn_c_class_not_flat:
 values(#'Posn,
 classC(#'Object,
 [#'x, #'y],
 [values(#'mdist,
 plusE(getE(thisE(), #'x),
 getE(thisE(), #'y))),
 addDist_c_method]))
 def posn3d_c_class:
 values(#'Posn3D,
 classC(#'Posn,
 [#'x, #'y, #'z],
 [posn3d_mdist_c_method,
 addDist_c_method]))

 check: flatten_class(#'Posn3D,
 [posn_c_class_not_flat,
 posn3d_c_class_not_flat],
 [posn_i_class,
 posn3d_i_class])
 ~is snd(posn3d_c_class)

// ----------------------------------------

def add_fields = append

fun add_or_replace_methods(methods :: Listof(Symbol * Exp),
 new_methods :: Listof(Symbol * Exp))
 :: (Listof (Symbol * Exp)):
 match new_methods
 | []: methods
 | cons(fst_method, rst_new_methods):
 add_or_replace_methods(add_or_replace_method(methods,
 fst_method),
 rst_new_methods)

fun add_or_replace_method(methods :: Listof(Symbol * Exp),
 new_method :: Symbol * Exp)
 :: (Listof (Symbol * Exp)):
 match methods
 | []: [new_method]
 | cons(fst_method, rst_methods):
 if fst(fst_method) == fst(new_method)
 | cons(new_method, rst_methods)
 | cons(fst_method,
 add_or_replace_method(rst_methods,
 new_method))

module test:
 check: add_fields([#'x, #'y], [#'z])
 ~is [#'x, #'y, #'z]

 check: add_or_replace_methods([], [])
 ~is []
 check: add_or_replace_methods([], [values(#'m, intE(0))])
 ~is [values(#'m, intE(0))]
 check: add_or_replace_methods([values(#'m, intE(0))], [])
 ~is [values(#'m, intE(0))]
 check: add_or_replace_methods([values(#'m, intE(0))],
 [values(#'m, intE(1))])
 ~is [values(#'m, intE(1))]
 check: add_or_replace_methods([values(#'m, intE(0)),
 values(#'n, intE(2))],
 [values(#'m, intE(1))])
 ~is [values(#'m, intE(1)),
 values(#'n, intE(2))]
 check: add_or_replace_methods([values(#'m, intE(0))],
 [values(#'m, intE(1)),
 values(#'n, intE(2))])
 ~is [values(#'m, intE(1)),
 values(#'n, intE(2))]

 check: add_or_replace_method([values(#'m, intE(0))],
 values(#'m, intE(1)))
 ~is [values(#'m, intE(1))]
 check: add_or_replace_method([values(#'m, intE(0))],
 values(#'n, intE(2)))
 ~is [values(#'m, intE(0)),
 values(#'n, intE(2))]

// ----------------------------------------

fun interp_i(i_a :: ExpI, i_classes :: Listof(Symbol * ClassI)) :: Value:
 block:
 def a = exp_i_to_c(i_a, #'Object)
 def classes_not_flat:
 map(fun (i): values(fst(i),
 class_i_to_c_not_flat(snd(i))),
 i_classes)
 def classes:
 map(fun (c):
 let name = fst(c):
 values(name,
 flatten_class(name, classes_not_flat, i_classes)),
 classes_not_flat)
 interp(a, classes, objV(#'Object, []), intV(0))

module test:
 check: interp_i(intI(0), [])
 ~is intV(0)

 check: interp_i(
 sendI(newI(#'Posn3D, [intI(5), intI(3), intI(1)]),
 #'addDist,
 newI(#'Posn, [intI(2), intI(7)])),
 [posn_i_class,
 posn3d_i_class]
 )
 ~is intV(18)

// ----------------------------------------
// "inherit_parse.rhm"

fun parse_class(s :: Syntax) :: (Symbol * ClassI):
 match s
 | 'class $name($field, ...):
 extends $parent_name
 $method
 ...':
 values(syntax_to_symbol(name),
 classI(syntax_to_symbol(parent_name),
 map(parse_field,
 syntax_to_list('[$field, ...]')),
 map(parse_method,
 syntax_to_list('[$method, ...]'))))
 | ~else: error(#'parse_class, "invalid input: " +& s)

fun parse_field(s :: Syntax) :: Symbol:
 cond
 | syntax_is_symbol(s):
 syntax_to_symbol(s)
 | ~else: error(#'parse_field, "invalid input: " +& s)

fun parse_method(s :: Syntax) :: (Symbol * ExpI):
 match s
 |'method $name(arg): $body':
 values(syntax_to_symbol(name),
 parse(body))
 | ~else: error(#'parse_method, "invalid input: " +& s)

fun parse(s :: Syntax) :: ExpI:
 cond
 | syntax_is_integer(s):
 intI(syntax_to_integer(s))
 | ~else:
 match s
 | 'arg': argI()
 | 'this': thisI()
 | '$exp is_a $sym':
 isaI(parse(exp), syntax_to_symbol(sym))
 | 'select $left : $right':
 selectI(parse(left), parse(right))
 | '$left + $right':
 plusI(parse(left),
 parse(right))
 | '$left * $right':
 multI(parse(left),
 parse(right))
 | 'new $id($arg, ...)':
 newI(syntax_to_symbol(id),
 map(parse, syntax_to_list('[$arg, ...]')))
 | 'super . $method_name ($arg)':
 superI(syntax_to_symbol(method_name),
 parse(arg))
 | '$obj . $method_name ($arg)':
 sendI(parse(obj),
 syntax_to_symbol(method_name),
 parse(arg))
 | '$obj . $field_name':
 getI(parse(obj),
 syntax_to_symbol(field_name))
 | '($e)':
 parse(e)
 | ~else:
 error(#'parse, "invalid input: " +& s)

module test:
 check: parse('0')
 ~is intI(0)
 check: parse('arg')
 ~is argI()
 check: parse('this')
 ~is thisI()
 check: parse('1 + 2')
 ~is plusI(intI(1), intI(2))
 check: parse('1 * 2')
 ~is multI(intI(1), intI(2))
 check: parse('new Posn(1, 2)')
 ~is newI(#'Posn, [intI(1), intI(2)])
 check: parse('this.x')
 ~is getI(thisI(), #'x)
 check: parse('this.m(2)')
 ~is sendI(thisI(), #'m, intI(2))
 check: parse('super.m(1)')
 ~is superI(#'m, intI(1))
 check: parse('x')
 ~raises "invalid input"

 check: parse_field('x')
 ~is #'x
 check: parse_field('x 1')
 ~raises "invalid input"

 check: parse_method('method m(arg): this')
 ~is values(#'m, thisI())
 check: parse_method('m(arg): 1 2')
 ~raises "invalid input"

 check: parse_class('class Posn3D(x, y, z):
 extends Posn
 method m1(arg): arg
 method m2(arg): this')
 ~is values(#'Posn3D,
 classI(#'Posn,
 [#'x, #'y, #'z],
 [values(#'m1, argI()),
 values(#'m2, thisI())]))
 check: parse_class('class')
 ~raises "invalid input"

// ----------------------------------------

fun interp_prog(classes :: Listof(Syntax), s :: Syntax) :: Syntax:
 let v = interp_i(parse(s),
 map(parse_class, classes)):
 match v
 | intV(n): integer_to_syntax(n)
 | objV(class_name, field_vals): 'object'

module test:
 check: interp_prog(
 ['class Empty():
 extends Object'],
 'new Empty()'
 )
 ~is 'object'

 check: interp_prog(
 ['class Posn(x, y):
 extends Object
 method mdist(arg): this.x + this.y
 method addDist(arg): arg.mdist(0) + this.mdist(0)',
 'class Posn3D(z):
 extends Posn
 method mdist(arg): this.z + super.mdist(arg)'],
 '(new Posn3D(5, 3, 1)).addDist(new Posn(2, 7))'
 )
 ~is '18'

// Part 1
module test:
 check: interp_prog([],
 'new Object()')
 ~is 'object'
 check: interp_prog(['class Fish(size, color):
 extends Object'],
 'new Fish(1, 2)')
 ~is 'object'


// Part 2
module test:
 check: interp_prog(['class Snowball(size):
 extends Object
 method zero(arg): this
 method nonzero(arg):
 new Snowball(1 + this.size)'],
 '(select 0: new Snowball(1)).size')
 ~is '1'
 check: interp_prog(['class Snowball(size):
 extends Object
 method zero(arg): this
 method nonzero(arg):
 new Snowball(1 + this.size)'],
 '(select 1 + 2: new Snowball(1)).size')
 ~is '2'

 // To cover the error cases
 check: interp_prog(['class Snowball(size):
 extends Object
 method zero(arg): this
 method nonzero(arg):
 new Snowball(1 + this.size)'],
 '(select (new Snowball(1)): new Snowball(1)).size')
 ~raises "left exp must resolve to intV"
 check: interp_prog(['class Snowball(size):
 extends Object
 method zero(arg): this
 method nonzero(arg):
 new Snowball(1 + this.size)'],
 '(select 1 + 2: 6)')
 ~raises "right exp must resolve to objV"

// Part 3
module test:
 check: interp_prog(['class Fish(size, color):
 extends Object'],
 'new Fish(1, 2) is_a Object')
 ~is '0'
 check: interp_prog(['class Fish(size, color):
 extends Object'],
 'new Object() is_a Fish')
 ~is '1'
 check: interp_prog(['class Fish(size, color):
 extends Object'],
 'new Fish(1, 2) is_a Fish')
 ~is '0'
 check: interp_prog(['class Fish(size, color):
 extends Object',
 'class Shark(teeth):
 extends Fish'],
 'new Shark(1, 2, 3) is_a Fish')
 ~is '0'
 check: interp_prog(['class Fish(size, color):
 extends Object',
 'class Shark(teeth):
 extends Fish',
 'class Hammerhead():
 extends Shark'],
 'new Hammerhead(1, 2, 3) is_a Fish')
 ~is '0'
 check: interp_prog(['class PlainFish(size):
 extends Object',
 'class ColorFish(color):
 extends PlainFish',
 'class Bear(size, color):
 extends Object
 method rate_food(arg):
 (arg is_a ColorFish) + arg.color'],
 '(new Bear(100, 5)).rate_food(new ColorFish(10, 3))')
 ~is '3'

 // To cover the error cases
 check: interp_prog(['class Fish(size, color):
 extends Object'],
 '5 is_a Object')
 ~raises "exp must resolve to objV"

HW10

Difficulty: ★★☆☆

Part 1 — `true`, `false`, `=`, and `if`

Start with typed_lambda.rhm.

The implementation already includes a Boolean type, but no expressions of Boolean type.

Add support for #true, #false, <Exp> == <Exp>, and if <Exp> | <Exp> | <Exp> expressions, where == produces a boolean given two numbers, and if requires a boolean expression for the test. The precedence of == should be just below +, and the precedence of if should be lowest.

Examples:

 check: interp(parse('if #true | 4 | 5'),
mt_env)
~is intV(4)
check: interp(parse('if #false | 4 | 5'),
mt_env)
~is intV(5)
check: interp(parse('if 13 == (if 1 == -1 + 2
| 12
| 13)
| 4
| 5'),
mt_env)
~is intV(5)
check: typecheck(parse('13 == (if 1 == -1 + 2
| 12
| 13)'),
mt_env)
~is boolT()
check: typecheck(parse('if 1 == -1 + 2
| fun (x :: Int): x + 1
| fun (y :: Int): y'),
mt_env)
~is arrowT(intT(), intT())
check: typecheck(parse('1 + if #true | #true | #false'),
mt_env)
~raises "no type"

Part 2 — Pairs

Implement pair(<Exp>, <Exp>), fst(<Exp>), and snd(<Exp>) expressions with the usual precedence, as well as <Type> * <Type> types where * in types has precedence just above ->. The relevant type rules are shown in video 9. These are eager pairs: pair evaluates its arguments eagerly.

Examples:

 check: interp(parse('pair(10, 8)'),
mt_env)
~is pairV(intV(10), intV(8))
check: interp(parse('fst(pair(10, 8))'),
mt_env)
~is intV(10)
check: interp(parse('snd(pair(10, 8))'),
mt_env)
~is intV(8)
check: interp(parse('let p :: Int * Int = pair(10, 8):
fst(p)'),
mt_env)
~is intV(10)
check: interp(parse('let f :: Int -> Int * Int
= (fun (n :: Int):
pair(n, n+1)):
snd(f(10))'),
mt_env)
~is intV(11)
check: interp(parse('let f :: Int * Boolean -> Int
= (fun (p :: Int * Boolean):
fst(p)):
f(pair(10, #false))'),
mt_env)
~is intV(10)
check: typecheck(parse('pair(10, 8)'),
mt_env)
~is crossT(intT(), intT())
check: typecheck(parse('fst(pair(10, 8))'),
mt_env)
~is intT()
check: typecheck(parse('snd(pair(10, 8))'),
mt_env)
~is intT()
check: typecheck(parse('let p :: Int * Int = pair(10, 8):
fst(p)'),
mt_env)
~is intT()
check: typecheck(parse('let f :: Int -> Int * Int
= (fun (n :: Int):
pair(n, n+1)):
snd(f(10))'),
mt_env)
~is intT()
check: typecheck(parse('let f :: Int * Boolean -> Int
= (fun (p :: Int * Boolean):
fst(p)):
f(pair(10, #false))'),
mt_env)
~is intT()
check: typecheck(parse('let f :: Int * Boolean -> Boolean
= (fun (p :: Int * Boolean):
snd(p)):
f(pair(10, #false))'),
mt_env)
~is boolT()
check: typecheck(parse('fun (x :: Int * Boolean):
if snd(x)
| fst(x)
| 0'),
mt_env)
~is arrowT(crossT(intT(), boolT()), intT())
check: typecheck(parse('fst(10)'),
mt_env)
~raises "no type"
check: typecheck(parse('1 + fst(pair(#false, 10))'),
mt_env)
~raises "no type"
check: typecheck(parse('fun (x :: Int * Boolean):
if fst(x)
| 1
| 2'),
mt_env)
~raises "no type"

Part 3 — Functions that Accept Multiple Arguments, Yet Again

With pairs, functions can accept multiple arguments by accepting paired values, but we can also add direct support for multiple arguments.

Change the interpreter to allow multiple function arguments and multiple arguments at function calls. The grammar of the language is now as follows:

 <Exp> = <Number>
| #true
| #false
| <Exp> + <Exp>
| <Exp> * <Exp>
| <Exp> == <Exp>
| <Symbol>
| if <Exp> | <Exp> | <Exp>
| fun (<Sym> :: <Type>, ...): <Exp>
| <Exp>(<Exp>, ...)
| let <Sym> :: <Type> = <Exp>: <Exp>
| pair(<Exp>, <Exp>)
| fst(<Exp>)
| snd(<Exp>)
| (<Exp>)
<Type> = Int
| Boolean
| <Type> -> <Type>
| (<Type>, ...) -> <Type>
| <Type> * <Type>
| (<Type>)

The <Type> -> <Type> type form is a shorthand for (<Type>) -> <Type> in the case of a single argument. In parse_type, match (<Type>, ...) -> <Type> before <Type> -> <Type>, because a pattern for the latter single-single case will also match the former multi-argument case.

Examples:

 check: interp(parse('(fun (): 10)()'),
mt_env)
~is intV(10)
check: interp(parse('(fun (x :: Int, y :: Int): x+y)(10, 20)'),
mt_env)
~is intV(30)
check: typecheck(parse('(fun (x :: Int, y :: Int): x+y)(10, 20)'),
mt_env)
~is intT()
check: typecheck(parse('(fun (x :: Int, y :: Boolean): y)(10, #false)'),
mt_env)
~is boolT()
check: typecheck(parse('(fun (x :: Int, y :: Boolean): y)(#false, 10)'),
mt_env)
~raises "no type"
check: typecheck(parse('(fun (): 10)(1, 2, 3)'),
mt_env)
~raises "no type"
check: typecheck(parse('let x :: Int = 4:
let f :: (Int, Int) -> Int
= (fun (y :: Int, z :: Int):
z + y):
f(x, x)'),
mt_env)
~is intT()
check: typecheck(parse('let x :: Int = 4:
let f :: (Boolean, Int) -> Int
= (fun (sel :: Boolean, z :: Int):
if sel | x | z):
f(x == 5, 0)'),
mt_env)
~is intT()

Solution

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655


#lang shplait

type Value
| intV(n :: Int)
| closV(args :: Listof(Symbol),
 body :: Exp,
 env :: Env)
| boolV(n :: Boolean)
| pairV(fst :: Value,
 snd :: Value)

type Exp
| intE(n :: Int)
| boolE(n :: Boolean)
| idE(s :: Symbol)
| plusE(l :: Exp,
 r :: Exp)
| multE(l :: Exp,
 r :: Exp)
| funE(ns :: Listof(Symbol),
 args_type :: Listof(Type),
 body :: Exp)
| appE(fn :: Exp,
 args :: Listof(Exp))
| ifE(exp :: Exp,
 true :: Exp,
 false :: Exp)
| equalE(left :: Exp,
 right :: Exp)
| pairE(fst :: Exp,
 snd :: Exp)
| fstE(exp :: Exp)
| sndE(exp :: Exp)

type Type
| intT()
| boolT()
| arrowT(args :: Listof(Type),
 result :: Type)
| crossT(fst :: Type,
 snd :: Type)

type Binding
| bind(name :: Symbol,
 val :: Value)

type Env = Listof(Binding)

type TypeBinding
| tbind(name :: Symbol,
 ty :: Type)

type TypeEnv = Listof(TypeBinding)

def mt_env = []
def extend_env = cons

fun parse_fun_args(args :: Listof(Syntax)) :: Listof(Symbol):
 match args
 | []: []
 | cons(arg, rest_args):
 match arg
 | '$arg_name :: $arg_type': cons(syntax_to_symbol(arg_name), parse_fun_args(rest_args))
 | ~else: error(#'parse, "invalid input")

fun parse_fun_args_types(args :: Listof(Syntax)) :: Listof(Type):
 match args
 | []: []
 | cons(arg, rest_args):
 match arg
 | '$arg_name :: $arg_type': cons(parse_type(arg_type), parse_fun_args_types(rest_args))
 | ~else: error(#'parse, "invalid input")

// There is no way to reach the error line without explicit call to parse_fun_args_types
module test:
 check: parse_fun_args(['a :: Int', 'b somethign'])
 ~raises "invalid input"
 check: parse_fun_args_types(['a :: Int', 'b somethign'])
 ~raises "invalid input"


// parse ----------------------------------------
fun parse(s :: Syntax) :: Exp:
 cond
 | syntax_is_integer(s):
 intE(syntax_to_integer(s))
 | syntax_is_symbol(s):
 idE(syntax_to_symbol(s))
 | ~else:
 match s
 | '#true': boolE(#true)
 | '#false': boolE(#false)
 | 'pair($fst, $snd)':
 pairE(parse(fst), parse(snd))
 | 'fst($exp)': fstE(parse(exp))
 | 'snd($exp)': sndE(parse(exp))
 | 'if $exp | $true | $false':
 ifE(parse(exp), parse(true), parse(false))
 | 'let $name :: $ty = $rhs:
 $body':
 appE(funE([syntax_to_symbol(name)],
 [parse_type(ty)],
 parse(body)),
 [parse(rhs)])
 | '$left == $right':
 equalE(parse(left), parse(right))
 | '$left + $right':
 plusE(parse(left),
 parse(right))
 | '$left * $right':
 multE(parse(left),
 parse(right))
 | 'fun ($args, ...): $body':
 funE(check_unique(parse_fun_args(syntax_to_list('[$args, ...]'))),
 parse_fun_args_types(syntax_to_list('[$args, ...]')),
 parse(body))
 | '$fn($args, ...)':
 appE(parse(fn),
 map(parse, syntax_to_list('[$args, ...]')))
 | '($e)':
 parse(e)
 | ~else:
 error(#'parse, "invalid input: " +& s)

fun check_unique(syms :: Listof(Symbol)):
 match syms
 | []: []
 | cons(sym, rst_syms):
 if member(sym, rst_syms)
 | error(#'parse, "bad syntax, duplicate argument: " +& sym)
 | cons(sym, check_unique(rst_syms))

fun parse_type(s :: Syntax) :: Type:
 match s
 | 'Int': intT()
 | 'Boolean': boolT()
 | '($args, ...) -> $result':
 arrowT(map(parse_type, syntax_to_list('[$args, ...]')),
 parse_type(result))
 | '$arg1 -> $arg2 -> $result':
 // make `->` right-associative
 parse_type('$arg1 -> ($arg2 -> $result)')
 | '$arg -> $result':
 arrowT([parse_type(arg)], parse_type(result))
 | '$fst * $snd': crossT(parse_type(fst), parse_type(snd))
 | '($ty)': parse_type(ty)
 | ~else: error(#'parse_type, "invalid input: " +& s)

module test:
 check: parse('2')
 ~is intE(2)
 check: parse('x')
 ~is idE(#'x)
 check: parse('2 + 1')
 ~is plusE(intE(2), intE (1))
 check: parse('3 * 4')
 ~is multE(intE(3), intE(4))
 check: parse('3 * 4 + 8')
 ~is plusE(multE(intE(3), intE(4)),
 intE(8))
 check: parse('fun (x :: Int): 9')
 ~is funE([#'x], [intT()], intE(9))
 check: parse('double(9)')
 ~is appE(idE(#'double), [intE(9)])
 check: parse('1 + double(9)')
 ~is plusE(intE(1),
 appE(idE(#'double), [intE(9)]))
 check: parse('3 * (4 + 8)')
 ~is multE(intE(3),
 plusE(intE(4), intE(8)))
 check: parse('let x :: Int = 1 + 2:
 y')
 ~is appE(funE([#'x],
 [intT()],
 idE(#'y)),
 [plusE(intE(1), intE(2))])
 check: parse('1 2')
 ~raises "invalid input"

 check: parse_type('Int')
 ~is intT()
 check: parse_type('Boolean')
 ~is boolT()
 check: parse_type('Int -> Boolean')
 ~is arrowT([intT()], boolT())
 check: parse_type('Int -> (Boolean -> Int)')
 ~is arrowT([intT()], arrowT([boolT()], intT()))
 check: parse_type('Int -> Boolean -> Int')
 ~is arrowT([intT()], arrowT([boolT()], intT()))
 check: parse_type('1')
 ~raises "invalid input"

fun extend_env_with_args(ns :: Listof(Symbol), args :: Listof(Value), env :: Env) :: Env:
 match ns
 | []:
 match args
 | []: env
 | cons(arg, rest_args): error(#'interp, "wrong number of args")
 | cons(n, rest_ns):
 match args
 | []: error(#'interp, "wrong number of args")
 | cons(arg, rest_args):
 extend_env_with_args(rest_ns,
 rest_args,
 extend_env(bind(n, arg), env))

// interp ----------------------------------------
fun interp(a :: Exp, env :: Env) :: Value:
 match a
 | intE(n): intV(n)
 | idE(s): lookup(s, env)
 | plusE(l, r): num_plus(interp(l, env), interp(r, env))
 | multE(l, r): num_mult(interp(l, env), interp(r, env))
 | funE(ns, arg_types, body): closV(ns, body, env)
 | appE(fn, args):
 match interp(fn, env)
 | closV(ns, body, c_env):
 interp(body,
 extend_env_with_args(ns,
 map(fun (a1): interp(a1, env), args),
 c_env))
 | ~else: error(#'interp, "not a function")
 | boolE(n): boolV(n)
 | ifE(exp, true, false):
 match interp(exp, env)
 | boolV(n): if n:
 | interp(true, env)
 | interp(false, env)
 | ~else: error(#'interp, "not a boolean")
 | equalE(left, right):
 match interp(left, env)
 | intV(leftV): match interp(right, env)
 | intV(rightV): boolV(leftV == rightV)
 | ~else: error(#'interp, "not an Int")
 | ~else: error(#'interp, "not an Int")
 | pairE(fst, snd):
 pairV(interp(fst, env), interp(snd, env))
 | fstE(exp):
 match interp(exp, env)
 | pairV(fst, second): fst
 | ~else: error(#'interp, "not a pair")
 | sndE(exp):
 match interp(exp, env)
 | pairV(fst, snd): snd
 | ~else: error(#'interp, "not a pair")

module test:
 check: interp(parse('2'), mt_env)
 ~is intV(2)
 check: interp(parse('x'), mt_env)
 ~raises "free variable"
 check: interp(parse('x'),
 extend_env(bind(#'x, intV(9)), mt_env))
 ~is intV(9)
 check: interp(parse('2 + 1'), mt_env)
 ~is intV(3)
 check: interp(parse('2 * 1'), mt_env)
 ~is intV(2)
 check: interp(parse('(2 * 3) + (5 + 8)'), mt_env)
 ~is intV(19)
 check: interp(parse('fun (x :: Int):
 x + x'),
 mt_env)
 ~is closV([#'x], plusE(idE(#'x), idE(#'x)), mt_env)
 check: interp(parse('let x :: Int = 5: x + x'),
 mt_env)
 ~is intV(10)
 check: interp(parse('let x :: Int = 5:
 let x :: Int = x + 1:
 x + x'),
 mt_env)
 ~is intV(12)
 check: interp(parse('let x :: Int = 5:
 let y :: Int = 6:
 x'),
 mt_env)
 ~is intV(5)
 check: interp(parse('(fun (x :: Int): x + x)(8)'),
 mt_env)
 ~is intV(16)
 check: interp(parse('1(2)'), mt_env)
 ~raises "not a function"
 check: interp(parse('1 + (fun (x :: Int): x)'), mt_env)
 ~raises "not a number"
 check: interp(parse('let bad :: Int -> Int = (fun (x :: Int):
 x + y):
 let y :: Int = 5:
 bad(2)'),
 mt_env)
 ~raises "free variable"

// num_plus and num_mult ----------------------------------------
fun num_op(op :: (Int, Int) -> Int, l :: Value, r :: Value) :: Value:
 cond
 | l is_a intV && r is_a intV:
 intV(op(intV.n(l), intV.n(r)))
 | ~else:
 error(#'interp, "not a number")
fun num_plus(l :: Value, r :: Value) :: Value:
 num_op(fun (a, b): a+b, l, r)
fun num_mult(l :: Value, r :: Value) :: Value:
 num_op(fun (a, b): a*b, l, r)

module test:
 check: num_plus(intV(1), intV(2))
 ~is intV(3)
 check: num_mult(intV(3), intV(2))
 ~is intV(6)

// lookup ----------------------------------------
fun make_lookup(get_name :: ?a -> Symbol, get_val :: ?a -> ?b):
 fun (n :: Symbol, env :: Listof(?a)) :: ?b:
 match env
 | []: error(#'lookup, "free variable")
 | cons(b, rst_env):
 cond
 | n == get_name(b):
 get_val(b)
 | ~else:
 make_lookup(get_name, get_val)(n, rst_env)

def lookup = make_lookup(bind.name, bind.val)

module test:
 check: lookup(#'x, mt_env)
 ~raises "free variable"
 check: lookup(#'x, extend_env(bind(#'x, intV(8)), mt_env))
 ~is intV(8)
 check: lookup(#'x, extend_env(bind(#'x, intV(9)),
 extend_env(bind(#'x, intV(8)),
 mt_env)))
 ~is intV(9)
 check: lookup(#'y, extend_env(bind(#'x, intV(9)),
 extend_env(bind(#'y, intV(8)),
 mt_env)))
 ~is intV(8)

fun check_arg_type_match(fn_arg_types :: Listof(Type), app_arg_types :: Listof(Type)):
 match fn_arg_types
 | []: match app_arg_types
 | []: #true
 | ~else: #false
 | cons(fn_arg_type, rest_fn_arg_types):
 match app_arg_types
 | []: #false
 | cons(app_arg_type, rest_app_arg_types):
 if fn_arg_type == app_arg_type:
 | check_arg_type_match(rest_fn_arg_types, rest_app_arg_types)
 | #false

fun extend_tenv_with_args(ns :: Listof(Symbol), args :: Listof(Type), tenv :: TypeEnv) :: TypeEnv:
 match ns
 | []:
 match args
 | []: tenv
 | cons(arg, rest_args): type_error(arg, "wrong number of args")
 | cons(n, rest_ns):
 match args
 | []: type_error(n, "wrong number of args")
 | cons(arg, rest_args):
 extend_tenv_with_args(rest_ns,
 rest_args,
 extend_env(tbind(n, arg), tenv))

module test:
 check: extend_tenv_with_args([#'a, #'b], [intT()], mt_env)
 ~raises "wrong number of args"
 check: extend_tenv_with_args([#'a], [intT(), intT()], mt_env)
 ~raises "wrong number of args"

// typecheck ----------------------------------------
fun typecheck(a :: Exp, tenv :: TypeEnv) :: Type:
 match a
 | intE(n): intT()
 | idE(n): type_lookup(n, tenv)
 | plusE(l, r): typecheck_nums(l, r, tenv)
 | multE(l, r): typecheck_nums(l, r, tenv)
 | funE(ns, arg_types, body):
 arrowT(arg_types,
 typecheck(body,
 extend_tenv_with_args(ns, arg_types, tenv)))
 | appE(fn, args):
 match typecheck(fn, tenv)
 | arrowT(arg_types, result_type):
 if check_arg_type_match(arg_types, map(fun (a1): typecheck(a1, tenv), args)):
 | result_type
 | type_error(arg_types, to_string(arg_types))
 | ~else: type_error(fn, "function")
 | boolE(n): boolT()
 | equalE(l, r):
 match typecheck(l, tenv)
 | intT():
 match typecheck(r, tenv)
 | intT(): boolT()
 | ~else: type_error(r, "num")
 | ~else: type_error(l, "num")
 | ifE(exp, true, false):
 match typecheck(exp, tenv)
 | boolT():
 def trueT = typecheck(true, tenv)
 def falseT = typecheck(false, tenv)
 if trueT == falseT:
 | trueT
 | type_error(false, "true and false not same")
 | ~else: type_error(exp, "bool")
 | pairE(fst, snd):
 crossT(typecheck(fst, tenv), typecheck(snd, tenv))
 | fstE(exp):
 match typecheck(exp, tenv)
 | crossT(fst, snd): fst
 | ~else: type_error(exp, "pair")
 | sndE(exp):
 match typecheck(exp, tenv)
 | crossT(fst, snd): snd
 | ~else: type_error(exp, "pair")

fun typecheck_nums(l, r, tenv):
 match typecheck(l, tenv)
 | intT():
 match typecheck(r, tenv)
 | intT():
 intT()
 | ~else: type_error(r, "num")
 | ~else: type_error(l, "num")

fun type_error(a, msg):
 error(#'typecheck, "no type: " +& a +& " not " +& msg)

def type_lookup: make_lookup(tbind.name, tbind.ty)

module test:
 check: typecheck(parse('10'), mt_env)
 ~is intT()
 check: typecheck(parse('10 + 17'), mt_env)
 ~is intT()
 check: typecheck(parse('10 * 17'), mt_env)
 ~is intT()
 check: typecheck(parse('fun (x :: Int): 12'), mt_env)
 ~is arrowT([intT()], intT())
 check: typecheck(parse('fun (x :: Int): fun (y :: Boolean): x'),
 mt_env)
 ~is arrowT([intT()], arrowT([boolT()], intT()))

 check: typecheck(parse('(fun (x :: Int): 12)(1 + 17)'),
 mt_env)
 ~is intT()

 check: typecheck(parse('let x :: Int = 4:
 let f :: (Int -> Int) = (fun (y :: Int):
 x + y):
 f(x)'),
 mt_env)
 ~is intT()

 check: typecheck(parse('1(2)'),
 mt_env)
 ~raises "no type"
 check: typecheck(parse('(fun (x :: Boolean): x)(2)'),
 mt_env)
 ~raises "no type"
 check: typecheck(parse('1 + (fun (x :: Int): x)'),
 mt_env)
 ~raises "no type"
 check: typecheck(parse('(fun (x :: Int): x) * 1'),
 mt_env)
 ~raises "no type"

// Part 1
module test:
 check: interp(parse('if #true | 4 | 5'),
 mt_env)
 ~is intV(4)
 check: interp(parse('if #false | 4 | 5'),
 mt_env)
 ~is intV(5)
 check: interp(parse('if 13 == (if 1 == -1 + 2
 | 12
 | 13)
 | 4
 | 5'),
 mt_env)
 ~is intV(5)
 check: typecheck(parse('13 == (if 1 == -1 + 2
 | 12
 | 13)'),
 mt_env)
 ~is boolT()
 check: typecheck(parse('if 1 == -1 + 2
 | fun (x :: Int): x + 1
 | fun (y :: Int): y'),
 mt_env)
 // This result may need to be adjusted after part 3:
 ~is arrowT([intT()], intT())
 check: typecheck(parse('1 + if #true | #true | #false'),
 mt_env)
 ~raises "no type"

 // To cover error cases in interp
 check: typecheck(parse('if #true | 4 | #false'), mt_env)
 ~raises "true and false not same"
 check: typecheck(parse('if 5 | #true | #false'), mt_env)
 ~raises "bool"
 check: typecheck(parse('#true == 5'), mt_env)
 ~raises "num"
 check: typecheck(parse('5 == #true'), mt_env)
 ~raises "num"

 check: interp(parse('if 5 | #true | #false'), mt_env)
 ~raises "not a boolean"
 check: interp(parse('#true == 5'), mt_env)
 ~raises "not an Int"
 check: interp(parse('5 == #true'), mt_env)
 ~raises "not an Int"

// Part 2
module test:
 check: interp(parse('pair(10, 8)'),
 mt_env)
 // Your constructor might be different than pairV:
 ~is pairV(intV(10), intV(8))
 check: interp(parse('fst(pair(10, 8))'),
 mt_env)
 ~is intV(10)
 check: interp(parse('snd(pair(10, 8))'),
 mt_env)
 ~is intV(8)
 check: interp(parse('let p :: Int * Int = pair(10, 8):
 fst(p)'),
 mt_env)
 ~is intV(10)
 check: interp(parse('let f :: Int -> Int * Int
 = (fun (n :: Int):
 pair(n, n+1)):
 snd(f(10))'),
 mt_env)
 ~is intV(11)
 check: interp(parse('let f :: Int * Boolean -> Int
 = (fun (p :: Int * Boolean):
 fst(p)):
 f(pair(10, #false))'),
 mt_env)
 ~is intV(10)

 check: typecheck(parse('pair(10, 8)'),
 mt_env)
 // Your constructor might be different than crossT:
 ~is crossT(intT(), intT())
 check: typecheck(parse('fst(pair(10, 8))'),
 mt_env)
 ~is intT()
 check: typecheck(parse('snd(pair(10, 8))'),
 mt_env)
 ~is intT()
 check: typecheck(parse('let p :: Int * Int = pair(10, 8):
 fst(p)'),
 mt_env)
 ~is intT()
 check: typecheck(parse('let f :: Int -> Int * Int
 = (fun (n :: Int):
 pair(n, n+1)):
 snd(f(10))'),
 mt_env)
 ~is intT()
 check: typecheck(parse('let f :: Int * Boolean -> Int
 = (fun (p :: Int * Boolean):
 fst(p)):
 f(pair(10, #false))'),
 mt_env)
 ~is intT()
 check: typecheck(parse('let f :: Int * Boolean -> Boolean
 = (fun (p :: Int * Boolean):
 snd(p)):
 f(pair(10, #false))'),
 mt_env)
 ~is boolT()
 check: typecheck(parse('fun (x :: Int * Boolean):
 if snd(x)
 | fst(x)
 | 0'),
 mt_env)
 // Your constructor might be different than crossT:
 ~is arrowT([crossT(intT(), boolT())], intT())

 check: typecheck(parse('fst(10)'),
 mt_env)
 ~raises "no type"
 check: typecheck(parse('1 + fst(pair(#false, 10))'),
 mt_env)
 ~raises "no type"
 check: typecheck(parse('fun (x :: Int * Boolean):
 if fst(x)
 | 1
 | 2'),
 mt_env)
 ~raises "no type"

 // To cover error cases
 check: typecheck(parse('fst(5)'), mt_env)
 ~raises "pair"
 check: typecheck(parse('snd(5)'), mt_env)
 ~raises "pair"
 check: interp(parse('fst(5)'), mt_env)
 ~raises "not a pair"
 check: interp(parse('snd(5)'), mt_env)
 ~raises "not a pair"

// Part 3
module test:
 check: interp(parse('(fun (): 10)()'),
 mt_env)
 ~is intV(10)
 check: interp(parse('(fun (x :: Int, y :: Int): x+y)(10, 20)'),
 mt_env)
 ~is intV(30)

 check: typecheck(parse('(fun (x :: Int, y :: Int): x+y)(10, 20)'),
 mt_env)
 ~is intT()
 check: typecheck(parse('(fun (x :: Int, y :: Boolean): y)(10, #false)'),
 mt_env)
 ~is boolT()

 check: typecheck(parse('(fun (x :: Int, y :: Boolean): y)(#false, 10)'),
 mt_env)
 ~raises "no type"
 check: typecheck(parse('(fun (): 10)(1, 2, 3)'),
 mt_env)
 ~raises "no type"

 check: typecheck(parse('let x :: Int = 4:
 let f :: (Int, Int) -> Int
 = (fun (y :: Int, z :: Int):
 z + y):
 f(x, x)'),
 mt_env)
 ~is intT()
 check: typecheck(parse('let x :: Int = 4:
 let f :: (Boolean, Int) -> Int
 = (fun (sel :: Boolean, z :: Int):
 if sel | x | z):
 f(x == 5, 0)'),
 mt_env)
 ~is intT()

 // To cover error cases
 check: typecheck(parse('(fun (x :: Int, y :: Int): 5)(5)'), mt_env)
 ~raises "no type"
 check: typecheck(parse('(fun (x :: Int): 5)(5, 6)'), mt_env)
 ~raises "no type"
 check: interp(parse('(fun (x :: Int, y :: Int): 5)(5)'), mt_env)
 ~raises "wrong number of args"
 check: interp(parse('(fun (x :: Int): 5)(5, 6)'), mt_env)
 ~raises "wrong number of args"
 check: parse('fun (x :: Int, x :: Int): 5')
 ~raises "bad syntax"

HW11

Difficulty: ★★☆☆

Start with hw11_starter.rhm, which is based on infer_lambda.rhm.

The language implemented by hw11_starter.rhm adds [], cons, first, and rest expressions to the language, and a Listof type constructor:

 <Exp> = <Number>
| <Exp> + <Exp>
| <Exp> * <Exp>
| <Symbol>
| fun (<Symbol> :: <Type>): <Exp>
| <Exp>(<Exp>)
| []
| cons(<Exp>, <Exp>)
| first(<Exp>)
| rest(<Exp>)
| (<Exp>)
<Type> = Int
| Boolean
| <Type> -> <Type>
| ?
| Listof(<Type>)
| (<Type>)

Only the interp part of the language is implemented so far. The typecheck part is incomplete (there are ....s), and your job will be to complete it. First, however, you’ll add if.

Your solution should not add any calls to resolve, except maybe in tests, because it’s not useful outside of the one place in unify. That is, the only call to resolve that’s not in a test should be the one that’s in unify in the starting code.

Part 1 — Inferring Conditional Types

Extend the language with an if form with its usual meaning and form constrained to == 0:

 <Exp> = ....
| if <Exp> == 0 | <Exp> | <Exp>

Also, add a run_prog function that takes a syntax object, parses it, typechecks it, and interprets it. If the parsed syntax has no type, run_prog should raise an expression including the words “no type.” Otherwise, the result from run_prog should be a syntax object: a syntax number if interp produces any number, the syntax object 'function' if interp produces a closure, or the syntax object 'list' if interp produces a list.

Examples:

 check: run_prog('if 0 == 0 | 1 | 2')
~is '1'
check: run_prog('if 3 == 0 | 1 | 2')
~is '2'
check: run_prog('if 2 == 0 | (fun (x :: ?): x) | (fun (x :: ?): 1 + x)')
~is 'function'
check: run_prog('if (fun (x :: ?): x) == 0 | 1 | 2')
~raises "no type"
check: run_prog('if 0 == 0 | (fun (x :: ?): x) | 2')
~raises "no type"
check: run_prog('let f :: ? = (fun (x :: ?):
fun (y :: ?):
fun (z :: ?):
if x == 0 | y | z):
f(1)(2)(3)')
~is '3'
check: run_prog('let f :: ? = (fun (x :: ?):
fun (y :: ?):
fun (z :: ?):
if x == 0
| y
| fun (x :: ?): z):
f(1)(fun (x :: Int): 2)(3)(4)')
~is '3'
check: run_prog('let f :: ? = (fun (x :: ?):
if x == 0 | x | x(1)):
f(1)')
~raises "no type"

Part 2 — Inferring List Types

Complete typecheck for lists. Your typecheck must ensure that an expression with a type never triggers a “not a list” or “not a number” error from interp, although an expression with a type may still trigger a “list is empty” error.

The Listof type constructor takes another type for the elements of a list. For example, the expression cons(1, []) should have type Listof(Int). Similarly, the expression cons(fun (x :: Int): x, []) should have type Listof(Int -> Int).

The expression [] can have type Listof(<Type>) for any <Type>. Similarly, cons should work on arguments of type <Type> and Listof(<Type>) for any <Type>, while first and rest work on an argument of type Listof(<Type>).

$$Γ ⊢ [] : Listof(τ)$$

$$\frac{Γ ⊢ e₁ : τ Γ ⊢ e₂ : Listof(τ)}{Γ ⊢ cons(e₁, e₂) : Listof(τ)}$$

$$\frac{Γ ⊢ e : Listof(τ)}{Γ ⊢ first(e) : τ}$$

$$\frac{Γ ⊢ e : Listof(τ)}{Γ ⊢ rest(e) : Listof(τ)}$$

A list is somewhat like a pair that you added to the language in HW 10, but it is treated differently by the type system. Note that type inference is needed for a plain [] expression form to make sense (or else we’d need one [] for every type of list element). Type-inferring and checking a first or rest expression will be similar to the application case, in that you’ll need to invent a type variable to stand for the list element’s type.

Examples:

 check: run_prog('[]')
~is 'list'
check: run_prog('cons(1, [])')
~is 'list'
check: run_prog('cons([], [])')
~is 'list'
check: run_prog('cons(1, cons([], []))')
~raises "no type"
check: run_prog('first(1)')
~raises "no type"
check: run_prog('rest(1)')
~raises "no type"
check: run_prog('first([])')
~raises "list is empty"
check: run_prog('rest([])')
~raises "list is empty"
check: run_prog('let f :: ? = (fun (x :: ?):
first(x)):
f(cons(1, [])) + 3')
~is '4'
check: run_prog('let f :: ? = (fun (x :: ?):
rest(x)):
first(f(cons(1, cons(2, [])))) + 3')
~is '5'
check: run_prog('let f :: ? = (fun (x :: ?):
fun (y :: ?):
cons(x, y)):
first(rest(f(1)(cons(2, []))))')
~is '2'
check: run_prog('fun (x :: ?):
cons(x, x)')
~raises "no type"
check: run_prog('let f :: ? = (fun (x :: ?): x):
cons(f(1), f([]))')
~raises "no type"

Solution

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642


#lang shplait

type Value
| intV(n :: Int)
| closV(arg :: Symbol,
 body :: Exp,
 env :: Env)
| listV(elems :: Listof(Value))

type Exp
| intE(n :: Int)
| idE(s :: Symbol)
| plusE(l :: Exp,
 r :: Exp)
| multE(l :: Exp,
 r :: Exp)
| funE(n :: Symbol,
 arg_type :: Type,
 body :: Exp)
| appE(fn :: Exp,
 arg :: Exp)
| emptyE()
| consE(l :: Exp,
 r :: Exp)
| firstE(arg :: Exp)
| restE(arg :: Exp)
| if0E(exp :: Exp,
 true :: Exp,
 false :: Exp)

type Type
| intT()
| boolT()
| arrowT(arg :: Type,
 result :: Type)
| varT(is :: Boxof(Optionof(Type)))
| listofT(elem :: Type)

type Binding
| bind(name :: Symbol,
 val :: Value)

type Env = Listof(Binding)

type TypeBinding
| tbind(name :: Symbol,
 ty :: Type)

type TypeEnv = Listof(TypeBinding)

def mt_env = []
def extend_env = cons

// parse ----------------------------------------
fun parse(s :: Syntax) :: Exp:
 cond
 | syntax_is_integer(s):
 intE(syntax_to_integer(s))
 | syntax_is_symbol(s):
 idE(syntax_to_symbol(s))
 | ~else:
 match s
 | '[]':
 emptyE()
 | 'if $exp == 0 | $true | $false':
 if0E(parse(exp), parse(true), parse(false))
 | 'let $name :: $ty = $rhs:
 $body':
 appE(funE(syntax_to_symbol(name),
 parse_type(ty),
 parse(body)),
 parse(rhs))
 | '$left + $right':
 plusE(parse(left),
 parse(right))
 | '$left * $right':
 multE(parse(left),
 parse(right))
 | 'fun ($id :: $ty): $body':
 funE(syntax_to_symbol(id),
 parse_type(ty),
 parse(body))
 | 'cons($left, $right)':
 consE(parse(left), parse(right))
 | 'first($arg)':
 firstE(parse(arg))
 | 'rest($arg)':
 restE(parse(arg))
 | '$fn($arg)':
 appE(parse(fn),
 parse(arg))
 | '($e)':
 parse(e)
 | ~else:
 error(#'parse, "invalid input: " +& s)

fun parse_type(s :: Syntax) :: Type:
 match s
 | '?': varT(box(none()))
 | 'Int': intT()
 | 'Boolean': boolT()
 | '$arg1 -> $arg2 -> $result':
 // make `->` right-associative
 parse_type('$arg1 -> ($arg2 -> $result)')
 | '$arg -> $result':
 arrowT(parse_type(arg), parse_type(result))
 | 'Listof($elem)':
 listofT(parse_type(elem))
 | '($ty)': parse_type(ty)
 | ~else: error(#'parse_type, "invalid input: " +& s)

module test:
 check: parse('2')
 ~is intE(2)
 check: parse('x')
 ~is idE(#'x)
 check: parse('2 + 1')
 ~is plusE(intE(2), intE (1))
 check: parse('3 * 4')
 ~is multE(intE(3), intE(4))
 check: parse('3 * 4 + 8')
 ~is plusE(multE(intE(3), intE(4)),
 intE(8))
 check: parse('fun (x :: Int): 9')
 ~is funE(#'x, intT(), intE(9))
 check: parse('double(9)')
 ~is appE(idE(#'double), intE(9))
 check: parse('1 + double(9)')
 ~is plusE(intE(1),
 appE(idE(#'double), intE(9)))
 check: parse('3 * (4 + 8)')
 ~is multE(intE(3),
 plusE(intE(4), intE(8)))
 check: parse('let x :: Int = 1 + 2:
 y')
 ~is appE(funE(#'x,
 intT(),
 idE(#'y)),
 plusE(intE(1), intE(2)))
 check: parse('[]')
 ~is emptyE()
 check: parse('cons([], [])')
 ~is consE(emptyE(), emptyE())
 check: parse('first([])')
 ~is firstE(emptyE())
 check: parse('rest([])')
 ~is restE(emptyE())
 check: parse('1 2')
 ~raises "invalid input"

 check: parse_type('Int')
 ~is intT()
 check: parse_type('Boolean')
 ~is boolT()
 check: parse_type('Int -> Boolean')
 ~is arrowT(intT(), boolT())
 check: parse_type('Int -> (Boolean -> Int)')
 ~is arrowT(intT(), arrowT(boolT(), intT()))
 check: parse_type('Int -> Boolean -> Int')
 ~is arrowT(intT(), arrowT(boolT(), intT()))
 check: parse_type('?')
 ~is varT(box(none()))
 check: parse_type('Listof(Int)')
 ~is listofT(intT())

 check: parse_type('1')
 ~raises "invalid input"

// interp ----------------------------------------
fun interp(a :: Exp, env :: Env) :: Value:
 match a
 | intE(n): intV(n)
 | idE(s): lookup(s, env)
 | plusE(l, r): num_plus(interp(l, env), interp(r, env))
 | multE(l, r): num_mult(interp(l, env), interp(r, env))
 | funE(n, arg_type, body): closV(n, body, env)
 | appE(fn, arg):
 match interp(fn, env)
 | closV(n, body, c_env):
 interp(body,
 extend_env(bind(n, interp(arg, env)),
 c_env))
 | ~else: error(#'interp, "not a function")
 | emptyE(): listV([])
 | consE(left, right):
 def v_l = interp(left, env)
 def v_r = interp(right, env)
 match v_r
 | listV(elems): listV(cons(v_l, elems))
 | ~else: error(#'interp, "not a list")
 | firstE(arg):
 match interp(arg, env)
 | listV(elems):
 match elems
 | []: error(#'interp , "list is empty")
 | cons(f, r): f
 | ~else: error(#'interp, "not a list")
 | restE(arg):
 match interp(arg, env)
 | listV(elems):
 match elems
 | []: error(#'interp , "list is empty")
 | cons(f, r): listV(r)
 | ~else: error(#'interp, "not a list")
 | if0E(exp, true, false):
 match interp(exp, env)
 | intV(n): if n == 0:
 | interp(true, env)
 | interp(false, env)
 | ~else: error(#'interp, "not a number")

module test:
 check: interp(parse('2'), mt_env)
 ~is intV(2)
 check: interp(parse('x'), mt_env)
 ~raises "free variable"
 check: interp(parse('x'),
 extend_env(bind(#'x, intV(9)), mt_env))
 ~is intV(9)
 check: interp(parse('2 + 1'), mt_env)
 ~is intV(3)
 check: interp(parse('2 * 1'), mt_env)
 ~is intV(2)
 check: interp(parse('(2 * 3) + (5 + 8)'), mt_env)
 ~is intV(19)
 check: interp(parse('fun (x :: Int):
 x + x'),
 mt_env)
 ~is closV(#'x, plusE(idE(#'x), idE(#'x)), mt_env)
 check: interp(parse('let x :: Int = 5: x + x'),
 mt_env)
 ~is intV(10)
 check: interp(parse('let x :: Int = 5:
 let x :: Int = x + 1:
 x + x'),
 mt_env)
 ~is intV(12)
 check: interp(parse('let x :: Int = 5:
 let y :: Int = 6:
 x'),
 mt_env)
 ~is intV(5)
 check: interp(parse('(fun (x :: Int): x + x)(8)'),
 mt_env)
 ~is intV(16)
 check: interp(parse('[]'), mt_env)
 ~is listV([])
 check: interp(parse('cons(1, [])'), mt_env)
 ~is listV([intV(1)])
 check: interp(parse('first(cons(1, []))'), mt_env)
 ~is intV(1)
 check: interp(parse('rest(cons(1, []))'), mt_env)
 ~is listV([])
 check: interp(parse('cons(1, 2)'), mt_env)
 ~raises "not a list"
 check: interp(parse('first(1)'), mt_env)
 ~raises "not a list"
 check: interp(parse('rest(2)'), mt_env)
 ~raises "not a list"
 check: interp(parse('first([])'), mt_env)
 ~raises "list is empty"
 check: interp(parse('rest([])'), mt_env)
 ~raises "list is empty"
 check: interp(parse('1(2)'), mt_env)
 ~raises "not a function"
 check: interp(parse('1 + (fun (x :: Int): x)'), mt_env)
 ~raises "not a number"
 check: interp(parse('let bad :: Int -> Int = (fun (x :: Int):
 x + y):
 let y :: Int = 5:
 bad(2)'),
 mt_env)
 ~raises "free variable"

// num_plus and num_mult ----------------------------------------
fun num_op(op :: (Int, Int) -> Int, l :: Value, r :: Value) :: Value:
 cond
 | l is_a intV && r is_a intV:
 intV(op(intV.n(l), intV.n(r)))
 | ~else:
 error(#'interp, "not a number")
fun num_plus(l :: Value, r :: Value) :: Value:
 num_op(fun (a, b): a+b, l, r)
fun num_mult(l :: Value, r :: Value) :: Value:
 num_op(fun (a, b): a*b, l, r)

module test:
 check: num_plus(intV(1), intV(2))
 ~is intV(3)
 check: num_mult(intV(3), intV(2))
 ~is intV(6)

// lookup ----------------------------------------
fun make_lookup(get_name :: ?a -> Symbol, get_val :: ?a -> ?b):
 fun (n :: Symbol, env :: Listof(?a)) :: ?b:
 match env
 | []: error(#'lookup, "free variable")
 | cons(b, rst_env):
 cond
 | n == get_name(b):
 get_val(b)
 | ~else:
 make_lookup(get_name, get_val)(n, rst_env)

def lookup = make_lookup(bind.name, bind.val)

module test:
 check: lookup(#'x, mt_env)
 ~raises "free variable"
 check: lookup(#'x, extend_env(bind(#'x, intV(8)), mt_env))
 ~is intV(8)
 check: lookup(#'x, extend_env(bind(#'x, intV(9)),
 extend_env(bind(#'x, intV(8)),
 mt_env)))
 ~is intV(9)
 check: lookup(#'y, extend_env(bind(#'x, intV(9)),
 extend_env(bind(#'y, intV(8)),
 mt_env)))
 ~is intV(8)


// typecheck ----------------------------------------
fun typecheck(a :: Exp, tenv :: TypeEnv) :: Type:
 match a
 | intE(n): intT()
 | idE(n): type_lookup(n, tenv)
 | plusE(l, r): typecheck_nums(l, r, tenv)
 | multE(l, r): typecheck_nums(l, r, tenv)
 | funE(n, arg_type, body):
 arrowT(arg_type,
 typecheck(body,
 extend_env(tbind(n, arg_type),
 tenv)))
 | appE(fn, arg):
 def result_type = varT(box(none()))
 unify(arrowT(typecheck(arg, tenv),
 result_type),
 typecheck(fn, tenv),
 fn)
 result_type
 | if0E(exp, true, false):
 unify(typecheck(exp, tenv), intT(), exp)
 def result_type = varT(box(none()))
 unify(typecheck(true, tenv), result_type, true)
 unify(typecheck(false, tenv), result_type, false)
 result_type
 | emptyE(): listofT(varT(box(none())))
 | consE(left, right):
 def rightT = typecheck(right, tenv)
 def leftT = typecheck(left, tenv)
 match rightT
 | listofT(rightElemT):
 unify(leftT, rightElemT, left)
 | varT(t):
 unify(listofT(leftT), rightT, left)
 | ~else: type_error(left, leftT, rightT)
 listofT(leftT)
 | firstE(arg): def argT = typecheck(arg, tenv)
 match argT
 | listofT(elemT): elemT
 | varT(t):
 def result_type = varT(box(none()))
 unify(argT, listofT(result_type), arg)
 result_type
 | ~else: error(#'typecheck, "no type")
 | restE(arg): def argT = typecheck(arg, tenv)
 match argT
 | listofT(elemT): listofT(elemT)
 | varT(t):
 def result_type = listofT(varT(box(none())))
 unify(argT, result_type, arg)
 result_type
 | ~else: error(#'typecheck, "no type")

fun typecheck_nums(l, r, tenv):
 unify(typecheck(l, tenv), intT(), l)
 unify(typecheck(r, tenv), intT(), r)
 intT()

def type_lookup: make_lookup(tbind.name, tbind.ty)

module test:
 check: typecheck(parse('10'), mt_env)
 ~is intT()
 check: typecheck(parse('10 + 17'), mt_env)
 ~is intT()
 check: typecheck(parse('10 * 17'), mt_env)
 ~is intT()
 check: typecheck(parse('fun (x :: Int): 12'), mt_env)
 ~is arrowT(intT(), intT())
 check: typecheck(parse('fun (x :: Int): fun (y :: Boolean): x'),
 mt_env)
 ~is arrowT(intT(), arrowT(boolT(), intT()))

 check: resolve(typecheck(parse('(fun (x :: Int): 12)(1 + 17)'),
 mt_env))
 ~is intT()

 check: resolve(typecheck(parse('let x :: Int = 4:
 let f :: (Int -> Int) = (fun (y :: Int):
 x + y):
 f(x)'),
 mt_env))
 ~is intT()

 check: typecheck(parse('1(2)'),
 mt_env)
 ~raises "no type"
 check: typecheck(parse('(fun (x :: Boolean): x)(2)'),
 mt_env)
 ~raises "no type"
 check: typecheck(parse('1 + (fun (x :: Int): x)'),
 mt_env)
 ~raises "no type"
 check: typecheck(parse('(fun (x :: Int): x) * 1'),
 mt_env)
 ~raises "no type"

// unify ----------------------------------------
fun unify(t1 :: Type, t2 :: Type, exp :: Exp):
 match t1
 | varT(is1):
 match unbox(is1)
 | some(t3): unify(t3, t2, exp)
 | none():
 let t3 = resolve(t2):
 if t1 === t3
 | #void
 | if occurs(t1, t3)
 | type_error(exp, t1, t3)
 | set_box(is1, some(t3))
 | ~else:
 match t2
 | varT(is2): unify(t2, t1, exp)
 | intT(): match t1
 | intT(): #void
 | ~else: type_error(exp, t1, t2)
 | boolT(): match t1
 | boolT(): #void
 | ~else: type_error(exp, t1, t2)
 | arrowT(a2, b2): match t1
 | arrowT(a1, b1):
 unify(a1, a2, exp)
 unify(b1, b2, exp)
 | ~else: type_error(exp, t1, t2)
 | listofT(e2): match t1
 | listofT(e1): unify(e1, e2, exp)
 | ~else: type_error(exp, t1, t2)

fun resolve(t :: Type) :: Type:
 match t
 | varT(is):
 match unbox(is)
 | none(): t
 | some(t2): resolve(t2)
 | ~else: t

fun occurs(r :: Type, t :: Type) :: Boolean:
 match t
 | intT(): #false
 | boolT(): #false
 | arrowT(a, b): occurs(r, a) || occurs(r, b)
 | varT(is):
 // `===` checks for the same box
 (r === t) || (match unbox(is)
 | none(): #false
 | some(t2): occurs(r, t2))
 | listofT(e): occurs(r, e)

fun type_error(a :: Exp, t1 :: Type, t2 :: Type):
 error(#'typecheck, "no type: "
 +& a
 +& " type " +& t1
 +& " vs. " +& t2)

module test:
 def a_type_var = varT(box(none()))
 def an_exp = intE(0)

 check: unify(intT(), intT(), an_exp)
 ~is #void
 check: unify(boolT(), boolT(), an_exp)
 ~is #void
 check: unify(arrowT(intT(), boolT()), arrowT(intT(), boolT()), an_exp)
 ~is #void
 check: unify(varT(box(some(boolT()))), boolT(), an_exp)
 ~is #void
 check: unify(boolT(), varT(box(some(boolT()))), an_exp)
 ~is #void
 check: unify(a_type_var, a_type_var, an_exp)
 ~is #void
 check: unify(a_type_var, varT(box(some(a_type_var))), an_exp)
 ~is #void

 check: block:
 def t = varT(box(none()))
 unify(t, boolT(), an_exp)
 unify(t, boolT(), an_exp)
 ~is #void

 check: unify(intT(), boolT(), an_exp)
 ~raises "no type"
 check: unify(intT(), arrowT(intT(), boolT()), an_exp)
 ~raises "no type"
 check: unify(arrowT(intT(), intT()), arrowT(intT(), boolT()), an_exp)
 ~raises "no type"
 check: block:
 def t = varT(box(none()))
 unify(t, boolT(), an_exp)
 unify(t, intT(), an_exp)
 ~raises "no type"
 check: unify(a_type_var, arrowT(a_type_var, boolT()), an_exp)
 ~raises "no type"
 check: unify(a_type_var, arrowT(boolT(), a_type_var), an_exp)
 ~raises "no type"

 check: resolve(a_type_var)
 ~is a_type_var
 check: resolve(varT(box(some(intT()))))
 ~is intT()

 check: occurs(a_type_var, a_type_var)
 ~is #true
 check: occurs(a_type_var, varT(box(none())))
 ~is #false
 check: occurs(a_type_var, varT(box(some(a_type_var))))
 ~is #true
 check: occurs(a_type_var, intT())
 ~is #false
 check: occurs(a_type_var, boolT())
 ~is #false
 check: occurs(a_type_var, arrowT(a_type_var, intT()))
 ~is #true
 check: occurs(a_type_var, arrowT(intT(), a_type_var))
 ~is #true

// Part 1

fun run_prog(exp :: Syntax):
 def ast = parse(exp)
 def ast_type = typecheck(ast, mt_env)
 match interp(ast, mt_env)
 | intV(n): integer_to_syntax(n)
 | closV(arg, body, c_env): 'function'
 | listV(elems): 'list'

module test:
 check: run_prog('if 0 == 0 | 1 | 2')
 ~is '1'

 check: run_prog('if 3 == 0 | 1 | 2')
 ~is '2'

 check: run_prog('if 2 == 0 | (fun (x :: ?): x) | (fun (x :: ?): 1 + x)')
 ~is 'function'

 check: run_prog('if (fun (x :: ?): x) == 0 | 1 | 2')
 ~raises "no type"

 check: run_prog('if 0 == 0 | (fun (x :: ?): x) | 2')
 ~raises "no type"

 check: run_prog('let f :: ? = (fun (x :: ?):
 fun (y :: ?):
 fun (z :: ?):
 if x == 0 | y | z):
 f(1)(2)(3)')
 ~is '3'

 check: run_prog('let f :: ? = (fun (x :: ?):
 fun (y :: ?):
 fun (z :: ?):
 if x == 0
 | y
 | fun (x :: ?): z):
 f(1)(fun (x :: Int): 2)(3)(4)')
 ~is '3'

 check: run_prog('let f :: ? = (fun (x :: ?):
 if x == 0 | x | x(1)):
 f(1)')
 ~raises "no type"

 // To cover all
 check: interp(parse('if (fun (x :: Int): x) == 0 | 0 | 1'), mt_env)
 ~raises "not a number"

// Part 2
module test:
 check: run_prog('[]')
 ~is 'list'

 check: run_prog('cons(1, [])')
 ~is 'list'
 check: run_prog('cons([], [])')
 ~is 'list'
 check: run_prog('cons(1, cons([], []))')
 ~raises "no type"

 check: run_prog('first(1)')
 ~raises "no type"
 check: run_prog('rest(1)')
 ~raises "no type"

 check: run_prog('first([])')
 ~raises "list is empty"
 check: run_prog('rest([])')
 ~raises "list is empty"

 check: run_prog('(fun (x :: ?): first(x))(cons(1, []))')
 ~is '1'

 check: run_prog('let f :: ? = (fun (x :: ?):
 first(x)):
 f(cons(1, [])) + 3')
 ~is '4'
 check: run_prog('let f :: ? = (fun (x :: ?):
 rest(x)):
 first(f(cons(1, cons(2, [])))) + 3')
 ~is '5'

 check: run_prog('(fun (x :: ?):
 fun (y :: ?):
 cons(x, y))(1)(cons(2, []))')
 ~is 'list'
 check: run_prog('let f :: ? = (fun (x :: ?):
 fun (y :: ?):
 cons(x, y)):
 first(rest(f(1)(cons(2, []))))')
 ~is '2'

 check: run_prog('fun (x :: ?):
 cons(x, x)')
 ~raises "no type"

 check: run_prog('let f :: ? = (fun (x :: ?): x):
 cons(f(1), f([]))')
 ~raises "no type"

 // To cover everything
 check: run_prog('cons(5, 6)')
 ~raises "no type"

Final Assignment

Submit your work by scheduling a meeting with an instructor on the sign-up spreadsheet, preferably at a time well before the final available date. You’ll show your code and answer questions in the meeting. You don’t need to hand in your code at all, other than showing it at the meeting.

Implementation

Start with the typed-class interpreter and typechecker: typed_parse.rhm, typed_class.rhm, inherit.rhm, inherit_parse.rhm, and class.rhm. Since you won’t use the “Handin” button to submit your work, there’s no need to collapse the modules into a single file.

Implement some of the following additions, which are of varying difficulty. Each addition is annotated by a star rating; implement enough additions so that the sum of the star ratings is:

CS 3520 students: at least 8 ★s
CS 6520 students: at least 10 ★s

Extra credit will be awarded for rating sums beyond the required level, where the extra-point value of an extra star will be 50% of the point value of a required star (e.g., 16 ★s would be 150% for a CS 3520 student).

The options are somewhat underspecified and open-ended, so you will need to make some reasonable choices and be ready to defend them, particularly with respect to whether your choices are sound (i.e., interpreter and type checker are consistent). The intent in most cases is to imitate Java, so you may find it useful to browse the Java Language Specification: https://docs.oracle.com/javase/specs/.

Options:

★	Task Description
★	1. Add a `(Symbol)ExpI` cast form to the language. At run-time, the cast expression reports an error if `ExpI` does not produce an instance of `Symbol` or one of its subclasses. Otherwise, the result is just the result of `ExpI`. The type checker must reject the expression if the type of `ExpI` is neither a subtype nor supertype of `Symbol`, and runtime checks must ensure the validity of the cast.
★★	2. Change type checking so that an overridden method’s result type can vary covariantly and its argument types can vary contravariantly. Provide tests that show how the new type checker soundly allows previously rejected programs and still rejects unsound ones.
★★	3. Add an `if ExpI == 0
★★	4. Add support for declaring `private` methods that can only be called via `this.` or `super.`. Other invocations should be statically rejected. Ensure private methods cannot be overridden by public ones and vice versa.
★★	5. Add a local-binding expression form like `let Symbol :: Type = ExpI: ExpI` with identifier support in expressions. Disallow `this` as a local variable or method argument.
★★	6. [Prerequisite: 5] Allow fields to be referenced directly within methods using the field name without `this.`. Implement shadowing for local variables and method arguments over field names.
★★	7. Add imperative field assignment (`ExpI.Symbol := ExpI`). Ensure the type checker guarantees safe assignments and include tests to show imperativeness.
★★	8. Add a Java-style `null` expression. Ensure `null` works with object types but raises runtime errors when accessed incorrectly. Type checkers should allow `null` as a method argument or field value.
★★	9. [Works with 7 and 8] Add support for constructors in class definitions, allowing both default and user-defined constructors. Include constructor behavior for subclasses and support default constructors.
★★★	10. [Prerequisite: 8] Add Java-style object arrays (`new Type[ExpI]`, `ExpI[ExpI]`, `ExpI[ExpI] := ExpI`). The typechecker must allow any type for arrays and ensure assignment operations are imperative.
★★	11. [Prerequisite: 10] Allow array-of-Type1 to be a subtype of array-of-Type2 when Type1 is a subtype of Type2. Implement runtime checks for subtyping array assignments.
★★★★	12. Add support for declaring `final` classes and optimize method calls that are definitely dispatched to a final method to static method calls instead of dynamic ones.
★★★★★	13. Add Java-style interfaces to the language. Implement support for subinterfaces and classes that implement interfaces, extending the type system to include interface names.
★★★★★★	14. Add Java-style overloading, allowing multiple methods with the same name but different argument types. Implement type-checking logic to handle overloading based on argument types.
★★★★★★	15. Add Java-style generics (parametric polymorphism) where classes are parameterized by types. Ignore support for generic methods or using a generic type directly as a type.

Solution

class.rhm

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456


#lang shplait

type Exp
| intE(n :: Int)
| plusE(lhs :: Exp,
 rhs :: Exp)
| multE(lhs :: Exp,
 rhs :: Exp)
| negE(n :: Exp)
| argE()
| thisE()
| idE(id :: Symbol)
| newE(class_name :: Symbol,
 args :: Listof(Exp))
| newArrayE(t :: Symbol,
 lens :: Listof(Exp))
| getE(obj_exp :: Exp,
 field_name :: Symbol)
| sendE(obj_exp :: Exp,
 method_name :: Symbol,
 arg_exp :: Exp)
| ssendE(obj_exp :: Exp,
 class_name :: Symbol,
 method_name :: Symbol,
 arg_exp :: Exp)
| castE(obj_exp :: Exp,
 class_name :: Symbol)
| if0E(exp :: Exp,
 true :: Exp,
 false :: Exp)
| setE(obj_exp :: Exp,
 field_name :: Symbol,
 right_exp :: Exp)
| letE(var :: Symbol,
 right :: Exp,
 body :: Exp)
| nullE()
| getArrayE(exp :: Exp,
 index :: Exp)
| setArrayE(exp :: Exp,
 index :: Exp,
 val :: Exp)

type Class
| classC(field_names :: Listof(Symbol),
 methods :: Listof(Symbol * Exp))

type Value
| intV(n :: Int)
| objV(class_name :: Symbol,
 fields :: Listof(Boxof(Value)))
| nullV()
| arrayV(val :: Listof(Boxof(Value)))

type Binding
| bind(name :: Symbol,
 val :: Value)

type Env = Listof(Binding)

def mt_env = []
def extend_env = cons

// ----------------------------------------

fun find(l :: Listof(Symbol * ?a), name :: Symbol) :: ?a:
 match l
 | []:
 error(#'find, "not found: " +& name)
 | cons(p, rst_l):
 if fst(p) == name
 | snd(p)
 | find(rst_l, name)

module test:
 check: find([values(#'a, 1)], #'a)
 ~is 1
 check: find([values(#'a, "apple")], #'a)
 ~is "apple"
 check: find([values(#'a, 1), values(#'b, 2)], #'b)
 ~is 2
 check: find([], #'a)
 ~raises "not found: a"
 check: find([values(#'a, 1)], #'x)
 ~raises "not found: x"

// ----------------------------------------

def interp :: (Exp, Listof(Symbol * Class), Value, Value, Env) -> Value:
 fun (a, classes, this_val, arg_val, env):
 fun recur(exp):
 interp(exp, classes, this_val, arg_val, env)
 match a
 | intE(n): intV(n)
 | plusE(l, r): num_plus(recur(l), recur(r))
 | multE(l, r): num_mult(recur(l), recur(r))
 | negE(e): match recur(e)
 | intV(n): intV(n * -1)
 | ~else: error(#'interp, "not a number")
 | idE(s): lookup(s, env)
 | thisE(): this_val
 | argE(): arg_val
 | newE(class_name, field_exps):
 def c = find(classes, class_name)
 def vals = map(recur, field_exps)
 if length(vals) == length(classC.field_names(c))
 | objV(class_name, map(box, vals))
 | error(#'interp, "wrong field count")
 | getE(obj_exp, field_name):
 match recur(obj_exp)
 | objV(class_name, fields):
 match find(classes, class_name)
 | classC(field_names, methods):
 unbox(find(map2(fun (n, v): values(n, v), field_names, fields),
 field_name))
 | ~else: error(#'interp, "not an object")
 | sendE(obj_exp, method_name, arg_exp):
 def obj = recur(obj_exp)
 def arg_val = recur(arg_exp)
 match obj
 | objV(class_name, fields):
 call_method(class_name, method_name, classes, obj, arg_val, env)
 | ~else:
 error(#'interp, "not an object")
 | ssendE(obj_exp, class_name, method_name, arg_exp):
 def obj = recur(obj_exp)
 def arg_val = recur(arg_exp)
 call_method(class_name, method_name, classes, obj, arg_val, env)
 | castE(obj_exp, cast_class_name):
 match recur(obj_exp)
 | objV(obj_class_name, fields):
 def cast_class = find(classes, cast_class_name)
 def cast_fields_len = length(classC.field_names(cast_class))
 objV(cast_class_name,
 get_n_sublist(fields, cast_fields_len))
 | intV(n): intV(n)
 | nullV(): if cast_class_name == #'null:
 | nullV()
 | error(#'interp, "cannot cast " +& obj_exp)
 | arrayV(vals): error(#'interp, "cannot cast " +& obj_exp)
 | if0E(exp, true, false):
 match recur(exp)
 | intV(n): if n == 0:
 | recur(true)
 | recur(false)
 | ~else: error(#'interp, "not a number")
 | setE(obj_exp, field_name, right_exp):
 match recur(obj_exp)
 | objV(class_name, fields):
 match find(classes, class_name)
 | classC(field_names, methods):
 set_box(find(map2(fun (n, v): values(n, v), field_names, fields),
 field_name),
 recur(right_exp))
 intV(0)
 | ~else: error(#'interp, "not an object")
 | letE(s, right, body):
 interp(body, classes, this_val, arg_val, extend_env(bind(s, recur(right)), env))
 | nullE(): nullV()
 | newArrayE(s, lens):
 def lens_vals = map(fun (len): match recur(len)
 | intV(n): if n >= 0:
 | n
 | error(#'interp, "length of array must be Positive")
 | ~else: error(#'interp, "length of array must be Int"),
 lens)

 if length(lens_vals) == 1:
 | arrayV(make_list(s, first(lens_vals)))
 | arrayV(do_n(fun (): box(recur(newArrayE(s, rest(lens)))),
 first(lens_vals)))
 | getArrayE(exp, index):
 match recur(exp)
 | arrayV(vals): match recur(index)
 | intV(n): if n < length(vals)
 | unbox(list_get(vals, n))
 | error(#'interp, "out of bound")
 | ~else: error(#'interp, "not an int")
 | ~else: error(#'interp, "not an array")
 | setArrayE(exp, index, val):
 match recur(exp)
 | arrayV(vals): match recur(index)
 | intV(n): if n < length(vals)
 | set_box(list_get(vals, n), recur(val))
 intV(0)
 | error(#'interp, "out of bound")
 | ~else: error(#'interp, "not an int")
 | ~else: error(#'interp, "not an array")


fun do_n(fn, n):
 if n == 0:
 | []
 | cons(fn(), do_n(fn, n-1))

fun make_list(t :: Symbol, len :: Int) :: Listof(Boxof(Value)):
 if len == 0:
 | []
 | if t == #'Int:
 | cons(box(intV(0)), make_list(t, len - 1))
 | cons(box(nullV()), make_list(t, len - 1))

fun last(list :: Listof(?a)) :: ?a:
 match list
 | []: error(#'last, "list is empty")
 | cons(elem, rest_elem):
 if length(rest_elem) == 0:
 | elem
 | last(rest_elem)

check: last([1, 2, 3])
 ~is 3
check: last([])
 ~raises "list is empty"

fun get_n_sublist(list :: Listof(?a), n :: Int) :: Listof(?a):
 match list
 | []: if n <= 0:
 | list
 | error(#'get_n_sublist, "not enough element")
 | cons(elem, elem_rest):
 if n <= 0:
 | []
 | cons(elem, get_n_sublist(elem_rest, n-1))

check: get_n_sublist([1, 2, 3, 4, 5], 0)
 ~is []
check: get_n_sublist([1, 2, 3, 4, 5], 2)
 ~is [1, 2]
check: get_n_sublist([1, 2, 3, 4, 5], 100)
 ~raises "not enough element"
check: get_n_sublist([1, 2, 3, 4, 5], -2)
 ~is []
check: get_n_sublist([intV(1), intV(2), intV(3), intV(4)], 2)
 ~is [intV(1), intV(2)]
check: get_n_sublist([], -2)
 ~is []

// lookup ----------------------------------------
fun make_lookup(get_name :: ?a -> Symbol, get_val :: ?a -> ?b):
 fun (n :: Symbol, env :: Listof(?a)) :: ?b:
 match env
 | []: error(#'lookup, "free variable " +& n)
 | cons(b, rst_env):
 cond
 | n == get_name(b):
 get_val(b)
 | ~else:
 make_lookup(get_name, get_val)(n, rst_env)

def lookup = make_lookup(bind.name, bind.val)

check: lookup(#'x, [bind(#'a, intV(5)), bind(#'x, intV(6))])
 ~is intV(6)
check: lookup(#'x, [bind(#'a, intV(5))])
 ~raises "free variable"

fun call_method(class_name, method_name, classes, obj, arg_val, env):
 match find(classes, class_name)
 | classC(field_names, methods):
 let body_exp = find(methods, method_name):
 interp(body_exp, classes, obj, arg_val, env)

fun num_op(op :: (Int, Int) -> Int, l :: Value, r :: Value) :: Value:
 cond
 | l is_a intV && r is_a intV:
 intV(op(intV.n(l), intV.n(r)))
 | ~else:
 error(#'interp, "not a number")
fun num_plus(l :: Value, r :: Value) :: Value:
 num_op(fun (a, b): a+b, l, r)
fun num_mult(l :: Value, r :: Value) :: Value:
 num_op(fun (a, b): a*b, l, r)

// ----------------------------------------
// Examples

module test:
 def posn_class:
 values(
 #'Posn,
 classC([#'x,#'y],
 [
 values(#'mdist,
 plusE(getE(thisE(), #'x), getE(thisE(), #'y))),
 values(#'addDist,
 plusE(sendE(thisE(), #'mdist, intE(0)),
 sendE(argE(), #'mdist, intE(0)))),
 values(#'addX,
 plusE(getE(thisE(), #'x), argE())),
 values(#'multY,
 multE(argE(), getE(thisE(), #'y))),
 values(#'factory12,
 newE(#'Posn, [intE(1), intE(2)]))
 ])
 )

 def posn3D_class:
 values(
 #'Posn3D,
 classC([#'x,#'y, #'z],
 [
 values(#'mdist,
 plusE(getE(thisE(), #'z),
 ssendE(thisE(), #'Posn, #'mdist, argE()))),
 values(#'addDist,
 ssendE(thisE(), #'Posn, #'addDist, argE()))
 ])
 )

 def posn27 = newE(#'Posn, [intE(2), intE(7)])
 def posn531 = newE(#'Posn3D, [intE(5), intE(3), intE(1)])
 fun interp_posn(a):
 interp(a, [posn_class, posn3D_class], intV(-1), intV(-1), mt_env)

// ----------------------------------------

module test:
 check: interp(intE(10),
 [], objV(#'Object, []), intV(0), mt_env)
 ~is intV(10)
 check: interp(plusE(intE(10), intE(17)),
 [], objV(#'Object, []), intV(0), mt_env)
 ~is intV(27)
 check: interp(multE(intE(10), intE(7)),
 [], objV(#'Object, []), intV(0), mt_env)
 ~is intV(70)
 check: interp_posn(newE(#'Posn, [intE(2), intE(7)]))
 ~is objV(#'Posn, [box(intV(2)), box(intV(7))])

 check: interp_posn(sendE(posn27, #'mdist, intE(0)))
 ~is intV(9)

 check: interp_posn(sendE(posn27, #'addX, intE(10)))
 ~is intV(12)

 check: interp_posn(sendE(ssendE(posn27, #'Posn, #'factory12, intE(0)),
 #'multY,
 intE(15)))
 ~is intV(30)
 check: interp_posn(sendE(posn531, #'addDist, posn27))
 ~is intV(18)

 check: interp_posn(plusE(intE(1), posn27))
 ~raises "not a number"
 check: interp_posn(getE(intE(1), #'x))
 ~raises "not an object"
 check: interp_posn(sendE(intE(1), #'mdist, intE(0)))
 ~raises "not an object"
 check: interp_posn(newE(#'Posn, [intE(0)]))
 ~raises "wrong field count"

// 1
module test:
 check: interp_posn(castE(posn531, #'Posn))
 ~is objV(#'Posn, [box(intV(5)), box(intV(3))])
 check: interp_posn(castE(intE(5), #'Int))
 ~is intV(5)

 check: interp_posn(negE(intE(1)))
 ~is intV(-1)
 check: interp_posn(negE(nullE()))
 ~raises "not a number"
 check: interp_posn(castE(nullE(), #'null))
 ~is nullV()

// 3
module test:
 check: interp(if0E(intE(10), intE(1), intE(0)), [], objV(#'Object, []), intV(0), mt_env)
 ~is intV(0)
 check: interp(if0E(intE(0), intE(1), intE(0)), [], objV(#'Object, []), intV(0), mt_env)
 ~is intV(1)
 check: interp_posn(if0E(posn531, intE(1), intE(0)))
 ~raises "not a number"

// 7
module test:
 check: interp_posn(letE(#'x, newE(#'Posn, [intE(2), intE(7)]), letE(#'y, setE(idE(#'x), #'x, intE(1)), getE(idE(#'x), #'x))))
 ~is intV(1)
 check: interp_posn(setE(intE(5), #'x, intE(10)))
 ~raises "not an object"

// 8
module test:
 check: interp_posn(nullE())
 ~is nullV()
 check: interp_posn(castE(nullE(), #'Posn))
 ~raises "cannot cast"
 check: interp_posn(castE(newArrayE(#'Int, [intE(0)]), #'Posn))
 ~raises "cannot cast"

// 10
module test:
 check: interp_posn(newArrayE(#'Int, [intE(0)]))
 ~is arrayV([])
 check: interp_posn(newArrayE(#'Posn, [intE(0)]))
 ~is arrayV([])
 check: interp_posn(newArrayE(#'Int, [intE(3)]))
 ~is arrayV([box(intV(0)), box(intV(0)), box(intV(0))])
 check: interp_posn(newArrayE(#'Posn, [intE(3)]))
 ~is arrayV([box(nullV()), box(nullV()), box(nullV())])
 check: interp_posn(newArrayE(#'Int, [intE(3), intE(2)]))
 ~is arrayV([
 box(arrayV([box(intV(0)), box(intV(0))])),
 box(arrayV([box(intV(0)), box(intV(0))])),
 box(arrayV([box(intV(0)), box(intV(0))]))
 ])
 check: interp_posn(newArrayE(#'Posn, [intE(3), intE(2)]))
 ~is arrayV([
 box(arrayV([box(nullV()), box(nullV())])),
 box(arrayV([box(nullV()), box(nullV())])),
 box(arrayV([box(nullV()), box(nullV())]))
 ])
 check: interp_posn(newArrayE(#'Posn, [intE(0), intE(10)]))
 ~is arrayV([])
 check: interp_posn(newArrayE(#'Posn, [intE(3), intE(-2)]))
 ~raises "length of array must be Positive"
 check: interp_posn(newArrayE(#'Posn, [intE(3), posn531]))
 ~raises "length of array must be Int"

 check: interp_posn(getArrayE(newArrayE(#'Posn, [intE(3), intE(2)]), intE(2)))
 ~is arrayV([box(nullV()), box(nullV())])
 check: interp_posn(getArrayE(newArrayE(#'Posn, [intE(3), intE(2)]), intE(3)))
 ~raises "out of bound"
 check: interp_posn(getArrayE(getArrayE(newArrayE(#'Posn, [intE(3), intE(2)]), intE(2)), intE(1)))
 ~is nullV()
 check: interp_posn(getArrayE(getArrayE(newArrayE(#'Posn, [intE(3), intE(2)]), intE(2)), posn27))
 ~raises "not an int"
 check: interp_posn(getArrayE(posn531, intE(2)))
 ~raises "not an array"

 check: interp_posn(letE(#'x,
 newArrayE(#'Posn, [intE(3)]),
 letE(#'y, setArrayE(idE(#'x), intE(1), posn27),
 getArrayE(idE(#'x), intE(1)))))
 ~is objV(#'Posn, [box(intV(2)), box(intV(7))])
 check: interp_posn(letE(#'x,
 newArrayE(#'Posn, [intE(3)]),
 letE(#'y, setArrayE(idE(#'x), intE(1), posn27),
 getArrayE(idE(#'x), intE(2)))))
 ~is nullV()
 check: interp_posn(letE(#'x,
 posn27,
 letE(#'y, setArrayE(idE(#'x), intE(1), posn27),
 getArrayE(idE(#'x), intE(2)))))
 ~raises "not an array"
 check: interp_posn(letE(#'x,
 newArrayE(#'Posn, [intE(3)]),
 letE(#'y, setArrayE(idE(#'x), intE(10), posn27),
 getArrayE(idE(#'x), intE(2)))))
 ~raises "out of bound"
 check: interp_posn(letE(#'x,
 newArrayE(#'Posn, [intE(3)]),
 letE(#'y, setArrayE(idE(#'x), posn27, posn27),
 getArrayE(idE(#'x), intE(2)))))
 ~raises "not an int"

inherit_parse.rhm

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263


#lang shplait
import:
 open:
 "class.rhm"
 "inherit.rhm"

// ----------------------------------------

fun parse_class(s :: Syntax) :: (Symbol * ClassI):
 match s
 | 'class $name($field, ...):
 extends $parent_name
 $method
 ...':
 values(syntax_to_symbol(name),
 classI(syntax_to_symbol(parent_name),
 map(parse_field,
 syntax_to_list('[$field, ...]')),
 map(parse_method,
 syntax_to_list('[$method, ...]'))))
 | ~else: error(#'parse_class, "invalid input: " +& s)

fun parse_field(s :: Syntax) :: Symbol:
 cond
 | syntax_is_symbol(s):
 syntax_to_symbol(s)
 | ~else: error(#'parse_field, "invalid input: " +& s)

fun parse_method(s :: Syntax) :: (Symbol * ExpI):
 match s
 |'method $name(arg): $body':
 values(syntax_to_symbol(name),
 parse(body))
 | ~else: error(#'parse_method, "invalid input: " +& s)

fun parse(s :: Syntax) :: ExpI:
 cond
 | syntax_is_integer(s):
 intI(syntax_to_integer(s))
 | syntax_is_symbol(s):
 match s:
 | 'arg': argI()
 | 'this': thisI()
 | 'null': nullI()
 | ~else: idI(syntax_to_symbol(s))
 | ~else:
 match s
 | 'if $exp == 0 | $true | $false':
 if0I(parse(exp), parse(true), parse(false))
 | 'let $(id :: Identifier) = $right:
 $body':
 letI(syntax_to_symbol(id), parse(right), parse(body))
 | '$left - $right':
 plusI(parse(left), negI(parse(right)))
 | '$left + $right':
 plusI(parse(left),
 parse(right))
 | '$left * $right':
 multI(parse(left),
 parse(right))
 | '- $exp':
 negI(parse(exp))
 | 'new $(id :: Identifier) [$flen] [$rlens] ...':
 newArrayI(syntax_to_symbol(id),
 map(parse, syntax_to_list('[$flen, $rlens, ...]')))
 | '$exp [$index] := $val':
 setArrayI(parse(exp), parse(index), parse(val))
 | '$exp [$index]':
 getArrayI(parse(exp), parse(index))
 | 'new $id($arg, ...)':
 newI(syntax_to_symbol(id),
 map(parse, syntax_to_list('[$arg, ...]')))
 | 'super . $method_name ($arg)':
 superI(syntax_to_symbol(method_name),
 parse(arg))
 | '$obj . $(field_name :: Identifier) := $exp':
 setI(parse(obj), syntax_to_symbol(field_name), parse(exp))
 | '$obj . $method_name ($arg)':
 sendI(parse(obj),
 syntax_to_symbol(method_name),
 parse(arg))
 | '$obj . $field_name':
 getI(parse(obj),
 syntax_to_symbol(field_name))
 | '($(id :: Identifier))$exp':
 castI(parse(exp), syntax_to_symbol(id))
 | '($e)':
 parse(e)
 | ~else:
 error(#'parse, "invalid input: " +& s)

module test:
 check: parse('0')
 ~is intI(0)
 check: parse('arg')
 ~is argI()
 check: parse('this')
 ~is thisI()
 check: parse('1 + 2')
 ~is plusI(intI(1), intI(2))
 check: parse('1 * 2')
 ~is multI(intI(1), intI(2))
 check: parse('new Posn(1, 2)')
 ~is newI(#'Posn, [intI(1), intI(2)])
 check: parse('this.x')
 ~is getI(thisI(), #'x)
 check: parse('this.m(2)')
 ~is sendI(thisI(), #'m, intI(2))
 check: parse('super.m(1)')
 ~is superI(#'m, intI(1))
 check: parse('x')
 ~is idI(#'x)
 check: parse('43 55')
 ~raises "invalid input"
 check: parse('5 - 2')
 ~is plusI(intI(5), negI(intI(2)))

 check: parse('new Posn[5][6+3]')
 ~is newArrayI(#'Posn, [intI(5), plusI(intI(6), intI(3))])
 check: parse('null')
 ~is nullI()

 check: parse_field('x')
 ~is #'x
 check: parse_field('x 1')
 ~raises "invalid input"

 check: parse_method('method m(arg): this')
 ~is values(#'m, thisI())
 check: parse_method('m(arg): 1 2')
 ~raises "invalid input"

 check: parse_class('class Posn3D(x, y, z):
 extends Posn
 method m1(arg): arg
 method m2(arg): this')
 ~is values(#'Posn3D,
 classI(#'Posn,
 [#'x, #'y, #'z],
 [values(#'m1, argI()),
 values(#'m2, thisI())]))
 check: parse_class('class')
 ~raises "invalid input"

// ----------------------------------------

fun interp_prog(classes :: Listof(Syntax), s :: Syntax) :: Syntax:
 let v = interp_i(parse(s),
 map(parse_class, classes), mt_env):
 match v
 | intV(n): integer_to_syntax(n)
 | objV(class_name, field_vals): 'object'
 | nullV(): 'null'
 | arrayV(vals): 'array'

module test:
 check: interp_prog(
 ['class Empty():
 extends Object'],
 'new Empty()'
 )
 ~is 'object'

 check: interp_prog(
 ['class Posn(x, y):
 extends Object
 method mdist(arg): this.x + this.y
 method addDist(arg): arg.mdist(0) + this.mdist(0)',
 'class Posn3D(z):
 extends Posn
 method mdist(arg): this.z + super.mdist(arg)'],
 '(new Posn3D(5, 3, 1)).addDist(new Posn(2, 7))'
 )
 ~is '18'

// 1
module test:
 def class_syntaxes = ['class Posn(x, y):
 extends Object
 method mdist(arg): this.x + this.y
 method addDist(arg): arg.mdist(0) + this.mdist(0)',
 'class Posn3D(z):
 extends Posn
 method mdist(arg): this.z + super.mdist(arg)',
 'class A():
 extends Object',
 'class B():
 extends A',
 'class C():
 extends B',
 'class D():
 extends A',
 'class E():
 extends Object']
 check: interp_prog(class_syntaxes, '((Posn)new Posn3D(2, 3, 4)).x')
 ~is '2'
 check: interp_prog(class_syntaxes, '((Posn)new Posn3D(2, 3, 4)).z')
 ~raises "not found"
 check: interp_prog(class_syntaxes, '((Posn3D)new Posn(2, 3)).x')
 ~raises "not enough element"
 check: interp_prog(class_syntaxes, '((Int)new Posn3D(2, 3, 4))')
 ~raises "not found"

 check: interp_prog(class_syntaxes, 'if 5 == 0 | 5 | 10')
 ~is '10'


// 7
module test:
 check: interp_prog(class_syntaxes,
 'let x = 5:
 x')
 ~is '5'
 check: interp_prog(class_syntaxes,
 'let x = new Posn(1, 2):
 let _ = x.x := (- 5):
 x.x + x.y')
 ~is '-3'
 check: interp_prog(['class X(a):
 extends Object',
 'class Y(b):
 extends X'],
 'let y = new Y(0, new X(5)):
 let _ = y.b := new X(1):
 y.b')
 ~is 'object'


// 10
module test:
 check: interp_prog(class_syntaxes,
 'let x = new Posn[3][2]:
 x')
 ~is 'array'


 check: interp_prog(class_syntaxes,
 'let x = new Posn[3]:
 let _ = x[0] := new Posn(0, 0):
 let _ = x[1] := new Posn(1, 1):
 x[0]')
 ~is 'object'
 check: interp_prog(class_syntaxes,
 'let x = new Posn[3]:
 let _ = x[0] := new Posn(0, 0):
 let _ = x[1] := new Posn(1, 1):
 x[2]')
 ~is 'null'
 check: interp_prog(class_syntaxes,
 'let x = new Posn[3]:
 let _ = x[0] := new Posn(0, 0):
 let _ = x[1] := new Posn(1, 1):
 x[5]')
 ~raises "out of bound"
 check: interp_prog(class_syntaxes,
 'let x = new Posn[3][2]:
 let _ = x[0][0] := new Posn(0, 0):
 let _ = x[1][1] := new Posn(1, 1):
 x[0][0]')
 ~is 'object'

inherit.rhm

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308


#lang shplait

// Make all "class.rhm" definitions available here, where
// the "class.rhm" file must be in the same directory
// as this one:
import:
 open: "class.rhm"

type ExpI
| intI(n :: Int)
| idI(s :: Symbol)
| negI(e :: ExpI)
| nullI()
| plusI(lhs :: ExpI,
 rhs :: ExpI)
| multI(lhs :: ExpI,
 rhs :: ExpI)
| argI()
| thisI()
| newI(class_name :: Symbol,
 args :: Listof(ExpI))
| getI(obj_exp :: ExpI,
 field_name :: Symbol)
| sendI(obj_exp :: ExpI,
 method_name :: Symbol,
 arg_exp :: ExpI)
| superI(method_name :: Symbol,
 arg_exp :: ExpI)
| castI(exp :: ExpI,
 id :: Symbol)
| if0I(exp :: ExpI,
 true :: ExpI,
 false :: ExpI)
| letI(s :: Symbol,
 right :: ExpI,
 body :: ExpI)
| setI(obj :: ExpI,
 s :: Symbol,
 val :: ExpI)
| newArrayI(t :: Symbol,
 lens :: Listof(ExpI))
| getArrayI(array :: ExpI,
 index :: ExpI)
| setArrayI(array :: ExpI,
 index :: ExpI,
 val :: ExpI)

type ClassI
| classI(super_name :: Symbol,
 field_names :: Listof(Symbol),
 methods :: Listof(Symbol * ExpI))

// ----------------------------------------

fun exp_i_to_c(a :: ExpI, super_name :: Symbol) :: Exp:
 block:
 fun recur(exp):
 exp_i_to_c(exp, super_name)
 match a
 | intI(n): intE(n)
 | nullI(): nullE()
 | idI(s): idE(s)
 | negI(e): negE(recur(e))
 | plusI(l, r): plusE(recur(l), recur(r))
 | multI(l, r): multE(recur(l), recur(r))
 | argI(): argE()
 | thisI(): thisE()
 | newI(class_name, field_exps):
 newE(class_name, map(recur, field_exps))
 | getI(exp, field_name):
 getE(recur(exp), field_name)
 | sendI(exp, method_name, arg_exp):
 sendE(recur(exp), method_name, recur(arg_exp))
 | superI(method_name, arg_exp):
 ssendE(thisE(), super_name, method_name, recur(arg_exp))
 | castI(exp, id):
 castE(recur(exp), id)
 | if0I(exp, true, false):
 if0E(recur(exp), recur(true), recur(false))
 | letI(s, right, body):
 letE(s, recur(right), recur(body))
 | setI(obj, s, val):
 setE(recur(obj), s, recur(val))
 | newArrayI(s, lens):
 newArrayE(s, map(recur, lens))
 | getArrayI(exp, index):
 getArrayE(recur(exp), recur(index))
 | setArrayI(exp, index, val):
 setArrayE(recur(exp), recur(index), recur(val))

module test:
 check: exp_i_to_c(intI(10), #'Object)
 ~is intE(10)
 check: exp_i_to_c(plusI(intI(10), intI(2)), #'Object)
 ~is plusE(intE(10), intE(2))
 check: exp_i_to_c(multI(intI(10), intI(2)), #'Object)
 ~is multE(intE(10), intE(2))
 check: exp_i_to_c(argI(), #'Object)
 ~is argE()
 check: exp_i_to_c(thisI(), #'Object)
 ~is thisE()
 check: exp_i_to_c (newI(#'Object, [intI(1)]), #'Object)
 ~is newE(#'Object, [intE(1)])
 check: exp_i_to_c(getI(intI(1), #'x), #'Object)
 ~is getE(intE(1), #'x)
 check: exp_i_to_c(sendI(intI(1), #'mdist, intI(2)), #'Object)
 ~is sendE(intE(1), #'mdist, intE(2))
 check: exp_i_to_c(superI(#'mdist, intI(2)), #'Posn)
 ~is ssendE(thisE(), #'Posn, #'mdist, intE(2))
 check: exp_i_to_c(castI(intI(5), #'Int), #'Object)
 ~is castE(intE(5), #'Int)
 check: exp_i_to_c(if0I(intI(0), intI(1), intI(2)), #'Object)
 ~is if0E(intE(0), intE(1), intE(2))
 check: exp_i_to_c(letI(#'a, intI(0), intI(1)), #'Object)
 ~is letE(#'a, intE(0), intE(1))
 check: exp_i_to_c(setI(intI(0), #'a, intI(1)), #'Object)
 ~is setE(intE(0), #'a, intE(1))
 check: exp_i_to_c(idI(#'a), #'Object)
 ~is idE(#'a)
 check: exp_i_to_c(nullI(), #'Object)
 ~is nullE()
 check: exp_i_to_c(negI(intI(5)), #'Object)
 ~is negE(intE(5))
 check: exp_i_to_c(newArrayI(#'Posn, [intI(5)]), #'Object)
 ~is newArrayE(#'Posn, [intE(5)])
 check: exp_i_to_c(getArrayI(intI(5), intI(5)), #'Object)
 ~is getArrayE(intE(5), intE(5))
 check: exp_i_to_c(setArrayI(intI(5), intI(5), intI(1)), #'Object)
 ~is setArrayE(intE(5), intE(5), intE(1))

// ----------------------------------------

fun class_i_to_c_not_flat(c :: ClassI) :: Class:
 match c
 | classI(super_name, field_names, methods):
 classC(field_names,
 map(fun (m):
 values(fst(m),
 exp_i_to_c(snd(m), super_name)),
 methods))
module test:
 def posn3d_mdist_i_method:
 values(#'mdist,
 plusI(getI(thisI(), #'z),
 superI(#'mdist, argI())))
 def posn3d_mdist_c_method:
 values(#'mdist,
 plusE(getE(thisE(), #'z),
 ssendE(thisE(), #'Posn, #'mdist, argE())))

 def posn3d_i_class:
 values(#'Posn3D,
 classI(#'Posn,
 [#'z],
 [posn3d_mdist_i_method]))
 def posn3d_c_class_not_flat:
 values(#'Posn3D,
 classC([#'z],
 [posn3d_mdist_c_method]))

 check: class_i_to_c_not_flat(snd(posn3d_i_class))
 ~is snd(posn3d_c_class_not_flat)

// ----------------------------------------

fun flatten_class(name :: Symbol,
 classes_not_flat :: Listof(Symbol * Class),
 i_classes :: Listof(Symbol * ClassI)) :: Class:
 match find(classes_not_flat, name)
 | classC(field_names, methods):
 match flatten_super(name, classes_not_flat, i_classes)
 | classC(super_field_names, super_methods):
 classC(add_fields(super_field_names, field_names),
 add_or_replace_methods(super_methods, methods))

fun flatten_super(name :: Symbol,
 classes_not_flat :: Listof(Symbol * Class),
 i_classes :: Listof(Symbol * ClassI)) :: Class:
 match find(i_classes, name)
 | classI(super_name, field_names, i_methods):
 if super_name == #'Object
 | classC([], [])
 | flatten_class(super_name, classes_not_flat, i_classes)

module test:
 def posn_i_class:
 values(#'Posn,
 classI(#'Object,
 [#'x, #'y],
 [values(#'mdist,
 plusI(getI(thisI(), #'x),
 getI(thisI(), #'y))),
 values(#'addDist,
 plusI(sendI(thisI(), #'mdist, intI(0)),
 sendI(argI(), #'mdist, intI(0))))]))
 def addDist_c_method:
 values(#'addDist,
 plusE(sendE(thisE(), #'mdist, intE(0)),
 sendE(argE(), #'mdist, intE(0))))
 def posn_c_class_not_flat:
 values(#'Posn,
 classC([#'x, #'y],
 [values(#'mdist,
 plusE(getE(thisE(), #'x),
 getE(thisE(), #'y))),
 addDist_c_method]))
 def posn3d_c_class:
 values(#'Posn3D,
 classC([#'x, #'y, #'z],
 [posn3d_mdist_c_method,
 addDist_c_method]))

 check: flatten_class(#'Posn3D,
 [posn_c_class_not_flat,
 posn3d_c_class_not_flat],
 [posn_i_class,
 posn3d_i_class])
 ~is snd(posn3d_c_class)

// ----------------------------------------

def add_fields = append

fun add_or_replace_methods(methods :: Listof(Symbol * Exp),
 new_methods :: Listof(Symbol * Exp))
 :: (Listof (Symbol * Exp)):
 match new_methods
 | []: methods
 | cons(fst_method, rst_new_methods):
 add_or_replace_methods(add_or_replace_method(methods,
 fst_method),
 rst_new_methods)

fun add_or_replace_method(methods :: Listof(Symbol * Exp),
 new_method :: Symbol * Exp)
 :: (Listof (Symbol * Exp)):
 match methods
 | []: [new_method]
 | cons(fst_method, rst_methods):
 if fst(fst_method) == fst(new_method)
 | cons(new_method, rst_methods)
 | cons(fst_method,
 add_or_replace_method(rst_methods,
 new_method))

module test:
 check: add_fields([#'x, #'y], [#'z])
 ~is [#'x, #'y, #'z]

 check: add_or_replace_methods([], [])
 ~is []
 check: add_or_replace_methods([], [values(#'m, intE(0))])
 ~is [values(#'m, intE(0))]
 check: add_or_replace_methods([values(#'m, intE(0))], [])
 ~is [values(#'m, intE(0))]
 check: add_or_replace_methods([values(#'m, intE(0))],
 [values(#'m, intE(1))])
 ~is [values(#'m, intE(1))]
 check: add_or_replace_methods([values(#'m, intE(0)),
 values(#'n, intE(2))],
 [values(#'m, intE(1))])
 ~is [values(#'m, intE(1)),
 values(#'n, intE(2))]
 check: add_or_replace_methods([values(#'m, intE(0))],
 [values(#'m, intE(1)),
 values(#'n, intE(2))])
 ~is [values(#'m, intE(1)),
 values(#'n, intE(2))]

 check: add_or_replace_method([values(#'m, intE(0))],
 values(#'m, intE(1)))
 ~is [values(#'m, intE(1))]
 check: add_or_replace_method([values(#'m, intE(0))],
 values(#'n, intE(2)))
 ~is [values(#'m, intE(0)),
 values(#'n, intE(2))]

// ----------------------------------------

fun interp_i(i_a :: ExpI, i_classes :: Listof(Symbol * ClassI), env :: Env) :: Value:
 block:
 def a = exp_i_to_c(i_a, #'Object)
 def classes_not_flat:
 map(fun (i): values(fst(i),
 class_i_to_c_not_flat(snd(i))),
 i_classes)
 def classes:
 map(fun (c):
 let name = fst(c):
 values(name,
 flatten_class(name, classes_not_flat, i_classes)),
 classes_not_flat)
 interp(a, classes, objV(#'Object, []), intV(0), env)

module test:
 check: interp_i(intI(0), [], mt_env)
 ~is intV(0)

 check: interp_i(
 sendI(newI(#'Posn3D, [intI(5), intI(3), intI(1)]),
 #'addDist,
 newI(#'Posn, [intI(2), intI(7)])),
 [posn_i_class,
 posn3d_i_class],
 mt_env
 )
 ~is intV(18)

typed_class.rhm

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616


#lang shplait
import:
 open:
 "class.rhm"
 "inherit.rhm"

type ClassT
| classT(super_name :: Symbol,
 fields :: Listof(Symbol * Type),
 methods :: Listof(Symbol * MethodT))

type MethodT
| methodT(arg_type :: Type,
 result_type :: Type,
 body_exp :: ExpI)

type Type
| intT()
| objT(class_name :: Symbol)
| nullT()
| arrayT(t :: Symbol,
 dim :: Int)

type TypeBinding
| tbind(name :: Symbol,
 ty :: Type)

type TypeEnv = Listof(TypeBinding)

// ----------------------------------------

fun type_error(a, msg):
 error(#'typecheck, "no type: " +& a +& " not " +& msg)

fun get_all_field_types(class_name, t_classes):
 if class_name == #'Object
 | []
 | match find(t_classes, class_name)
 | classT(super_name, fields, methods):
 append(get_all_field_types(super_name, t_classes),
 map(snd, fields))

// ----------------------------------------

fun make_find_in_tree(class_items):
 fun (name, class_name, t_classes):
 def t_class = find(t_classes, class_name)
 def items = class_items(t_class)
 def super_name = classT.super_name(t_class)
 if super_name == #'Object
 | find(items, name)
 | try:
 find(items, name)
 ~catch:
 make_find_in_tree(class_items)(name,
 super_name,
 t_classes)

def find_field_in_tree = make_find_in_tree(classT.fields)

def find_method_in_tree = make_find_in_tree(classT.methods)

// ----------------------------------------

fun is_subclass(name1, name2, t_classes):
 cond
 | name1 == name2: #true
 | name1 == #'Object: #false
 | ~else:
 match find(t_classes, name1)
 | classT(super_name, fields, methods):
 is_subclass(super_name, name2, t_classes)

fun is_subtype(t1, t2, t_classes):
 match t1
 | objT(name1):
 match t2
 | objT(name2):
 is_subclass(name1, name2, t_classes)
 | ~else: #false
 | arrayT(name1, dims1):
 match t2
 | arrayT(name2, dims2):
 is_subclass(name1, name2, t_classes) && dims1 == dims2
 | ~else: #false
 | ~else: t1 == t2

check: is_subtype(nullT(), nullT(), [])
 ~is #true

module test:
 def a_t_class = values(#'A, classT(#'Object, [], []))
 def b_t_class = values(#'B, classT(#'A, [], []))

 check: is_subclass(#'Object, #'Object, [])
 ~is #true
 check: is_subclass(#'A, #'B, [a_t_class, b_t_class])
 ~is #false
 check: is_subclass(#'B, #'A, [a_t_class, b_t_class])
 ~is #true

 check: is_subtype(intT(), intT(), [])
 ~is #true
 check: is_subtype(intT(), objT(#'Object), [])
 ~is #false
 check: is_subtype(objT(#'Object), intT(), [])
 ~is #false
 check: is_subtype(objT(#'A), objT(#'B), [a_t_class, b_t_class])
 ~is #false
 check: is_subtype(objT(#'B), objT(#'A), [a_t_class, b_t_class])
 ~is #true

 check: is_subtype(arrayT(#'B, 3), arrayT(#'A, 3), [a_t_class, b_t_class])
 ~is #true
 check: is_subtype(arrayT(#'A, 2), arrayT(#'A, 3), [a_t_class, b_t_class])
 ~is #false
 check: is_subtype(arrayT(#'B, 2), arrayT(#'A, 3), [a_t_class, b_t_class])
 ~is #false
 check: is_subtype(arrayT(#'A, 3), arrayT(#'B, 3), [a_t_class, b_t_class])
 ~is #false
 check: is_subtype(arrayT(#'A, 2), objT(#'A), [a_t_class, b_t_class])
 ~is #false
 check: is_subtype(objT(#'A), arrayT(#'A, 2), [a_t_class, b_t_class])
 ~is #false


fun check_array_dims(lens :: Listof(ExpI), recur, exp):
 if length(lens) < 1:
 | type_error(exp, "array must be at least 1 dimensional")
 | def _ = map(fun (len):
 match recur(len)
 | intT(): intT()
 | ~else: type_error(exp, "array length must be Int"),
 lens)
 #void

// ----------------------------------------
def type_lookup: make_lookup(tbind.name, tbind.ty)

def typecheck_exp :: (ExpI, Listof(Symbol * ClassT), Type, Type, TypeEnv) -> Type:
 fun (exp, t_classes, this_type, arg_type, tenv):
 fun recur(exp):
 typecheck_exp(exp, t_classes, this_type, arg_type, tenv)
 fun typecheck_nums(l, r):
 match recur(l)
 | intT():
 match recur(r)
 | intT(): intT()
 | ~else: type_error(r, "Int")
 | ~else: type_error(l, "Int")
 match exp
 | intI(n): intT()
 | nullI(): nullT()
 | negI(e): match recur(e)
 | intT(): intT()
 | ~else: type_error(e, "Int")
 | idI(s): type_lookup(s, tenv)
 | plusI(l, r): typecheck_nums(l, r)
 | multI(l, r): typecheck_nums(l, r)
 | argI(): arg_type
 | thisI(): this_type
 | newI(class_name, exps):
 def arg_types = map(recur, exps)
 def field_types = get_all_field_types(class_name, t_classes)
 if (length(arg_types) == length(field_types)
 && foldl(fun (b, r): b && r,
 #true,
 map2(fun (t1, t2):
 (is_subtype(t1, t2, t_classes) || (match t2
 | objT(_): match t1
 | nullT(): #true
 | ~else: #false
 | arrayT(_1, _2): match t1
 | nullT(): #true
 | ~else: #false
 | ~else: #false)),
 arg_types,
 field_types)))
 | objT(class_name)
 | type_error(exp, "field type mismatch")
 | newArrayI(t, lens):
 check_array_dims(lens, recur, exp)
 if t == #'Int:
 | arrayT(t, length(lens))
 | match find(t_classes, t)
 | classT(super_name, fields, methods): arrayT(t, length(lens))
 | getArrayI(array, index):
 match recur(index)
 | intT(): match recur(array)
 | arrayT(t, dim): if dim > 1:
 | arrayT(t, dim - 1)
 | if t == #'Int:
 | intT()
 | objT(t)
 | ~else: type_error(array, "not an array")
 | ~else: type_error(index, "index must be Int")
 | setArrayI(array, index, val):
 match recur(index)
 | intT():
 match recur(array)
 | arrayT(t, dim):
 match recur(val)
 | arrayT(t_val, dim_val):
 if dim-1 == dim_val && (is_subclass(t_val, t, t_classes) || (t_val == #'Int && t == #'Int)):
 | intT()
 | type_error(array, "wrong type assignment")
 | intT(): if dim == 1 && t == #'Int:
 | intT()
 | type_error(array, "wrong type assignment")
 | nullT(): if dim == 1 && t != #'Int:
 | intT()
 | type_error(array, "wrong type assignment")
 | objT(t_val_class): if dim == 1 && is_subclass(t_val_class, t, t_classes):
 | intT()
 | type_error(array, "wrong type assignment")
 | ~else: type_error(array, "not an array")
 | ~else: type_error(index, "index must be Int")
 | getI(obj_exp, field_name):
 match recur(obj_exp):
 | objT(class_name):
 find_field_in_tree(field_name,
 class_name,
 t_classes)
 | ~else: type_error(obj_exp, "object")
 | sendI(obj_exp, method_name, arg_exp):
 def obj_type = recur(obj_exp)
 def arg_type = recur(arg_exp)
 match obj_type
 | objT(class_name):
 typecheck_send(class_name, method_name,
 arg_exp, arg_type,
 t_classes)
 | ~else:
 type_error(obj_exp, "object")
 | superI(method_name, arg_exp):
 def arg_type = recur(arg_exp)
 def this_class = find(t_classes, objT.class_name(this_type))
 typecheck_send(classT.super_name(this_class),
 method_name,
 arg_exp, arg_type,
 t_classes)
 | castI(obj_exp, cast_class_name):
 match recur(obj_exp)
 | objT(obj_class_name):
 if cast_class_name == #'null:
 | nullT()
 | if is_subclass(obj_class_name, cast_class_name, t_classes):
 | objT(cast_class_name)
 | type_error(exp, "not a subclass")
 | intT(): if cast_class_name == #'Int:
 | intT()
 | type_error(exp, "cannot cast Int to object")
 | nullT(): if cast_class_name == #'null:
 | nullT()
 | type_error(exp, "cannot cast null to object")
 | arrayT(t, dim): type_error(exp, "cannot cast array")
 | if0I(exp, true, false):
 match recur(exp)
 | intT():
 def t_true = recur(true)
 def t_false = recur(false)
 match t_true
 | intT(): match t_false
 | intT(): intT()
 | ~else: type_error(exp, "then and else type mismatch")
 | objT(class1_name): match t_false
 | objT(class2_name): objT(get_most_specific_classT(class1_name, class2_name, t_classes))
 | nullT(): t_true
 | ~else: type_error(exp, "then and else type mismatch")
 | nullT(): match t_false
 | nullT(): nullT()
 | objT(class_name): t_false
 | ~else: type_error(exp, "then and else type mismatch")
 | arrayT(t1, dim1): match t_false
 | arrayT(t2, dim2): if dim1 == dim2:
 | arrayT(get_most_specific_classT(t1, t2, t_classes), dim1)
 | type_error(exp, "then and else type mismatch")
 | ~else: type_error(exp, "then and else type mismatch")
 | ~else: type_error(exp, "not a number")
 | letI(s, right, body):
 typecheck_exp(body, t_classes, this_type, arg_type,
 extend_env(tbind(s, recur(right)), tenv))
 | setI(exp, field_name, val):
 match recur(exp)
 | objT(class_name):
 def item = find_field_in_tree(field_name,
 class_name,
 t_classes)
 intT()
 | ~else: type_error(exp, "not an object")


fun get_most_specific_classT(c1 :: Symbol, c2 :: Symbol, t_classes :: Listof(Symbol * ClassT)) :: Symbol:
 if is_subclass(c1, c2, t_classes):
 | c2
 | if is_subclass(c2, c1, t_classes):
 | c1
 | match find(t_classes, c1)
 | classT(super_name, fields, methods):
 if super_name == #'Object:
 | #'Object
 | get_most_specific_classT(super_name, c2, t_classes)

fun typecheck_send(class_name :: Symbol,
 method_name :: Symbol,
 arg_exp :: ExpI,
 arg_type :: Type,
 t_classes :: Listof(Symbol * ClassT)):
 match find_method_in_tree(method_name,
 class_name,
 t_classes)
 | methodT(arg_type_m, result_type, body_exp):
 if is_subtype(arg_type, arg_type_m, t_classes)
 | result_type
 | match arg_type_m
 | objT(_): if arg_type == nullT():
 | result_type
 | type_error(arg_exp, to_string(arg_type_m))
 | ~else: type_error(arg_exp, to_string(arg_type_m))

check: typecheck_send(#'A, #'call, intI(0), nullT(),
 [values(#'A,
 classT(#'Object,
 [],
 [values(#'call, methodT(objT(#'A), intT(), intI(0)))]))
 ])
 ~is intT()
check: typecheck_send(#'A, #'call, intI(0), objT(#'B),
 [values(#'A,
 classT(#'Object,
 [],
 [values(#'call, methodT(objT(#'A), intT(), intI(0)))])),
 values(#'B, classT(#'Object, [], []))
 ])
 ~raises "no type"

fun typecheck_method(method :: MethodT,
 this_type :: Type,
 t_classes :: Listof(Symbol * ClassT),
 tenv :: TypeEnv) :: Void:
 match method
 | methodT(arg_type, result_type, body_exp):
 if is_subtype(typecheck_exp(body_exp, t_classes,
 this_type, arg_type, tenv),
 result_type,
 t_classes)
 | #void
 | type_error(body_exp, to_string(result_type))

fun check_override(method_name :: Symbol,
 method :: MethodT,
 this_class :: ClassT,
 t_classes :: Listof(Symbol * ClassT)):
 def super_name = classT.super_name(this_class)
 def super_method:
 try:
 // Look for method in superclass:
 find_method_in_tree(method_name,
 super_name,
 t_classes)
 ~catch:
 // no such method in superclass:
 method
 if (methodT.arg_type(method) == methodT.arg_type(super_method)
 && methodT.result_type(method) == methodT.result_type(super_method))
 | #void
 | error(#'typecheck, "bad override of " +& method_name)

fun typecheck_class(class_name :: Symbol,
 t_class :: ClassT,
 t_classes :: Listof(Symbol * ClassT),
 tenv :: TypeEnv):
 match t_class
 | classT(super_name, fields, methods):
 map(fun (m):
 typecheck_method(snd(m), objT(class_name), t_classes, tenv)
 check_override(fst(m), snd(m), t_class, t_classes),
 methods)

fun typecheck(a :: ExpI,
 t_classes :: Listof(Symbol * ClassT), tenv :: TypeEnv) :: Type:
 begin:
 map(fun (tc):
 typecheck_class(fst(tc), snd(tc), t_classes, tenv),
 t_classes)
 typecheck_exp(a, t_classes, objT(#'Object), intT(), tenv)

// ----------------------------------------

module test:
 def posn_t_class:
 values(#'Posn,
 classT(#'Object,
 [values(#'x, intT()), values(#'y, intT())],
 [values(#'mdist,
 methodT(intT(), intT(),
 plusI(getI(thisI(), #'x), getI(thisI(), #'y)))),
 values(#'addDist,
 methodT(objT(#'Posn), intT(),
 plusI(sendI(thisI(), #'mdist, intI(0)),
 sendI(argI(), #'mdist, intI(0)))))]))

 def posn3D_t_class:
 values(#'Posn3D,
 classT(#'Posn,
 [values(#'z, intT())],
 [values(#'mdist,
 methodT(intT(), intT(),
 plusI(getI(thisI(), #'z),
 superI(#'mdist, argI()))))]))

 def square_t_class :
 values(#'Square,
 classT(#'Object,
 [values(#'topleft, objT(#'Posn))],
 []))

 fun typecheck_posn(a):
 typecheck(a, [posn_t_class, posn3D_t_class, square_t_class], mt_env)

 def new_posn27 = newI(#'Posn, [intI(2), intI(7)])
 def new_posn531 = newI(#'Posn3D, [intI(5), intI(3), intI(1)])

 check: typecheck_posn(sendI(new_posn27, #'mdist, intI(0)))
 ~is intT()
 check: typecheck_posn(sendI(new_posn531, #'mdist, intI(0)))
 ~is intT()
 check: typecheck_posn(sendI(new_posn531, #'addDist, new_posn27))
 ~is intT()
 check: typecheck_posn(sendI(new_posn27, #'addDist, new_posn531))
 ~is intT()

 check: typecheck_posn(newI(#'Square, [newI(#'Posn, [intI(0), intI(1)])]))
 ~is objT(#'Square)
 check: typecheck_posn(newI(#'Square, [newI(#'Posn3D, [intI(0), intI(1), intI(3)])]))
 ~is objT(#'Square)

 check: typecheck(multI(intI(1), intI(2)),
 [], mt_env)
 ~is intT()

 check: typecheck_posn(sendI(intI(10), #'mdist, intI(0)))
 ~raises "no type"
 check: typecheck_posn(sendI(new_posn27, #'mdist, new_posn27))
 ~raises "no type"
 check: typecheck(plusI(intI(1), newI(#'Object, [])),
 [], mt_env)
 ~raises "no type"
 check: typecheck(plusI(newI(#'Object, []), intI(1)),
 [], mt_env)
 ~raises "no type"
 check: typecheck(plusI(intI(1), newI(#'Object, [intI(1)])),
 [], mt_env)
 ~raises "no type"
 check: typecheck(getI(intI(1), #'x),
 [], mt_env)
 ~raises "no type"
 check: typecheck(intI(10),
 [posn_t_class,
 values(#'Other,
 classT(#'Posn,
 [],
 [values(#'mdist,
 methodT(objT(#'Object), intT(),
 intI(10)))]))],
 mt_env)
 ~raises "bad override"
 check: typecheck_method(methodT(intT(), objT(#'Object), intI(0)), objT(#'Object), [], mt_env)
 ~raises "no type"
 check: typecheck(intI(0),
 [square_t_class,
 values(#'Cube,
 classT(#'Square,
 [],
 [values(#'m,
 methodT(intT(), intT(),
 // No such method in superclass:
 superI(#'m, intI(0))))]))],
 mt_env)
 ~raises "not found"

// ----------------------------------------

def strip_types :: ClassT -> ClassI:
 fun (t_class):
 match t_class
 | classT(super_name, fields, methods):
 classI(super_name,
 map(fst, fields),
 map(fun (m):
 values(fst(m),
 match snd(m)
 | methodT(arg_type, result_type, body_exp):
 body_exp),
 methods))

def interp_t :: (ExpI, Listof(Symbol * ClassT), Env) -> Value:
 fun (a, t_classes, env):
 interp_i(a,
 map(fun (c):
 values(fst(c), strip_types(snd(c))),
 t_classes),
 env)

module test:
 fun interp_t_posn(a):
 interp_t(a, [posn_t_class, posn3D_t_class], mt_env)

 check: interp_t_posn(sendI(new_posn27, #'mdist, intI(0)))
 ~is intV(9)
 check: interp_t_posn(sendI(new_posn531, #'mdist, intI(0)))
 ~is intV(9)
 check: interp_t_posn(sendI(new_posn531, #'addDist, new_posn27))
 ~is intV(18)
 check: interp_t_posn(sendI(new_posn27, #'addDist, new_posn531))
 ~is intV(18)

// 1
module test:
 check: interp_t_posn(negI(intI(5)))
 ~is intV(-5)
 check: interp_t_posn(negI(nullI()))
 ~raises "not a number"

 // I know it doesn't make sense to add Int type casting on an Int,
 // but this will help for other types if there were floats, bools etc.
 check: interp_t_posn(castI(intI(5), #'Int))
 ~is intV(5)
 check: interp_t_posn(getI(castI(new_posn531, #'Posn), #'x))
 ~is intV(5)
 check: interp_t_posn(getI(castI(new_posn531, #'Posn), #'y))
 ~is intV(3)
 check: interp_t_posn(getI(castI(new_posn27, #'Posn), #'x))
 ~is intV(2)

 check: typecheck_posn(castI(intI(5), #'Int))
 ~is intT()
 check: typecheck_posn(getI(castI(new_posn531, #'Posn), #'x))
 ~is intT()
 check: typecheck_posn(castI(new_posn531, #'Int))
 ~raises "no type"
 check: typecheck_posn(getI(castI(new_posn531, #'Posn), #'y))
 ~is intT()
 check: typecheck_posn(getI(castI(new_posn531, #'Posn), #'z))
 ~raises "not found"
 check: typecheck_posn(getI(castI(new_posn27, #'Posn), #'x))
 ~is intT()
 check: typecheck_posn(getI(castI(new_posn27, #'Posn3D), #'x))
 ~raises "not a subclass"
 check: typecheck_posn(getI(castI(new_posn27, #'Posn3D), #'z))
 ~raises "not a subclass"
 check: typecheck_posn(castI(intI(5), #'Posn))
 ~raises "cannot cast"


// 3
module test:
 // Object
 // A E
 // B D
 // C
 def a_t = values(#'A, classT(#'Object, [], []))
 def b_t = values(#'B, classT(#'A, [], []))
 def c_t = values(#'C, classT(#'B, [], []))
 def d_t = values(#'D, classT(#'A, [], []))
 def e_t = values(#'E, classT(#'Object, [], []))

 fun get_most_specific_test(x, y):
 get_most_specific_classT(x, y, [a_t, b_t, c_t, d_t, e_t])

 check: get_most_specific_test(#'A, #'B)
 ~is #'A
 check: get_most_specific_test(#'C, #'B)
 ~is #'B
 check: get_most_specific_test(#'B, #'D)
 ~is #'A
 check: get_most_specific_test(#'C, #'D)
 ~is #'A
 check: get_most_specific_test(#'C, #'E)
 ~is #'Object

 fun typecheck_ABCDE(exp, true, false):
 typecheck(if0I(intI(exp), newI(true, []), newI(false, [])), [a_t, b_t, c_t, d_t, e_t], mt_env)

 check: typecheck_ABCDE(0, #'A, #'B)
 ~is objT(#'A)
 check: typecheck_ABCDE(0, #'C, #'B)
 ~is objT(#'B)
 check: typecheck_ABCDE(0, #'B, #'D)
 ~is objT(#'A)
 check: typecheck_ABCDE(0, #'C, #'D)
 ~is objT(#'A)
 check: typecheck_ABCDE(0, #'C, #'E)
 ~is objT(#'Object)

 check: typecheck(if0I(thisI(), intI(10), intI(11)), [a_t, b_t, c_t, d_t, e_t], mt_env)
 ~raises "not a number"
 check: typecheck(if0I(intI(1), newI(#'A, []), intI(11)), [a_t, b_t, c_t, d_t, e_t], mt_env)
 ~raises "then and else type mismatch"
 check: typecheck(if0I(intI(1), intI(11), newI(#'A, [])), [a_t, b_t, c_t, d_t, e_t], mt_env)
 ~raises "then and else type mismatch"
 check: typecheck(if0I(intI(0), intI(10), intI(11)), [a_t, b_t, c_t, d_t, e_t], mt_env)
 ~is intT()

// 7
module test:
 check: typecheck(letI(#'x, thisI(), intI(5)), [], mt_env)
 ~is intT()
 check: typecheck(setI(intI(10), #'x, intI(5)), [], mt_env)
 ~raises "not an object"
 check: typecheck_posn(setI(new_posn531, #'x, intI(5)))
 ~is intT()

 check: typecheck(letI(#'x, intI(5), idI(#'x)), [], mt_env)
 ~is intT()

typed_parse.rhm

 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312


#lang shplait
import:
 open:
 "class.rhm"
 "inherit.rhm"
 "typed_class.rhm"
 "inherit_parse.rhm"

// ----------------------------------------

fun parse_t_class(s :: Syntax) :: (Symbol * ClassT):
 match s
 | 'class $name($field, ...):
 extends $parent_name
 $method
 ...':
 values(syntax_to_symbol(name),
 classT(syntax_to_symbol(parent_name),
 map(parse_t_field,
 syntax_to_list('[$field, ...]')),
 map(parse_t_method,
 syntax_to_list('[$method, ...]'))))
 | ~else: error(#'parse_class, "invalid input: " +& s)

fun parse_t_field(s :: Syntax) :: (Symbol * Type):
 match s
 | '$name :: $ty':
 values(syntax_to_symbol(name),
 parse_type(ty))
 | ~else: error(#'parse_t_field, "invalid input: " +& s)

fun parse_t_method(s :: Syntax) :: (Symbol * MethodT):
 match s
 |'method $name(arg :: $arg_ty) :: $res_ty: $body':
 values(syntax_to_symbol(name),
 methodT(parse_type(arg_ty),
 parse_type(res_ty),
 parse(body)))
 | ~else: error(#'parse_t_method, "invalid input: " +& s)

fun parse_type(s :: Syntax) :: Type:
 cond
 | s == 'Int': intT()
 | syntax_is_symbol(s): objT(syntax_to_symbol(s))
 | ~else: match s
 | '$(name :: Identifier) [$nothing] ...': // I don't know how to parse Posn[][][], so doing Posn[1][2][3] instead
 arrayT(syntax_to_symbol(name), length(syntax_to_list('[$nothing, ...]')))
 | ~else: error(#'parse_type, "invalid input: " +& s)

module test:
 check: parse_type('Int')
 ~is intT()
 check: parse_type('Object')
 ~is objT(#'Object)
 check: parse_type('()')
 ~raises "invalid input"
 check: parse_type('Posn[1][2][3]')
 ~is arrayT(#'Posn, 3)

 check: parse_t_field('x :: Int')
 ~is values(#'x, intT())
 check: parse_t_field('x')
 ~raises "invalid input"

 check: parse_t_method('method m(arg :: Int) :: Object: this')
 ~is values(#'m, methodT(intT(), objT(#'Object), thisI()))
 check: parse_t_method('m 1')
 ~raises "invalid input"

 check: parse_t_class('class Posn3D(x :: Int,
 y :: Int):
 extends Posn
 method m1(arg :: Int) :: Int:
 arg
 method m2(arg :: Int) :: Object:
 this')
 ~is values(#'Posn3D,
 classT(#'Posn,
 [values(#'x, intT()),
 values(#'y, intT())],
 [values(#'m1, methodT(intT(), intT(), argI())),
 values(#'m2, methodT(intT(), objT(#'Object), thisI()))]))
 check: parse_t_class('class')
 ~raises "invalid input"

// ----------------------------------------

fun interp_t_prog(classes :: Listof(Syntax), a :: Syntax) :: Syntax:
 let v = interp_t(parse(a),
 map(parse_t_class, classes),
 mt_env):
 match v
 | intV(n): integer_to_syntax(n)
 | objV(class_name, field_vals): 'object'
 | nullV(): 'null'
 | arrayV(vals): 'array $(integer_to_syntax(length(vals)))'

module test:
 check: interp_t_prog(['class Empty():
 extends Object'],
 'new Empty()')
 ~is 'object'

 check: interp_t_prog(
 [
 'class Posn(x :: Int,
 y :: Int):
 extends Object
 method mdist(arg :: Int) :: Int:
 this.x + this.y
 method addDist(arg :: Posn) :: Int:
 arg.mdist(0) + this.mdist(0)',
 'class Posn3D(z :: Int):
 extends Posn
 method mdist(arg :: Int) :: Int:
 this.z + super.mdist(arg)'
 ],
 '(new Posn3D(5, 3, 1)).addDist(new Posn(2, 7))'
 )
 ~is '18'

// 8
module test:
 def classes = [
 'class Posn(x :: Int,
 y :: Int):
 extends Object
 method mdist(arg :: Int) :: Int:
 this.x + this.y
 method addDist(arg :: Posn) :: Int:
 arg.mdist(0) + this.mdist(0)',
 'class Char(ascii :: Int):
 extends Object',
 'class Button(char :: Int):
 extends Object
 method press(arg :: Char) :: Char: // arg is dummy
 new Char(this.char)',
 'class Keyboard3(btn1 :: Button, btn2 :: Button, btn3 :: Button):
 extends Object
 method press(arg :: Int) :: Char:
 if arg - 1 == 0
 | this.btn1.press(null)
 | if arg - 2 == 0
 | this.btn2.press(null)
 | if arg - 3 == 0
 | this.btn3.press(null)
 | null',
 'class KeyboardWithSpace(btn_space :: Button):
 extends Keyboard3
 method press_ascii(arg :: Int) :: Int:
 if arg == 0 // 0 is space
 | this.btn_space.press(null).ascii
 | super.press(arg).ascii',

 'class GeneralKeyboard(btns :: Button[10][10],
 num_keys_row :: Int,
 num_keys_col :: Int,
 curr_row :: Int,
 curr_col :: Int):
 extends Object
 method replace_row(arg :: Button[10]) :: Int:
 this.btns[this.curr_row] := arg
 method press_btn(arg :: Posn) :: Char:
 this.btns[arg.x][arg.y].press(new Char(0))
 method print_char_on_btn(arg :: Char) :: Int:
 this.btns[this.curr_row][this.curr_col].char := arg
 method add_btn(arg :: Button) :: Int:
 this.btns[this.curr_row][this.curr_col] := arg
 method update_row_col(arg :: Int) :: Int:
 let _1 = this.curr_col := (this.curr_col + arg):
 if this.curr_col - this.num_keys_col == 0
 | let _2 = this.curr_row := (this.curr_row + 1):
 let _3 = this.curr_col := 0:
 1
 | 1'
 ]

 def parsed_classes = map(parse_t_class, classes)
 fun typecheck_keyboard_class(i):
 typecheck_class(fst(list_get(parsed_classes, i)),
 snd(list_get(parsed_classes, i)),
 parsed_classes,
 mt_env)
 fun typecheck_keyboard(a):
 typecheck(parse(a), parsed_classes, mt_env)

 check: typecheck_keyboard_class(0)
 ~is [#void, #void]
 check: typecheck_keyboard_class(1)
 ~is []
 check: typecheck_keyboard_class(2)
 ~is [#void]
 check: typecheck_keyboard_class(3)
 ~is [#void]
 check: typecheck_keyboard_class(4)
 ~is [#void]
 check: typecheck_keyboard_class(5)
 ~is [#void, #void, #void, #void, #void]

 fun typecheck_interp(a):
 snd(values(typecheck_keyboard(a),
 match interp_t(parse(a), parsed_classes, mt_env)
 | intV(n): integer_to_syntax(n)
 | objV(class_name, field_vals): symbol_to_syntax(class_name)
 | nullV(): 'null'
 | arrayV(vals): 'array $(integer_to_syntax(length(vals)))'))

 check: typecheck_interp('let kb = new GeneralKeyboard(new Button[10][10], 10, 10, 0, 0):
 let _ = kb.add_btn(new Button(0)):
 let res = kb.press_btn(new Posn(0, 0)):
 res')
 ~is 'Char'
 check: typecheck_interp('let kb = new GeneralKeyboard(new Button[10][10], 10, 10, 0, 0):
 let _ = kb.add_btn(null):
 let res = kb.press_btn(new Posn(0, 0)):
 res')
 ~raises "not an object" // during interp
 check: typecheck_interp('let kb = new GeneralKeyboard(new Button[10][10], 10, 10, 0, 0):
 let _ = kb.add_btn(new Button(2)):
 let _ = kb.update_row_col(1):
 let _ = kb.add_btn(new Button(3)):
 let res = kb.press_btn(new Posn(0, 0)).ascii + kb.press_btn(new Posn(0, 1)).ascii:
 res')
 ~is '5'
 check: typecheck_interp('let kb = new GeneralKeyboard(new Button[10][10], 10, 10, 0, 0):
 let _ = kb.add_btn(new Button(2)):
 let _ = kb.update_row_col(1):
 let _ = kb.add_btn(new Button(3)):
 kb.btns')
 ~is 'array 10'


 check: typecheck_keyboard('new Keyboard3(new Button(1), new Button(2), new Button(3))')
 ~is objT(#'Keyboard3)
 check: typecheck_keyboard('new KeyboardWithSpace(new Button(1), new Button(2), new Button(3), new Button(0))')
 ~is objT(#'KeyboardWithSpace)

 check: typecheck_keyboard('let x = new KeyboardWithSpace(new Button(1), null, new Button(3), new Button(0)):
 if x.press_ascii(0) == 0
 | (let dummy = x.btn2 := (new Button(22)):
 x.press_ascii(2))
 | 404')
 ~is intT()

 check: typecheck(parse('5'),
 map(parse_t_class,
 [
 'class A(x :: Int):
 extends Object
 method add(arg :: Int) :: Int:
 this.x + arg'
 ]),
 mt_env)
 ~is intT()

// 10
module test:
 check: typecheck(parse('new A[2][3]'), map(parse_t_class,
 ['class A(x :: Int):
 extends Object']), mt_env)
 ~is arrayT(#'A, 2)

 check: interp_t_prog(['class Empty():
 extends Object'],
 'new Empty[5][10]')
 ~is 'array 5'

 fun typecheck_posn(a):
 typecheck(parse(a), map(parse_t_class, [
 'class Posn(x :: Int,
 y :: Int):
 extends Object
 method mdist(arg :: Int) :: Int:
 this.x + this.y
 method addDist(arg :: Posn) :: Int:
 arg.mdist(0) + this.mdist(0)',
 'class Posn3D(z :: Int):
 extends Posn
 method mdist(arg :: Int) :: Int:
 this.z + super.mdist(arg)'
 ]),
 mt_env)


 check: typecheck_posn('let x = new Posn[3]:
 x[0] := new Posn(0, 0)')
 ~is intT()
 check: typecheck_posn('let x = new Posn[3]:
 let _ = x[0] := new Posn(0, 0):
 let _ = x[1] := new Posn(1, 1):
 x[0]')
 ~is objT(#'Posn)
 check: typecheck_posn('let x = new Posn[3]:
 let _ = x[0] := new Posn(0, 0):
 let _ = x[1] := new Posn(1, 1):
 x[2]')
 ~is objT(#'Posn)
 check: typecheck_posn('let x = new Posn[3]:
 let _ = x[0] := new Posn(0, 0):
 let _ = x[1] := new Posn(1, 1):
 x[5]')
 ~is objT(#'Posn)
 check: typecheck_posn('let x = new Posn[3]:
 let _ = x[0] := new Posn(0, 0):
 let _ = x[1] := 5:
 x[1]')
 ~raises "wrong type assignment"
 check: typecheck_posn('let x = new Posn[3][2]:
 let _ = x[0][0] := new Posn(0, 0):
 let _ = x[1][1] := new Posn(1, 1):
 x[0][0]')
 ~is objT(#'Posn)