Early work-in-progress.

[sod] / cutting-room-floor.lisp

;;;--------------------------------------------------------------------------
;;; C types stuff.

(cl:defpackage #:c-types
  (:use #:common-lisp
	#+sbcl #:sb-mop
	#+(or cmu clisp) #:mop
	#+ecl #:clos)
  (:export #:c-type
	   #:c-declarator-priority #:maybe-parenthesize
	   #:c-declaration
	   #:c-type-subtype #:compount-type-declaration
	   #:qualifiable-c-type #:c-type-qualifiers #:format-qualifiers
	   #:simple-c-type #:c-type-name
	   #:c-pointer-type
	   #:tagged-c-type #:c-enum-type #:c-struct-type #:c-union-type
	   #:tagged-c-type-kind
	   #:c-array-type #:c-array-dimensions
	   #:make-argument #:argument-name #:argument-type
	   #:c-function-type #:c-function-arguments

	   #:define-c-type-syntax #:c-type-alias #:defctype
	   #:print-c-type
	   #:qualifier #:declare-qualifier
	   #:define-simple-c-type

	   #:const #:volatile #:static #:restrict
	   #:char #:unsigned-char #:uchar #:signed-char #:schar
	   #:int #:signed #:signed-int #:sint
	   #:unsigned #:unsigned-int #:uint
	   #:short #:signed-short #:short-int #:signed-short-int #:sshort
	   #:unsigned-short #:unsigned-short-int #:ushort
	   #:long #:signed-long #:long-int #:signed-long-int #:slong
	   #:unsigned-long #:unsigned-long-int #:ulong
	   #:float #:double #:long-double
	   #:pointer #:ptr
	   #:[] #:vec
	   #:fun #:func #:fn))


;;;--------------------------------------------------------------------------
;;; Convenient syntax for C types.

;; Basic machinery.

;; Qualifiers.  They have hairy syntax and need to be implemented by hand.

;; Simple types.

;; Pointers.

;; Tagged types.

;; Arrays.

;; Functions.


(progn
  (defconstant q-byte (byte 3 0))
  (defconstant q-const 1)
  (defconstant q-volatile 2)
  (defconstant q-restrict 4)

  (defconstant z-byte (byte 3 3))
  (defconstant z-unspec 0)
  (defconstant z-short 1)
  (defconstant z-long 2)
  (defconstant z-long-long 3)
  (defconstant z-double 4)
  (defconstant z-long-double 5)

  (defconstant s-byte (byte 2 6))
  (defconstant s-unspec 0)
  (defconstant s-signed 1)
  (defconstant s-unsigned 2)

  (defconstant t-byte (byte 3 8))
  (defconstant t-unspec 0)
  (defconstant t-int 1)
  (defconstant t-char 2)
  (defconstant t-float 3)
  (defconstant t-user 4))

(defun make-type-flags (size sign type &rest quals)
  (let ((flags 0))
    (dolist (qual quals)
      (setf flags (logior flags qual)))
    (setf (ldb z-byte flags) size
	  (ldb s-byte flags) sign
	  (ldb t-byte flags) type)
    flags))