【杂记】Cnss Recruit 2021 wps of Dev
这是Cnss Recruit 2021
,Dev
方向的write-ups。
🐥Hello World
用不同的编程语言输出
"Hello World"
。
推荐写写c/c++
、javascript
、python
、lua
、go
和scheme
。
🔗Deathloop
尝试用某种语言进行并发数组求和,并且能够比较与单线程求和的效率差别。
花一天时间学一下go
,你就能做这题。
(这并不是说你能在一天内精通go
,而是你光是翻你要用的函数的文档就要翻一天)
main.go
package main
import (
"fmt"
)
func sum(begin int, end int) int {
s := 0
for i := begin; i < end; i++ {
s += i
}
return s
}
func newSum(begin int, end int) int {
s := 0
l := end - begin
N := 5
n := l / N
var ch = make(chan int)
for i := 0; i < N - 1; i++ {
go func(i int) {
ch <- sum(i * n, (i + 1) * n)
} (i)
}
go func() {
ch <- sum((N - 1) * n, l)
} ()
for i := 0; i < N; i++ {
s += <- ch
}
return s
}
func main() {
const MAXN int = 1145141919
fmt.Printf("%d\n", sum(0, MAXN))
fmt.Printf("%d\n", newSum(0, MAXN))
}
main_test.go
package main
import (
"testing"
)
func BenchmarkSum(b *testing.B) {
b.ResetTimer()
b.StopTimer()
const MAXN int = 1145141919
b.StartTimer()
for i := 0; i < b.N; i++ {
sum(0, MAXN)
}
}
func BenchmarkNewSum(b *testing.B) {
b.ResetTimer()
b.StopTimer()
const MAXN int = 1145141919
b.StartTimer()
for i := 0; i < b.N; i++ {
newSum(0, MAXN)
}
}
🧱Constant
实现一个
Vernam
算法,并且保证代码的可读性。
你需要知道pylint
和python
的语言规范。
'''Vernam Cipher 加密解密器
程序开始时,将会提示输入加密或解密,此时,您只能输入encode或者decode来进行下一步。
如果输入encode,请按照提示分别输入原文和密钥,并且妥善存储程序输出的密文。密文形如A#B,A为原文长度,B为加密后的密文。
如果输入decode,请按照提示分别输入由本程序加密后产生的密文和加密时所用的密钥,程序将会输出原文。
'''
import math
from Crypto.Util.number import long_to_bytes, bytes_to_long
def encode(text, key):
'''将 text 使用 key 加密。
text 和 key 都应该是类型 str。'''
key = key * (math.ceil(len(text) / len(key))) # 将 key 重复,补全到长度至少和原文一致
# 由于加密后的数据并不能推出原本数据的大小
# 所以在密文前附带原文的长度,并且用 '#' 隔开
return str(len(text)) + "#" + str(bytes_to_long(text.encode()) ^ bytes_to_long(key.encode()))
def decode(ciphertext, key):
'''将 ciphertext 使用 key 解密。
ciphertext 类型为 str 并且形式为 A#B,其中 A、B 均为整数,而 key 类型为 str。'''
len_text, ciphertext = ciphertext.split('#')
try:
# 将 ciphertext 和 len_text 分别转化为数字
ciphertext = int(ciphertext)
len_text = int(len_text)
except ValueError: # 转化失败,说明 A、B 至少有一个不是整数,也就是格式错误
print("您输入的密文格式有误")
return ""
key = key * (math.ceil(len_text / len(key))) # 将 key 重复,补全到长度至少和原文一致
return long_to_bytes(ciphertext ^ bytes_to_long(key.encode())).decode()
# 程序从这里开始
mode = input("您需要加密还是解密(encode/decode):")
if mode == "encode":
arg1 = input("请输入原文:")
arg2 = input("请输入密钥:")
print("密文是:", encode(arg1, arg2))
if mode == "decode":
arg1 = input("请输入密文:")
arg2 = input("请输入密钥:")
print("原文是:", decode(arg1, arg2))
🧮Primes
使用
Linux
下的pipe
和folk
函数,实现素数求解。
大致算法解释:
- 假设每个数字是一个人。
- 一开始场上只有一个人
2
。 - 接着
3
入场,到2
的面前接受2
的检查:如果2
不能整除3
,那么3
排到2
的后面。现在场上有2
和3
。 - 接着
4
入场,到2
的面前接受检查。由于$2|4$,4
离开场地。 - 接着
5
入场,依次接受2
和3
的检查后,排到3
的后面。现在场上有2
、3
和5
。 - ……
- 接着
n
入场,依次接受所有小于n
的素数人的检查,如果不通过就离场,全部通过就排到最后一个素数的后面。
对于linux
下pipe
和fork
的理解:
- 每次执行
fork
的时候,系统复制整份程序(包括运行状态)。fork
后,一份进程将变为两份,他们的区别只有fork
返回的pid
。 pipe
用于两个程序间的通信。每个pipe
会有两个口,分别用于放进信息和取出信息。pipe
实际上就是linux
下的文件。
```cpp
#include <cstdio>
#include <cassert>
#include "unistd.h"
const int PRIME_BEGIN = 2;
const int PRIME_END = 101;
const int MAXN = PRIME_END - PRIME_BEGIN + 1;
int read_int(int id)
{
static char r_buf[128];
static int res;
if(read(id, r_buf, 128) == -1)
return -1;
sscanf(r_buf, "%d", &res);
return res;
}
void write_int(int id, int num)
{
static char w_buf[128];
sprintf(w_buf, "%d", num);
write(id, w_buf, 128);
}
int pipes[MAXN][2], pcnt = 0; // [][0] - read, [][1] - write
int pipe_ret, id;
/*
| Number Generator | | Individual 1 | | Individual 2 |
| | -> | | -> | |
id: | 0 | pipe 0 | 1 | pipe 1 | 2 |
previous pipe : id - 1
next pipe : id
*/
int* previous()
{
return pipes[id - 1];
}
int* next()
{
return pipes[id];
}
int main()
{
pipe_ret = pipe(next());
assert(pipe_ret != -1); // Assume success
id = pcnt;
int pid = fork();
if(pid > 0) { // Parent
goto Label_1;
} else { // Child
goto Label_2;
}
Label_1: // [1] Number Generator
close(next()[0]);
for(int i=PRIME_BEGIN; i<PRIME_END; ++i) {
write_int(next()[1], i);
}
close(next()[1]);
return 0;
Label_2: // [2] Individual
int n;
// [2] Start
id = pcnt + 1; // next id = previous pipe + 1
n = read_int(previous()[0]);
if(n == -1) {
return 0;
}
printf("prime %d\n", n);
for(;;) {
int m;
m = read_int(previous()[0]);
if(m == -1) {
return 0;
}
if(m % n == 0) continue; // Not a prime
if(pcnt < id) {
++pcnt;
pipe_ret = pipe(next());
assert(pipe_ret != -1);
int pid_next = fork();
if(pid_next <= 0) { // Child
goto Label_2;
}
close(next()[0]);
}
write_int(next()[1], m); // pass to the right
}
return 0;
}
🐕Trace it!
实现一个
traceroute
。
traceroute
有两种实现方式:ICMP
和UDP
。这里介绍ICMP
方式。
ICMP
是和IP
并列的协议,用于传输出错报告、控制信息。具体的ICMP
报文可以上网查。对于本题而言,我们需要自行构造ICMP
报文,并且控制TTL
从1
开始递增,暴力得到每一层节点即可。
import socket
import struct
import select
import time
import os
# 一些常数
MAX_TTL_NUM = 64
MAX_TIMEOUT_NUM = 4
# checksum 检验码的计算
def check_sum(strings):
csum = 0
countTo = (len(strings) / 2) * 2
count = 0
while count < countTo:
thisVal = strings[count + 1] * 256 + strings[count]
csum = csum + thisVal
csum = csum & 0xffffffff
count = count + 2
if countTo < len(strings):
csum = csum + strings[len(strings) - 1]
csum = csum & 0xffffffff
csum = (csum >> 16) + (csum & 0xffff)
csum = csum + (csum >> 16)
answer = ~csum
answer = answer & 0xffff
answer = answer >> 8 | (answer << 8 & 0xff00)
return answer
# 查询报文-回显请求
ICMP_REQUEST_TYPE = 8
ICMP_REQUEST_CODE = 0
# 差错报文-端口不可达
ICMP_UN_PORT_TYPE = 3
ICMP_UN_PORT_CODE = 3
# 差错报文-TTL为0
ICMP_TTL_0_TYPE = 11
ICMP_TTL_0_CODE = 0
# 查询报文-回显y应答
ICMP_ECHO_TYPE = 0
ICMP_ECHO_CODE = 0
# make_icmp_head 制作一个 icmp 报头
# icmp 报头:[1]类型 [1]代码 [2]检验和 [2]标识符 [2]序列号
def make_icmp_head():
data = struct.pack("d", time.time())
message = struct.pack("bbHHh",
ICMP_REQUEST_TYPE,
ICMP_REQUEST_CODE,
0,
os.getpid(),
0 # 随意
) + data
sum = socket.htons(check_sum(message))
message = struct.pack("bbHHh",
ICMP_REQUEST_TYPE,
ICMP_REQUEST_CODE,
sum,
os.getpid(),
0 # 随意
) + data
return message
# Traceroute 基于 ICMP 的主程序
def traceroute(address):
print("Traceroute -> {0}[{1}]".format(address, socket.gethostbyname(address)))
# 循环 ttl
for ttl in range(1, MAX_TTL_NUM):
print("[TTL = {0}] ".format(ttl), end = "")
# 采用 raw 形式,自定义 ICMP 报头
icmp_socket = socket.socket(
socket.AF_INET,
socket.SOCK_RAW,
socket.getprotobyname("icmp")
)
# 设定默认的 ip 报头
icmp_socket.setsockopt(
socket.IPPROTO_IP,
socket.IP_TTL,
struct.pack("I", ttl)
)
# 设定 ICMP 的超时时间
icmp_socket.settimeout(MAX_TIMEOUT_NUM)
# 发送请求
icmp_socket.sendto(make_icmp_head(), (address, 33434))
# 计时
time_start = time.time()
select.select([icmp_socket], [], [], MAX_TIMEOUT_NUM)
time_end = time.time()
time_all = time_end - time_start
# 判断是否超时
if time_all >= MAX_TIMEOUT_NUM:
print("***", end = " ")
else:
print("%.2fms" % (time_all), end = " ")
# 得到 ICMP 报头
try:
message, info = icmp_socket.recvfrom(1024)
except socket.timeout:
print("Timeout")
else:
icmp_header = message[20:28]
icmp_type, _, _, _, _ = struct.unpack("bbHHh", icmp_header)
# 判断类型
if icmp_type == ICMP_UN_PORT_TYPE:
print("Reached but port denied, Address = {0}".format(info[0]))
return
elif icmp_type == ICMP_TTL_0_TYPE:
print("Midway, Address = {0}".format(info[0]))
elif icmp_type == ICMP_ECHO_TYPE:
print("Reached, Address = {0}".format(info[0]))
return
if __name__ == '__main__':
address = input("Traceroute Address: ")
traceroute(address)
🎭Hello BraveNewWorld
不使用操作系统,在电脑上输出
"Hello World"
。
你可以在纸上写"Hello World"
然后看看出题人给不给你过。
不使用操作系统,我们就自己写一个(bushi)。
除了自己写一个操作系统这种方式外,我们其实也可以不需要操作系统。你需要学习汇编的基本操作和中断,还有系统从哪里启动之类的知识点。
推荐一本书:《Oranges:一个操作系统的实现》。
org 07c00h
mov ax, cs
mov es, ax
call DisplayHelloWorld
jmp $
DisplayHelloWorld:
; 调用中断 int 0x10
; 其中 ES:BP 为字符串地址
; CX 为字符串长度
; AH = 13: 显示字符串
; AL = 1: 光标跟随移动
; DL = 2: 开始的列为 2
; BH = 0: 页号为 0
; BL = 0: 红字高亮
mov ax, String
mov bp, ax
mov cx, 12
mov ax, 01301h
mov bx, 000ch
mov dl, 2
int 10h
ret
String: db "Hello World!"
times 510-($-$$) db 0
dw 0xaa55
📲Proxy with Cache
实现一个带缓存的
http
代理服务器。允许使用别的库。
你需要知道http
的缓存机制(比如怎么判断一个页面是否过期),也要知道HTTP
协议在网络结构中的位置和作用(这有助于你快速入门go
的网络库net/http
)。
这些网页可能对你有帮助:
- TCP协议详解
- http报文详解
- HTTP head请求
- 万字长文,一文搞懂TCP、IP和HTTP、HTTPS
- Go 语言使用 net 包实现 Socket 网络编程
- Web缓存
- 深入解析 HTTP 缓存控制
- 一文读懂http缓存(超详细)
- HTTP 缓存机制
- Go http
实际上,题目要求的加密不一定要用ssl
。出题人的意思是,你写个凯撒加密都行,能用就可以。
// proxache.go
package main
import (
"fmt"
"io/ioutil"
"net/http"
"time"
"github.com/fanjindong/go-cache"
)
var myCache cache.ICache
type CacheElement struct {
content []byte
etag string
last_modified string
}
func proxache(w http.ResponseWriter, request *http.Request) {
fmt.Printf("METHOD[%s] URL[%s] %s\n", request.Method, request.URL, request.RequestURI)
client := &http.Client{}
req, err := http.NewRequest(request.Method, request.RequestURI, request.Body)
if err != nil {
fmt.Println("New Request err, err =", err)
return
}
for k, v := range request.Header {
for _, vv := range v {
req.Header.Add(k, vv)
}
}
resp, err := client.Do(req)
if err != nil {
fmt.Println("Get response err, err =", err)
return
}
defer resp.Body.Close()
for key, value := range resp.Header {
w.Header()[key] = value
}
res, stat := myCache.Get(request.URL.String())
// stat 为false表示需要更新缓存
currentEtag := resp.Header.Get("Etag")
currentIfNoneMatch := resp.Header.Get("If-None-Match")
currentLastModified := resp.Header.Get("Last-Modified")
if stat { // 存在这个缓存,开始判断是否需要更新缓存
// 判断 Etag 和 If-None-Match
if currentIfNoneMatch != "" && res.(CacheElement).etag != currentIfNoneMatch {
fmt.Printf(" Not the newest page - If-None-Match\n")
stat = false
} else {
// 判断 Last-Modified
if currentIfNoneMatch != "" && res.(CacheElement).last_modified != currentLastModified {
fmt.Printf(" Not the newest page - Last-Modified\n")
stat = false
}
}
}
if !stat {
fmt.Printf(" First time accessing\n")
fileContent, err := ioutil.ReadAll(resp.Body)
if err != nil {
fmt.Println("Read file err, err =", err)
return
}
w.Write(fileContent)
myCache.Set(request.URL.String(), CacheElement{fileContent, currentEtag, currentLastModified})
} else {
fmt.Printf(" Not first time accessing\n")
w.Write(res.(CacheElement).content)
}
}
func main() {
myCache = cache.NewMemCache(cache.WithClearInterval(10 * time.Minute))
http.HandleFunc("/", proxache)
err := http.ListenAndServe("127.0.0.1:8000", nil)
if err != nil {
fmt.Println("http listen failed.")
}
}
😘计算器
不使用语言自带的
eval
函数,计算一个字符串所代表的表达式的值。
你需要读一下《编译原理》的前几章。
附上当时交的wp里的中间过程:
上下文无关语法
$$Tint \rightarrow Tint||Tint |0|1|2|3|4|5|6|7|8|9$$
$$Tfloat \rightarrow Tint . Tint | Tint$$
$$elem \rightarrow Tfloat | (expr_1)$$
$$expr_0 \rightarrow elem \space rest_0 | expr_0 \space rest_0$$
$$rest_0 \rightarrow \times elem | / elem | \epsilon$$
$$expr_1 \rightarrow expr_0 \space rest_1 | expr_1 \space rest_1$$
$$rest_1 \rightarrow + expr_0 | -expr_0 | \epsilon$$
对于 ^ 的扩展(不考虑右结合运算符和非二元运算符)
注意这四个式子:
$$expr_0 \rightarrow elem \space rest_0 | expr_0 \space rest_0$$
$$rest_0 \rightarrow \times elem | / elem | \epsilon$$
$$expr_1 \rightarrow expr_0 \space rest_1 | expr_1 \space rest_1$$
$$rest_1 \rightarrow + expr_0 | -expr_0 | \epsilon$$ 我们注意到,对于$m$个优先级为$i$($i$越小优先级越高)的二元运算符,$expr_i$和$rest_i$只需写作:
$$expr_i \rightarrow expr_{i-1} \space rest_i | expr_i \space rest_i$$
$$rest_i \rightarrow \space opr_{i, j} \space expr_{i-1} | \epsilon, j \in [1, m]$$
(当$i=0$时,并不是调用$expr_{-1}$而是调用$elem$);
由此,我们可以定义出无限“阶”的$expr$和$rest$,并且动态扩展需要使用的函数。
#include <cstdio>
#include <cstring>
#include <cctype>
#include <cmath>
#include <functional>
#include <vector>
#include <list>
#include <map>
const int MAXN = 1e5 + 1;
enum Type {
T_INVALID,
T_INT,
T_OPERATOR, // The property of operator { + - * / . }
};
struct Token
{
Token() {
type = T_INVALID;
value = 0;
}
void print(int i = 0) {
for(int j=0; j<i*2; ++j)
printf(" ");
switch(type) {
case T_INVALID:
printf("<>\n");
case T_INT:
printf("<int, %d>\n", value);
break;
case T_OPERATOR:
printf("<%c>\n", value);
break;
}
}
Type type;
int value;
};
struct Node
{
void print(int i = 0) {
token.print(i);
for(auto j : children)
j.print(i + 1);
}
Token token;
std::list<Node> children;
};
class PredictiveParser
{
public:
Node process(const char* str) {
s = str;
n = strlen(s);
m = 0;
Node ans = expr(oprs.size() - 1);
if(n != m)
error("[Process] Not fully processed");
printf("Processed at %d/%d\n", m, n);
return ans;
}
void registerOperator(int level, char c) {
while(oprs.size() <= level)
oprs.push_back(std::vector<char>());
oprs[level].push_back(c);
}
private:
void error(const char *s) {
throw s;
}
char lookahead() {
return s[m];
}
void match(char c) {
if(s[m] == c) {
++m;
} else error("[Match] does't match");
}
Node Tint() {
Node ans;
bool result = false;
while(isdigit(lookahead())) {
ans.token.value = ans.token.value * 10 + lookahead() - '0';
match(lookahead());
result = true;
}
if(!result) {
error("[Tint] Require at least one word");
}
ans.token.type = T_INT;
return ans;
}
Node Tfloat() {
Node ans;
ans.children.push_back(Tint());
if(lookahead() == '.') {
match('.');
ans.children.push_back(Tint());
}
ans.token.type = T_OPERATOR;
ans.token.value = '.';
return ans;
}
Node elem() {
Node ans;
if(lookahead() == '(') {
match('(');
ans = expr(oprs.size() - 1);
match(')');
} else {
ans = Tfloat();
}
return ans;
}
Node rest(int level) {
Node ans;
if(lookahead() == 0) // epsilon
return ans;
for(auto i : oprs[level]) {
if(lookahead() == i) {
ans.token.type = T_OPERATOR;
ans.token.value = i;
match(i);
ans.children.push_back(expr(level-1));
break;
}
}
return ans;
}
Node expr(int level) {
if(level == -1)
return elem();
Node ans;
ans = expr(level-1);
for(;;) {
Node nxt = rest(level);
if(nxt.token.type != T_INVALID) {
nxt.children.push_front(ans);
ans = nxt;
} else break;
}
return ans;
}
size_t n, m;
const char *s;
std::vector<std::vector<char>> oprs;
};
class Calculator
{
public:
void registerFunction(char c, std::function<double(const std::list<double>&)> fun) {
funs[c] = fun;
}
double value(const Node& o) {
switch(o.token.type) {
case T_INT:
return o.token.value;
case T_OPERATOR:
std::list<double> values;
for(auto i : o.children)
values.push_back(value(i));
if(funs.find(o.token.value) != funs.end()) {
return funs[o.token.value](values);
}
error("[Calculator] No operator");
}
return 0.0;
}
static double toSmall(int c) {
double divide = 1, ans = c;
while(c) {
c /= 10;
divide *= 10;
}
return ans / divide;
}
private:
void error(const char *s) {
throw s;
}
std::map<char, std::function<double(const std::list<double>&)>> funs;
};
class Processer
{
public:
void process(const char* s) {
Node ans;
try {
ans = P.process(s);
ans.print();
printf("= %lf\n\n", C.value(ans));
} catch(const char *s) {
puts(s);
puts("");
}
printf("> ");
}
void registerFunction(int level, char c, std::function<double(const std::list<double>&)> fun) {
C.registerFunction(c, fun);
P.registerOperator(level, c);
}
private:
PredictiveParser P;
Calculator C;
};
Processer S;
char s[MAXN];
int main()
{
S.registerFunction(3, '+', [](const std::list<double>& o) { return o.front() + o.back(); });
S.registerFunction(3, '-', [](const std::list<double>& o) { return o.front() - o.back(); });
S.registerFunction(2, '*', [](const std::list<double>& o) { return o.front() * o.back(); });
S.registerFunction(2, '/', [](const std::list<double>& o) { return o.front() / o.back(); });
S.registerFunction(1, '^', [](const std::list<double>& o) { return pow(o.front(), o.back()); });
S.registerFunction(0, '.', [](const std::list<double>& o) {
if(o.size() == 1)
return o.front();
return o.front() + Calculator::toSmall(o.back());
});
printf("> ");
while(~scanf("%s", s)) {
S.process(s);
}
return 0;
}
/*
(2^3+4)*(5+7)-3*4
> 132
5.5^2*(3+4.2)
> 217.8
(5+2*3^3
> [Match] does't match
(.1+2)
> [Tint] Require at least one word
(1*100)*20/5+1
> 401
*/
🗼Lost in Interpretation
使用
scheme
编写一个lisp
解释器。允许对表求值而不是对字符串求值。
你需要读《计算机程序的构造和解释》的前几章。
(我本来希望自己写的lisp
解释器能运行lisp
解释器,然后把解释器运行解释器的截图交上去,但是没弄出来)
#lang sicp
; 原有的apply副本
(define apply-in-underlying-scheme apply)
; eval
(define (eval exp env)
(cond ((self-evaluating? exp) exp)
((variable? exp) (lookup-variable-value exp env))
((quoted? exp) (text-of-quotation exp))
((assignment? exp) (eval-assignment exp env))
((definition? exp) (eval-definition exp env))
((if? exp) (eval-if exp env))
((map? exp) (eval-map exp env))
((lambda? exp)
(make-procedure (lambda-parameters exp)
(lambda-body exp)
env))
((begin? exp)
(eval-sequence (begin-actions exp) env))
((cond? exp) (eval (cond->if exp) env))
((let? exp) (eval (let->combination exp) env))
((application? exp)
(myapply (eval (operator exp) env)
(list-of-values (operands exp) env)))
(else
(error "Unknown expression type -- EVAL" exp))))
; apply
(define (myapply procedure arguments)
(cond ((primitive-procedure? procedure)
(apply-primitive-procedure procedure arguments))
((compound-procedure? procedure)
(eval-sequence
(procedure-body procedure)
(extend-environment
(procedure-parameters procedure)
arguments
(procedure-environment procedure))))
(else
(error "Unknown procedure type -- APPLY" procedure))))
(define (list-of-values exps env)
(if (no-operands? exps)
'()
(cons (eval (first-operand exps) env)
(list-of-values (rest-operands exps) env))))
(define (eval-if exp env)
(if (true? (eval (if-predicate exp) env))
(eval (if-consequent exp) env)
(eval (if-alternative exp) env)))
(define (eval-sequence exps env)
(cond ((last-exp? exps) (eval (first-exp exps) env))
(else (eval (first-exp exps) env)
(eval-sequence (rest-exps exps) env))))
(define (eval-assignment exp env)
(set-variable-value! (assignment-variable exp)
(eval (assignment-value exp) env)
env)
'ok) ; 最终具有一个返回值
(define (eval-definition exp env)
(define-variable! (definition-variable exp)
(eval (definition-value exp) env)
env)
'ok) ; 最终具有一个返回值
(define (self-evaluating? exp)
(cond ((number? exp) true)
((string? exp) true)
(else false)))
(define (variable? exp) ; 变量用符号来表示
(symbol? exp))
; quote
(define (quoted? exp)
(tagged-list? exp `quote))
(define (tagged-list? exp tag)
(if (pair? exp)
(eq? (car exp) tag)
false))
(define (text-of-quotation exp)
(cadr exp))
; assignment
(define (assignment? exp)
(tagged-list? exp 'set!))
(define (assignment-variable exp)
(cadr exp)) ; cadr: 先 cdr 再 car
(define (assignment-value exp)
(caddr exp))
; definition
(define (definition? exp)
(tagged-list? exp 'define))
(define (definition-variable exp)
(if (symbol? (cadr exp))
(cadr exp)
(caadr exp)))
(define (definition-value exp)
(if (symbol? (cadr exp))
(caddr exp)
(make-lambda (cdadr exp) ; formal parameters
(cddr exp)))) ; body
; lambda
(define (lambda? exp) (tagged-list? exp 'lambda))
(define (lambda-parameters exp) (cadr exp))
(define (lambda-body exp) (cddr exp))
(define (make-lambda parameters body)
(cons 'lambda (cons parameters body)))
; if
(define (if? exp) (tagged-list? exp 'if))
(define (if-predicate exp) (cadr exp))
(define (if-consequent exp) (caddr exp))
(define (if-alternative exp)
(if (not (null? (cdddr exp)))
(cadddr exp)
'false))
(define (make-if predictive consequent alternative)
(list 'if predictive consequent alternative))
; begin
(define (begin? exp) (tagged-list? exp 'begin))
(define (begin-actions exp) (cdr exp))
(define (last-exp? seq) (null? (cdr seq)))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))
(define (sequence->exp seq)
(cond ((null? seq) seq)
((last-exp? seq) (first-exp seq))
(else (make-begin seq))))
(define (make-begin seq)
(cons 'begin seq))
; application
(define (application? exp) (pair? exp))
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))
(define (no-operands? ops) (null? ops))
(define (first-operand ops) (car ops))
(define (rest-operands ops) (cdr ops))
; cond
(define (cond? exp) (tagged-list? exp 'cond))
(define (cond-clauses exp) (cdr exp))
(define (cond-else-clause? clause)
(eq? (cond-predicate clause) 'else))
(define (cond-predicate clause) (car clause))
(define (cond-actions clause) (cdr clause))
(define (cond->if exp)
(expand-clauses (cond-clauses exp)))
(define (expand-clauses clauses)
(if (null? clauses)
'false
(let ((first (car clauses))
(rest (cdr clauses)))
(if (cond-else-clause? first)
(if (null? rest)
(sequence->exp (cond-actions first))
(error "ELSE clause isn't last -- COND->IF"))
(make-if (cond-predicate first)
(sequence->exp (cond-actions first))
(expand-clauses rest))))))
; 这一段留给练习 4.6
(define (let? exp) (tagged-list? exp 'let))
(define (let-clauses exp) (cdr exp))
(define (let-body clause) (cdr clause))
(define (let-variables clause) (car clause))
(define (let->combination exp)
(expand-let (let-clauses exp)))
(define (make-combination vars body exps)
(display (cons (make-lambda vars body) exps))
(cons (make-lambda vars body) exps))
(define (expand-let clause) ; (let ((x 1) (y 2)) (cons x y))
(let ((body (let-body clause))
(variables (let-variables clause)))
(define (read-loop-first pairs)
(if (null? pairs)
'()
(if (pair? (car pairs))
(cons (caar pairs) (read-loop-first (cdr pairs)))
(error "LET expression lack of var -- expand-let"))))
(define (read-loop-second pairs)
(if (null? pairs)
'()
(if (pair? (car pairs))
(cons (cadar pairs) (read-loop-second (cdr pairs)))
(error "LET expression lack of exp -- expand-let"))))
(let ((vars (read-loop-first variables))
(exps (read-loop-second variables)))
(make-combination vars body exps))))
; 这里实现一个map
(define (map? exp) (tagged-list? exp 'map))
(define (eval-map exp env)
(let ((proc (cadr exp))
(alist (cddr exp)))
(apply-in-underlying-scheme
map
((lambda (x) (myapply (eval proc env) (list x)))
(list-of-values alist env)))))
; /这一段留给练习 4.6
; 这一段留给练习 4.9
; /这一段留给练习 4.9
; verb
(define (true? x)
(not (eq? x false)))
(define (false? x)
(eq? x false))
; procedure
(define (make-procedure parameters body env)
(list 'procedure parameters body env))
(define (compound-procedure? p)
(tagged-list? p 'procedure))
(define (procedure-parameters p) (cadr p))
(define (procedure-body p) (caddr p))
(define (procedure-environment p) (cadddr p))
; environment
(define (enclosing-environment env) (cdr env))
(define (first-frame env) (car env))
(define (the-empty-environment) '()) ; 注意这里理论上应该写 '()
; frame
(define (make-frame variables values)
(cons variables values)) ; 这个表由两个等长的表组成,一个是key,一个是value
(define (frame-variables frame) (car frame))
(define (frame-values frame) (cdr frame))
(define (add-binding-to-frame! var val frame)
(set-car! frame (cons var (car frame)))
(set-cdr! frame (cons val (cdr frame))))
; extending
(define (extend-environment vars vals base-env)
(if (= (length vars) (length vals))
(cons (make-frame vars vals) base-env)
(if (< (length vars) (length vals))
(error "Too many arguments supplied")
(error "Too few arguments supplied"))))
; set variable
(define (lookup-variable-value var env)
(define (env-loop env)
(define (scan vars vals)
(cond ((null? vars)
(env-loop (enclosing-environment env)))
((eq? var (car vars))
(car vals))
(else (scan (cdr vars) (cdr vals)))))
(if (eq? env the-empty-environment)
(error "Unbound variable" var)
(let ((frame (first-frame env)))
(scan (frame-variables frame)
(frame-values frame)))))
(env-loop env))
(define (set-variable-value! var val env)
(define (env-loop env)
(define (scan vars vals)
(cond ((null? vars)
(env-loop (enclosing-environment env)))
((eq? var (car vars))
(set-car! vals val))
(else (scan (cdr vars) (cdr vals)))))
(if (eq? env the-empty-environment)
(error "Unbound variable -- SET!" var)
(let ((frame (first-frame env)))
(scan (frame-variables frame)
(frame-values frame)))))
(env-loop env))
(define (define-variable! var val env)
(let ((frame (first-frame env)))
(define (scan vars vals)
(cond ((null? vars)
(add-binding-to-frame! var val frame))
((eq? var (car vars))
(set-car! vals val))
(else (scan (cdr vars) (cdr vals)))))
(scan (frame-variables frame)
(frame-values frame))))
; setup
(define (setup-environment)
(let ((initial-env
(extend-environment (primitive-procedure-names)
(primitive-procedure-objects)
the-empty-environment)))
(define-variable! 'true true initial-env)
(define-variable! 'false false initial-env)
initial-env))
; primitive procedure
(define (primitive-procedure? proc)
(tagged-list? proc 'primitive))
(define (primitive-implementation proc) (cadr proc))
(define primitive-procedures
(list (list 'car car)
(list 'cdr cdr)
(list 'cons cons)
(list 'null? null?)
(list 'string? string?)
(list 'number? number?)
(list 'read read)
(list 'display display)
(list 'newline newline)
(list 'apply apply)
(list 'list list)
(list '+ +)
(list '* *)
; 其他基本过程
))
(define (primitive-procedure-names)
(map car primitive-procedures))
(define (primitive-procedure-objects)
(map (lambda (proc) (list 'primitive (cadr proc)))
primitive-procedures))
(define (apply-primitive-procedure proc args)
(apply-in-underlying-scheme
(primitive-implementation proc) args))
; main
(define input-prompt ";;;M-Eval input:")
(define output-prompt ";;;M-Eval output:")
(define the-global-environment (setup-environment))
(define (driver-loop)
(prompt-for-input input-prompt)
(let ((input (read)))
(let ((output (eval input the-global-environment)))
(announce-output output-prompt)
(user-print output))
(driver-loop)))
(define (prompt-for-input string)
(newline)
(newline)
(display string)
(newline))
(define (announce-output string)
(newline)
(display string)
(newline))
(define (user-print object)
(if (compound-procedure? object)
(display (list 'compound-procedure
(procedure-parameters object)
(procedure-body object)))
(display object)))
; event-loop
(driver-loop)
(define (append x y)
(if (null? x)
y
(cons (car x)
(append (cdr x) y))))
; (append '(1 2 3) '(4 5))