Lazy_Pig

Racket 里的迭代

只知道 Scheme 里有个不太好用的 do 循环,一直不知道 Racket 里竟然还有 for 循环,而且还有好几种。

Read More

HLA 高级汇编语言基本语法备忘

并不是我突然对汇编语言产生了兴趣。其实我对汇编一无所知,唯一知道的是汇编指令其实就是 CPU 指令的助记符。用机器码写程序,想想都觉得可怕。我开始接触汇编的原因是,我正在看 Abdulaziz Ghuloum 写的一篇未完工的 tutorial:《Compilers: Backend to Frontend and Back to Front Again》,Abdulaziz Ghuloum 正是 ikarus 的作者,ikarus 是现存的已知的最快的 Scheme 实现(除了神龙见首不见尾的 Chez Scheme,那玩意就没人见过,所以不参与比较)。而 Chez 的作者 Kent Dybvig 正是 Abdulaziz Ghuloum 在印地安那大学的老师。Abdulaziz Ghuloum 这位老兄做事有始无终,06年写了篇tutorial,结果没写完就不写了,ikarus 也停止维护了。听人说他跑到中东某所大学教书去了。好在他还有一篇论文,可以与 tut 互相参考。

Read More

用 Scheme 写的简单数据库

《实用 Common Lisp 编程》开篇用CL实现了一个简单的数据库,我自认为知道点 Scheme, 同样作为上古 Lisp 的方言,两者应该相差不会太大,结果一开篇就看不太懂了。

Read More

将数字转换成大写中文

这是PAT上的一题,随便改改,通过参数传递要转换的数字,便有实用价值了。不过暂时没空实现浮点数支持,目前只能转换整数。

Read More

GCC 动态链接和静态链接

在 Linux 下,动态链接库以 .so 存在,而在 Windows 平台下是 .dll 文件。程序在运行时,根据函数入口调用库里面的函数。所以,动态链接库必须和可执行文件一同打包发布,而且在运行时要能够被找到。

Read More

浙大 PAT (Basic Level) 习题

最近在 MOOC 上学习 C 语言,由浙大的翁恺老师授课,作业也是提交到浙大的 PAT 网站。偶尔发现该网站上有一个 Basic Level 习题集,可以用很多种语言提交代码,其中就包括我正在自学的 scheme。手痒便用 scheme 把题做了一遍,不得不说 PAT 真坑爹。

Read More

数字黑洞 & Scheme 实现快速排序算法

其实这是浙大 PAT 网站上的一个题,要求输入一个小于 10000 的正整数,输出 6174 数字黑洞的计算步骤。既然要把数字位打散重新排序,那就得应用某种算法。之前从没接触过排序算法,Google 之后参考别人的写法写了一个快速排序函数。因为,PAT 侧重其它语言的测试,在输入其输出格式上颇为严格,而 Scheme 在输入及输出上比较弱,虽然 PAT 上指明了用的是实现是 guile ,但是不知道为什么,我在代码中导入 guile 的模块会发现无法通过测试。没办法,只好用 R5RS 里的标准函数来写。所以,搞得比较累,往往结果出来了,发现格式不对,于是再改代码,最后弄得比较乱。

Read More

call/cc 探秘

对我来讲,Scheme 中的 Continuation 是个过于神秘的东西,一直都搞不懂(好吧,我承认我被吓坏了,我从来没尝试过搞懂它,因为我一遇见它就决定绕开)。

Read More

把王垠的 scheme 解释器改了一下

王垠的这个解释器比起 The Little Schemer 第10章那个,简单得多,很容易就搞懂了。当然也差了一些东西,比如 quote cond 等。如果把这些东西加上去,两者也就差不多一样了。它们唯一的区别是,王垠的版本用 association list 来保存环境,而 TLS 里的那个用三层嵌套的列表来干这个事,结果很容易就被绕晕了。

Read More

终于把TLS最后一章的解释器调通了

TLS看完了,但是最后一章的MINI解释器没有运行成功,心里始终有个疙瘩。昨天抽空把代码敲了一遍,终于运行成功了。而且发现了上次没有成功的原因——代码中的 apply 与系统函数命名冲突了。我一般不用DrRacket,都是在命令行下配合 emacs 使用。在命令行下 racket 的出错提示不够详细。相同的代码,在 chicken 里通过了,在 racket 里通不过,让人颇受折磨。最后抱着尝试在 DrRacket 调试,结果一运行就提示冲突,改了就好了。

Read More

两种方法打印乘法口决

这两天中了 Scheme 的毒,看完《The Little Schemer》后我别的没学会,就学会了递归。我听说每一个循环最后都能转化成递归,于是我着迷地想把这两天做的C练习题都转换成递归实现。我已经做了两道题了,一道找出水仙花数,一道找素素。

Read More

用C实现的日历程序

昨天晚上看《现代方法》看到的一个习题,要求写一个程序,输入一个月的总天数,以及当月从一个星期的第几天开始,然后打印出月历。 突然想起来,把这个小程序扩展一下,不就是个万年历吗?于是花了一天晚上把它写了出来。

Read More

递归与尾递归

网络上的资料真是不严谨,对于非科班出身的人,试图搞懂一个专业问题的时候,往往会被网络误导。比如关于尾递归的严格、权威的概念,我到现在都搞不清楚,网上的示例,有一些把简单的问题搞复杂,而有一些干脆就是错的。

Read More

The Little Schemer 看完,还是一团浆糊

