From: Thomas Weigert
Subject: to avoid reinventing the wheel
Date: 
Message-ID: <WEIGERT.92Apr20154713@etlhit.etl.go.jp>
I was wondering if there are pd-packages already out there
which do the following:

(1) Implement structure sharing cons. I.e., use some kind of
hashing scheme to avoid creating a new cons cell, if a cons
cell #'equal to the one requested already exists.

(2) Regular expression lexer generator (like lex). I.e.,
from a regular expression grammar create the
set-macro-character definitions to implement the lexer in a
costum readtable.

Any pointers are appreciated,

Cheers, Thomas.

--
+--------------------------------+---------------------------------+
| Thomas Weigert                 |                                 |
| Suiron-kenkyuu-shitsu          | ·······@{mcs.anl.gov,etl.go.jp} |
| Electrotechnical Laboratory    | +81-298-58-5918 (phone+fax)     |
+--------------------------------+---------------------------------+

From: Barry Margolin
Subject: Re: to avoid reinventing the wheel
Date: 
Message-ID: <kv5tahINN7b1@early-bird.think.com>
In article <·····················@etlhit.etl.go.jp> ·······@mcs.anl.gov writes:
>(1) Implement structure sharing cons. I.e., use some kind of
>hashing scheme to avoid creating a new cons cell, if a cons
>cell #'equal to the one requested already exists.

Many Lisp implementations include a facility called "resources" that
supports this type of programming.  Here's a simple implementation of what
you want, if you're not using such an implementation:

(defvar *cons-hash-table* (make-hash-table :test #'equal))
(defvar *dummy-cons* (cons nil nil))

(defun hash-cons (car cdr)
  (setf (car *dummy-cons*) car
	(cdr *dummy-cons*) cdr)
    (or (gethash *dummy-cons* *cons-hash-table*)
	(let ((new-cons (cons car cdr)))
	  (setf (gethash new-cons *cons-hash-table*) new-cons)
	  new-cons))))

Of course, you must be careful how you use these conses.  If a cons is in
use as a key of an equal hash table, you can't destructively modify it.

Also, the above implementation will never permit these conses to become
garbage unless you explicitly REMHASH them.  If you're using an
implementation with "weak" hash tables, this may be a good application for
them.
-- 
Barry Margolin
System Manager, Thinking Machines Corp.

······@think.com          {uunet,harvard}!think!barmar
From: Peter Norvig - Sun Labs East
Subject: Re: to avoid reinventing the wheel
Date: 
Message-ID: <t1sq3INNkcl@seven-up.East.Sun.COM>
In article <·····················@etlhit.etl.go.jp> ·······@mcs.anl.gov writes:
>(1) Implement structure sharing cons. I.e., use some kind of
>hashing scheme to avoid creating a new cons cell, if a cons
>cell #'equal to the one requested already exists.

Barry Margolin gives a "simple" (but effective) solution to this
problem.  One way in which it is simple is that it uses an #'equal hash
table, which will perform poorly on large structures, and may infinite
loop on circular structures.  The following version is more
complicated, but more efficient.  It uses a two-level table, with one
#'eq hash table at the top level, and a separate #'eq hash table for
each car:

(defvar *uniq-cons-table* (make-hash-table :test #'eq))

(defun ucons (x y)
  "Return a cons s.t. (eq (ucons x y) (ucons x y)) is true."
  (let ((car-table (or (gethash x *uniq-cons-table*)
                       (setf (gethash x *uniq-cons-table*)
                             (make-hash-table :test #'eq)))))
    (or (gethash y car-table)
        (setf (gethash y car-table) (cons x y)))))

Another way that Barry's solution is simple is that it doesn't make sure
that the car and cdr of the preposed new cons are unique.  The function
unique-cons does this (although at the cost of walking the tree of the input
and thus risking infinite loop again).
            
(defun unique-cons (x y)
  "Return a cons such that (eq (ucons x y) (ucons x2 y2)) is true
  whenever (equal x x2) and (equal y y2) are true."
  (ucons (unique x) (unique y)))

(defvar *uniq-atom-table* (make-hash-table :test #'equal))

(defun unique (exp) 
  "Return a canonical representation that is EQUAL to exp,
  such that (equal x y) implies (eq (unique x) (unique y))."
  (typecase exp
    (symbol exp)
    (fixnum exp)  ;; Remove if fixnums are not eq in your Lisp
    (atom   (or (gethash exp *uniq-atom-table*)
                (setf (gethash exp *uniq-atom-table*) exp)))
    (cons   (unique-cons (car exp) (cdr exp)))))
            

For more information, and a better version of unique-cons,
see my "Paradigms of Articial Intelligence Programming",
published by Morgan Kaufmann.

______________________________________________________________________
Peter Norvig				Tel: (508) 671-0508
Sun Microsystems Laboratories		Fax: (508) 671-0624
Two Federal Street			Net: ············@East.Sun.COM
Billerica MA 01821			USA
______________________________________________________________________