| (no subject) |
[Jul. 2nd, 2009|04:24 pm] |
|
На lisp.ru большая часть сообщений в разделе "программирование" - просьбы скубентов написать программку для допуска к зачету/экзамену. Это уныло. |
|
|
| (no subject) |
[Jun. 10th, 2009|05:37 pm] |
Передознулся кофеином.
Учитывая, что я еще не спал двое суток и ебашил фенотропил ночью и утром - получилось особенно весело. |
|
|
| (no subject) |
[Jun. 2nd, 2009|07:27 pm] |
20
Всем похуй, но тем не менее. |
|
|
| (no subject) |
[Feb. 15th, 2009|08:39 pm] |
А как вы относитесь к тому, что на ЛОРе запретили анонимуса?
я думаю, это совсем пиздец не то чтобы мне влом было регистрироваться, просто, бля, exler.ru это плохой пример |
|
|
| (no subject) |
[Jan. 28th, 2009|01:17 am] |
Пишу из Висты. Еще системник новый собрал, да.
Такие дела. |
|
|
| (no subject) |
[Jan. 16th, 2009|04:01 pm] |
Для Common Lisp существует нестандартизированный MOP, описанный в книжке "Art of the MetaObject Protocol" Его возможности дико охуенны, впрочем как и все возможности CLOS(особенно в сравнении с java, c# или c++) Более-менее его поддерживают все основные реализации, хотя лучше всего(из свободных), как я понял - SBCL
Вот небольшой пример создания классов в рантайме, с его использованием - реализация паттерна синглтон. Проверял на sbcl и clisp.
Одними из самых верхних классов в иерархии CLOS являются классы standard-class и standard-object. Инстансы standard-class - метаобъекты классов, как понятно из названия. Standard-object собственно - один из таких инстансов, встроенных в CLOS. Все классы, определенные через defclass являются его наследниками.
#+sbcl (use-package :sb-mop)
;;Метакласс классов-синглтонов.
;;Сам является инстансом
;;класса `standard-class' (а также наследником)
;;Запоминаем его в переменную, хотя с таким же успехом
;;можно было спрятать его в замыкание
(defvar *singleton-metaclass*
(make-instance 'standard-class
:name 'singleton-class
:direct-superclasses
(list (find-class 'standard-class))
:direct-slots
(list
(list :name 'instance
:initform nil
:initfunction (constantly nil)))))
;;Позволяет получать доступ к классу по символу-имени
(setf (find-class 'singleton-class) *singleton-metaclass*)
;;Перегрузка стандартного конструктора CLOS
;;Теперь для класса, для которого singleton-class
;;является метаклассом, он создает инстанс только один раз.
;;при повторном вызове - просто возвращает уже существующий
(defmethod make-instance ((class singleton-class) &key)
(with-slots (instance) class
(or instance (setf instance (call-next-method)))))
;;Обобщенная функция для доступа к инстансу класса
;;Принимает как параметр объект-класс или символ-имя такого
;;(хотя в принципе можно пользоваться и make-instance)
(defgeneric instance (class-object))
(defmethod instance ((class-object singleton-class))
(slot-value class-object 'instance))
(defmethod instance ((class-object symbol))
(instance (find-class class-object)))
;;Позволяет инстансам singleton-class наследоваться от
;;обычного standard-object.
;;Это необходимо, если мы хотим пользоваться
;;встроенными для standard-object механизмами CLOS,
;;такими, как автоматическая инициализация инстансов
;;в ходе вызова make-instance, или встраивать синглтоны в общую
;;иерархию
(defmethod validate-superclass ((class singleton-class)
(superclass standard-object))
t)
;;Некий класс-синглтон.
;;Инстанс созданного выше класса 'singleton-class'
(defvar *my-singleton-class*
(make-instance 'singleton-class
:name 'my-singleton
:direct-superclasses
(list (find-class 'standard-object))
:direct-slots
(list
(list :name 'text-slot
:initform ""
:initfunction (constantly "")
:type 'string
:initargs '(:text-slot)
:readers '(text-slot)
:writers '((setf text-slot))))))
(setf (find-class 'my-singleton) *my-singleton-class*)
;(defparameter *singleton-instance*
; (make-instance 'my-singeton :text-slot "Singleton instance!"))
;
;(instance 'my-singleton) ==> #<MY-SINGLETON ....>
;
;(text-slot (make-instance 'my-singleton :text-slot "12345"))
; ==> "Singleton instance!"
;;Конечно, не обязательно создавать классы вручную через
;;make-instance, можно пользоваться и встроенным макросом defclass.
;;На этот случай там есть параметр :metaclass
(defclass another-singleton ()
((another-slot :initarg :another-slot
:initform nil
:accessor another-slot))
(:metaclass singleton-class))
|
|
|
| (no subject) |
[Jan. 4th, 2009|09:52 pm] |
;;Church numerals
(def |0| (l (f x) x))
(def |1| (l (f x) {f x}))
(def |2| (l (f x) {f {f x}}))
(def |3| (l (f x) {f {f {f x}}}))
(def succ (l (n f x) {f {n f x}}))
(def plus (l (n m) {m succ n}))
(def mult (l (m n) {m {plus n} |0|}))
(def pred (l (n f x) {n (l (g h) {h {g f}}) (l u x) (l u u)}))
(def sub (l (m n) {n pred m}))
(def churchify-numeral
(lambda (n)
(labels ((make-number (n)
(if (<= n 0)
|0|
{succ (make-number (1- n))})))
(let ((sym (intern (format nil "~a" n))))
(setf (symbol-function sym) (make-number n))
(setf (symbol-value sym) (symbol-function sym))))))
(def dechurchify-numeral (l (f) {f #'1+ 0}))
;;Church booleans
(def |true| (l (x y) x))
(def |false| (l (x y) y))
(def |and| (l (p q) {p q p}))
(def |or| (l (p q) {p p q}))
(def |not| (l (p a b) {p b a}))
(def is-zero (l n {n (l x |false|) |true|}))
(def less-then-or-equal (l (m n) {is-zero {sub m n}}))
(def dechurchify-boolean (l f {if-then-else f T NIL}))
;;If then else
;;Не работает в силу applicative-order-evaluation:
;;(def if-then-else-lambda (l (p a b) {p a b}))
;;
;;Костыли:
(def force (l x (funcall x)))
(defmacro delay (x) `(lambda () ,x))
(defmacro if-then-else (p a b)
`(force (funcall (funcall ,p (delay ,a)) (delay ,b))))
;;Church encoding for pairs
(def |cons| (l (x y f) {f x y}))
(def |car| (l p {p |true|}))
(def |cdr| (l p {p |false|}))
(def |nil| (l x |true|))
(def |null-p| (l p {p (l x {y |false|})}))
;; Y combinator
;(def Y (l g {(l x {g {x x}}) (l x {g {x x}})}))
(def App-Order-Y (l g {(l x {g (l y {x x y})})
(l x {g (l y {x x y})})}))
(def fact
{App-Order-Y
(l (f n)
(if-then-else {is-zero n}
|1|
{mult n {f {pred n}}}))})
(dechurchify-numeral (fact (churchify-numeral 5)))
==> 120 |
|
|
| (no subject) |
[Jan. 3rd, 2009|09:15 pm] |
Тут, уже в прошлом году, делать было нефиг написал расширение синтаксиса к CL для лямбда-исчисления и комбинаторной логики типа, как в математике почти
;;автокаррирующая лямбда
(defmacro l (x &body body)
(cond
((null x) (error "Lambda w/o arguments is not allowed here"))
((atom x) `(lambda (,x) ,@body))
(T (labels ((parse-lambda (args)
`(lambda (,(car args))
,@(if (null (rest args))
body
(list (parse-lambda (cdr args)))))))
(parse-lambda x)))))
;;ну просто
(defmacro def (name args &body body)
`(progn ,(if (null body)
`(setf (symbol-function ',name)
,args)
`(defun ,name ,args ,@body))
(defparameter ,name #',name)))
( Парсер )
;;Теперь можно писать так:
;;S K и I комбинаторы
(def S (l (x y z) {x z {y z}}))
(def K (l (x y) x))
(def I (l x {S K S x}))
;;B C и W соответственно
(def B {S {K S} K})
(def C {{S {{S {K {{S {K S}} K}}} S}} {K K}})
(def W {S S {K {S K K}}})
|
|
|
| (no subject) |
[Jan. 3rd, 2009|08:59 pm] |
Долго ебался с этой херней
http://love5an.livejournal.com/305219.html
думаю, для начала сделаю простенький DFA, без сложных подвыражений, типа как в lex а потом учить матчасть
Вот в ANTLR охуенный лексер! Совсем охуенно было бы его на CL портировать. |
|
|
| (no subject) |
[Dec. 31st, 2008|04:54 pm] |
Желаю всем дико угореть в новом году!1 Я так уже сейчас начинаю, например |
|
|
| (no subject) |
[Dec. 29th, 2008|07:01 am] |
Ночью переписывал генератор, решил сделать по-другому. Пока написал базу, разбор элементарных частей токена вида '0'..'9'* или {'0','1','2'}+
(defun match-state (ch state lexer-stream temp-out inverse-call)
(let* ((state-type (car state)))
(cond
((atom-state-p state-type)
(multiple-value-bind
(val count) (match-atom-state ch state lexer-stream temp-out)
(when (and (not inverse-call) val)
(vector-push-extend ch temp-out))
(values val count)))
((eq state-type :quant)
(let* ((min (first (second state)))
(max (second (second state)))
(count 0)
(match nil)
(real-state (third state))
(infinite-p (eq max :inf)))
(handler-case
(loop
while (and (or infinite-p (< count max))
(multiple-value-bind
(val cnt) (match-state ch real-state lexer-stream temp-out nil)
(incf count cnt)
val)) do
(setf ch (read-char lexer-stream))
(incf count)
finally (setf match (>= count min)))
(end-of-file () (setf match (>= count min))))
(when (not match) (loop repeat count do (vector-pop temp-out)))
(values match count))))))
(defun match-atom-state (ch state lexer-stream temp-out)
(case (car state)
(:set (values (member ch (rest state) :test #'char=) 0 nil))
(:char (values (char= ch (second state)) 0 nil))
(:range (values (char<= (second state) ch (third state)) 0 nil))
(:not (multiple-value-bind
(val count) (match-state ch (second state) lexer-stream temp-out t)
(values (not val) count)))))
Вроде работает. Верхняя функция возвращает множественные значения - совпадает/нет и число считанных из потока элементов; я думаю делать так, что если основной результат nil, с помощью unread-char считать назад и попробовать матчить другое. Над этим сверху будет работа с последовательностями таких элементов, там же '|', а сверху уже разбор типов. |
|
|
| (no subject) |
[Dec. 28th, 2008|07:22 pm] |
Не нашел для CL приличных генераторов лексеров. Поэтому, решил такой написать. Ну, типа, почему бы и нет.
То, что есть уже: http://pastebin.com/m3a7d0979
Пока работает с деревьями вида (:ws (:quant 0 (0 :inf) (:set #\Newline #\Return #\Space #\Tab))) (:integer (:quant 0 (0 1) (:set #\+ #\-)) (:quant 0 (1 :inf) (:range #\0 #\9))) но в будущем наверное прикручу EBNF-подобный интерфейс
На текущий момент поломаны конечные квантификаторы ((0 2) (2 5) etc) и с жадностью/нежадностью какая-то херня(обработки этого пока просто нет). Основная кривота в области функции (token-type-match), я так думаю(рефакторинг и все такое тоже конечно не помешает, да) |
|
|
| (no subject) |
[Dec. 25th, 2008|01:18 am] |
Я никак не пойму, зачем Google раскручивает Python. То есть, по крайней мере, с рациональной точки зрения(остается думать на желание Google поднять бренды/тренды, "свой язык программирования" etc).
Тормонутый, урезанный до невозможности Common Lisp с засахаренным синтаксисом и, соответственно, без макросов(да даже без лямбд нормальных), зато с огромной стдлибой, да.
То есть, понятно, да, зачем M$ продвигает C#, или Sun - Java. Но вот это. |
|
|
| (no subject) |
[Dec. 23rd, 2008|03:52 pm] |
Вчера полночи ебался, пытаясь заставить ANTLR работать с C# Заставил, и это радует. ANTLR охуенен. |
|
|
| (no subject) |
[Dec. 21st, 2008|09:41 pm] |
Раздел "программирование" на форуме ixbt это адовая анальная бездна. 99,99% - виндаус 75% из этого - c++ 20% - дельпхи ~5% - Java, C#, ASP, VB Ад. Я туда больше не. |
|
|
| (no subject) |
[Dec. 17th, 2008|12:49 am] |
|
"=)" - уебищный смайлик. Невыносимо уебищный. |
|
|
| (no subject) |
[Dec. 12th, 2008|07:51 pm] |
Похоже, RDNZL теперь поддерживает коллбэки на SBCL на Win32. По крайней мере, работают и все приложенные examples, и такой вот хелловорд:
(in-package :rdnzl-user)
(enable-rdnzl-syntax)
(import-assembly "mscorlib")
(import-assembly "System.Windows.Forms")
(use-namespace "System.Windows.Forms")
(defun timestr ()
(multiple-value-bind
(sec min hr d m y day dl gmt) (get-decoded-time)
(declare (ignore dl))
(format nil "~a, ~a ~a ~a ~2,'0d:~2,'0d:~2,'0d GMT~:[-~;+~]~1,2f"
(nth day '("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun"))
d
(nth (1- m) '("Jan" "Feb" "Mar" "Apr" "May" "Jun"
"Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
y hr min sec
(<= gmt 0) (abs gmt))))
(defun main ()
(let ((form (new "Form"))
(label (new "Label"))
(textbox (new "TextBox"))
(btn (new "Button"))
(timer (new "Timer")))
[+Tick timer
(new "System.EventHandler"
#'(lambda (sender e)
(declare (ignore sender) (ignore e))
(setf [%Text label] (timestr))))]
[+Click btn
(new "System.EventHandler"
#'(lambda (sender e)
(declare (ignore sender) (ignore e))
(setf [%Text textbox] (read-line *standard-input*))))]
(setf [%Height form] 100 [%Width form] 300
[%FormBorderStyle form] [$FormBorderStyle.FixedSingle]
[%Text form] "Hello, world!" [%Text btn] "Click it!"
[%StartPosition form] [$FormStartPosition.CenterScreen]
[%AutoSize label] t [%AutoSize textbox] t [%AutoSize form] t
[%Dock label] [$DockStyle.Top]
[%Dock textbox] [$DockStyle.Bottom]
[%Dock btn] [$DockStyle.Right]
[%Parent label] form
[%Parent textbox] form
[%Parent btn] form
[%Interval timer] 1000)
[Start timer]
[Application.Run form]))
Это дико круто, потому что теперь можно использовать не только гуйню из дотнета, но и треды, например(хотя, конечно, это будет относительно медленно, других путей на некоммерческих реализациях на винде, вощемта, особо и не найти). Дико круто. |
|
|
| navigation |
| [ |
viewing |
| |
most recent entries |
] |
| [ |
go |
| |
earlier |
] |
| |
|
|