@@ -3,29 +3,6 @@

   (:export ))

 (in-package :fwoar.blog)

-(defmacro new (class &rest initializer-syms)

-  (multiple-value-bind (required optional rest) (parse-ordinary-lambda-list initializer-syms)

-    (when optional

-      (error "new doesn't handle optional arguments"))

-    (if rest

-        `(make-instance ,class

-                        ,@(mapcan (serapeum:op (list (alexandria:make-keyword _1) _1))

-                                  required)

-                        ,(make-keyword rest) ,rest)

-        `(make-instance ,class

-                        ,@(mapcan (serapeum:op (list (alexandria:make-keyword _1) _1))

-                                  initializer-syms)))))

-

-(defun-ct %constructor-name (class)

-  (format nil "~a-~a" '#:make class))

-

-(defmacro make-constructor (class &rest args)

-  (destructuring-bind (class &optional (constructor-name (intern (%constructor-name class))))

-      (ensure-list class)

-    `(defgeneric ,constructor-name (,@args)

-       (:method (,@args)

-         (new ',class ,@args)))))

-

 (defclass blog ()

   ((%posts :initarg :posts :accessor posts))

   (:default-initargs :posts ()))

@@ -34,7 +11,6 @@

   (format s "#.(make-blog ~{~s~^ ~})"

           (posts o)))

-

 (defclass post ()

   ((%content :initarg :content :accessor content)))

@@ -85,15 +61,13 @@

 (defclass blog-route ()

   ((%blog :initarg :blog :reader blog)))

-(defclass index (blog-route)

+(defclass index-route (blog-route)

   ())

-(make-constructor (index make-blog-index))

 (defclass post-route (blog-route)

   ((%post :initarg :post :reader post)))

-(make-constructor (post make-blog-post))

-(defmethod controller ((route index) params &key)

+(defmethod controller ((route index-route) params &key)

   (posts (blog route)))

 (defmethod controller ((route post-route) params &key)

@@ -106,7 +80,7 @@

      (:div

       (content post)))))

-(defmethod view ((name index) posts)

+(defmethod view ((name index-route) posts)

   (spinneret:with-html-string

     (:section

      (:h* "Blog Index")

@@ -114,13 +88,13 @@

       (loop for post in posts

             do (call-current-view post))))))

-(defmethod view ((name index) (post micropost))

+(defmethod view ((name index-route) (post micropost))

   (spinneret:with-html

     (:section.post.micropost

      (content post))))

-(defmethod view ((name index) (post macropost))

+(defmethod view ((name index-route) (post macropost))

   (spinneret:with-html

     (:section.post.macropost

      (:h* (:a :href (format nil "/~a" (slugify (title post)))

@@ -128,12 +102,15 @@

 (defun setup-routes (app blog)

   (defroutes app

-    (("/" :method :GET) (as-route (make-instance 'index :blog blog)))

-    (("/:post" :method :GET) (lambda (params)

-                               (format t "~&params: ~s~%" params)

-                               (let* ((post-name (cdr (assoc :post params)))

-                                      (route (make-instance 'post-route :post (find-post post-name blog))))

-                                 (run-route route params))))))

+    (("/" :method :GET)

+     (as-route

+      (make-instance 'index-route :blog blog)))

+    (("/:post" :method :GET)

+     (lambda (params)

+       (format t "~&params: ~s~%" params)

+       (let* ((post-name (cdr (assoc :post params)))

+              (route (make-instance 'post-route :post (find-post post-name blog))))

+         (run-route route params))))))

 (defvar *blog*

   (make-blog (make-micropost "first post")

new file mode 100644

@@ -0,0 +1,62 @@

+(defpackage :fwoar.decision-table

+  (:use :cl )

+  (:export ))

+(in-package :fwoar.decision-table)

+

+(defun array= (array1 array2 &optional (element-compare 'eql))

+  (and (= (length array1)

+          (length array2))

+       (every element-compare array1 array2)))

+

+(defun apply-decision-table (table inputs)

+  (destructuring-bind (row col) (array-dimensions table)

+    (loop with input-length = (length inputs)

+          for cur-row from 0 below row

+          for array-accessor = (make-array input-length

+                                           :displaced-to table

+                                           :displaced-index-offset (array-row-major-index table cur-row 0))

+            then (adjust-array array-accessor input-length

+                               :displaced-to table

+                               :displaced-index-offset (array-row-major-index table cur-row 0))

+          while (not (array= inputs array-accessor))

+          finally (return

+                    (aref table cur-row (1- col))))))

+

+(defmacro let-order ((min max) (a b) &body body)

+  (alexandria:once-only (a b)

+    `(destructuring-bind (,min ,max) (if (<= (length ,a) (length ,b))

+                                         (list ,a ,b)

+                                         (list ,b ,a))

+       ,@body)))

+

+(defmacro let-by-length ((a b) &body body)

+  `(let-order (,a ,b) (,a ,b)

+     ,@body))

+

+;; 

+;;

+;;

+;;

+

+(defun levehnstein-1-p (a b)

+  (let-by-length (a b)

+    (if (equal a b)

+        t

+        (cond ((= (length b)

+                  (length a))

+               (= (loop

+                    for x from 0 below (length a)

+                    when (not (eql (elt a x)

+                                   (elt b x)))

+                      count 1)

+                  1))

+              ((= (- (length b)

+                     (length a))

+                  1)

+               (some 'identity

+                     (map 'list

+                          (op (equal a

+                                     (remove _1 b

+                                             :start _2

+                                             :count 1)))

+                          b (alexandria:iota (length b)))))))))

@@ -98,7 +98,7 @@

      (format nil "~a.mp4"

              (puri:render-uri

               (fw.lu:prog1-bind (uri (puri:copy-uri uri))

-                (setf (puri:uri-host uri) "gfycat.com"))

+                (setf (puri:uri-host uri) "giant.gfycat.com"))

               nil))))

   (:method ((site (eql :imgur)) uri)

     (make-image

@@ -244,7 +244,7 @@

 (define-view root ((model video))

   (spinneret:with-html

     (:div.image

-     (:video :autoplay "autoplay" (:source :src (url model) :type "video/mp4")))))

+     (:video :autoplay "autoplay" :loop "loop" (:source :src (url model) :type "video/mp4")))))

 (defun initialize-app (app gallery)

   (defroutes app

new file mode 100644

@@ -0,0 +1,93 @@

+(defpackage :fwoar.generic-fun-special-decl

+  (:use :cl )

+  (:export ))

+(in-package :fwoar.generic-fun-special-decl)

+

+(defgeneric foo (arg))

+(let (*arg*)

+  (declare (special *arg*))

+  (defmethod foo :around (*arg*)

+             (declare (special *arg*))

+             (format t "~&*ARG* in :around: ~s~%" *arg*)

+             (call-next-method))

+  (defmethod foo :before (arg)

+             (declare (ignore arg))

+             (format t "~&*ARG* in :before: ~s~%" *arg*))

+  (defmethod foo :after (arg)

+             (declare (ignore arg))

+             (format t "~&*ARG* in :after: ~s~%" *arg*))

+  (defmethod foo ((arg string))

+    (format t "~&*ARG* in method for string: ~s~%" *arg*)

+    (let ((*arg* (parse-integer *arg*)))

+      (declare (special *arg*))

+      (format t "~&*ARG* in method for string, after rebinding: ~s~%" *arg*)

+      (call-next-method)))

+  (defmethod foo (arg)

+    (declare (ignore arg))

+    (format t "~&*ARG* in method for t: ~s~%" *arg*)))

+

+

+#|

+FWOAR.GENERIC-FUN-SPECIAL-DECL> (foo "4")

+*ARG* in :around: "4"

+*ARG* in :before: "4"

+*ARG* in method for string: "4"

+*ARG* in method for string, after rebinding: 4

+*ARG* in method for t: 4

+*ARG* in :after: "4"

+|#

+

+;; in: DEFMETHOD FOO :AROUND (T)

+;;     (DEFMETHOD FWOAR.GENERIC-FUN-SPECIAL-DECL::FOO :AROUND

+;;                (FWOAR.GENERIC-FUN-SPECIAL-DECL::*ARG*)

+;;       (DECLARE (SPECIAL FWOAR.GENERIC-FUN-SPECIAL-DECL::*ARG*))

+;;       (FORMAT T "~&*ARG* in :around: ~s~%" FWOAR.GENERIC-FUN-SPECIAL-DECL::*ARG*)

+;;       (CALL-NEXT-METHOD))

+;; --> PROGN EVAL-WHEN SB-PCL::%DEFMETHOD-EXPANDER 

+;; --> SB-PCL::LOAD-DEFMETHOD LIST* LET* SB-INT:NAMED-LAMBDA FUNCTION 

+;; --> SYMBOL-MACROLET SB-PCL::FAST-LEXICAL-METHOD-FUNCTIONS 

+;; --> SB-PCL::BIND-FAST-LEXICAL-METHOD-FUNCTIONS FLET CALL-NEXT-METHOD 

+;; --> BLOCK SB-PCL::FAST-CALL-NEXT-METHOD-BODY IF IF SB-PCL::BIND-ARGS 

+;; ==>

+;;   (LET* ((SB-PCL::.ARGS-TAIL. SB-PCL::CNM-ARGS)

+;;          (FWOAR.GENERIC-FUN-SPECIAL-DECL::*ARG* (POP SB-PCL::.ARGS-TAIL.))

+;;          (SB-PCL::.DUMMY0.))

+;;     (DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))

+;;     (SB-PCL::INVOKE-NARROW-EFFECTIVE-METHOD-FUNCTION SB-PCL::.NEXT-METHOD-CALL.

+;;                                                      NIL :REQUIRED-ARGS

+;;                                                      (FWOAR.GENERIC-FUN-SPECIAL-DECL::*ARG*)

+;;                                                      :REST-ARG NIL))

+;; 

+;; caught STYLE-WARNING:

+;;   using the lexical binding of the symbol (FWOAR.GENERIC-FUN-SPECIAL-DECL::*ARG*), not the

+;;   dynamic binding, even though the name follows

+;;   the usual naming convention (names like *FOO*) for special variables

+

+;; in: DEFMETHOD FOO :AROUND (T)

+;;     (DEFMETHOD FWOAR.GENERIC-FUN-SPECIAL-DECL::FOO :AROUND

+;;                (FWOAR.GENERIC-FUN-SPECIAL-DECL::*ARG*)

+;;       (DECLARE (SPECIAL FWOAR.GENERIC-FUN-SPECIAL-DECL::*ARG*))

+;;       (FORMAT T "~&*ARG* in :around: ~s~%" FWOAR.GENERIC-FUN-SPECIAL-DECL::*ARG*)

+;;       (CALL-NEXT-METHOD))

+;; --> PROGN EVAL-WHEN SB-PCL::%DEFMETHOD-EXPANDER 

+;; --> SB-PCL::LOAD-DEFMETHOD LIST* LET* SB-INT:NAMED-LAMBDA FUNCTION 

+;; --> SYMBOL-MACROLET SB-PCL::FAST-LEXICAL-METHOD-FUNCTIONS 

+;; --> SB-PCL::BIND-FAST-LEXICAL-METHOD-FUNCTIONS FLET CALL-NEXT-METHOD 

+;; --> BLOCK SB-PCL::FAST-CALL-NEXT-METHOD-BODY IF IF SB-PCL::BIND-ARGS 

+;; ==>

+;;   (LET* ((SB-PCL::.ARGS-TAIL. SB-PCL::CNM-ARGS)

+;;          (FWOAR.GENERIC-FUN-SPECIAL-DECL::*ARG* (POP SB-PCL::.ARGS-TAIL.))

+;;          (SB-PCL::.DUMMY0.))

+;;     (DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))

+;;     (SB-PCL::INVOKE-NARROW-EFFECTIVE-METHOD-FUNCTION SB-PCL::.NEXT-METHOD-CALL.

+;;                                                      NIL :REQUIRED-ARGS

+;;                                                      (FWOAR.GENERIC-FUN-SPECIAL-DECL::*ARG*)

+;;                                                      :REST-ARG NIL))

+;; 

+;; caught STYLE-WARNING:

+;;   using the lexical binding of the symbol (FWOAR.GENERIC-FUN-SPECIAL-DECL::*ARG*), not the

+;;   dynamic binding, even though the name follows

+;;   the usual naming convention (names like *FOO*) for special variables

+;; 

+;; compilation unit finished

+;;   caught 2 STYLE-WARNING conditions

new file mode 100644

@@ -0,0 +1,103 @@

+(defpackage :fwoar.raft

+  (:use :cl )

+  (:export ))

+(in-package :fwoar.raft)

+

+(defun take-keys (h-t &rest keys)

+  (mapcar (lambda (key)

+            (gethash key h-t))

+          keys))

+

+(defclass node ()

+  ((%current-term :accessor term :initform 0 :initarg :current-term)

+   (%voted-for    :accessor voted-for    :initform nil :initarg :leader-id)

+   (%e-log        :accessor e-log

+                  :initform (make-array 100 :adjustable t :fill-pointer 0))

+   (%client-id    :accessor id)

+   (%committed-index :accessor commit-index :initform 0)

+   (%last-applied :accessor last-applied :initform 0)))

+

+

+(defclass leader (node)

+  ((%next-index  :accessor next-index  :initform ())

+   (%match-index :accessor match-index :initform ())))

+

+(defclass append-entry-arguments ()

+  ((%term :initarg :term :reader term)

+   (%leader-id :initarg :leader-id :reader leader-id)

+   (%prev-log-index :initarg :prev-log-index :reader prev-log-index)

+   (%prev-log-term :initarg :prev-log-term :reader prev-log-term)

+   (%entries :initarg :entries :reader entries)

+   (%leader-commit :initarg :leader-commit :reader leader-commit)))

+

+(defclass entry ()

+  ((%term :initarg :term :accessor term)

+   (%data :initarg :data :accessor data)))

+

+(defmethod print-object ((o entry) s)

+  (print-unreadable-object (o s :type t :identity t)

+    (format s "term: ~s data: ~s"

+            (term o)

+            (data o))))

+

+(defun entry (term data)

+  (make-instance 'entry

+                 :term term

+                 :data data))

+

+(defun add-log-entry (node entry)

+  (assert (= (term entry) (term node))

+          (entry node)

+          "term-mismatch ~s ~s"

+          (term entry)

+          (term node))

+  (vector-push-extend entry (e-log node)))

+

+(defun get-log-entry (follower idx)

+  (elt (e-log follower)

+       idx))

+

+(defgeneric append-entries (follower args)

+  (:method ((follower node) (args append-entry-arguments))

+    (with-accessors ((term term)

+                     (leader-id leader-id)

+                     (prev-log-index prev-log-index)

+                     (prev-log-term prev-log-term)

+                     (entries entries)

+                     (leader-commit leader-commit)) args

+      

+      (when (< term (term follower))

+        (return-from append-entries

+          (values term nil)))

+

+      (when (/= (term (get-log-entry follower prev-log-index))

+                prev-log-term)

+        (return-from append-entries

+          (values term nil)))

+

+      #|If an existing entry conflicts with a new one (same index but|#

+      #|   different terms), delete the existing entry and all that  |#

+      #|   follow it (§5.3)                                          |#

+

+      (loop for new-entries-index from (1+ prev-log-index)

+            for (entry . rest-entries) on entries

+            for existing-entry in (subseq (e-log follower) (1+ prev-log-index))

+            until (/= (term entry)

+                      (term existing-entry))

+            finally

+               (when (< new-entries-index (length (e-log follower)))

+                 (setf (fill-pointer (e-log follower)) new-entries-index))

+

+               (map nil

+                    (lambda (el)

+                      (vector-push-extend el (e-log follower)))

+                    rest-entries))

+

+      (when (> leader-commit (commit-index follower))

+        (setf (commit-index follower)

+              (min leader-commit

+                   (1- (length (e-log follower))))))

+

+      (values (term follower)

+              t))))

+

@@ -1,21 +1,21 @@

 (ql:quickload '(:plump

-		:lquery

-		:serapeum

-		:alexandria

-		:flexi-streams

-		:chipz

-		:babel

-		:net.didierverna.clon))

+                :lquery

+                :serapeum

+                :alexandria

+                :flexi-streams

+                :chipz

+                :babel

+                :net.didierverna.clon))

 (in-package #:org.shirakumo.plump.parser)

 (define-tag-dispatcher (script *tag-dispatchers* *html-tags*)

     (name)

-    (string-equal name "script")

+  (string-equal name "script")

   (let* ((closing (consume))

          (attrs

-          (if (char= closing #\ )

-              (prog1 (read-attributes) (setf closing (consume)))

-              (make-attribute-map))))

+           (if (char= closing #\ )

+               (prog1 (read-attributes) (setf closing (consume)))

+               (make-attribute-map))))

     (case closing

       (#\/ (advance) (make-element *root* "script" :attributes attrs))

       (#\>

@@ -34,11 +34,11 @@

 (defvar *version* "0.001")

 (defsynopsis (:postfix "FILE")

-  (group (:header "Generic options")

-         (flag :short-name "v" :long-name "version"

-               :description "Show the program version")

-         (flag :short-name "h" :long-name "help"

-               :description "Show this help")))

+    (group (:header "Generic options")

+           (flag :short-name "v" :long-name "version"

+                 :description "Show the program version")

+           (flag :short-name "h" :long-name "help"

+                 :description "Show this help")))

 (defvar *txt* nil "The parsed HTML")

@@ -50,14 +50,14 @@

 (defun call-with-decompressed-text (fn cb &optional (encoding :iso-8859-1))

   (with-input-from-file (s fn :element-type '(unsigned-byte 8))

     (let* ((decompressing-stream (chipz:make-decompressing-stream 'chipz:bzip2 s))

-	   (flexi-stream (flexi-streams:make-flexi-stream decompressing-stream :external-format encoding)))

+           (flexi-stream (flexi-streams:make-flexi-stream decompressing-stream :external-format encoding)))

       (unwind-protect (funcall cb flexi-stream)

-	(close flexi-stream)

-	(close decompressing-stream)))))

+        (close flexi-stream)

+        (close decompressing-stream)))))

 (defun lookup-ref (p q a &rest r)

   (gethash (format nil "~aq.~da.~d~{~a~}" (string-upcase p) q a r)

-	   *lookup-table*))

+           *lookup-table*))

 (defun translate-book-ref (ref)

   (string-case ref

@@ -68,13 +68,13 @@

 (defun normalize-ref (ref)

   (destructuring-bind (book . ref) (split-sequence #\, ref)

     (if ref

-	(setf ref (string-join ref ","))

-	(setf ref book

-	      book ""))

+        (setf ref (string-join ref ","))

+        (setf ref book

+              book ""))

     (values (string-join (split-sequence #\space ref

-					 :remove-empty-subseqs t))

-	    (translate-book-ref (remove-if-not #'upper-case-p

-					       (string-capitalize book))))))

+                                         :remove-empty-subseqs t))

+            (translate-book-ref (remove-if-not #'upper-case-p

+                                               (string-capitalize book))))))

 (defun help ())

@@ -86,46 +86,46 @@

 (defmacro mark-start (&body body)

   (with-gensyms (start)

     `(tagbody

-	,start

-	(flet ((to-top () (go ,start)))

-	  ,@body))))

+        ,start

+        (flet ((to-top () (go ,start)))

+          ,@body))))

 (defun transform-ct-main ()

   (make-context)

   (mark-start

-    (restart-case

-	(cond

-	  ((getopt :long-name "help") (help))

-	  ((getopt :long-name "version") (show-version))

-	  (t (let ((file (car (remainder)))

-		   (ofile (cadr (remainder)))

-		   (*package* (find-package 'ct-transform)))

-	       (lquery:initialize (call-with-decompressed-text file #'plump:parse))

-	       (map 'list

-		    (op (destructuring-bind (ref el) _

-			  (setf (gethash (multiple-value-list (normalize-ref ref))

-					 *lookup-table*)

-				(plump:text el))))

-		    ($ "p[title]" (combine (attr :title) (node))))

-

-	       (let ((*print-case* :downcase))

-		 (alexandria:with-output-to-file (*standard-output* ofile)

-		   (loop for (ref book) being the hash-keys in *lookup-table* using (hash-value text)

-		      do (print `(ref ,book ,ref

-				      ,text)))))

-	       ;; (alexandria:with-input-from-file (s *fn* :external-format :iso-8859-1)

-	       ;;   (setf *txt* (plump:parse s)))

-

-	       ;; (uiop:directory-files "." (uiop:merge-pathnames* (make-pathname :type "bz2") uiop:*wild-file*))

-	       ;; (car *)

-	       ;; (plump:parse *)

-	       ;; (lquery:initialize *)

-	       ;; ($ "p[title]" (combine (attr :title)

-	       ;; 			    (text)))

-

-	       )))

-      (retry () (to-top))

-      (abort ()))))

+   (restart-case

+       (cond

+         ((getopt :long-name "help") (help))

+         ((getopt :long-name "version") (show-version))

+         (t (let ((file (car (remainder)))

+                  (ofile (cadr (remainder)))

+                  (*package* (find-package 'ct-transform)))

+              (lquery:initialize (call-with-decompressed-text file #'plump:parse))

+              (map 'list

+                   (op (destructuring-bind (ref el) _

+                         (setf (gethash (multiple-value-list (normalize-ref ref))

+                                        *lookup-table*)

+                               (plump:text el))))

+                   ($ "p[title]" (combine (attr :title) (node))))

+

+              (let ((*print-case* :downcase))

+                (alexandria:with-output-to-file (*standard-output* ofile)

+                  (loop for (ref book) being the hash-keys in *lookup-table* using (hash-value text)

+                        do (print `(ref ,book ,ref

+                                        ,text)))))

+              ;; (alexandria:with-input-from-file (s *fn* :external-format :iso-8859-1)

+              ;;   (setf *txt* (plump:parse s)))

+

+              ;; (uiop:directory-files "." (uiop:merge-pathnames* (make-pathname :type "bz2") uiop:*wild-file*))

+              ;; (car *)

+              ;; (plump:parse *)

+              ;; (lquery:initialize *)

+              ;; ($ "p[title]" (combine (attr :title)

+              ;;          (text)))

+

+              )))

+     (retry () (to-top))

+     (abort ()))))

 (defun make-executable ()

   (dump "transform-ct" transform-ct-main

@@ -8,7 +8,7 @@

     `(defun ,name ,args

        (flet (,@defs)

          ,@(loop for form in body until (and (consp form) (eql :where (car form)))

-                collect form)))))

+                 collect form)))))

 (defun make-zipfile-stream (fn)

   (open fn :element-type '(unsigned-byte 8)))