[e90b2f]: src / cmp / cmpfun.lsp Maximize Restore History

Download this file

cmpfun.lsp    81 lines (71 with data), 2.7 kB

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
;;;;
;;;; CMPFUN Library functions.
;;;; Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
;;;; Copyright (c) 1990, Giuseppe Attardi and William F. Schelter.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Library General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 2 of the License, or (at your option) any later version.
;;;;
;;;; See file '../Copyright' for full details.
(in-package "COMPILER")
(defun c1apply (args)
(check-args-number 'APPLY args 2)
(let* ((fun (first args))
(arguments (rest args)))
(cond ((and (consp fun)
(eq (first fun) 'LAMBDA))
(optimize-funcall/apply-lambda (cdr fun) arguments t))
((and (consp fun)
(eq (first fun) 'EXT::LAMBDA-BLOCK))
(setf fun (macroexpand-1 fun))
(optimize-funcall/apply-lambda (cdr fun) arguments t))
((and (consp fun)
(eq (first fun) 'FUNCTION)
(consp (second fun))
(member (caadr fun) '(LAMBDA EXT::LAMBDA-BLOCK)))
(c1apply (list* (second fun) arguments)))
(t
(let ((form (c1funcall (list* '#'APPLY args))))
(when (and (consp fun) (eq (first fun) 'FUNCTION))
(let* ((fname (second fun))
(type (get-return-type fname)))
(when type
(setf (c1form-type form) type))))
form)))))
;;----------------------------------------------------------------------
;; We transform BOOLE into the individual operations, which have
;; inliners
;;
(define-compiler-macro boole (&whole form op-code op1 op2)
(or (and (constantp op-code)
(case (eval op-code)
(#. boole-clr `(progn ,op1 ,op2 0))
(#. boole-set `(progn ,op1 ,op2 -1))
(#. boole-1 `(prog1 ,op1 ,op2))
(#. boole-2 `(progn ,op1 ,op2))
(#. boole-c1 `(prog1 (lognot ,op1) ,op2))
(#. boole-c2 `(progn ,op1 (lognot ,op2)))
(#. boole-and `(logand ,op1 ,op2))
(#. boole-ior `(logior ,op1 ,op2))
(#. boole-xor `(logxor ,op1 ,op2))
(#. boole-eqv `(logeqv ,op1 ,op2))
(#. boole-nand `(lognand ,op1 ,op2))
(#. boole-nor `(lognor ,op1 ,op2))
(#. boole-andc1 `(logandc1 ,op1 ,op2))
(#. boole-andc2 `(logandc2 ,op1 ,op2))
(#. boole-orc1 `(logorc1 ,op1 ,op2))
(#. boole-orc2 `(logorc2 ,op1 ,op2))))
form))
;----------------------------------------------------------------------
;; Return the most particular type we can EASILY obtain from x.
(defun result-type (x)
(cond ((symbolp x)
(c1form-primary-type (c1expr x)))
((constantp x)
(type-of x))
((and (consp x) (eq (car x) 'the))
(second x))
(t t)))