g000001

;; type-system-deftypes.lisp
(deftype pvar (&optional (element-type '*))
  ;; I have to return a satisfies type with a closure so that typep can work.
  ;; But, returning a closure will blow up both subtypep and the compiler on lucid.
  (let ((g (gentemp))
        (closure (*lisp-i::pvar-type-predicate 
                  (cadr (*lisp-i::canonical-pvar-type `(pvar ,element-type))))))
;      (format t "////////// ~S //////////~%" closure)
      (setf (symbol-function g) 
            (lambda (&rest args) (apply closure args)))

g000001

;; 後ろ向きのkill-sexp C-M-Sh-k
(define-key slime-mode-map [(control meta shift ?k)] 
  (lambda ()
    (interactive)
    (kill-sexp -1)))

g000001

(octets-to-string                       ;flexi-streamとか
 (drakma:http-request "http://twitter.com" :force-binary 'T)
 :external-format :utf-8)

g000001

(declaim (optimize (speed 3) (safety 0) (space 0)))

(defun tak (x y z)
  (declare (fixnum x y z))
  (declare (ftype (function (fixnum fixnum fixnum) fixnum) tak))
  (if (not (< y x))                             ;x >= y
      z
      (tak (tak (the fixnum (1- x)) y z)
              (tak (the fixnum (1- y)) z x)
              (tak (the fixnum (1- z)) x y))))

g000001

(declaim (inline foo))
(defun foo (&rest args)
  (format T "global foo!!! => ~{~A~^ ~}~%" args))
  
(defun bar ()
  (list (apply #'foo '(1 2 3))
        (apply 'foo '(1 2 3))))
  
(bar)
;global foo!!! => 1 2 3

g000001

(define-syntax $define 
  (lambda (x)
    (syntax-case x ()
      ((_ var val)
       (with-syntax ((var (string->symbol 
                           (format #f "$~a" (syntax->datum #'var)))))
         #'(define var val))))))

; ($define foo 88)
; $foo => 88

g000001

;-*- Mode:LISP; Package:USER; Base:8.-*-

(login-setq base 10.
	    ibase 10.
	    user-id "mc")

(load "local:>mc>zwei-cust.lisp")
(login-eval zwei:(set-comtab-return-undo *standard-comtab* 
					 `(
					   ;; same as C-X for C-C

g000001

;; 要素1億
(defparameter *a* (make-array 100000000))

(defun fill-random-and-sum-single (array)
  (let ((len (length array)))
    (loop :for pos :from 0 :below len 
          :do (setf (aref array pos) (random 100)))
    (loop :for pos :from 0 :below len
          :sum (aref array pos))))

g000001

(progn
  ;; Allegro CL Documentation
  (defun acl-lookup ()
    (interactive)
    (browse-url
     (concat "http://www.google.com/search?q=" (thing-at-point 'symbol)
             "&q=site%3Ahttp%3A%2F%2Fwww.franz.com"
             "&q=\"documentation/\"")))
     
  (define-key slime-mode-map [(control ?c) (control ?d) (shift ?a)] 'acl-lookup))

g000001

;; Utilisp
;; (cdr ());=>エラー
(defun *cdr (list)
  (cond ((null list) list)
        (t (cdr list))))

;; (car ());=>エラー
(defun *car (list)
  (cond ((null list) list)
        (t (car list))))