Lines Matching +defs:args +defs:keywords
189 (defmacro defun* (name args &rest body)
195 (let* ((res (cl-transform-lambda (cons args body) name))
199 (defmacro defmacro* (name args &rest body)
205 (let* ((res (cl-transform-lambda (cons args body) name))
225 (defconst lambda-list-keywords
233 (let* ((args (car form)) (body (cdr form)) (orig-args args)
236 (header nil) (simple-args nil))
240 (setq args (if (listp args) (copy-list args) (list '&rest args)))
241 (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
242 (if (setq bind-defs (cadr (memq '&cl-defs args)))
243 (setq args (delq '&cl-defs (delq bind-defs args))
245 (if (setq bind-enquote (memq '&cl-quote args))
246 (setq args (delq '&cl-quote args)))
247 (if (memq '&whole args) (error "&whole not currently implemented"))
248 (let* ((p (memq '&environment args)) (v (cadr p)))
249 (if p (setq args (nconc (delq (car p) (delq v args))
251 (while (and args (symbolp (car args))
252 (not (memq (car args) '(nil &rest &body &key &aux)))
253 (not (and (eq (car args) '&optional)
254 (or bind-defs (consp (cadr args))))))
255 (push (pop args) simple-args))
258 (if (null args)
259 (list* nil (nreverse simple-args) (nconc (nreverse header) body))
260 (if (memq '&optional simple-args) (push '&optional args))
261 (cl-do-arglist args nil (- (length simple-args)
262 (if (memq '&optional simple-args) 1 0)))
266 (nconc (nreverse simple-args)
272 ;; orig-args can contain &cl-defs (an internal CL
274 (let ((x (memq '&cl-defs orig-args)))
275 (if (null x) orig-args
276 (delq (car x) (remq (cadr x) orig-args)))))
281 (defun cl-do-arglist (args expr &optional num) ; uses bind-*
282 (if (nlistp args)
283 (if (or (memq args lambda-list-keywords) (not (symbolp args)))
284 (error "Invalid argument name: %s" args)
285 (push (list args expr) bind-lets))
286 (setq args (copy-list args))
287 (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
288 (let ((p (memq '&body args))) (if p (setcar p '&rest)))
289 (if (memq '&environment args) (error "&environment used incorrectly"))
290 (let ((save-args args)
291 (restarg (memq '&rest args))
300 (if (eq (car args) '&whole)
301 (push (list (cl-pop2 args) restarg) bind-lets))
302 (let ((p args))
304 (while (and p (not (memq (car p) lambda-list-keywords)))
305 (or (eq p args) (setq minarg (list 'cdr minarg)))
309 (length (ldiff args p)))
310 exactarg (not (eq args p)))))
311 (while (and args (not (memq (car args) lambda-list-keywords)))
312 (let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car)
315 (pop args)
323 (while (and (eq (car args) '&optional) (pop args))
324 (while (and args (not (memq (car args) lambda-list-keywords)))
325 (let ((arg (pop args)))
336 (if (eq (car args) '&rest)
337 (let ((arg (cl-pop2 args)))
339 (or (eq (car args) '&key) (= safety 0) exactarg
347 (while (and (eq (car args) '&key) (pop args))
348 (while (and args (not (memq (car args) lambda-list-keywords)))
349 (let ((arg (pop args)))
380 (or (and (eq (car args) '&allow-other-keys) (pop args))
403 (while (and (eq (car args) '&aux) (pop args))
404 (while (and args (not (memq (car args) lambda-list-keywords)))
405 (if (consp (car args))
406 (if (and bind-enquote (cadar args))
407 (cl-do-arglist (caar args)
408 (list 'quote (cadr (pop args))))
409 (cl-do-arglist (caar args) (cadr (pop args))))
410 (cl-do-arglist (pop args) nil))))
411 (if args (error "Malformed argument list %s" save-args)))))
413 (defun cl-arglist-args (args)
414 (if (nlistp args) (list args)
416 (while (consp args)
417 (setq arg (pop args))
418 (if (memq arg lambda-list-keywords) (setq kind arg)
419 (if (eq arg '&cl-defs) (pop args)
422 (setq res (nconc res (cl-arglist-args arg))))))
423 (nconc res (and args (list args))))))
425 (defmacro destructuring-bind (args expr &rest body)
428 (cl-do-arglist (or args '(&aux)) expr)
618 (defvar args) (defvar loop-accum-var) (defvar loop-accum-vars)
625 (defmacro loop (&rest args)
640 (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list args))))))
641 (list 'block nil (list* 'while t args))
650 (setq args (append args '(cl-end-loop)))
651 (while (not (eq (car args) 'cl-end-loop)) (cl-parse-loop-clause))
691 (defun cl-parse-loop-clause () ; uses args, loop-*
692 (let ((word (pop args))
698 ((null args)
702 (setq loop-name (pop args)))
705 (if (memq (car args) '(do doing)) (pop args))
706 (or (consp (car args)) (error "Syntax error on `initially' clause"))
707 (while (consp (car args))
708 (push (pop args) loop-initially)))
711 (if (eq (car args) 'return)
712 (setq loop-result-explicit (or (cl-pop2 args) '(quote nil)))
713 (if (memq (car args) '(do doing)) (pop args))
714 (or (consp (car args)) (error "Syntax error on `finally' clause"))
715 (if (and (eq (caar args) 'return) (null loop-name))
716 (setq loop-result-explicit (or (nth 1 (pop args)) '(quote nil)))
717 (while (consp (car args))
718 (push (pop args) loop-finally)))))
727 (let ((var (or (pop args) (gensym "--cl-var--"))))
728 (setq word (pop args))
729 (if (eq word 'being) (setq word (pop args)))
730 (if (memq word '(the each)) (setq word (pop args)))
732 (setq word 'in args (cons '(buffer-list) args)))
737 (push word args)
738 (if (memq (car args) '(downto above))
740 (let* ((down (or (eq (car args) 'downfrom)
741 (memq (caddr args) '(downto above))))
742 (excl (or (memq (car args) '(above below))
743 (memq (caddr args) '(above below))))
744 (start (and (memq (car args) '(from upfrom downfrom))
745 (cl-pop2 args)))
746 (end (and (memq (car args)
748 (cl-pop2 args)))
749 (step (and (eq (car args) 'by) (cl-pop2 args)))
772 (push (list temp (pop args)) loop-for-bindings)
782 (if (eq (car args) 'by)
783 (let ((step (cl-pop2 args)))
794 (let* ((start (pop args))
795 (then (if (eq (car args) 'then) (cl-pop2 args) start)))
797 (if (or ands (eq (car args) 'and))
817 (push (list temp-vec (pop args)) loop-for-bindings)
829 (let ((ref (or (memq (car args) '(in-ref of-ref))
830 (and (not (memq (car args) '(in of)))
832 (seq (cl-pop2 args))
834 (temp-idx (if (eq (car args) 'using)
835 (if (and (= (length (cadr args)) 2)
836 (eq (caadr args) 'index))
837 (cadr (cl-pop2 args))
863 (or (memq (car args) '(in of)) (error "Expected `of'"))
864 (let* ((table (cl-pop2 args))
865 (other (if (eq (car args) 'using)
866 (if (and (= (length (cadr args)) 2)
867 (memq (caadr args) hash-types)
868 (not (eq (caadr args) word)))
869 (cadr (cl-pop2 args))
879 (let ((ob (and (memq (car args) '(in of)) (cl-pop2 args))))
885 (while (memq (car args) '(in of from to))
886 (cond ((eq (car args) 'from) (setq from (cl-pop2 args)))
887 ((eq (car args) 'to) (setq to (cl-pop2 args)))
888 (t (setq buf (cl-pop2 args)))))
899 (while (memq (car args) '(in of property from to))
900 (cond ((eq (car args) 'from) (setq from (cl-pop2 args)))
901 ((eq (car args) 'to) (setq to (cl-pop2 args)))
902 ((eq (car args) 'property)
903 (setq prop (cl-pop2 args)))
904 (t (setq buf (cl-pop2 args)))))
914 (or (memq (car args) '(in of)) (error "Expected `of'"))
915 (let ((map (cl-pop2 args))
916 (other (if (eq (car args) 'using)
917 (if (and (= (length (cadr args)) 2)
918 (memq (caadr args) key-types)
919 (not (eq (caadr args) word)))
920 (cadr (cl-pop2 args))
942 (let ((scr (and (memq (car args) '(in of)) (cl-pop2 args)))
960 (eq (car args) 'and))
962 (pop args))
978 (push (list (list temp (pop args))) loop-bindings)
982 (let ((what (pop args))
991 (let ((what (pop args))
1006 (let ((what (pop args))
1011 (let ((what (pop args))
1016 (let ((what (pop args))
1021 (let ((what (pop args))
1026 (let* ((what (pop args))
1037 (while (progn (push (list (pop args)
1038 (and (eq (car args) '=) (cl-pop2 args)))
1040 (eq (car args) 'and))
1041 (pop args))
1045 (push (pop args) loop-body))
1048 (push (list 'not (pop args)) loop-body))
1052 (push (list 'setq loop-finish-flag (pop args)) loop-body)
1057 (push (list 'setq loop-finish-flag (list 'not (pop args)))
1065 (list 'not (list 'setq loop-result-var (pop args))))
1069 (let* ((cond (pop args))
1074 (if (eq (car args) 'else)
1075 (progn (pop args) (cl-parse-loop-clause)))
1078 (if (eq (car args) 'end) (pop args))
1092 (or (consp (car args)) (error "Syntax error on `do' clause"))
1093 (while (consp (car args)) (push (pop args) body))
1099 (push (list 'setq loop-result-var (pop args)
1106 (if (eq (car args) 'and)
1107 (progn (pop args) (cl-parse-loop-clause)))))
1143 (defun cl-loop-handle-accum (def &optional func) ; uses args, loop-*
1144 (if (eq (car args) 'into)
1145 (let ((var (cl-pop2 args)))
1267 (defmacro psetq (&rest args)
1273 (cons 'psetf args))
1333 (push (list (car (pop bindings)) 'lambda '(&rest cl-labels-args)
1335 'cl-labels-args))
1546 (defmacro define-setf-method (func args &rest body)
1561 func 'setf-method (cons args body)))))
1564 (defmacro defsetf (func arg1 &rest args)
1588 (store-var (car (prog1 (car args) (setq args (cdr args)))))
1592 (if (stringp (car args))
1593 (setq docstr (prog1 (car args) (setq args (cdr args)))))
1637 ,@args)
1640 `(defsetf ,func (&rest args) (store)
1642 (append args (list store)))))
1643 (if (car args)
1906 (defmacro setf (&rest args)
1914 (if (cdr (cdr args))
1916 (while args (push (list 'setf (pop args) (pop args)) sets))
1918 (if (symbolp (car args))
1919 (and args (cons 'setq args))
1920 (let* ((method (cl-setf-do-modify (car args) (nth 1 args)))
1921 (store (cl-setf-do-store (nth 1 method) (nth 1 args))))
1924 (defmacro psetf (&rest args)
1930 (let ((p args) (simple t) (vars nil))
1940 (list 'progn (cons 'setf args) nil)
1941 (setq args (reverse args))
1942 (let ((expr (list 'setf (cadr args) (car args))))
1943 (while (setq args (cddr args))
1944 (setq expr (list 'setf (cadr args) (list 'prog1 (car args) expr))))
1979 (defmacro shiftf (place &rest args)
1986 ((null args) place)
1987 ((symbolp place) `(prog1 ,place (setq ,place (shiftf ,@args))))
1992 ,(cl-setf-do-store (nth 1 method) `(shiftf ,@args))))))))
1994 (defmacro rotatef (&rest args)
2000 (if (not (memq nil (mapcar 'symbolp args)))
2001 (and (cdr args)
2003 (first (car args)))
2004 (while (cdr args)
2005 (setq sets (nconc sets (list (pop args) (car args)))))
2006 (nconc (list 'psetf) sets (list (car args) first))))
2007 (let* ((places (reverse args))
2093 (defmacro callf (func place &rest args)
2099 (let* ((method (cl-setf-do-modify place (cons 'list args)))
2100 (rargs (cons (nth 2 method) args)))
2107 (defmacro callf2 (func arg1 place &rest args)
2113 (list 'setf place (list* func arg1 place args))
2114 (let* ((method (cl-setf-do-modify place (cons 'list args)))
2116 (rargs (list* (or temp arg1) (nth 2 method) args)))
2132 (cl-arglist-args arglist)))))
2172 (args (cdr-safe (pop opts))))
2174 (if args
2175 (setq conc-name (if (car args)
2176 (symbol-name (car args)) ""))))
2178 (if (cdr args)
2182 (if (eq (car args) constructor)
2184 (push args constrs))
2185 (if args (setq constructor (car args)))))
2187 (if args (setq copier (car args))))
2189 (if args (setq predicate (car args))))
2191 (setq include (car args)
2195 (cdr args))))
2197 (setq print-func (car args)))
2199 (setq type (car args)))
2203 (setq descs (nconc (make-list (car args) '(cl-skip-slot))
2327 (args (cadr (pop constrs)))
2328 (anames (cl-arglist-args args))
2332 (list* '&cl-defs (list 'quote (cons nil descs)) args)
2448 (defmacro assert (form &optional show-args string &rest args)
2451 Other args STRING and ARGS... are arguments to be passed to `error'.
2456 (let ((sargs (and show-args (delq nil (mapcar
2464 (list* 'error string (append sargs args))
2477 (defmacro define-compiler-macro (func args &rest body)
2488 (let ((p args) (res nil))
2490 (setq args (nconc (nreverse res) (and p (list '&rest p)))))
2494 (cons (if (memq '&whole args) (delq '&whole args)
2495 (cons '--cl-whole-arg-- args)) body))
2518 (defmacro defsubst* (name args &rest body)
2525 (let* ((argns (cl-arglist-args args)) (p argns)
2528 (while (and p (eq (cl-expr-contains args (car p)) 1)) (pop p))
2530 (if p nil ; give up if defaults refer to earlier args
2532 (if (memq '&key args)
2533 (list* '&whole 'cl-whole '&cl-quote args)
2534 (cons '&cl-quote args))
2538 (and (memq '&key args) 'cl-whole) unsafe argns)))
2539 (list* 'defun* name args body))))
2607 (let* ((args (reverse (cons arg others)))
2608 (form (car args)))
2609 (while (setq args (cdr args))
2610 (setq form (list 'cons (car args) form)))