LINUX.ORG.RU

Ответ на: комментарий от ados

потому что там нет абстрактных типов. строки - это массив, с которым можно работать только функцией. Тем Си и хорош, что в нем ты работаешь с памятью, которую интерпретируешь как душе будет угодно.

Deleted
()

Ещё вижу вычисление intern от строки, но что-то костылями попахивает.

ados ★★★★★
() автор топика
Ответ на: комментарий от Deleted

массив, с которым можно работать только функцией.

(macroexpand-1 '(case x
			  (1 'one)
			  (2 'two)))
(LET ((#:G887 X))
  (DECLARE (IGNORABLE #:G887))
  (COND ((EQL #:G887 '1) NIL 'ONE) ((EQL #:G887 '2) NIL 'TWO)))
T

Значит макрос с #'equal вместо #'eql самим создавать?

ados ★★★★★
() автор топика
Ответ на: комментарий от Deleted

Есть ли такая уверенность, что из множества решений работы с памятью, которые «как душе будет угодно», и которые не могут предоставить стандартные средства cl не окажутся неэффективными?

ados ★★★★★
() автор топика
Ответ на: комментарий от ados

Значит макрос с #'equal вместо #'eql самим создавать?

(defpackage #:new-case
  (:export #:case))

#+sbcl
(defmacro new-case:case (keyform &body cases)
  `(locally (declare (disable-package-locks cl:eql))
     (flet ((eql (x y) (equal x y)))
       (declare (enable-package-locks cl:eql))
       (case ,keyform ,@cases))))

#-sbcl ;; broken version
(defmacro new-case:case (keyform &body cases)
  `(flet ((eql (x y) (equal x y)))
     (case ,keyform ,@cases)))

CL-USER> (case "123" ("!" 1) ("123" 2))
NIL
CL-USER> (new-case:case "123" ("!" 1) ("123" 2))
2
quasimoto ★★★★
()
Ответ на: комментарий от quasimoto

broken version

И первая тоже:

CL-USER> (new-case:case "123" ("!" 1) ("123" (eql "123" "123")))
T
CL-USER> (eql "123" "123")
NIL

если только обещать себе не использовать eql в case.

quasimoto ★★★★
()
Ответ на: комментарий от ados

20 строк 

(defmacro scase (value &rest cases)
  (let ((var (gensym)))
    (labels ((case-body (cases)
               (if (endp cases)
                 nil
                 (destructuring-bind
                     ((case . body) . rest) cases
                   (if (and (endp rest) (member case '(t otherwise)))
                     `(progn ,@body)
                     (let ((case (if (listp case)
                                   case
                                   (list case))))
                       `(if (or ,@(mapcar (lambda (c) `(equal ,c ,var))
                                    case))
                          (progn ,@body)
                          ,(case-body rest))))))))
      `(let ((,var ,value))
         ,(case-body cases)))))

anonymous
()
Ответ на: комментарий от anonymous

Извольте пояснить по-хардкору.

anonymous
()
Ответ на: комментарий от ados

Значит макрос с #'equal вместо #'eql самим создавать?

А в чем сложность? Делов-то на пару минут.

korvin_ ★★★★★
()
Ответ на: комментарий от ados

упс, не знаю, но я каким-то образом не заметил буковку l и подумал, что речь идет о си :). извиняюсь.

Deleted
()
Ответ на: комментарий от tensai_cirno

да, я лоханулся :). отписал в каменте выше.

Deleted
()
Ответ на: комментарий от ados

cond слишком крут. Не понимаю, почему о поддержке строк забыли.

Зачем тащить этот тривиал в ядро? пакет #:CL и так слишком жирный. есть COND/IF, есть DEFMACRO, все что необходимо. KISS во все поля.

gensym ★★
()
Ответ на: комментарий от anonymous 
(defmacro scase (value &rest cases)
  `(cond
     ,@(mapcar #'(lambda (case)
		   `(
		    ,(let ((f (first case)))
		      (typecase f
			(list 
			 `(or ,@(mapcar #'(lambda (x) `(equal ,value ,x))
					f)))
			(atom 
			 (if (eql f 'otherwise)
			     t
			     `(equal ,value ,f)))))
		     ,@(rest case)))
	       cases)))
ados ★★★★★
() автор топика
Ответ на: комментарий от ados

Может лучше так:

(defmacro scase (expr predicate &body cases)
  (let ((value (gensym (string 'scase-value-))))
    `(let ((,value ,expr))
       (cond
        ,@(loop :for ((case . body) . rest) :on cases
                :collect
                (cons
                 (cond ((or (eq case t) (eq case 'otherwise))
                        (if (null rest)
                            t
                            (error "~a or ~a not the last clause in ~a." t 'otherwise 'scase)))
                       ((consp case)
                        `(or ,@(loop :for x :in case :collect `(,predicate ,value ,x))))
                       (t `(,predicate ,value ,case)))
                 body))))))

?

korvin_ ★★★★★
()
Ответ на: комментарий от anonymous

20 строк

Для SBCL всего две:

(defmacro scase (keyform &body cases)
  (sb-impl::case-body 'scase keyform cases t 'equal nil nil nil))
quasimoto ★★★★
()
Ответ на: комментарий от dmitry_vk

Главное, что одинаковые символы всегда равны, а разные - нет, и наоборот, и что сравнение происходит не по текстовому представлению символа (а там может быть любой unicode текст), а по указателю на это представление. Сам адрес портабельно использовать всё равно не получится (он, конечно, может и меняться в процессе эволюции, так как символы можно удалять и вводить снова).

quasimoto ★★★★
()
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.
Development