mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2025-12-05 18:30:24 -08:00
76 lines
2.6 KiB
Common Lisp
76 lines
2.6 KiB
Common Lisp
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil; Package: C -*-
|
|
;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab:
|
|
|
|
;;;;
|
|
;;;; Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
|
|
;;;; Copyright (c) 1990, Giuseppe Attardi.
|
|
;;;;
|
|
;;;; See file 'LICENSE' for the copyright details.
|
|
|
|
;;;; CMPMAP Map functions.
|
|
|
|
(in-package "COMPILER")
|
|
|
|
(defun expand-mapcar (whole)
|
|
(when (< (length whole) 3)
|
|
(cmpwarn "Too few arguments to function ~A in form: ~A" (first whole) whole)
|
|
(return-from expand-mapcar
|
|
`(si:simple-program-error
|
|
"Too few arguments to function ~A in form: ~A" ',(first whole) ',whole)))
|
|
(let ((which (first whole)))
|
|
(when (eq which 'FUNCALL)
|
|
(setf whole (rest whole)
|
|
which (first whole))
|
|
(when (consp which)
|
|
(if (eq (first which) 'FUNCTION)
|
|
(setf which (second which))
|
|
(return-from expand-mapcar whole))))
|
|
(let* ((function (gensym))
|
|
(fun-with `(with ,function = ,(second whole)))
|
|
(args (cddr whole))
|
|
iterators for-statements
|
|
(in-or-on :IN)
|
|
(do-or-collect :COLLECT)
|
|
(list-1-form nil)
|
|
(finally-form nil))
|
|
(case which
|
|
(MAPCAR)
|
|
(MAPLIST (setf in-or-on :ON))
|
|
(MAPC (setf do-or-collect :DO))
|
|
(MAPL (setf in-or-on :ON do-or-collect :DO))
|
|
(MAPCAN (setf do-or-collect 'NCONC))
|
|
(MAPCON (setf in-or-on :ON do-or-collect 'NCONC)))
|
|
(when (eq in-or-on :ON)
|
|
(setf args (mapcar #'(lambda (arg) `(ext:checked-value list ,arg)) args)))
|
|
(when (eq do-or-collect :DO)
|
|
(let ((var (gensym)))
|
|
(setf list-1-form `(with ,var = ,(first args))
|
|
args (list* var (rest args))
|
|
finally-form `(finally (return ,var)))))
|
|
(loop for arg in (reverse args)
|
|
do (let ((var (gensym)))
|
|
(setf iterators (cons var iterators)
|
|
for-statements (list* :for var in-or-on arg for-statements))))
|
|
`(loop ,@fun-with
|
|
,@list-1-form
|
|
,@for-statements
|
|
,do-or-collect (funcall ,function ,@iterators)
|
|
,@finally-form))))
|
|
|
|
(define-compiler-macro mapcar (&whole whole &rest r)
|
|
(expand-mapcar whole))
|
|
|
|
(define-compiler-macro mapc (&whole whole &rest r)
|
|
(expand-mapcar whole))
|
|
|
|
(define-compiler-macro mapcan (&whole whole &rest r)
|
|
(expand-mapcar whole))
|
|
|
|
(define-compiler-macro maplist (&whole whole &rest r)
|
|
(expand-mapcar whole))
|
|
|
|
(define-compiler-macro mapl (&whole whole &rest r)
|
|
(expand-mapcar whole))
|
|
|
|
(define-compiler-macro mapcon (&whole whole &rest r)
|
|
(expand-mapcar whole))
|