eshamster

; ----- package a ----- ;
(defpackage pack-a
  (:use :cl))
(in-package :pack-a)

; 文字列strをinternしてvalueを束縛する
(defmacro with-interned-str (str value &body body)
  (let ((sym (intern (string-upcase str))))
    `(let ((,sym ,value))
       ,@body)))

eshamster

; ----- package a ----- ;
(defpackage pack-a
  (:use :cl))
(in-package :pack-a)

(defun equal-name (l r)
  (and (symbolp l)
       (symbolp r)
       (equal (symbol-name l) (symbol-name r))))

eshamster

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(ql:quickload :parenscript)

(defun intern-ub (sym)
  (intern (format nil "~A_" (symbol-name sym))))

eshamster

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(ql:quickload :parenscript)
(ql:quickload :cl-ppcre)

(defun replace-dot-sep (elem)
  (if (symbolp elem)

eshamster

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
"
ps-experiment is required to be cloned from
  https://github.com/eshamster/ps-experiment.git
(commit id: 984dd0b18c962895f0a915da9136890e970e700d)
"

eshamster

;; src/defines.lisp から抜粋

(defun parse-defstruct-name (name)
  (if (symbolp name)
      name
      (error 'type-error :expected-type 'symbol :datum name)))
  
(defun parse-defstruct-options (options)
  (unless (eq (car options) :include)
    (error "unknown DEFSTRUCT.PS option:~% ~S" options))

eshamster

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(eval-when (:compile-toplevel :execute :load-toplevel)
  (ql:quickload :ps-experiment)
  (ql:quickload :cl-js))

(pse:defstruct.ps parent

eshamster

;; --- src/defines.lispから抜粋 --- ;;

(def-ps-definer defstruct.ps (name-and-options &rest slot-description)
  `(defstruct ,name-and-options ,@slot-description))

;; ついでにdefunとdefvar
(def-ps-definer defun.ps (name args &body body)
  `(defun ,name ,args ,@body))

(def-ps-definer defvar.ps (name initial-value)

eshamster

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros +Q -- $0 "$@"
|#
(defpackage pack-a
  (:use :cl)
  (:export :test-struct))
(in-package :pack-a)

eshamster

(in-package :cl-user)
(defpackage test-ps-eval-order
  (:use :cl
        :parenscript)
  (:export :print-ps))
(in-package :test-ps-eval-order)

(eval-when (:compile-toplevel :execute :load-toplevel)
  (defpsmacro test-defpsmacro ()
    `(setf ok "expanded by test-defpsmacro")))