断断续续终于把进度推进到最后一章,书中实现的解释器调试通不过。我一个字母一个字母地复查了几遍,没发现错误,可还是出错。从网上COPY了别人的代码,还是运行出错,搞得有点心灰意冷了。我可耻地产生了想要逃跑的想法。

Read More

奇葩的字体错乱

因为老爷机上的XP越来越卡,于是我将它的系统换成了Debian + LXDE。花几天工夫终于把系统调教得差不多了。

Read More

Y-Combinator推导

卡这里好几天了,杂务又多,今天抽空把TLS第9章的代码敲了一遍,MS有一点点理解了

Read More

被bash的初始化文件搞到头大

刚装上Debian的时候,我发现自己home目录下的.profile .bashrc等文件被清空了。我误以为Debian没有为用户提供预定制的脚本,对我而言,仅仅是用它来定义几个别名,把几个目录加进 $PATH 变量。

Read More

Geiser 基本用法

Geiser是一个类似于common lisp上的slime的emacs插件,它只支持两种scheme实现——racket和guile

Read More

刚刚遭到黑客攻击

昨天出门远行,还在汽车上的时候突然收到几百条短信轰炸,在大约一个小时的时间里不停地有短信进来。短信内容全部是一些网站的验证码,其中不乏一些知名网站,比如华为商城,其它的都是一些在线交易或者游戏类型的网站。我不由得静下心来思索这是为什么,很自然的一个猜测是有人试图冒用我的手机号进行注册,注册的网站这么多,短信进来的时间都非常接近,几乎是同时进来的,那么可以肯定他是用脚本进行操作,而不是手工操作。可是他这么干有什么好处呢?验证码都发到我手机上了,他并没有收到。也许他有我手机的复制卡?我仔细想了一下,为了方便使用,我确实复制过我自己的手机卡,但是都没有丢失过,其它人不可能得到。而且就算是对方有我的复制卡,那么如果他悄悄上线的话,我会被强制下线,我是不可能收到短信的,因为短信会发到他的手机上。

Read More

蛋疼的一天

作为一个半文盲农民,一见到英文就头大。尽管很多人说The Little Schemer里的英文很浅显,但是对我来说还是太难了。一直以来我都是靠着两件宝贝在硬啃:星际译王和谷狗翻译。实在弄不懂的句子干脆就不管了,只看代码。就这样硬啃到了第六章。

Read More

理解不能的函数

在《The Little Schemer》第91页有两个版本的函数eqlist?,用来比较两个列表是否完全相同。其中版本一的逻辑真让人理解不能。版本2倒是挺简单。

Read More

又一个Scheme实现——Vicare

Vicare的前身是Ikarus Scheme,一个速度很快的增量式编译器,可以将Scheme代码直接编译成机器码运行,但是不支持可执行文件生成。Ikarus的作者Abdulaziz Ghuloum是著名的Chez Scheme的作者Kent Dybvig的学生。嗯,算起辈份来,是王垠的师哥。

Read More

The Little Schemer 练习代码

;;;;;;;;;;;;;;;;;;;;前言;;;;;;;;;;;;;;;;;;;;;;

(define atom?
  (lambda (a)
    (and (not (pair? a)) (not (null? a)))))

;;;;;;;;;;;;;;;;;;;;第2章;;;;;;;;;;;;;;;;;;;;;

