wip on lisp dir

Author: jcs090218

.gitignore

@@ -1,6 +1,10 @@
 # qob
 /.qob
 
+# executables
+qob
+*.exe
+
 # lisp
 *.FASL
 *.fasl

bin/.gitignore

@@ -1,2 +1,2 @@
-# others
+/lisp
 qob.*

cmds/core/build.lisp

@@ -36,17 +36,16 @@
     :description "output directory"
     :short-name #\o
     :long-name "output"
-    :required t
     :key :output)))
 
 (defun handler (cmd)
   "Handler for `build' command."
   (let* ((name   (clingon:getopt cmd :name))
          (output (clingon:getopt cmd :output)))
+    ;; Delete if exists to prevent errors.
+    (when (uiop:file-exists-p output)
+      (delete-file output))
     ;; TODO: Change build path.
-    (format t "~A" output)
-
-
     (qob:setup)
     (asdf:operate :build-op name)))
 

cmds/core/list.lisp

@@ -22,8 +22,9 @@
 (defun handler (cmd)
   "Handler for `list' command."
   (declare (ignore cmd))
-  (qob:setup)
-  (format t "~A" (asdf/system-registry:registered-systems)))
+  ;;(qob:setup)
+  ;;(format t "~A" (asdf/system-registry:registered-systems))
+  (qob:call-lisp "core/list"))
 
 (defun command ()
   "List command."

scripts/build.lisp

@@ -7,6 +7,8 @@
 
 ;;; Code
 
+(require 'asdf)
+
 (push '*default-pathname-defaults* asdf:*central-registry*)
 (asdf:load-system "qob")
 
@@ -20,9 +22,32 @@
 
 ;;(uiop:dump-image "./bin/qob.exe" :executable t)
 
+(defun copy-directory (src-dir dst-dir)
+  "Recursively copy the contents of SRC-DIR to DST-DIR."
+  (let ((src (uiop:parse-native-namestring src-dir))
+        (dst (uiop:parse-native-namestring dst-dir)))
+    ;; Ensure the source directory exists
+    (unless (probe-file src)
+      (error "Source directory ~a does not exist!" src))
+
+    ;; Create destination directory if it doesn't exist
+    (unless (probe-file dst)
+      (ensure-directories-exist dst))
+
+    ;; Recursively copy files and directories
+    (dolist (entry (directory (merge-pathnames "*" src)))
+      (let ((entry-name (uiop:parse-native-namestring entry)))
+        (if (uiop:file-exists-p entry-name)
+            ;; Copy file
+            (uiop:copy-file entry-name (merge-pathnames (uiop:pathname-name entry) dst))
+            ;; Recursively copy subdirectory
+            (copy-directory entry-name (merge-pathnames (uiop:pathname-name entry) dst)))))))
+
+(copy-directory "lisp" "bin/lisp")
+
 (let ((exec (el-lib:el-expand-fn (if (uiop:os-windows-p)
-                                     "./bin/qob.exe"
-                                     "./bin/qob"))))
+                                     "bin/qob.exe"
+                                     "bin/qob"))))
   (when (uiop:file-exists-p exec)
     (delete-file exec)))
 

src/el-lib.lisp

@@ -10,22 +10,40 @@
 (defpackage el-lib
   (:use cl)
   (:export el-memq
+           el-member
            el-expand-fn
-           el-member))
+           el-executable-find
+           el-move-path))
 
 (in-package :el-lib)
 
+(defvar el-executables nil
+  "Executable cache.")
+
+(defun el-executables ()
+  "Return list of executables."
+  (loop with path = (uiop:getenv "PATH")
+        for p in (uiop:split-string path :separator
+                                    (if (uiop:os-windows-p) ";" ":"))
+        for dir = (probe-file p)
+        when (uiop:directory-exists-p dir)
+          append (uiop:directory-files dir)))
+
+(defun el-executable-find (name)
+  "Mimic `executable-find' function."
+  (unless el-executables
+    (setq el-executables (el-executables)))
+  (find name el-executables
+        :test #'equalp
+        :key #'pathname-name))
+
 (defun el-memq (elt list)
   "Mimic `memq' function."
   (member elt list :test #'eq))
 
 (defun el-member (elt list)
   (member elt list :test #'string=))
 
-(defun el-expand-fn (path-string &optional (dir-name (uiop:getcwd)))
+(defun el-expand-fn (path &optional (dir-name (uiop:getcwd)))
   "Like `expand-file-name' function."
-  (uiop:unix-namestring
-   (uiop:ensure-absolute-pathname
-    (uiop:merge-pathnames*
-     (uiop:parse-unix-namestring path-string))
-    dir-name)))
+  (uiop:ensure-absolute-pathname (uiop:merge-pathnames* path dir-name)))

src/packages.lisp

@@ -11,17 +11,18 @@
   (:use cl)
   (:export
    ;; src/utils.lsip
-   setup
-   load-system
-   asd-files
-   asd-test-files
+   call-lisp
+   setup           ; TODO: move to prepare.lisp
+   load-system     ; TODO: move to prepare.lisp
+   asd-files       ; TODO: move to prepare.lisp
+   asd-test-files  ; TODO: move to prepare.lisp
    ;; src/logger.lsip
-   print
-   trace
-   debug
-   info
-   warning
-   error
+   print           ; TODO: move to prepare.lisp
+   trace           ; TODO: move to prepare.lisp
+   debug           ; TODO: move to prepare.lisp
+   info            ; TODO: move to prepare.lisp
+   warning         ; TODO: move to prepare.lisp
+   error           ; TODO: move to prepare.lisp
    ;; cmds/qob.lisp
    command
    ;; src/main.lsip

src/utils.lisp

@@ -9,6 +9,33 @@
 
 (in-package :qob)
 
+(defvar *lisp-root* "lisp/"
+  "Directory path points to the lisp folder.")
+
+(defun program-name ()
+  "Lisp program we target to run."
+  (or (uiop:getenv "QOB_LISP")
+      "sbcl"))
+
+(defun lisp-script (name)
+  "Form lisp script path."
+  (concatenate 'string name ".lisp"))
+
+(defun call-lisp (script &rest args)
+  "Run the lisp implementation."
+  (let ((lisp-impls (program-name)))
+    (unless (el-lib:el-executable-find lisp-impls)
+      (error "Defined Lisp implementation is not installed: ~A" lisp-impls))
+    (let* ((lisp-dir (el-lib:el-expand-fn *lisp-root* sb-ext:*runtime-pathname*))
+           (script (lisp-script script)))
+      (format t "~A" (el-lib:el-expand-fn script lisp-dir))
+      ;; (uiop:run-program (list lisp-impls
+      ;;                         "--load" (el-lib:el-expand-fn script *lisp-root*)
+      ;;                         )
+      ;;                   :output t
+      ;;                   :force-shell t)
+      )))
+
 (defun setup ()
   "Setup the system."
   (let ((files (asd-files t)))