From: akr <akr>
Date: Sun, 23 Aug 1998 08:03:45 +0000 (+0000)
Subject: * Makefile (clean): Delete rule for cleaning tl.
X-Git-Tag: doodle-1_9_2~28
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=fdaefcdf0a078d06ba87a08828ca538ae837eb65;p=elisp%2Fflim.git

* Makefile (clean): Delete rule for cleaning tl.

* natset.el (natset-gen-ccl-branch256): New function.
---

diff --git a/ChangeLog b/ChangeLog
index 3d9b878..0f55380 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 1998-08-23  Tanaka Akira      <akr@jaist.ac.jp>
 
+	* Makefile (clean): Delete rule for cleaning tl.
+
+	* natset.el (natset-gen-ccl-branch256): New function.
+
+1998-08-23  Tanaka Akira      <akr@jaist.ac.jp>
+
 	* Makefile (check): New rule.
 
 	* TESTPAT: Add batch testing facility.
diff --git a/Makefile b/Makefile
index 0882879..c78700e 100644
--- a/Makefile
+++ b/Makefile
@@ -27,7 +27,6 @@ install:	elc
 
 clean:
 	-$(RM) $(GOMI)
-	cd ../tl && make clean
 
 
 tar:
diff --git a/lex.el b/lex.el
index 30e1d11..2dd6aa9 100644
--- a/lex.el
+++ b/lex.el
@@ -264,7 +264,7 @@
 	      ((read r0)
 	       (r2 += 1)
 	       ,(apply
-		 'natset-gen-ccl-branch
+		 'natset-gen-ccl-branch ; 'natset-gen-ccl-branch256 produce quote big codes.
 		 'r0
 		 '(end)
 		 (mapcar
diff --git a/natset.el b/natset.el
index 2a09041..20372a7 100644
--- a/natset.el
+++ b/natset.el
@@ -187,6 +187,17 @@ It is impossible to set VALID to empty set because empty set is represented as n
    ((= (car ns) 0) (natset-gen-pred-exp-internal (cdr ns) var nil 0))
    (t (natset-gen-pred-exp-internal ns var t 0))))
 
+(defun natset-gen-ccl-branch256 (reg fail &rest clauses)
+  (let ((i 255) tmp blocks)
+    (while (<= 0 i)
+      (setq blocks (cons
+                     (if (setq tmp (natset-assoc i clauses))
+                       (cdr tmp)
+                       fail)
+                     blocks)
+            i (1- i)))
+    `(branch ,reg ,@blocks)))
+
 (defun natset-gen-ccl-branch (reg fail &rest clauses)
   (let* ((natsets (mapcar 'car clauses)))
     (let ((range (apply 'natset-union natsets)) tmp)