diff --git a/forge/forge.lisp b/forge/forge.lisp index f98fb08..8d013e2 100644 --- a/forge/forge.lisp +++ b/forge/forge.lisp @@ -12,26 +12,26 @@ (defclass forge-env () ((data-stack :initform nil - :reader data-stack - :accessor data-stack!) + :reader data-stack + :accessor data-stack!) (vocabulary :initform (list *builtins*) - :accessor vocabulary))) + :accessor vocabulary))) (defun forge-env () (let ((fe (make-instance 'forge-env))) - (push (make-hash-table :test 'equalp) (vocabulary fe)) - fe)) + (push (make-hash-table :test 'equalp) (vocabulary fe)) + fe)) (defun exec-str (fe s) (exec fe (read-from-string - (concatenate 'string "(" s ")")))) + (concatenate 'string "(" s ")")))) (defun exec (fe code) (dolist (x code) - (typecase x - (symbol (funcall (comp1 fe x) fe)) - (compiled-function (funcall x fe)) - (t (pushd fe x))))) + (typecase x + (symbol (funcall (comp1 fe x) fe)) + (compiled-function (funcall x fe)) + (t (pushd fe x))))) (defun repl (fe) (do ((input (read-line) (read-line))) ((string= input "q") nil) @@ -40,20 +40,20 @@ (defun find-word (fe key) (let ((k (string-downcase (symbol-name key)))) (dolist (voc (vocabulary fe)) - (let ((v (gethash k voc))) - (if v (return v)))))) + (let ((v (gethash k voc))) + (if v (return v)))))) (defun comp (fe inp) (let ((code nil)) (dolist (item inp) - (setf code (cons (comp1 fe item) code))) - (reverse code))) + (setf code (cons (comp1 fe item) code))) + (reverse code))) (defun comp1 (fe item) (typecase item - (symbol (find-word fe item)) - (cons (comp fe item)) - (t item))) + (symbol (find-word fe item)) + (cons (comp fe item)) + (t item))) (defun register (voc key fn) (let ((k (if (symbolp key) (symbol-name key) key))) @@ -73,19 +73,19 @@ (reg-b "def" #'(lambda (fe) (let* ((name (popd fe)) - (code (comp fe (popd fe)))) + (code (comp fe (popd fe)))) (register (voc fe) name #'(lambda (fe) (exec fe code)))))) (reg-b "const" #'(lambda (fe) (let ((name (popd fe)) - (value (popd fe))) + (value (popd fe))) (register (voc fe) name #'(lambda (fe) (pushd fe value)))))) (reg-b "var" #'(lambda (fe) (let ((name (popd fe)) - (var (list (popd fe)))) + (var (list (popd fe)))) (register (voc fe) name #'(lambda (fe) - (pushd fe #'(lambda (fn) + (pushd fe #'(lambda (fn) (funcall fn var)))))))) (reg-b "get" #'(lambda (fe) @@ -93,7 +93,7 @@ (reg-b "put" #'(lambda (fe) (let ((fn (popd fe)) - (vl (popd fe))) + (vl (popd fe))) (funcall fn #'(lambda (x) (setf (car x) vl)))))) ; internal definitions diff --git a/scopes.asd b/scopes.asd index 3133333..51eb210 100644 --- a/scopes.asd +++ b/scopes.asd @@ -8,11 +8,11 @@ :description "" :depends-on (:str :sxql) :components ((:file "forge/forge") - (:file "storage/storage") - (:file "storage/tracking" :depends-on ("storage/storage")) - (:file "testing") - (:file "test/test-forge" :depends-on ("testing" "forge/forge")) - (:file "test/test-storage" :depends-on ("testing" "storage/storage" "storage/tracking"))) + (:file "storage/storage") + (:file "storage/tracking" :depends-on ("storage/storage")) + (:file "testing") + (:file "test/test-forge" :depends-on ("testing" "forge/forge")) + (:file "test/test-storage" :depends-on ("testing" "storage/storage" "storage/tracking"))) :long-description "scopes: generic data processing facilities") ;;#.(uiop:read-file-string ;; (uiop:subpathname *load-pathname* "README.md"))) diff --git a/scratch.lisp b/scratch.lisp index 86736ba..fe8a974 100644 --- a/scratch.lisp +++ b/scratch.lisp @@ -13,25 +13,25 @@ (defun make-iter () (let ((pointers (vector nil nil nil))) - #'(lambda (fn) - (funcall fn pointers)))) + #'(lambda (fn) + (funcall fn pointers)))) (defun iter-current (it) (funcall it #'(lambda (p) (car (svref p 0))))) (defun classes () (let ((r nil)) - (maphash #'(lambda (k v) + (maphash #'(lambda (k v) (setf r (cons k r))) si:*class-name-hash-table*) - (sort r #'(lambda (x y) + (sort r #'(lambda (x y) (string<= (package-name (symbol-package x)) - (package-name (symbol-package y))))))) + (package-name (symbol-package y))))))) (defun x-make-var (value) #'(lambda (nv) - (if (null nv) - value - (setf value nv)))) + (if (null nv) + value + (setf value nv)))) (defun x-get-var (vf) (funcall vf nil)) diff --git a/storage/storage.lisp b/storage/storage.lisp index 60579bc..4ecd493 100644 --- a/storage/storage.lisp +++ b/storage/storage.lisp @@ -5,8 +5,8 @@ (defpackage :scopes/storage (:use :common-lisp) (:export #:*db-params* - #:storage - #:drop-table)) + #:storage + #:drop-table)) (in-package :scopes/storage) @@ -20,4 +20,4 @@ (defun drop-table (st tn) st (print (sxql:yield - (sxql:drop-table tn :if-exists t)))) + (sxql:drop-table tn :if-exists t)))) diff --git a/storage/tracking.lisp b/storage/tracking.lisp index c41b17a..7eeeca0 100644 --- a/storage/tracking.lisp +++ b/storage/tracking.lisp @@ -5,8 +5,8 @@ (defpackage :scopes/storage/tracking (:use :common-lisp) (:export #:track #:time-stamp #:data - #:container - #:create-table)) + #:container + #:create-table)) (in-package :scopes/storage/tracking) @@ -22,11 +22,11 @@ (defun create-table (storage table-name head-fields) storage (let - ((id-type 'bigserial) - (hf-def (mapcar #'(lambda (x) (list x :type 'text)) head-fields))) + ((id-type 'bigserial) + (hf-def (mapcar #'(lambda (x) (list x :type 'text)) head-fields))) (print (sxql:yield (sxql:make-statement :create-table table-name - (nconc + (nconc `((trackid :type ,id-type :primary-key t)) hf-def '((timestamp :type timestamp) diff --git a/test/test-forge.lisp b/test/test-forge.lisp index 84e9129..98b5331 100644 --- a/test/test-forge.lisp +++ b/test/test-forge.lisp @@ -5,14 +5,14 @@ (defpackage :scopes/test-forge (:use :common-lisp) (:local-nicknames (:scf :scopes/forge) - (:sct :scopes/testing)) + (:sct :scopes/testing)) (:export #:run)) (in-package :scopes/test-forge) (defun run () (let ((fe (scf:forge-env)) - (tst (sct:test-suite))) + (tst (sct:test-suite))) (test-exec tst fe) ;(format t "~%data-stack ~a" (data-stack fe)) (test-def tst fe) diff --git a/test/test-storage.lisp b/test/test-storage.lisp index 8dba544..5c6a1ef 100644 --- a/test/test-storage.lisp +++ b/test/test-storage.lisp @@ -5,8 +5,8 @@ (defpackage :scopes/test-storage (:use :common-lisp) (:local-nicknames (:storage :scopes/storage) - (:tracking :scopes/storage/tracking) - (:t :scopes/testing)) + (:tracking :scopes/storage/tracking) + (:t :scopes/testing)) (:export #:run #:try)) (in-package :scopes/test-storage) @@ -19,13 +19,13 @@ (defun run () (let ((st (make-instance 'storage:storage)) - (tst (t:test-suite))) + (tst (t:test-suite))) (test-track tst st) (t:result tst))) (defun test-track (tst st) (let ((tr (make-instance 'tracking:track))) - (storage:drop-table st :tracks) - (tracking:create-table st :tracks '(trackid username)) - ;(setf (scs:data tr) nil) - (t:assert-eq tst (tracking:data tr) nil))) + (storage:drop-table st :tracks) + (tracking:create-table st :tracks '(trackid username)) + ;(setf (scs:data tr) nil) + (t:assert-eq tst (tracking:data tr) nil))) diff --git a/testing.lisp b/testing.lisp index d006a16..e9f62db 100644 --- a/testing.lisp +++ b/testing.lisp @@ -10,8 +10,8 @@ (defclass test-suite () ((result :initform nil - :reader result - :accessor result!))) + :reader result + :accessor result!))) (defun test-suite () (make-instance 'test-suite))