Re: Symbol clashes: how to avoid them. Part 2

Well, I'm very tired. But your attacks are so appealing... I like
debates.

I wonder why.  With the great language design skills you have
demonstrated here, employees should be bidding for you like crazy.
Hmm, you may start just now. I didn't advertise myself last several
years I had enough money. Now it changed. BTW, I'm not a language
designer. DSL's are not languages. Writing a lisp macros is mainly too
easy to call it language design.

You are missing the point.  
I only answered to your question in a detail. Your question were to
easy. I could ask much more hard one. To be serious, in fact, Pascal
is of course not as flexible as lisp. But in the context your
question, difference is not so significant.

Give me a break.  Java bytecode doesn't come close to a decent Lisp
compiler.
Do you know about JIT? You may find some data here. It is a surprise,
but Java on Linux is even a bit faster than SBCL. Yes, SBCL with all
types declared.

http://shootout.alioth.debian.org/u32q/benchmark.php?test=all&lang=java&lang2=sbcl

You can see competition rules are fair. You may even participate in a
competition. I tried to improve a couple lisp examples, but failed to
do that.

How would you know what is improbable?
I'm a qualified mathematician. I graduated probability cathedra of
Mathematics and Mechanics department of MSU at 1995. I didn't use
mathematics a lot after that, but I still remember that probabilities
sometimes multiply :)

Your problem is a classical one: you are a Blub [1] programmer, so you
want Lisp to look/feel like Blub.
Your problem is that you are making too hasty conslusions.

Here is my code that I wrote today. Sorry, I won't translate comments
from Russian for you.

(eval-when (:compile-toplevel :execute) ; compiler only
(defpackage :tokenizer
(:nicknames :tkn)
(:use :cl :cl-ppcre :port :iter)
(:import-from :cl-user :let1 :match :withgensyms :ignored :map-
dir)))

(in-package :tokenizer)


(defparameter *repl-kind* #+ignore :clipboard "D:/sw/
conds.pas") ; :variable - переменная, :clipboard - буфер обмена (не
всегда работает из-за уникода), имя-файла (выводим в такое же . out)
(defvar *src-1*)

(cond ((eq *repl-kind* :variable)
(setf *src-1* (list "my pascal code")))
((eq *repl-kind* :clipboard)
(setf *src-1* (list (CAPI-WIN32-LIB::GET-CLIPBOARD-TEXT))))
(t (setf *src-1* (list (cl-user::read-file-into-string *repl-
kind*)))))

(defparameter *lexer-list* '(
(identifier (:sequence (:flags :case-insensitive-p) (:sequence
(:regex "[a-zA-Z_][a-zA-Z_0-9]*"))))
(reg-identifier (:register identifier))
(whitespace (:greedy-repetition 0 nil :whitespace-char-class))
(reg-whitespace (:register whitespace))
))


(loop for (a b) in
*lexer-list*
do (eval `(define-parse-tree-synonym ,a ,b)))


; classes are #\a - ident, #\n - number #\ -whitespace no eol #\1 {} #
\2 (* *) #\3 //...:eol #\h hex
(defstruct (token (:conc-name tok.)) class position text)

(defvar *print-tok-mode* :short ":short - только содержимое и класс
нечитаемо, :full - как обычно")
(defmethod print-object ((tok token) stream)
(if (eq *print-tok-mode* :short)
(print-unreadable-object (tok stream :type nil)
(let ((text (tok.text tok))
(class (tok.class tok)))
(if (and (= (length text) 1)
(elt text 0) class)
(format stream "~A" class)
(format stream "~A ~A" class text))))
(call-next-method)))

(defmacro with-scan (scanner &body body)
"for use in tokenize. Сканирует сканером, связывает переменные beg,
end, len и выполняет body в progn. Body может менять end и class
(class по умолчанию равен ch, т.е., элементу строки в позиции start.
Сканер, если он что-то находит, должен находить это от начала строки
(beg=start).
Если body вернуло t, считаем, что body выявило токен от start до end.
Кладём его в tokens. Cмещаем start на эл-т после end. Если же body
вернул nil или если scanner ничего не нашел, ничего не делаем и
возвращаем nil"
(withgensyms
(beg res)
`(multiple-value-bind
(,beg end junk1 junk2)
(scan ,scanner s :start start)
(declare (ignore junk1 junk2))
(when ,beg
(assert (= ,beg start))
(let* ((class ch)
(len (- end ,beg))
(,res (progn ,@body)))
(ignored len)
(when ,res
(push (make-token :class class
:position start
:text (subseq s start end)) tokens)
(setf start end)
t))))))

