Other good talks I like are,

- A semantic model for graphical user interface (the use of linear type is eye opening, but the example code doesn't look great enough)

- Modular rollback through control logging (though backtracking and modification/deletion/insertion heurisitics are known techniques for error-checking parsers ... for a long time i guess)

- Parametric polymorphism and semantic subtyping: the logical connection (straightforward approach with proved complexity upper-bound is good :)

- Balanced trees inhabiting functional parallel programming (though it's known that trees should replace list for parallel programs and using balanced trees doesn't seems a big improvement to me.)

- Monads, zippers and views (maybe, but i don't understand enough, especially don't know how they used this in their search combinators, that seems to be a cool application)

I'm very ignorant in functional programming, so please correct me or leaving me comments for your ideas and opinions. :)

Two weeks ago, a post from the Lisp-cn mailing list asked whether Emacs's elisp implementation supports tail-call optimization. Though the answer turned out to be "nope", I broke into the conversation and said he could implement his own version of abstraction easily in Lisp. Then I followed up a new post of a small quiz for implementing tail-call optimized (but crippled) "defun" (or "define" for Schemes). Maybe because it's not a very interesting quiz, only one person showed up with his solution, and eventually it became my own amusement. However, the result that shows the optimization done by several Common Lisp implementations is not boring at least. And it can be of help when using implementations that doesn't do tail-call optimization such as ABCL or ECL.

Task 1 Self-recursion Optimization

Write a macro called "defun-tc" that does similar things (define a toplevel function) as "defun" but also does forced tail-call optimization when calling itself recursively.

This is a very simple one. Tail-calls are in fact gotos, but in a structured way. The point is to shadow the function definition with a local macro (nlet-tc as follows) that expands to goto.

(defmacro nlet-tc (name bindings &body body)
  (alexandria:with-unique-names (entry return)
    (let* ((bindings (mapcar #'alexandria:ensure-list bindings))
           (vars (mapcar #'first bindings)))
      `(macrolet ((,name (&rest args)
                    `(progn
                       (psetf ,@(mapcan #'list ',vars args))
                       (go ,',entry))))
         (let ,bindings
           (block ,return
             (tagbody
                ,entry
                (return-from ,return
                  (locally ,@body)))))))))
 
(defmacro defun-tc (name args &body body)
  `(defun ,name ,args
     (nlet-tc ,name ,(mapcar (lambda (a) `(,a ,a)) args)
       ,@body)))

To make it more explicit, here's an example.

(defun-tc sum (n acc)
  (declare (fixnum n acc)
           (optimize speed (safety 0)))
  (if (< = n 0)
      acc
      (sum (- n 1) (+ acc n))))

when expanded, will be:

(DEFUN SUM (N ACC)
  (MACROLET ((SUM (&REST ARGS)
               `(PROGN
                 (PSETF ,@(MAPCAN #'LIST '(N ACC) ARGS))
                 (GO #:ENTRY967))))
    (LET ((N N) (ACC ACC))
      (BLOCK #:RETURN968
        (TAGBODY
         #:ENTRY967
          (RETURN-FROM #:RETURN968
            (LOCALLY
             (DECLARE (FIXNUM N ACC)
                      (OPTIMIZE SPEED (SAFETY 0)))
             (IF (< = N 0)
                 ACC
                 (SUM (- N 1) (+ ACC N))))))))))

The following benchmark

(defun-tc test (n acc)
  (declare (fixnum n acc)
           (optimize speed (safety 0)))
  (if (< = n 0)
       acc
       (test (1- n) (1+ acc)))) 
(time (test (expt 2 32))) 
=> 4294967296

showed there's a little bit more overhead than SBCL's native implementation. After examination the assembly code, it turned out that in my version SBCL wil treat (1- n) and (1+ acc) as machine integer rather than fixnum as declared, and the 4 redundant shifts are the only overhead. After adding (the fixnum ...) to both form, the difference disappeared.

A natural improvement is to automatically add the type declaration in the "psetf" form, the following trick does that, though it turned out to be less useful in the next task.

(defun variable-type (var &optional env)
  nil
  #+sbcl (cdr (assoc 'cl:type (nth-value 2 (sb-cltl2:variable-information var env)))))
 
(defmacro my-psetf (&environment env &rest args)
  (assert (and (> (length args) 0)
               (evenp (length args))))
  (multiple-value-bind (places vals newvars)
      (loop with e = args
            while e
            collect (pop e) into places
            collect (pop e) into vals
            collect (gensym "NEW") into newvars
            finally (return (values places vals newvars)))
    `(let* ,(mapcar (lambda (p v n)
                     (if (and (symbolp p)
                              (variable-type p env))
                         `(,n (the ,(variable-type p env) ,v))
                         `(,n ,v)))
                   places vals newvars)
       (setf ,@(mapcan #'list places newvars)))))

Change "psetf" to "my-psetf" and the type information will be propagated in compile-time.

Task 2 Mutual-recursion Optimization

Write a macro called "labels-tc" that does similar things as "label" but also does forced tail-call optimization when recursively calling functions defined in the same scope.

This task is much more fun. You need to

• Establish tagbody scope that covers all local functions
• Still allow local functions being used in "funcall" and "apply"
• Handle all variables in one scope

My idea is to define an anonymous local function that includes all the definitions, and use a dispatch to jump to the right entry point. All other functions will call the anonymous one. As for variable handling, I currently don't have a good solution without a full renaming. So it's ignored and I simply combined all the variables (maybe an error checking is necessary).

Here's the code:

(defmacro labels-tc (definitions &body body)
  (multiple-value-bind (names argss bodies jump-tags)
      (loop for d in definitions
            for n = (first d)
            for a = (second d)
            for b = (rest (rest d))
            for j = (gensym (symbol-name n))
            collect n into ns
            collect a into as
            collect b into bs
            collect j into js
            finally (return (values ns as bs js)))
    (alexandria:with-unique-names (entry exit name dispatch)
      `(labels ((,entry (,name &key ,@(remove-duplicates (apply #'append argss)))
                  (macrolet (,@(mapcar (lambda (name args jump-tag)
                                         `(,name (&rest arrrgs)
                                                 `(progn
                                                    (my-psetf ,@(mapcan #'list ',args arrrgs))
                                                    (go ,',jump-tag))))
                                 names argss jump-tags))
                    (block ,exit
                      (tagbody
                         ,dispatch
                         (case ,name
                           ,@(mapcar (lambda (name jump-tag)
                                       `(,name (go ,jump-tag)))
                              names jump-tags))
                         ,@(mapcan (lambda (jump-tag body)
                                     `(,jump-tag
                                       (return-from ,exit
                                         (locally ,@body))))
                                   jump-tags bodies)))))
                ,@(mapcar (lambda (name args)
                            `(,name ,args
                                    (,entry
                                     ',name
                                     ,@(mapcan (lambda (a)
                                                 `(,(alexandria:make-keyword a) ,a))
                                               args))))
                    names argss))
         (locally ,@body)))))

So again, example:

(labels-tc ((oddp (n)
           (declare (fixnum n))
           (if (= n 0)
               nil
               (evenp (1- n))))
         (evenp (m)
           (declare (fixnum m))
           (if (= m 0)
               t
               (oddp (1- m)))))
  (print (oddp 21)))

will be expanded to:

(labels ((#:entry (#:name &key n m)
           (block #:exit
             (tagbody
                #:dispatch
                (case #:name
                  (oddp (go #:oddp))
                  (evenp (go #:evenp)))
                #:oddp
                (return-from #:exit
                  (locally
                      (declare (fixnum n))
                    (if (= n 0)
                        nil
                        (progn
                          (psetf m (1- n))
                          (go #:evenp)))))
                #:evenp
                (return-from #:exit
                  (locally
                      (declare (fixnum m))
                    (if (= m 0)
                        t
                        (progn
                          (psetf n (1- m))
                          (go #:oddp))))))))
         (oddp (n)
           (#:entry 'oddp :n n))
         (evenp (m)
           (#:entry 'evenp :m m)))
  (print (oddp 21)))

Note again that this version doesn't handle variables properly except the simplest form. And as mentioned above, my-psetf has no effect here since type declarations are not visible in the scope of labels-tc.

Benchmark and Verification

Ok, here's the fun part, benchmark and verifying the implementation in different implementations. Here's the benchmark code:

(defun test (n)
  (declare (fixnum n)
           (optimize speed (safety 0)))
  (labels-tc ((my-oddp (n)
                       (declare (fixnum n))
                       (if (= n 0)
                           nil
                           (my-evenp (the fixnum (1- n)))))
              (my-evenp (m)
                        (declare (fixnum m))
                        (if (= m 0)
                            t
                            (my-oddp (the fixnum (1- m))))))
    (my-evenp n)))
 
(time (test (expt 2 30)))
=> T

And here's the result:

* OS: Ubuntu natty 11.04 x86_64 (CPU: Core2 3.0GHz)
* AllegroCL needs compiler flag to turn on the optimization on.
* Since CMUCL is 32bit, to avoid fixnum overflow, I changed the benchmark to (test (expt 2 28)) and looped 4 times.

What amazed me is that my implementation is among the best with SBCL/CMUCL's, so if your algorithm depends heavily on mutual tail-recursion, you can use this customized labels-tc without changing a single line of your code (but be aware of the variable handling!). And I think the reason other implementations don't optimize enough is because many tail-recursion programs can be intuitively translated into ones using loop, however, in some situations, it is not case.

Here's the file for download.

Everything seems to work fine until I plugged my headphone to it this afternoon, and it crashed (WTF!), and keep rebooting over and over again. I'm afraid I have to do the restore again. It's so annoying! I have had so many troubles with my iPhone and it's so unbelievable that the software delivered from Apple is so crappy.

I'd like to share my previous experience of fixing a problem that caused my iphone not to be recognized in my macbook (not even charging).

1. For debugging USB devices I needed some tools with a debug version of the IOUSBFamily Kernel Extension
2. I started USB Prober, turned log details to high, plugged in my iPhone and hundreds of lines show up.
3. I found a line which said charging cannot be started because of error return code.
4. I found in syslog message that launchd tried to start usbmuxd every 10 seconds but failed everytime.
5. I googled usbmuxd and found it's a daemon for iPhone power management...
6. I located the binary and started it in the shell, it gave me an error message saying that it cannot find the symbol _history in libedit.dylib
7. I use objdump to show the symbols in libedit and yes, there's no _history but only _the_history. It seems I have a different version of libedit.
8. I downloaded the latest libedit from Apple website, compiled and installed it.
9. Problem solved!

One thing I still don't understand is why they want to link to libedit in a daemon? libedit provides line-editing features for command-line tools.

P.S.

I found similar complaints here: http://theappleblog.com/2009/09/14/iphone-os-3-1-update-causing-crashes-on-iphone-3gs/

Update (2009/9/18, 00:51):

This time none of my computers can restore iPhone anymore. It will try to reboot during the restoration and it's in a totally unusable state. Good job, Apple! And remember Apple, I'm not your tester!

Update (2009/9/21):

Softbank paid the price for Apple's technical failure. I got a new iPhone now. I've asked them to erase my data.

1. 去噪声
2. 调节 White Balance
3. 调节对比度，亮度和修正过渡暴光
4. 若需要调节 Tone curve

软件用 Noiseware 和 Lightroom 2，基本上出来的照片就很完美了。

现在用单反拍得多了，懒得一张张去调节了。

意外中的必然，聚会中一半的人来自 Google Japan...还居然都用 C++ 参赛（ICFP是指函数式程序语言学会） 我们交流了各自的控制算法，visualizer, 以及各种失误。我比较喜欢讨论程序语言，自然聊了不少。最后大家又讨论了其他程序比赛，我虽然知道 Top Coder 和 Google Code Jam，但对这种让你快速 hack 出一个程序出来的比赛不怎么感兴趣，真正解决问题是需要大量思考和尝试的， ICFP Contest 可以说和现实最接近了。（号称Code Jam 由于没有 Google 员工的参与会简单不少, er...我看是其他公司的优秀的程序员不屑于参加吧）

据说明年的比赛组织方是澳洲的某个大学（可能是墨尔本大学），想去澳洲旅游的同学可以考虑拿个 1st prize ：）

就说道这，最近3个博客都是和比赛相关，其实我个人对比赛不是太感冒。。。是该写些其他的了。。。另外希望中国的FP爱好者们也加油参加（用C++/Java 也可以 :$ )

Here's the scoreboard:

http://icfpcontest.org/scoreboard.php

队名：Dysfunkycom

成员：
John Fremlin (UK), Mathematical Systems Inc. (Japan)
Jianshi Huang (China) (本人), Mathematical Systems Inc. (Japan)
Peter Salvi (Hungary), Phd. Candidate @ University of Tokyo

Lisp for the win! :)

P.S. email 摘录

Dear ICFP Competitor,

In order to finalize the winner of the ICFP contest by the end of this month, and be as consistent and fair as possible, we are directly soliciting help from the top 10 teams. So the good news is your entry was in the top 10!

--
Andy Gill, Garrin Kimmell, Kevin Matlage
ICFP Contest Organizers, 2009

为什么程序员都必须学好英语

1 现象

• 说同一种母语，但交流技术时说英语
• 有一部分美国人认为这是文化的帝国主义／法西斯主义

2 理由

• 英语有更丰富的技术用语，有助于更简洁的表达。
• 技术人员之间的交流需要精确的表达，而丰富的词汇很重要。(其实英语里
  有大量的难以理解的技术词汇，很多是历史原因造成的，无形中造成了壁
  垒，使得局外人更难以理解。我认为想中文和拉丁语之类的表达丰富易于
  组合的语言更胜任创造新的词汇，可惜现状…)
• 技术领域里经常有新的单词出现，没有统一的翻译标准也是造成用母语沟
  通的问题之一。
• 技术领域里的合作是没有国界的，往往是跨国界的，说写一口好英语是成
  功的关键之一，而蹩脚的英语却会让别人忽略你的存在。
• Get stuff done. Internet上大量的资料是用英语写的。
• 很现实的，有一部分的翻译相当糟糕。

3 翻译的问题，优美的／恶心的翻译举例

3.1 优美的翻译举例

• 化学元素(我一直认为这是翻译的典范，e.g. 氢(Hydrogen)，最轻的气体)

3.2 恶心的翻译

• 直接音译(滥用汉字)
  中文文字是如此的丰富，非得要找几个毫无关系的汉字来注音？
  e.g. 柯理化(currying)

4 假设现实的问题已被改善，用英语交流仍旧是最佳方式吗？

有一个论点说，如果大家都用英语交流，那我们的知识库就会更庞大，于是
搜索会更有效，能更快得找到解决问题的方法。因此，用英语交流是有利于
推动技术进步的。

5 如何改善技术领域里的翻译

• 学好中文，学好汉字
• 建立标准网站，加强协作沟通，快速统一翻译标准