;;测试列表是否由单个的原子构成
(define lat?
  (lambda (l)
    (cond
     ((null? l) #t)
     (else (and (atom? (car l))
                (lat? (cdr l)))))))


;;测试原子 a 是否是列表 lat 的成员
(define member?
  (lambda (a lat)
    (cond
     ((null? lat) #f)
     (else
      (or (eq? (car lat) a)
          (member? a (cdr lat)))))))

;;;;;;;;;;;;;;;;;;;;第3章;;;;;;;;;;;;;;;;;;;;;

;;从列表 lat 中删除第一个与原子 a 相同的成员
(define rember
  (lambda (a lat)
    (cond
     ((null? lat) (quote ()))
     ((eq? (car lat) a) (cdr lat))
     (else
      (cons (car lat) (rember a (cdr lat)))))))

;;从复合列表中取每一个子列表的car,组成一个新列表
(define firsts
  (lambda (l)
    (cond
     ((null? l) (quote ()))
     (else
      (cons (car (car l))
            (firsts (cdr l)))))))

;;从复合列表中取每个子列表的第二个原子,组成一个新列表
(define seconds
  (lambda (l)
    (cond
     ((null? l) (quote ()))
     (else
      (cons (car (cdr (car l)))
            (seconds (cdr l)))))))

(define insertR
  (lambda (new old lat)
    (cond
     ((null? lat) (quote ()))
     ((eq? (car lat) old)
      (cons old
            (cons new (cdr lat))))
     (else
      (cons (car lat) (insertR new old (cdr lat)))))))

(define insertL
  (lambda (new old lat)
    (cond
     ((null? lat) (quote ()))
     ((eq? (car lat) old)
      (cons new lat))
     (else
      (cons (car lat)
            (insertL new old (cdr lat)))))))

;;替换函数
(define subst
  (lambda (new old lat)
    (cond
     ((null? lat) (quote ()))
     ((eq? (car lat) old)
      (cons new (cdr lat)))
     (else
      (cons (car lat)
            (subst new old (cdr lat)))))))

;;替换函数,与subst不同的是不论找到o1还是o2都进行替换
(define subst2
  (lambda (new o1 o2 lat)
    (cond
     ((null? lat) (quote ()))
     ((or (eq? (car lat) o1)
          (eq? (car lat) o2))
      (cons new (cdr lat)))
     (else
      (cons (car lat) (subst2 new o1 o2 (cdr lat)))))))

;;多重删除列表成员
(define multirember
  (lambda (a lat)
    (cond
     ((null? lat) (quote ()))
     ((eq? (car lat) a)
      (multirember a (cdr lat)))
     (else
      (cons (car lat)
            (multirember a (cdr lat)))))))

;;多重插入(右边)
(define multiinsertR
  (lambda (new old lat)
    (cond
     ((null? lat) (quote ()))
     ((eq? (car lat) old)
      (cons old
            (cons new
                  (multiinsertR new old (cdr lat)))))
     (else
      (cons (car lat)
            (multiinsertR new old (cdr lat)))))))

;;多重插入(左边)
(define multiinsertL
  (lambda (new old lat)
    (cond
     ((null? lat) (quote ()))
     ((eq? (car lat) old)
      (cons new
            (cons old
                  (multiinsertL new old (cdr lat)))))
     (else
      (cons (car lat)
            (multiinsertL new old (cdr lat)))))))

;;多重替换
(define multisubst
  (lambda (new old lat)
    (cond
     ((null? lat) (quote ()))
     ((eq? (car lat) old)
      (cons new (multisubst new old (cdr lat))))
     (else
      (cons (car lat)
            (multisubst new old (cdr lat)))))))

;;;;;;;;;;;;;;;;;;;;;;;第4章;;;;;;;;;;;;;;;;;;;;;;;;;;

;;定义加法
(define o+
  (lambda (n m)
    (cond
     ((zero? m) n)
     (else
      (add1 (o+ n (sub1 m)))))))

;;定义减法
(define o-
  (lambda (n m)
    (cond
     ((zero? m) n)
     (else
      (sub1 (o- n (sub1 m)))))))

;;将数字列表成员相加
(define addtup
  (lambda (tup)
    (cond
     ((null? tup) 0)
     (else
      (+ (car tup) (addtup (cdr tup)))))))

;;定义乘法
(define x
  (lambda (n m)
    (cond
     ((zero? m) 0)
     (else
      (+ n (x n (sub1 m)))))))

;;对两个列表执行加法
(define tup+
  (lambda (tup1 tup2)
    (cond
     ((null? tup1) tup2)
     ((null? tup2) tup1)
     (else
      (cons (+ (car tup1) (car tup2))
            (tup+ (cdr tup1) (cdr tup2)))))))

;;定义大于号
(define >
  (lambda (n m)
    (cond
     ((zero? n) #f)
     ((zero? m) #t)
     (else
      (> (sub1 n) (sub1 m))))))

;;定义小于号
(define <
  (lambda (n m)
    (cond
     ((zero? m) #f)
     ((zero? n) #t)
     (else
      (< (sub1 n) (sub1 m))))))

;;定义等号
(define =
  (lambda (n m)
    (cond
     ((zero? n) (zero? m))
     ((zero? m) #f)
     (else
      (= (sub1 n) (sub1 m))))))

;;定义乘方函数^
(define ^
  (lambda (n m)
    (cond
     ((zero? m) 1)
     (else
      (* n (^ n (sub1 m)))))))

;;定义除法函数
(define div
  (lambda (n m)
    (cond
     ((< n m) 0)
     (else
      (add1 (div (- n m) m))))))

;;求列表中成员的个数
(define length
  (lambda (lat)
    (cond
     ((null? lat) 0)
     (else
      (add1 (length (cdr lat)))))))

;;从列表中取出指定位置的成员
(define pick
  (lambda (n lat)
    (cond
     ((zero? (sub1 n)) (car lat))
     (else
      (pick (sub1 n) (cdr lat))))))


;;从列表中删除指定位置的成员
(define rempick
  (lambda (n lat)
    (cond
     ((zero? (sub1 n)) (cdr lat))
     (else
      (cons (car lat) (rempick (sub1 n) (cdr lat)))))))

;;从列表中删除所有数字原子
(define no-nums
  (lambda (lat)
    (cond
     ((null? lat) (quote ()))
     ((number? (car lat))
      (no-nums (cdr lat)))
     (else
      (cons (car lat)
            (no-nums (cdr lat)))))))

;;从列表中取出所有数字原子,组成新列表
(define all-nums
  (lambda (lat)
    (cond
     ((null? lat) (quote ()))
     ((number? (car lat))
      (cons (car lat)
            (all-nums (cdr lat))))
     (else
      (all-nums (cdr lat))))))

;;比较两个原子是否相等(包括数字和非数字)
(define eqan?
  (lambda (a1 a2)
    (cond
     ((and (number? a1) (number? a2))
      (= a1 a2))
     ((or (number? a1) (number? a2))
      #f)
     (else (eq? a1 a2)))))

;;统计原子a在列表lat中出现的次数
(define occur
  (lambda (a lat)
    (cond
     ((null? lat) 0)
     ((eq? (car lat) a)
      (add1 (occur a (cdr lat))))
     (else (occur a (cdr lat))))))

;;测试一个原子是否等于1
(define one?
  (lambda (n)
    (= 1 n)))

;;;;;;;;;;;;;;;;;;;;;;第5章;;;;;;;;;;;;;;;;;;;;;;

;;递归删除列表中的原子
(define rember*
  (lambda (a l)
    (cond
     ((null? l) (quote ()))
     ((atom? (car l))
      (cond
       ((eq? (car l) a)
        (rember* a (cdr l)))
       (else (cons (car l)
                   (rember* a (cdr l))))))
     (else (cons (rember* a (car l))
                 (rember* a (cdr l)))))))

;;递归插入(右边)
(define insertR*
  (lambda (new old l)
    (cond
     ((null? l) (quote ()))
     ((atom? (car l))
      (cond
       ((eq? (car l) old)
        (cons (car l)
              (cons new
                    (insertR* new old (cdr l)))))
       (else (cons (car l)
                   (insertR* new old (cdr l))))))
     (else (cons (insertR* new old (car l))
                 (insertR* new old (cdr l)))))))

;;递归统计原子在列表中出现的次数
(define occur*
  (lambda (a l)
    (cond
     ((null? l) 0)
     ((atom? (car l))
      (cond
       ((eq? (car l) a)
        (add1 (occur* a (cdr l))))
       (else (occur* a (cdr l)))))
     (else (+ (occur* a (car l))
              (occur* a (cdr l)))))))

;;递归替换列表中的原子
(define subst*
  (lambda (new old l)
    (cond
     ((null? l) (quote ()))
     ((atom? (car l))
      (cond
       ((eq? (car l) old)
        (cons new (subst* new old (cdr l))))
       (else (cons (car l)
                   (subst* new old (cdr l))))))
     (else
      (cons (subst* new old (car l))
            (subst* new old (cdr l)))))))

;;递归插入(左边)
(define insertL*
  (lambda (new old l)
    (cond
     ((null? l) '())
     ((atom? (car l))
      (cond
       ((eq? (car l) old)
        (cons new
              (cons old
                    (insertL* new old (cdr l)))))
       (else
        (cons (car l)
              (insertL* new old (cdr l))))))
     (else
      (cons (insertL* new old (car l))
            (insertL* new old (cdr l)))))))

;;递归查询原子是否是列表成员
(define member*
  (lambda (a l)
    (cond
     ((null? l) #f)
     ((atom? (car l))
      (or (eq? (car l) a)
          (member* a (cdr l))))
     (else
      (or (member* a (car l))
          (member* a (cdr l)))))))

;;取出列表第一个成员的最内层原子
(define leftmost
  (lambda (l)
    (cond
     ((atom? (car l)) (car l))
     (else (leftmost (car l))))))

;;判断列表是否相等
(define eqlist?
  (lambda (l1 l2)
    (cond
     ((and (null? l1) (null? l2)) #t)
     ((or (null? l1) (null? l2)) #f) ;长度不一
     ((and (atom? (car l1))
           (atom? (car l2)))
      (and (eqan? (car l1) (car l2))
           (eqlist? (cdr l1) (cdr l2))))
     ((or (atom? (car l1))
          (atom? (car l2)))
      #f)
     (else
      (and (eqlist? (car l1) (car l2))
           (eqlist? (cdr l1) (cdr l2)))))))

;;比较两个S-表达式是否相等
(define equal?
  (lambda (s1 s2)
    (cond
     ((and (atom? s1) (atom? s2))
      (eqan? s1 s2))
     ((or (atom? s1) (atom? s2))
      #f)
     (else
      (eqlist? s1 s2)))))

;;使用equal?重写eqlist?
(define eqlist?
  (lambda (l1 l2)
    (cond
     ((and (null? l1) (null? l2)) #t)
     ((or (null? l1) (null? l2)) #f)
     (else
      (and (equal? (car l1) (car l2))
           (eqlist? (cdr l1) (cdr l2)))))))

;;重写rember,不限于删除原了,而是删除任意的表达式
(define rember
  (lambda (s l)
    (cond
     ((null? l) (quote ()))
     ((equal? (car l) s) (cdr l))
     (else (cons (car l)
                 (rember s (cdr l)))))))

;;;;;;;;;;;;;;;;;;;;;;第6章;;;;;;;;;;;;;;;;;;;;;

;;测试对象是否算术表达式
(define numbered?
  (lambda (aexp)
    (cond
     ((atom? aexp) (number? aexp))
     (else
      (and (numbered? (car aexp))
           (numbered? (car (cdr (cdr aexp)))))))))

;;求值函数
(define value
  (lambda (nexp)
    (cond
     ((atom? nexp) nexp)
     ((eq? (car (cdr nexp)) (quote +))
      (+ (value (car nexp))
         (value (car (cdr (cdr nexp))))))
     ((eq? (car (cdr nexp)) (quote x))
      (x (value (car nexp))
         (value (car (cdr (cdr nexp))))))
     (else
      (^ (value (car nexp))
         (value (car (cdr (cdr nexp)))))))))

;;去处符前置的表达式求值函数
;;需要先定义几个辅助函数,用来取出去处符和操作数
(define 1st-sub-exp
  (lambda (aexp)
    (car (cdr aexp))))

(define 2nd-sub-exp
  (lambda (aexp)
    (car (cdr (cdr aexp)))))

(define operator
  (lambda (aexp)
    (car aexp)))

(define value
  (lambda (nexp)
    (cond
     ((atom? nexp) nexp)
     ((eq? (operator nexp) (quote +))
      (+ (value (1st-sub-exp nexp))
         (value (2nd-sub-exp nexp))))
     ((eq? (operator nexp) (quote x))
      (x (value (1st-sub-exp nexp))
         (value (2nd-sub-exp nexp))))
     (else
      (^ (value (1st-sub-exp nexp))
         (value (2nd-sub-exp nexp)))))))

;;;;;;;;;;;;;;;;;;;第7章;;;;;;;;;;;;;;;;;;;;;

;;测试lat(单一列表)中是否含有重复的原子
(define set?
  (lambda (lat)
    (cond
     ((null? lat) #t)
     ((member? (car lat) (cdr lat)) #f)
     (else
      (set? (cdr lat))))))

;;删除列表中重复的原子(保留最后一个)
(define makeset
  (lambda (lat)
    (cond
     ((null? lat) lat)
     ((member? (car lat) (cdr lat))
      (makeset (cdr lat)))
     (else (cons (car lat)
                 (makeset (cdr lat)))))))

;;用multirember重写makeset,这次保留的是第一个原子
;;后面的重复原子都被删除了
(define makeset
  (lambda (lat)
    (cond
     ((null? lat) (quote ()))
     (else (cons (car lat)
                 (makeset
                  (multirember (car lat)
                               (cdr lat))))))))

;;测试set1中的原子是否都出现在set2中
(define subset?
  (lambda (set1 set2)
    (cond
     ((null? set1) #t)
     (else
      (and (member? (car set1) set2)
           (subset? (cdr set1) set2))))))

;;测试两个set是否相同
(define eqset?
  (lambda (set1 set2)
    (and (subset? set1 set2)
         (subset? set2 set1))))

;;测试两个set中是否有原子交集
(define intersect?
  (lambda (set1 set2)
    (cond
     ((null? set1) #f)
     (else
      (or (member? (car set1) set2)
          (intersect? (cdr set1) set2))))))

;;从两个set中取出有交集的原子,组成新列表
(define intersect
  (lambda (set1 set2)
    (cond
     ((null? set1) (quote ()))
     ((member? (car set1) set2)
      (cons (car set1)
            (intersect (cdr set1) set2)))
     (else
      (intersect (cdr set1) set2)))))

;;从两个set中删除重复的原子,将未重复的原子组成一个新列表
(define union
  (lambda (set1 set2)
    (cond
     ((null? set1) set2)
     ((member? (car set1) set2)
      (union (cdr set1) set2))
     (else
      (cons (car set1)
            (union (cdr set1) set2))))))

;;返回set1中有而set2中没有的原子
(define xxx
  (lambda (set1 set2)
    (cond
     ((null? set1) (quote ()))
     ((member? (car set1) set2)
      (xxx (cdr set1) set2))
     (else (cons (car set1)
                 (xxx (cdr set1) set2))))))

;;返回l-set的所有子set中都有的原子
(define intersectall
  (lambda (l-set)
    (cond
     ((null? (cdr l-set)) (car l-set))
     (else
      (intersect (car l-set)
                 (intersectall (cdr l-set)))))))

;;测试对象是否只由两个S-表达式组成
(define a-pair?
  (lambda (x)
    (cond
     ((atom? x) #f)
     ((null? x) #f)
     ((null? (cdr x)) #f)
     ((null? (cdr (cdr x))) #t)
     (else #f))))

(define first
  (lambda (p)
    (car p)))

(define second
  (lambda (p)
    (car (cdr p))))

(define build
  (lambda (s1 s2)
    (cons s1 (cons s2 (quote ())))))

(define third
  (lambda (p)
    (car (cdr (cdr p)))))

;;必须得理一理概念了
;;rel是一类特殊的列表,它只由pair构成,而且不能有重复的pair
;;那么pair又是什么呢?pair是由两个S-表达式构成的列表
;;fun是一类特殊的rel,它的特点是每一个子列表的第一个元素不能重复
;;也就是使用firsts函数取出所有子列表的第一个元素,组成的新列表
;;应该是一个set
;;fullfun是一类更特殊的fun,它的子列表的第二项也不能重复

(define fun?
  (lambda (rel)
    (set? (firsts rel))))

;;翻转rel
(define revrel
  (lambda (rel)
    (cond
     ((null? rel) (quote ()))
     (else
      (cons (build (second (car rel))
                   (first (car rel)))
            (revrel (cdr rel)))))))

;;翻转pair
(define  revpair
  (lambda (pair)
    (build (second pair)
           (first pair))))

;;重写revrel,使用了上面的辅助函数revpair
(define revrel
  (lambda (rel)
    (cond
     ((null? rel) (quote ()))
     (else
      (cons (revpair (car rel))
            (revrel (cdr rel)))))))

(define fullfun?
  (lambda (fun)
    (set? (seconds fun))))

(define one-to-one?
  (lambda (fun)
    (fun? (revrel fun))))

;;;;;;;;;;;;;;;;;;;;;;;;;第8章;;;;;;;;;;;;;;;;;;;;;;;;

;;把函数作为参数传递给另一个函数,实现rember
(define rember-f
  (lambda (test? a l)
    (cond
     ((null? l) (quote ()))
     ((test? (car l) a) (cdr l))
     (else (cons (car l) (rember-f test? a (cdr l)))))))

(define rember-f
  (lambda (test?)
    (lambda (a l)
      (cond
       ((null? l) (quote ()))
       ((test? (car l) a) (cdr l))
       (else (cons (car l)
                   ((rember-f test?) a l)))))))

(define insertL-f
  (lambda (test?)
    (lambda (new old l)
      (cond
       ((null? l) (quote ()))
       ((test? (car l) old)
        (cons new (cons old (cdr l))))
       (else
        (cons (car l)
              ((insertL-f test?) new old (cdr l))))))))

(define insertR-f
  (lambda (test?)
    (lambda (new old l)
      (cond
       ((null? l) (quote ()))
       ((test? (car l) old)
        (cons old (cons new (cdr l))))
       (else
        (cons (car l)
              ((insertR-f test?) new old (cdr l))))))))

(define seqL
  (lambda (new old l)
    (cons new (cons old l))))

(define seqR
  (lambda (new old l)
    (cons old (cons new l))))

;;根据调用的辅助函数不同,可以在old左边或右边插入原子
(define insert-g
  (lambda (seq)
    (lambda (new old l)
      (cond
       ((null? l) (quote ()))
       ((eq? (car l) old)
        (seq new old (cdr l)))
       (else (cons (car l)
                   ((insert-g seq) new old (cdr l))))))))

;;重写insertL,这次不用seqL
(define insertL
  (insert-g
   (lambda (new old l)
     (cons new (cons old l)))))

;;用insert-g重写subst(替换函数)
(define subst
  (insert-g
   (lambda (new old l)
     (cons new l))))

(define seqrem
  (lambda (new old l) l))

(define rember
  (lambda (a l)
    ((insert-g seqrem) #f a l)))
;;首先,(insert-g seqrem)返回一个函数,这个函数需要3个参数:
;;new old l
;;在insert-g内部有一个判断:如果(eq? (car l) old)
;;则执行(seqrem new old (cdr l))
;;而函数seqrem的程序逻辑是直接返回(cdr l)
;;如果eq?判断不相等,则把(car l) cons到递归执行insert-g的结果上
;;rember只需要两个参数a l
;;而insert-g需要3个参数:new old l
;;因为new参数在整个函数逻辑里不起作用,所以传递参数时使用一个#f作为
;;占位符。剩下的old对应a,l对应l
;;而seqrem所需要的3个参数:new old l,nwe old并未在程序逻辑中使用,
;;其实也是占位符,但是传值调用时,第3个参数 l 并未原封不动地传给它
;;传递的是(cdr l),这样就实现了递归调用。


(define atom-to-function
  (lambda (o)
    (cond
     ((eq? o (quote +)) +)
     ((eq? o (quote x)) x)
     (else ^))))

(define value
  (lambda (nexp)
    (cond
     ((atom? nexp) nexp)
     (else
      ((atom-to-function (operator nexp))
       (value (1st-sub-exp nexp))
       (value (2nd-sub-exp nexp)))))))

(define multirember-f
  (lambda (test?)
    (lambda (a lat)
      (cond
       ((null? lat) (quote ()))
       ((test? (car lat) a)
        ((multirember-f test?) a (cdr lat)))
       (else
        (cons (car lat)
              ((multirember-f test?) a (cdr lat))))))))

(define eq?-c
  (lambda (a)
    (lambda (x)
      (eq? x a))))

(define eq?-tuna
  (eq?-c (quote tuna)))

;;调用上面的eq?-tuna函数进行比较
(define multiremberT
  (lambda (test? lat)
    (cond
     ((null? lat) (quote ()))
     ((test? (car lat))
      (multiremberT test? (cdr lat)))
     (else (cons (car lat)
                 (multiremberT test? (cdr lat)))))))


;;continuation
(define multirember&co
  (lambda (a lat col)
    (cond
     ((null? lat)
      (col (quote ()) (quote ())))
     ((eq? (car lat) a)
      (multirember&co a (cdr lat)
                      (lambda (newlat seen)
                        (col newlat
                             (cons (car lat) seen)))))
     (else
      (multirember&co a (cdr lat)
                      (lambda (newlat seen)
                        (col (cons (car lat) newlat) seen)))))))

(define a-friend
  (lambda (x y)
    (null? y)))

(define last-friend
  (lambda (x y)
    (length x)))

(define multiinsertLR
  (lambda (new oldL oldR lat)
    (cond
     ((null? lat) (quote ()))
     ((eq? (car lat) oldL)
      (cons new
            (cons oldL
                  (multiinsertLR new oldL oldR
                                 (cdr lat)))))
     ((eq? (car lat) oldR)
      (cons oldR
            (cons new
                  (multiinsertLR new oldL oldR
                                 (cdr lat)))))
     (else
      (cons (car lat)
            (multiinsertLR new oldL oldR
                           (cdr lat)))))))

(define multiinsertLR&co
  (lambda (new oldL oldR lat col)
    (cond
     ((null? lat)
      (col (quote ()) 0 0))
     ((eq? (car lat) oldL)
      (multiinsertLR&co new oldL oldR
                        (cdr lat)
                        (lambda (newlat L R)
                          (col (cons new
                                     (cons oldL newlat))
                               (add1 L) R))))
     ((eq? (car lat) oldR)
      (multiinsertLR&co new oldL oldR
                        (cdr lat)
                        (lambda (newlat L R)
                          (col (cons oldR
                                     (cons new newlat))
                               L (add1 R)))))
     (else
      (multiinsertLR&co new oldL oldR
                        (cdr lat)
                        (lambda (newlat L R)
                          (col (cons (car lat) newlat) L R)))))))

(define newlat-and-times
  (lambda (newlat left right)
    (cons newlat
          (cons left
                (cons right '())))))

;;测试n是否偶数,如果n是偶数,则用整除法除以2,再乘以2将得到参数n本身
;;如果是奇数,则不能被2整除,小数部分被丢弃后再乘以2不能恢复n本身
(define even?
  (lambda (n)
    (= (x (div n 2) 2) n)))

(define evens-only*
  (lambda (l)
    (cond
     ((null? l) (quote ()))
     ((atom? (car l))
      (cond
       ((even? (car l))
        (cons (car l)
              (evens-only* (cdr l))))
       (else (evens-only* (cdr l)))))
     (else (cons (evens-only* (car l))
                 (evens-only* (cdr l)))))))

;;full of stars function
(define evens-only*&co
  (lambda (l col)
    (cond
     ((null? l)
      (col (quote ()) 1 0))
     ((atom? (car l))
      (cond
       ((even? (car l))
        (evens-only*&co (cdr l)
                        (lambda (newl p s)
                          (col (cons (car l) newl)
                               (x (car l) p)
                               s))))
       (else 
        (evens-only*&co (cdr l)
                        (lambda (newl p s)
                          (col newl
                               p
                               (+ (car l) s)))))))
     (else 
      (evens-only*&co (car l)
                      (lambda (al ap as)
                        (evens-only*&co (cdr l)
                                        (lambda (dl dp ds)
                                          (col (cons al dl)
                                               (x ap dp)
                                               (+ as ds))))))))))

(define the-last-friend
  (lambda (newl product sum)
    (cons sum
          (cons product newl))))

;;;;;;;;;;;;;;;;;;第9章;;;;;;;;;;;;;;;;;

(define looking
  (lambda (a lat)
    (keep-looking a (pick 1 lat) lat)))

(define keep-looking
  (lambda (a sorn lat)
    (cond
     ((number? sorn) (keep-looking a (pick sorn lat) lat))
     (else (eq? sorn a)))))

(define shift
  (lambda (pair)
    (build (first (first pair))
           (build (second (first pair))
                  (second pair)))))

(define align
  (lambda (pora)
    (cond
     ((atom? pora) pora)
     ((a-pair? (first pora)) (align (shift pora)))
     (else (build (first pora) (align (second pora)))))))

(define length*
  (lambda (pora)
    (cond
     ((atom? pora) 1)
     (else
      (+ (length* (first pora))
         (length* (second pora)))))))

(define weight*
  (lambda (pora)
    (cond
     ((atom? pora) 1)
     (else
      (+ (x (weight* (first pora)) 2)
         (weight* (second pora)))))))

(define shuffle
  (lambda (pora)
    (cond
     ((atom? pora) pora)
     ((a-pair? (first pora)) (shuffle (revpair pora)))
     (else (build (first pora) (shuffle (second pora)))))))

(define C
  (lambda (n)
    (cond
     ((one? n) 1)
     (else
      (cond
       ((even? n) (C (div n 2)))
       (else (C (add1 (x 3 n)))))))))

;;阿克曼函数
(define A
  (lambda (n m)
    (cond
     ((zero? n) (add1 m))
     ((zero? m) (A (sub1 n) 1))
     (else (A (sub1 n) (A n (sub1 m)))))))

;;Y combinator
(define Y
  (lambda (le)
    ((lambda (f) (f f))
     (lambda (f)
       (le (lambda (x) (f f) x))))))

;;;;;;;;;;;;;;;;;;;;;第10章;;;;;;;;;;;;;;;;;;;;;;

(define new-entry build)

;;entry 是一种数据结构,它嵌套两个列表构成,两个列表长度一致,而且第一个列表中
;;不能有重复的原子。类似于Python中的字典,由键和值一一对应。
;;lookup-in-entry 需要一个参数 name(键),然后返回对应的值,如果键和值不存在
;;则交由第三方函数 entry-f 进行下一步处理。
(define lookup-in-entry
  (lambda (name entry entry-f)
    (lookup-in-entry-help name
                          (first entry)
                          (second entry)
                          entry-f)))

(define lookup-in-entry-help
  (lambda (name names values entry-f)
    (cond
     ((null? names) (entry-f name))
     ((eq? (car names) name)
      (car values))
     (else (lookup-in-entry-help name
                                 (cdr names)
                                 (cdr values)
                                 entry-f)))))

;;table 是由多条 entry 复合构成的一种数据结构
;;extend-table 的作用就是将一条 entry 添加到一个 table 中
;;所以,可以简单地用 cons 代替
(define extend-table cons)

;;历遍 table, 找出 name 对应的值
(define lookup-in-table
  (lambda (name table table-f)
    (cond
     ((null? table) (table-f name))
     (else 
      (lookup-in-entry name
                       (car table)
                       (lambda (name)
                         (lookup-in-table name 
                                          (cdr table) 
                                          table-f)))))))

;;根据表达式执行动作
(define expression-to-action
  (lambda (e)
    (cond
     ((atom? e) (atom-to-action e))
     (else (list-to-action e)))))

;;如果是单个的原子,只有两种情况:
;;一、数字 #t #f cons car cdr null? eq? atom? zero? add1 sub1 number?
;;统统作为常数处理。
;;二、其它的所有原子,作为标识符处理
(define atom-to-action
  (lambda (e)
    (cond
     ((number? e) *const)
     ((eq? e #t) *const)
     ((eq? e #f) *const)
     ((eq? e (quote cons)) *const)
     ((eq? e (quote car)) *const)
     ((eq? e (quote cdr)) *const)
     ((eq? e (quote null?)) *const)
     ((eq? e (quote eq?)) *const)
     ((eq? e (quote atom?)) *const)
     ((eq? e (quote zero?)) *const)
     ((eq? e (quote add1)) *const)
     ((eq? e (quote sub1)) *const)
     ((eq? e (quote number?)) *const)
     (else *identifier))))

;;以括号开始的,除了quote lambda cond外,其它统统作为过程处理
(define list-to-action
  (lambda (e)
    (cond
     ((atom? (car e))
      (cond
       ((eq? (car e) (quote quote)) *quote)
       ((eq? (car e) (quote lambda)) *lambda)
       ((eq? (car e) (quote cond)) *cond)
       (else *application)))
     (else *application))))

;;解释器入口
(define value
  (lambda (e)
    (meaning e (quote ()))))

;;根据类型选择动作,传入两个参数:表达式 e,还有一个空列表(空table)
(define meaning
  (lambda (e table)
    ((expression-to-action e) e table)))

;;下面是具体的类型所执行的动作

;;处理常数,数字 #t #f直接返回
;;其它情况,返回一个列表,比如
;;(primitive cons)
;;(primitive car)
;;(primitive null?)
(define *const
  (lambda (e table)
    (cond
     ((number? e) e)
     ((eq? e #t) #t)
     ((eq? e #f) #f)
     (else (build (quote primitive) e)))))

;;标识符(identifier)
(define *identifier
  (lambda (e table)
    (lookup-in-table e table initial-table)))

(define initial-table
  (lambda (name)
    (car (quote ()))))

;;处理 quote 引用
;;将引用的对象直接返回比如(quote a)
;;返回 a,也就是列表的第2部分
(define *quote
  (lambda (e table)
    (text-of e)))

(define text-of second)

;;处理lambda
;;返回一个列表,保存了四个部分:
;;标志——non-primitive
;;传入的参数 table
;;匿名函数的参数
;;匿名函数的函数体
(define *lambda
  (lambda (e table)
    (build (quote non-primitive)
           (cons table (cdr e)))))

;;定义辅助函数来提取三个元素
(define table-of first)
(define formals-of second)
(define body-of third)

;;处理cond

(define evcon
  (lambda (lines table)
    (cond
     ((else? (question-of (car lines)))
      (meaning (answer-of (car lines))
               table))
     ((meaning (question-of (car lines))
               table)
      (meaning (answer-of (car lines))
               table))
     (else (evcon (cdr lines) table)))))

;;判断是否是 else 行
(define else?
  (lambda (x)
    (cond
     ((atom? x) (eq? x (quote else)))
     (else #f))))

(define question-of first)
(define answer-of second)
(define cond-lines-of cdr)

(define *cond
  (lambda (e table)
    (evcon (cond-lines-of e) table)))

;;处理application


(define evlis
  (lambda (args table)
    (cond
     ((null? args) (quote ()))
     (else
      (cons (meaning (car args) table)
            (evlis (cdr args) table))))))

(define *application
  (lambda (e table)
    (apply
     (meaning (function-of e) table)
     (evlis (arguments-of e) table))))

(define function-of car)
(define arguments-of cdr)

(define primitive?
  (lambda (l)
    (eq? (first l) (quote primitive))))

(define non-primitive?
  (lambda (l)
    (eq? (first l) (quote non-primitive))))

(define apply
  (lambda (fun vals)
    (cond
     ((primitive? fun)
      (apply-primitive (second fun) vals))
     ((non-primitive? fun)
      (apply-closure (second fun) vals)))))

(define apply-primitive
  (lambda (name vals)
    (cond
     ((eq? name (quote cons))
      (cons (first vals) (second vals)))
     ((eq? name (quote car))
      (car (first vals)))
     ((eq? name (quote cdr))
      (cdr (first vals)))
     ((eq? name (quote null?))
      (null? (first vals)))
     ((eq? name (quote eq?))
      (eq? (first vals) (second vals)))
     ((eq? name (quote atom?))
      (:atom? (first vals)))
     ((eq? name (quote zero?))
      (zero? (first vals)))
     ((eq? name (quote add1))
      (add1 (first vals)))
     ((eq? name (quote sub1))
      (sub1 (first vals)))
     ((eq? name (quote number?))
      (number? (first vals))))))

(define :atom?
  (lambda (x)
    (cond
     ((atom? x) #t)
     ((null? x) #t)
     ((eq? (car x) (quote primitive)) #t)
     (else #f))))

(define apply-closure
  (lambda (closure vals)
    (meaning (body-of closure)
             (extend-table
              (new-entry (formals-of closure) vals)
              (table-of closure)))))
Read More

eLisp其实是个完整的编程语言

Emacs不仅可以用来写代码,还能用来上网,收发邮件,有人说它其实是个披着编辑器外衣的操作系统。 而elisp不仅仅可以用来扩展emacs,还可以用来写脚本。甚至有人拿它来写cgi脚本。 ###一、进入Read-Eval-Print-Loop(REPL)

Read More

github的灵异事件

刚刚post一篇文章,结果没显示出来。开始以为是蛋疼的Markdown语法错误导致没有生成页面。整篇文字看了一下,把所有可能错误的地方都改了一下,然后在本地运行jekyll serve,没错误了。再push出去,刷新,还是没出来。

Read More

发现一个好玩的scheme编译器

URScheme,是一个可以将scheme代码编译成原生机器码的编译器。准确地说它是将scheme代码先编译成x86汇编代码,与SBCL不同的是,接下来它调用GNU汇编器和链接器再将汇编代码弄成ELF可执行文件,这让我不由得想起了传说中的chez scheme编译器。

Read More

Debian Wheezy 速配

我是用KDE光盘进行安装的,我只刻了第一张安装盘,很多东西缺失,安装完成后必须手动安装。

Read More

开始新一轮折腾

放在免费空间上的blog因为长久没登陆被删掉了,我工作与Linux、计算机没什么关系,完全是出于兴趣。因为生活的关系,我每年只有很少的时间折腾这些东西。。。

Read More