; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: (GMAP Common-Lisp) -*-
(in-package gmap)

;
; GMAP, version 3.2, by Scott L. Burson
;
; This file is in the public domain.
;
; The GMAP macro provides a new kind of iteration facility in LISP.
; Basically, it is intended for when you would like to use MAPCAR, but
; can't because the things you want to map over aren't in lists, or you
; need to collect the results of the mapping into something other than a
; list.  That is, GMAP is probably the right thing to use when you are
; using iteration to perform the same computation on each element of
; some collection, as opposed to changing your state in some complicated
; way on every iteration of a loop.
; In fact, it's conceptually reasonable to imagine all the iterations of a
; GMAP as happening in parallel, just as you might with MAPCAR.  The
; difference is that with GMAP you explicitly say, via keywords, what kinds
; of collections the elements come in and what kind of collection to make
; from the result.  For example, the following two expressions are equivalent:
; (mapcar #'foo this-list that-list)	and
; (gmap :list #'foo (:list this-list) (:list that-list))
; The first :list keyword indicates that GMAP is to build a list; the other
; two tell it that this-list and that-list are in fact lists of elements over
; which foo is to be mapped.  Other keywords exist besides :list; for
; example, :string, if used as an argument keyword, causes its argument
; to be viewed as a string; the values it "generates" for the function being
; mapped are the successive characters of the string.
; Perhaps the best feature of GMAP is its facility for defining one's own
; keywords.  Thus you can adapt it to other kinds of data structures over
; which you would like to iterate.
;
; The overall syntax of GMAP is:
;   (gmap <result-spec> <fn>
;	  <arg-spec-0>
;	  <arg-spec-1>
;	  ... )
; where <fn> is the function being mapped, just like the first argument
; to MAPCAR.  The <result-spec> and the <arg-spec-i> are lists, whose first
; element is a keyword indicating the type of result constructor or argument
; generator, and the interpretation of whose subsequent elements depends on
; that type.  For example, in:
;   (gmap :list #'+
;	  (:list '(14 32 51))
;	  (:index 3))
; #'+ is the function to be mapped;
; the result-type of :list specifies that a list is to be constructed containing
; the results;
; the first arg-spec specifies that the first argument to the function
; being mapped will be successive elements of the list '(14 32 51);
; and the second arg-spec says that the second argument will be successive
; integers starting with 3.
; The result, of course, is (17 36 56).
;
; **** Argument generators ****
; Each generator is given one variable in which to maintain its state.  We have
; to tell GMAP explicitly how to get from the current value of the state variable
; to a)the value to be generated and b)the next value of the state variable.
;
; The keyword, the first element, of each argument spec tells what kind of
; generator to use.  NIL as a keyword specifies that one is defining a generator
; for this instance of GMAP only instead of using one of the predefined ones.
; A NIL-type arg-spec has the following syntax:
;   (nil <init> &optional <exitp> <argfn> <nextfn> <let-specs>)
; where <init> is the initial value of the generator's state variable;
; <exitp>, if non-nil, is a function of one argument; when it becomes true of
;  [i.e., returns a non-nil value when applied to] the state variable, the
;  iteration terminates.  If it is absent or nil, this generator has no exit-test.
;  If more than one arg-spec supplies an exitp, then the
;  first one to finish terminates the entire iteration [just like mapcar, which
;  stops when any list runs out].
; <argfn>, if non-nil, is a function of one argument which is applied to the
;  current value of the state variable to get the value the generator actually
;  returns on this iteration.
; <nextfn>, if non-nil, is a function of one argument which takes the current
;  value of the state variable and returns the next.
; <let-specs> facilitates arbitrary hair and is explained below.
; For example, an arg-spec of (:list foo) is equivalent to
; (nil foo #'null #'car #'cdr)
; where foo is the initial value of the list; #'null is the predicate that says
; when the list has run out; #'car, the argfn, is what is done to the list to
; get the current element; and #'cdr, the nextfn, is what is done to the list
; to get the next list.
;
; An argument generator described this way is conceptually equivalent to
; (let `(state-var ,@<let-specs>)
;   #'(lambda ()
;	(if (<exitp> state-var)
;	    (*throw 'exit-iteration nil)
;	    (prog1 (<argfn> state-var)
;		   (setq state-var (<nextfn> state-var))))))
;
; Note that if only (nil <init>) is specified, the argument is a constant <init>;
; no more circular-list'ing!
;
; Other predefined argument types include:
;  (:constant <value>)
;    A more readable version of `(nil <value>)'.
;  (:list <list>)
;    As shown in examples above: supplies successive elements of <list>.
;  (:index <start> &optional <stop> <incr>)
;    Provides numbers beginning at <start> and going to (but not including) <stop>
;    incrementing by <incr> each time.  If <stop> is missing or nil, this generates
;    numbers indefinitely.  <incr> may be positive or negative and defaults to 1.
;  (:index-inc <start> <stop> &optional <incr>)
;    "Index, INClusive": like :index, but the numbers generated include <stop>.
;  (:vector <vector>)
;    Generates successive elements of <vector>.
;  (:simple-vector <vector>)
;    Generates successive elements of <vector> (which must be simple).
;  (:string <string>)
;    Generates successive characters of <string>.
;  (:simple-string <string>)
;    Generates successive characters of <string> (which must be simple).
;  (:exp <initial-value> <base>)
;    Generates an exponential sequence whose first value is <initial-value>, and
;    whose value is multiplied by <base> on each iteration.
;
; **** Result Constructors ****
; Like arg-specs, result-specs begin with a keyword saying what kind of
; constructor to use, i.e., how to put together the results of the function
; being mapped.  And again, a keyword of NIL means that no predefined
; constructor is being used.  A NIL-type result-spec looks like:
;  (nil <init> <resfn> &optional <cleanup> <filterp> <let-specs>)
; where
; <init> is the initial value of the constructor's state variable;
; <resfn> is a function of two arguments, the current value of the state variable
;  and the current value returned by the function being mapped; it gives the next
;  value of the state variable.
; <cleanup>, if present and non-nil, is a function of one argument that
;  translates the final value of the state variable into the value that the GMAP
;  actually returns.
; <filterp>, if present and non-nil, is a predicate of one argument; when it is false
;  of the current value of the function being mapped, <resfn> is not called on that
;  iteration, and the value of the state variable is unchanged.
; <let-specs>, as before, is hairy; I'll get back to it below.
; For example, a res-spec of (:list) is equivalent to
; (nil nil #'(lambda (a b) (cons b a)) #'nreverse)
; -- the state variable starts at nil, gets successive values consed onto it, and
;  gets nreversed before being returned.
;
; A result-spec that supplies no arguments may be written without the parens; so
; (:list) and :list are equivalent.
;
; Other predefined result types include:
;  :list
;    Generates a list, like mapcar, of the values.
;  :and
;    Returns the first NIL, or the last value if none are NIL.
;  :or
;    Returns the first non-NIL, or NIL if all values are NIL.
;  :sum
;    Returns the sum of the values.  E.g., to get sum of products, use
;    (gmap :sum #'* ...)
;  (:array <initial-array>)
;    Generates an array of the values.	You supply the initial array; the values
;    are stored starting with element 0.  If the array has a fill pointer, it is
;    set upon exit to the number of elements stored.  The array itself is returned.
;  (:string &optional <length-guess>)
;    Generates a string from the values.  <length-guess> is the initially allocated
;    string size; it defaults to 20.  #'array-push-extend is used to append each
;    character.
;  (:values &rest <result-specs>)
;    The function being mapped is expected to return as many values as there are
;    result-specs; each value is accumulated separately according to its respective
;    result-spec, and finally, all the result values are returned.
;
; **** User-defined argument and result types ****
; A useful feature of GMAP is the provision for the user to define his/her own
; argument generators and result constructors.	For example, if in some program you
; commonly iterate over words in a sentence, or lines in an editor buffer, or users
; currently logged on, then define an argument type SENTENCE, or LINES, or USERS.
; And similarly with result-types.  The way this is done [which I'm not yet sure is
; entirely satisfactory] is with the two special forms DEF-GMAP-ARG-TYPE and
; DEF-GMAP-RES-TYPE.  These have syntax like DEFUN:
; (def-gmap-foo-type <name> (<args>)
;   <body>)
; When <name> is seen as the keyword of an arg- or result-spec, and has
; been defined with the appropriate special form, then the function
; #'(lambda (<args>) <body>) is applied to the cdr of the spec; that is,
; the keyword itself has been stripped off.  Whatever this returns is interpreted
; as a nil-type spec, except, again, without the keyword "nil".  For example, the
; arg-type :list is actually defined by
;   (def-gmap-arg-type :list (initial-list)
;     `(,initial-list			; init
;	#'null #'car #'cdr))		; exitp, argfn, and resfn
;
; Lists of what arg- and result-types are defined can be found in the variables
; *GMAP-ARG-TYPE-LIST* and *GMAP-RES-TYPE-LIST*.
;
; Now for the promised explanation about let-specs.  Sometimes [indeed, fairly
; often] a user-defined type will want to compute values and bind variables
; other than those automatically provided by the iteration.  For example, the
; index type goes to some trouble to evaluate its parameters only once.  It does
; this by providing a list of specs, i.e., (<var> <value>) pairs, which go into
; a LET that surrounds the entire iteration.  Except, that is, for the following
; hack: if you want several dependent initializations, e.g., you want foo to be
; something hairy and bar to be the cdr of foo, you can indicate the dependence
; by the nesting in list structure of the specs:
; ((foo (something-hairy))
;  ((bar (cdr foo))))
; This will cause a gmap that uses this type to expand into
; (let ((foo (something-hairy)))
;   (let ((bar (cdr foo)))
;     ... [iteration] ...))
; For details, see the NLET macro at the end of this file.  For examples,
; see some of the types defined herein.

; Remaining tidbits:
; Many arg- and result-specs take optional parameters, which are defined to do
;  something only if both present and non-nil.	By "non-nil" here I mean non-nil
;  *at expansion time*.
; The function being mapped can itself be nil, subject of course to the above
;  considerations; in which case the identity function of the first argument is
;  used, and other arguments are ignored.

; Bugs:
;
; Purists will object to the use of symbols in the keyword package rather than
; the `lisp' package for the arg- and result-types.  It would make sense for
; these symbols to come from the package providing the types they refer to;
; among other advantages, this would prevent name collisions (which is, after
; all, the whole point of the package system).  Against this very reasonable
; argument is my desire to have it immediately apparent to someone seeing a
; `gmap' form, perhaps for the first time, that it is a macro with somewhat
; unusual syntax; the use of ordinary Lisp symbols (`list', `vector', etc.)
; would tend to disguise this fact.  Anyway, there's nothing requiring the arg-
; and result-type names to be in the keyword package; anyone who strongly
; dislikes this is welcome to define names in some other package.

; The top-level macro.
(defmacro gmap (res-spec fn &rest arg-spec-list)
  (gmap>expand fn
	       (gmap>res-spec-lookup res-spec)
	       (mapcar #'gmap>arg-spec-lookup arg-spec-list)))

; This does the real work.
(defun gmap>expand (fn res-specs arg-spec-list)
  (let ((param-list
	  (mapcar #'gmap>param arg-spec-list))
	(result-list (gmap>res>init-clauses res-specs))
	(let-specs (gmap>let-specs arg-spec-list res-specs)))
    (let ((one-value-p (null (cdr result-list)))
	  (fnval-vars (mapcar #'(lambda (ignore)
				  (declare (ignore ignore))
				  (gensym))
			      result-list)))
      `(nlet ,let-specs
	 (do (,@param-list
	      ,@result-list)
	     ((or ,@(apply #'append (mapcar #'gmap>param>exit-test	; exit test
					    param-list arg-spec-list)))
	      ,(gmap>res>cleanup res-specs result-list one-value-p))
	   ,(if one-value-p
		(if (car fnval-vars)
		    `(let ((,(car fnval-vars)
			    ,(apply #'gmap>funcall fn
				    (mapcar #'gmap>param>arg param-list arg-spec-list))))
		       (setq ,(caar result-list)
			     ,(gmap>res>next (car res-specs) (caar result-list)
					     (car fnval-vars))))
		  #| Null result spec -- just call the function for effect. |#
		  (apply #'gmap>funcall fn
			 (mapcar #'gmap>param>arg param-list arg-spec-list)))
	      `(multiple-value-bind ,fnval-vars
		   ,(apply #'gmap>funcall fn
			   (mapcar #'gmap>param>arg param-list arg-spec-list))
		 . ,(mapcar #'(lambda (fnval result-pair res-spec)
				`(setq ,(car result-pair)
				       ,(gmap>res>next res-spec (car result-pair) fnval)))
			    fnval-vars result-list res-specs))))))))


; extract the let-specs.
(defun gmap>let-specs (arg-specs res-specs)
  (nconc (mapcan #'fifth arg-specs) (mapcan #'fifth res-specs)))

; generate the do-variable spec for each argument.
(defun gmap>param (arg-spec)
  (let ((param-name (gensym))
	(init (first arg-spec))
	(nextfn (fourth arg-spec)))
    `(,param-name
      ,init
      ,@(if nextfn
	    `(,(gmap>funcall nextfn param-name))
	    nil))))

; get the argument to the function being mapped from the do-variable.
(defun gmap>param>arg (param arg-spec)
  (let ((param-name (first param))
	(argfn (third arg-spec)))
    (gmap>funcall argfn param-name)))

; get the exit test for the variable.
(defun gmap>param>exit-test (param arg-spec)
  (let ((param-name (first param))
	(exitp (second arg-spec)))
    (if exitp
	`(,(gmap>funcall exitp param-name))
	nil)))

; get the initial value of the result.
(defun gmap>res>init-clauses (res-specs)
  (mapcan #'(lambda (res-spec) (and res-spec (cons (list (gensym) (first res-spec)) nil)))
	  res-specs))

; compute the next value of the result from the current one and the
; current value of the function.
(defun gmap>res>next (res-spec result fnval)
  (let ((resfn (second res-spec))
	(filterp (fourth res-spec)))
    (if filterp
	`(if ,(gmap>funcall filterp fnval)
	     ,(gmap>funcall resfn result fnval)
	     ,result)
	(gmap>funcall resfn result fnval))))

; call the cleanup function on exit.
(defun gmap>res>cleanup (res-specs result-list one-value-p)
  (if one-value-p
      (gmap>funcall (third (car res-specs)) (caar result-list))
    `(values . ,(mapcar #'(lambda (res-spec result-pair)
			    (gmap>funcall (third res-spec) (car result-pair)))
			res-specs result-list))))

; For some reason, the compiler doesn't convert, e.g., (funcall #'car foo)
; to (car foo); thus we lose some efficiency for functions that would normally
; open-code, like car.	Hence this function to perform the optimization for it.
(defun gmap>funcall (function &rest args)
  (let ((args (copy-list args)))
    (cond ((or (null function) (eq function ':id))
	   (car args))
	  ((and (listp function)
		(eq (car function) 'function))
	   `(,(cadr function) . ,args))
	  (t `(funcall ,function . ,args)))))



(eval-when (:execute :compile-toplevel :load-toplevel)
  (defvar *gmap-arg-type-list* nil
    "A list of all GMAP arg types that have been defined.")
  (defvar *gmap-res-type-list* nil
    "A list of all GMAP result types that have been defined."))

; define an arg-type.
(defmacro def-gmap-arg-type (name args &body body)
  (let ((fn-name (gensym "GMAP-ARG-SPEC-EXPANDER-")))
    `(progn
       'compile
       (defun ,fn-name ,args . ,body)
       (eval-when (:execute :compile-toplevel :load-toplevel)
	 (setf (get ',name ':gmap-arg-spec-expander) ',fn-name)
	 (pushnew ',name *gmap-arg-type-list*)))))

; define a result-type.
(defmacro def-gmap-res-type (name args &body body)
  (let ((fn-name (gensym "GMAP-RES-SPEC-EXPANDER-")))
    `(progn
       'compile
       (defun ,fn-name ,args . ,body)
       (eval-when (:execute :compile-toplevel :load-toplevel)
	 (setf (get ',name ':gmap-res-spec-expander) ',fn-name)
	 (pushnew ',name *gmap-res-type-list*)))))

; look up an arg type.
(defun gmap>arg-spec-lookup (raw-arg-spec)
  (let ((type (car raw-arg-spec)))
    (if (null type)
	(cdr raw-arg-spec)
	(let ((generator (get type ':gmap-arg-spec-expander)))
	  (if generator
	      (apply generator (cdr raw-arg-spec))
	    (error "Argument spec, ~S, to gmap is of unknown type
  (Do you have the package right?)"
		   raw-arg-spec))))))

; look up a result type.
(defun gmap>res-spec-lookup (raw-res-spec)
  (if (and (listp raw-res-spec)
	   (eq (car raw-res-spec) ':values))
      (mapcar #'gmap>res-spec-lookup-1 (cdr raw-res-spec))
    (cons (gmap>res-spec-lookup-1 raw-res-spec) nil)))
(defun gmap>res-spec-lookup-1 (raw-res-spec)
  (let ((type (if (listp raw-res-spec) (car raw-res-spec)
		raw-res-spec)))
    (if (null type)
	(cdr raw-res-spec)
      (let ((generator (get type ':gmap-res-spec-expander)))
	(if generator
	    (apply generator (and (listp raw-res-spec) (cdr raw-res-spec)))
	  (error "Result spec, ~S, to gmap is of unknown type
  (Do you have the package right?)"
		 raw-res-spec))))))



; ******** Predefined argument types ********
; See above for documentation.

(def-gmap-arg-type :constant (value)
  `(,value))

(def-gmap-arg-type :list (initial-list)
  `(,initial-list
    #'null #'car #'cdr))

(def-gmap-arg-type :index (start &optional stop incr)
  (let ((incr-temp (gensym))
	(stop-temp (gensym))
	(bounds-fn-temp (gensym)))
    `(,start					; init
      ,(if stop                                 ; exitp
	   (if incr
	       `#'(lambda (val)
		    (funcall ,bounds-fn-temp val ,stop-temp))
	     `#'(lambda (val) (declare (type fixnum val))
		  (>= val ,stop-temp)))
	 'nil)
      nil					; no argfn
      ,(if incr                                 ; nextfn
	   `#'(lambda (val) (declare (type fixnum val))
		(+ val ,incr-temp))
	   '#'1+)
      (,@(if incr				; and let-specs
	     `((,incr-temp ,incr)
	       ((,bounds-fn-temp (if (minusp ,incr-temp) #'<= #'>=)))))
       ,@(if stop
	     `((,stop-temp ,stop)))))))

(def-gmap-arg-type :index-inc (start &optional stop incr)
  (let ((incr-temp (gensym))
	(stop-temp (gensym))
	(bounds-fn-temp (gensym)))
    `(,start					; init
      ,(if stop                                 ; generate (possibly hairy) exitp
	   (if incr
	       `#'(lambda (val)
		    (funcall ,bounds-fn-temp val ,stop-temp))
	       `#'(lambda (val) (declare (type fixnum val))
		    (> val ,stop-temp)))
	   'nil)
      nil					; no argfn
      ,(if incr                                 ; nextfn
	   `#'(lambda (val) (declare (type fixnum val))
		(+ val ,incr-temp))
	   '#'1+)
      (,@(if incr				; and let-specs
	     `((,incr-temp ,incr)
	       ((,bounds-fn-temp (if (minusp ,incr-temp) #'< #'>)))))
       ,@(if stop
	     `((,stop-temp ,stop)))))))

;;; Deprecated; use `:vector'.
(def-gmap-arg-type :array (array &optional start stop incr)
  (let ((array-temp (gensym))
	(incr-temp (and incr (gensym)))
	(stop-temp (gensym)))
    `(,(or start 0)
       #'(lambda (i) (>= i ,stop-temp))
       #'(lambda (i) (aref ,array-temp i))
       #'(lambda (x) (+ x ,(or incr-temp 1)))
       ((,array-temp ,array)
	,@(and incr `((,incr-temp ,incr)))
	((,stop-temp ,(or stop `(length ,array-temp))))))))

(def-gmap-arg-type :vector (array &optional start stop incr)
  (let ((array-temp (gensym))
	(incr-temp (and incr (gensym)))
	(stop-temp (gensym)))
    `(,(or start 0)
       #'(lambda (i) (>= i ,stop-temp))
       #'(lambda (i) (aref ,array-temp i))
       #'(lambda (x) (+ x ,(or incr-temp 1)))
       ((,array-temp ,array)
	,@(and incr `((,incr-temp ,incr)))
	((,stop-temp ,(or stop `(length ,array-temp))))))))

(def-gmap-arg-type :simple-vector (array &optional start stop incr)
  (let ((array-temp (gensym))
	(incr-temp (and incr (gensym)))
	(stop-temp (gensym)))
    `(,(or start 0)
       #'(lambda (i) (declare (type fixnum i)) (>= i ,stop-temp))
       #'(lambda (i) (declare (type fixnum i)) (svref ,array-temp i))
       #'(lambda (i) (declare (type fixnum i)) (+ i ,(or incr-temp 1)))
       ((,array-temp ,array)
	,@(and incr `((,incr-temp (the fixnum ,incr))))
	((,stop-temp (the fixnum ,(or stop `(length ,array-temp)))))))))

; This is like :array but coerces the object to a string first.
(def-gmap-arg-type :string (string &optional start stop incr)
  (let ((string-temp (gensym))
	(incr-temp (and incr (gensym)))
	(stop-temp (gensym)))
    `(,(or start 0)
       #'(lambda (i) (>= i ,stop-temp))
       #'(lambda (i) (char ,string-temp i))
       #'(lambda (x) (+ x ,(or incr-temp 1)))
       ((,string-temp (string ,string))
	,@(and incr `((,incr-temp ,incr)))
	((,stop-temp ,(or stop `(length ,string-temp))))))))

(def-gmap-arg-type :simple-string (string &optional start stop incr)
  (let ((string-temp (gensym))
	(incr-temp (and incr (gensym)))
	(stop-temp (gensym)))
    `(,(or start 0)
       #'(lambda (i) (>= i ,stop-temp))
       #'(lambda (i) (schar ,string-temp i))
       #'(lambda (x) (+ x ,(or incr-temp 1)))
       ((,string-temp (string ,string))
	,@(and incr `((,incr-temp ,incr)))
	((,stop-temp ,(or stop `(length ,string-temp))))))))


; ******** Predefined result types ********

(def-gmap-res-type :list (&optional filterp)
  `(nil #'xcons #'nreverse ,filterp))

(defun xcons (a b)
  (cons b a))

(def-gmap-res-type :nconc (&optional filterp)
  (let ((result-var (gensym)))			; have to use our own, sigh.
    `(nil					; init
      #'(lambda (tail-loc new)			; nextfn
	  (if tail-loc (rplacd tail-loc new)
	    (setq ,result-var new))
	  (if new (last new) tail-loc))
      #'(lambda (ignore)
	  (declare (ignore ignore))
	  ,result-var)
      ,filterp
      ((,result-var nil)))))

(def-gmap-res-type :and ()
  '(t #'(lambda (ignore new)
	  (declare (ignore ignore))
	  (if new new (return nil)))))

(def-gmap-res-type :or ()
  '(nil #'(lambda (ignore new)
	    (declare (ignore ignore))
	    (if new (return new) nil))))

(def-gmap-res-type :sum ()
  '(0 #'+))

(def-gmap-res-type :count-if ()
  '(0 #'(lambda (n new)
	  (if new (1+ n) n))))

(def-gmap-res-type :max ()
  '(nil #'max-with-nil-id))

(defun max-with-nil-id (x y)
  (if (null x) y
    (if (null y) x
      (max x y))))

(def-gmap-res-type :min ()
  '(nil #'min-with-nil-id))

(defun min-with-nil-id (x y)
  (if (null x) y
    (if (null y) x
      (min x y))))

;;; Deprecated; use `:vector'.
(def-gmap-res-type :array (initial-empty-array)
  (let ((array-temp (gensym)))
    `(0						; init
       #'(lambda (curr-index next-elt)		; nextfn
	   (setf (aref ,array-temp curr-index) next-elt)
	   (1+ curr-index))
       #'(lambda (last-index)			; cleanup
	   (if (array-has-fill-pointer-p ,array-temp)
	       (setf (fill-pointer ,array-temp) last-index))
	   ,array-temp)
       nil					; filterp
       ((,array-temp ,initial-empty-array)))))	; let-specs

(def-gmap-res-type :vector (initial-empty-vector)
  (let ((vector-temp (gensym)))
    `(0						; init
       #'(lambda (curr-index next-elt)		; nextfn
	   (setf (aref ,vector-temp curr-index) next-elt)
	   (1+ curr-index))
       #'(lambda (last-index)			; cleanup
	   (if (vector-has-fill-pointer-p ,vector-temp)
	       (setf (fill-pointer ,vector-temp) last-index))
	   ,vector-temp)
       nil					; filterp
       ((,vector-temp ,initial-empty-vector))))) ; let-specs

(def-gmap-res-type :string (&optional (length-guess 20.))
  `((make-array ,length-guess			; init
		:element-type :character
		:adjustable t :fill-pointer 0)
    #'(lambda (string char)			; nextfn
	(vector-push-extend char string)
	string)))

(def-gmap-arg-type :exp (initial-value base)
  (let ((base-temp (gensym)))
    `(,initial-value
      nil
      nil
      #'(lambda (x) (* x ,base-temp))
      ((,base-temp ,base)))))


; End of gmap.lisp