Ignore:
Timestamp:
03/13/05 01:50:18 (16 years ago)
Author:
piso
Message:

CSUBTYPEP-COMPLEX

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/subtypep.lisp

    r8643 r8762  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: subtypep.lisp,v 1.59 2005-02-26 17:44:10 piso Exp $
     4;;; $Id: subtypep.lisp,v 1.60 2005-03-13 01:50:18 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    226226              (make-ctype 'REAL type))
    227227             (COMPLEX
    228               (make-ctype 'COMPLEX type))
     228              (make-ctype 'COMPLEX
     229                          (if (atom type) '* (cadr type))))
    229230             (FUNCTION
    230231              (make-ctype 'FUNCTION type)))))))
     
    436437           (values nil nil)))))
    437438
     439(defun csubtypep-complex (ct1 ct2)
     440  (let ((type1 (cdr ct1))
     441        (type2 (cdr ct2)))
     442    (cond ((or (null type2) (eq type2 '*))
     443           (values t t))
     444          ((eq type1 '*)
     445           (values nil t))
     446          (t
     447           (subtypep type1 type2)))))
     448
    438449(defun csubtypep (ctype1 ctype2)
    439450  (cond ((null (and ctype1 ctype2))
     
    445456        ((eq (ctype-super ctype1) 'function)
    446457         (csubtypep-function ctype1 ctype2))
     458        ((eq (ctype-super ctype1) 'complex)
     459         (csubtypep-complex ctype1 ctype2))
    447460        (t
    448461         (values nil nil))))
Note: See TracChangeset for help on using the changeset viewer.