3 ;;; Lisp implementation of a `same-fringe' solver.
5 ;;;--------------------------------------------------------------------------
6 ;;; Iteration utilities.
8 ;; The iteration protocol is as follows. An iterator is simply a function
9 ;; invoked with no arguments. It returns two values: the next item, and a
10 ;; new iterator function to produce the remaining items; if there are no more
11 ;; items, then it returns NIL twice.
13 (defun list-iterator (iter)
14 "Collect the items from ITER into a list and return it."
15 (labels ((recur (iter list)
16 (multiple-value-bind (data iter) (funcall iter)
18 (recur iter (cons data list))
22 (defun same-iterators-p (iter-a iter-b &key (test #'eql))
23 "Return whether ITER-A and ITER-B produce the same items."
24 (labels ((recur (iter-a iter-b)
25 (multiple-value-bind (data-a iter-a) (funcall iter-a)
26 (multiple-value-bind (data-b iter-b) (funcall iter-b)
27 (cond ((null iter-a) (null iter-b))
29 (not (funcall test data-a data-b)))
31 (t (recur iter-a iter-b)))))))
32 (recur iter-a iter-b)))
34 ;;;--------------------------------------------------------------------------
38 "A simple node in a binary tree. Empty subtrees are denoted by NIL."
41 (defun iterate-fringe (node)
42 "Inorder iterator for the tree headed by NODE."
43 (labels ((recur (node cont)
44 (cond (node (recur (node-left node)
46 (values (node-data node)
48 (recur (node-right node)
51 (t (values nil nil)))))
52 (lambda () (recur node nil))))
54 (defun parse-tree (string)
55 "Parse STRING, and return the tree described.
59 tree ::= empty | `(' tree char tree `)'
61 The ambiguity is resolved by always treating `(' as a tree when a tree is
64 (let ((len (length string)))
68 ((char= (char string i) #\()
69 (multiple-value-bind (left i) (parse (1+ i))
70 (unless (< i len) (error "no data"))
71 (let ((data (char string i)))
72 (multiple-value-bind (right i) (parse (1+ i))
73 (unless (and (< i len)
74 (char= (char string i) #\)))
77 (make-node :left left :data data :right right)
80 (multiple-value-bind (tree i) (parse 0)
81 (unless (= i len) (error "trailing junk"))
84 ;;;--------------------------------------------------------------------------
88 "Main program: process ARGS."
89 (destructuring-bind (&optional a b &rest junk) args
90 (cond ((or (null a) junk) (error "bad args"))
91 ((null b) (format t "~{~C~}~%"
92 (list-iterator (iterate-fringe (parse-tree a)))))
93 (t (format t "~:[no match~;match~]~%"
94 (same-iterators-p (iterate-fringe (parse-tree a))
95 (iterate-fringe (parse-tree b))))))))
99 (flet ((bail (format args)
100 (format *error-output* "~A: ~?~%"
101 (cl-launch:getenv "CL_LAUNCH_FILE") format args)
104 (main cl-launch:*arguments*)
106 (bail (simple-condition-format-control err)
107 (simple-condition-format-arguments err)))
111 ;;;----- That's all, folks --------------------------------------------------