(defmacro mk-token-from-ch ()
"Для tokenize. Делает текущий ch токеном с таким же классом"
`(progn (push (make-token :class ch :position start :text (subseq s
start (+ start 1)))
tokens)
(incf start)))


(defun tokenize (s &key (start 0))
"возвращает два значения - список токенов и индекс, начиная с
которого нужно искать дальше"
(let (tokens ch prev-start
(ident-scanner (create-scanner '(:sequence :modeless-start-
anchor identifier)))
(num-scanner (create-scanner "\\A\\-*[0-9]+(\\.([0-9]*))*(e-
*[0-9]+)*")) ; seem to be ok for all reals
(hex-num-scanner (create-scanner "\\A\\$[0-9]+"))
(whitespace-no-eol-scanner (create-scanner
'(:sequence :modeless-start-anchor
(:greedy-
repetition 1 nil (:alternation #\ #\Tab)))))
(comment-1-scanner
(create-scanner '(:sequence :modeless-start-anchor #\
{ (:greedy-repetition 0 nil (:inverted-char-class #\})) #\})
))
(comment-2-scanner
(create-scanner '(:sequence :modeless-start-anchor #\( #\*
(:non-greedy-repetition 0 nil :everything) #\* #\))))
(comment-3-scanner
(create-scanner '(:sequence :modeless-start-anchor #\/ #\/
(:non-greedy-repetition 0 nil :everything) :end-anchor) :multi-line-
mode t))
)
(loop
(setf prev-start start)
; (print start)
(when (>= start (length s)) (return-from tokenize (nreverse
tokens)))
(setf ch (elt s start))
(cond
((alpha-char-p ch) (with-scan ident-scanner (setf class #\a)))
((or (digit-char-p ch)
(eql #\. ch)
(eql #\- ch))
(or
(with-scan num-scanner (setf class #\n))
(mk-token-from-ch))
)
((member ch '(#\ #\Tab)) (with-scan whitespace-no-eol-scanner
(setf class #\ )))
(t
(case ch
(#\$ (with-scan hex-num-scanner (unless (= len 1) (setf class
#\h))))
(#\{ (or (with-scan comment-1-scanner (setf class #\1))
(mk-token-from-ch)))
(#\( (with-scan comment-2-scanner (unless (= len 1)) (setf
class #\2))
(mk-token-from-ch))
(#\/ (or (with-scan comment-3-scanner (setf class #\3))
(mk-token-from-ch)))
(#\' (macrolet ((shift ()
'(progn
(incf end)
(when (= end (length s))
(go :failed))
(setf chh (elt s end)))))
(prog (chh (end start))
:beg-loop
(shift)
(setf chh (elt s end))
(when (eql chh #\') (go :got-a-quote))
(go :beg-loop)
:got-a-quote
(shift)
(when (eql chh #\') (go :beg-loop)) ; не парсим
строку, а стоило бы...
:closed
(make-token :class #\'
:position start
:text (subseq s start end))
(setf start end)
(return)
:failed
(mk-token-from-ch))))
(t (mk-token-from-ch)))))
(assert (> start prev-start)))))


(defun skip-comments-and-whitespace (token-list)
(loop for tok in token-list
for class = (tok.class tok)
unless (member class '(#\ #\1 #\2 #\3))
collect tok))

(defun split-list-by-condition (fun list-ptr)
"Разбивает list в точке, где fun первый раз равно true. list-ptr -
это cons, cdr которого содержит list.
У list-ptr отрезается всё, начиная с точки, где fun = true, и
возвращается. Last остатка list-ptr возвращается
в качестве второго значения.. Если fun не стало истиной, возвращаются
два значения nil"
(loop
:for old-sublist :on list-ptr
:for sublist :on (cdr list-ptr)
:for it := (car sublist)
:when (funcall fun it)
:do (progn
(setf (cdr old-sublist) nil)
(return (values sublist old-sublist)))
:finally (values nil nil)))

#| (defun wind-use-lists (tokens)
(multiple-value-bind


(loop
with state = :initial
for tok in tokens
for class = (tok.class tok)
for text = (tok.text tok)

|#



(defparameter *tokens* (tokenize (car *src-1*)))

(defparameter *tokens-w-o-namespace* (skip-comments-and-whitespace
*tokens*))

(defvar *interface-uses* nil)
(defvar *implementation-uses* nil)
(defvar *implementation-uses-start* nil "это будет указатель на токен
uses в implementation")
(defvar *interface-uses-start* nil "это будет указатель на токен uses
в interface")

(defun note-uses (token-list-w-o-whitespace)
(loop for x in token-list-w-o-whitespace
for class = (tok.class x)
for text = (tok.text x)
with flag = nil with section = nil
when (and flag (eq class #\a) (eq section :interface)) collect text
into interface-uses


when (and flag (eq class #\a) (eq section :implementation)) collect
text into implementation-uses
when (and (eql class #\a) (equalp text "interface")) do (setf
section :interface)
when (and (eql class #\a) (equalp text "implementation")) do (setf
section :implementation)
when (and (eql class #\a) (equalp text "uses"))
do
(setf flag t)
(if (eq section :interface)
(setf *interface-uses-start* x)
(setf *implementation-uses-start* x))
when (eql class #\;) do (setf flag nil)
finally (setf *interface-uses* interface-uses *implementation-uses*
implementation-uses)))

(note-uses *tokens-w-o-namespace*)
(print *interface-uses*)
(print *implementation-uses*)

(defun sublist-starting-from-token (token token-list)
(let1 pos (position token token-list)
(assert pos)
(nthcdr pos token-list)))

#| (defun subst-ado-with-ex-ado ()
(let* ((ado-in-int (member "adodb" *interface-uses* :test 'equalp))
(ado-in-impl (member "adodb" *implementation-uses* :test
'equalp)))
(cond
(ado-in-int |#


(defun subst-bar-with-baz ()
(let* ((int-uses-list (sublist-starting-from-token *interface-uses-
start*
*tokens*)) (use-
foo-token (find "bar" int-uses-list :key #'tok.text :test #'equalp)))
(assert use-foo-token)
(setf (cdr int-uses-list)
(cllib:substitute-subseq (cdr int-uses-list)
(list use-foo-token)
(list (make-token :class #\a :text
"baz,quux"))
:test 'equal))))


(defun print-list-of-tokens (lst &optional (stream t))
(loop for x in lst
for text = (tok.text x)
do (format stream "~A" text)))

(defparameter *redo-once* nil)
(defun undo-repl () (prog1 (second *src-1*) (when (cdr *src-1*) (setf
*redo-once* (pop *src-1*)))))
(defun redo-repl () (unless *redo-once* (error "can't redo")) (push
*redo-once* *src-1*) (setf *redo-once* nil))
(defun a-word (word) `(:sequence whitespace :word-boundary ,word :word-
boundary whitespace))


.

Relevant Pages

  • a Forth CPU assembler
    ... (defun add-byte (byte) ... (setf label-value 0)) ... (defun parse-push (tokens byte) ... (setf byte (logior byte #b00000100))) ...
    (comp.lang.lisp)
  • Re: memory usage in cmucl
    ... `(setf state,statename)) ... an abstraction that should be hidden in a more elegant state machine ... (defparameter driver-c nil) ... (defparameter incoming nil) ...
    (comp.lang.lisp)
  • Re: CLX/CMUCL: Event processing speed
    ... The pointer position at each pointer ... (setf *graphics-context* nil) ... > changed the wording around display-finish-output. ...
    (comp.lang.lisp)
  • Re: memory usage in cmucl
    ... `(setf state,statename)) ... This macro is just taking up space. ... I don't understand why "a more elegant state machine notation" ... (defparameter driver-c nil) ...
    (comp.lang.lisp)
  • Re: a hardware Lisp interpreter
    ... (defparameter *data-stack* nil) ... (setf *eval-state* nil) ... :function-name nil ...
    (comp.lang.lisp)