Return Styles: Pseud0ch, Terminal, Valhalla, NES, Geocities, Blue Moon. Entire thread

Hail to The King, Baby!

Name: Anonymous 2013-04-19 13:24

Holy cudders! Symta has came to Lisp. With just a few macros we turn your SBCL into a full featured Symta-grade enterprise system! Forget FIOC and Haskell! Try SIOC - Symta Indentation of Code now!

SYMTA> (
! say "Shalom, Jews!"
! i = 0
! n = 5
! while < i n
! ! say "sqrt of {i} is {sqrt i}"
! ! format t "square of {i} is {* i i}"
! ! incf i
! say "Happy Holocaust!"
)
Shalom, Jews!
sqrt of 0 is 0.0
square of 0 is 0sqrt of 1 is 1.0
square of 1 is 1sqrt of 2 is 1.4142135
square of 2 is 4sqrt of 3 is 1.7320508
square of 3 is 9sqrt of 4 is 2.0
square of 4 is 16Happy Holocaust!
NIL

SYMTA> (def f n ! if plusp n
                ! ! * n (f (- n 1))
                ! ! 1)
F
SYMTA> (f 10)
3628800
SYMTA>



Teh macros!

(defun say (&rest xs)
  (format t "~a~%"
    (with-output-to-string (o)
      (while xs
        (format o "~a" (pop xs))
        (when xs (format o " "))))))

;; LIOC = lisp indentation of code
(defun lioc (s xs)
  (let* ((p (or (position s xs)
                (return-from lioc
                  (if (and (consp xs)
                           (= (length xs) 1))
                      (cons 'progn xs)
                      xs))))
         (pref (subseq xs 0 p))
         (xs (subseq xs p (length xs)))
         (zs nil)
         )
    (while xs
      (pop xs)
      (let ((ys nil))
        (while (eql (car xs) s)
          (push (pop xs) ys))
        (while (and xs (not (eql (car xs) s)))
          (push (pop xs) ys))
        (let ((ys (nreverse ys)))
          (if (eql (car ys) s)
              (push (append (pop zs) ys) zs)
              (push ys zs)))))
    (setf xs `(lioc-prog ,@(mapcar (lambda (xs) (lioc s xs))
                                   (nreverse zs))))
    (when pref
      (case (car pref)
        (if (pop pref) (push 'lioc-if pref))
        (when (pop pref) (push 'lioc-when pref))
        (unless (pop pref) (push 'lioc-unless pref))
        (while (pop pref) (push 'lioc-while pref))
        (till (pop pref) (push 'lioc-till pref))
        )
      (setf xs `(,@pref ,xs))
      )
    xs))

(defmacro lioc-prog (&body xs)
  (labels ((shaded (xs)
             (when xs
               (let* ((x (pop xs))
                      (xs (shaded xs)))
                 (if (eql (second x) '=)
                     (let ((as (first x))
                           (body `(! ,@(cddr x))))
                       (if (consp as)
                           `((labels ((,(car as) ,(cdr as) ,body))
                               ,@xs))
                           `((let ((,as ,body))
                               ,@xs))))
                     `(,x ,@xs))))))
    `(progn ,@(shaded xs))))

(defmacro lioc-if (&body xs)
  (let ((head (butlast xs))
        (xs (car (last xs))))
    (unless (eql (car xs) 'lioc-prog)
      (error "lioc-if: invalid body"))
    `(if ,head ,@(cdr xs))))

(defmacro lioc-when (&body xs) `(when ,(butlast xs) ,(car (last xs))))
(defmacro lioc-unless (&body xs) `(when (not ,(butlast xs)) ,(car (last xs))))
(defmacro lioc-while (&body xs) `(while ,(butlast xs) ,(car (last xs))))
(defmacro lioc-till (&body xs) `(while (not ,(butlast xs)) ,(car (last xs))))

(defun lioc-expand-string (x)
  (let ((s (position #\{ x)))
    (unless s (return-from lioc-expand-string x))
    (let ((e (position #\} x)))
      (unless e (error "unterminated {"))
      `(concatenate 'string
         ,(subseq x 0 s)
         (format nil "~a" (! ,@(read-from-string (format nil "(~a)" (subseq x (+ s 1) e)))))
         ,(lioc-expand-string (subseq x (+ e 1) (length x)))))))

(defun lioc-expand-strings (x)
  (cond ((consp x) (mapcar #'lioc-expand-strings x))
        ((stringp x) (lioc-expand-string x))
        (t x)))

(defmacro ! (&body xs) (lioc '! (cons '! (lioc-expand-strings xs))))

(defmacro def (&body xs)
  (let ((p (position '! xs)))
    (unless p (error "def has no ! body"))
    `(defun ,(car xs) ,(cdr (subseq xs 0 p))
       ,(subseq xs p (length xs)))))

Name: Anonymous 2013-04-19 19:42

>>16
[@A B @C] is the same as `(,@A ,B ,@C) in Common Lisp.

Newer Posts
Don't change these.
Name: Email:
Entire Thread Thread List