cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

forge: make forge/sf the standard forge package; keep old files as x-... for reference

Browse source
This commit is contained in:
Helmut Merz 2024-09-17 19:52:42 +02:00
parent 6ed436f94f
commit c857da986b
6 changed files with 100 additions and 101 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
app/demo/etc/config.lisp
View file

@ -5,7 +5,9 @@
(config:root :env-keys '(:docroot :address :port :loglevel :logfile) (config:root :env-keys '(:docroot :address :port :loglevel :logfile)
:env-path (util:runtime-path ".env")) :env-path (util:runtime-path ".env"))
(config:add :logger :class 'logging:config) (config:add :logger
:class 'logging:config
:console nil)
(config:add :server (config:add :server
:class 'server:config :class 'server:config

4
app/demo/main.lisp
View file

@ -18,7 +18,7 @@
(format t "~%Hello World.~%config-path: ~s~%" config-path) (format t "~%Hello World.~%config-path: ~s~%" config-path)
(load config-path)) (load config-path))
(core:setup-services) (core:setup-services)
(setf forge:*forge-env* (forge:forge-env)) ;(setf forge:*forge-env* (forge:forge-env))
(forge:setup-builtins) ;(forge:setup-builtins)
(forge:repl) (forge:repl)
(core:shutdown)) (core:shutdown))

9
scopes-core.asd
View file

@ -13,8 +13,7 @@
:depends-on ("core/message" "config" :depends-on ("core/message" "config"
"forge/forge" "logging" "util/util")) "forge/forge" "logging" "util/util"))
(:file "core/message" :depends-on ("shape/shape")) (:file "core/message" :depends-on ("shape/shape"))
(:file "forge/forge") (:file "forge/forge" :depends-on ("util/iter" "util/util"))
(:file "forge/sf" :depends-on ("util/iter" "util/util"))
(:file "logging" :depends-on ("config" "util/util")) (:file "logging" :depends-on ("config" "util/util"))
(:file "shape/shape") (:file "shape/shape")
(:file "util/util") (:file "util/util")
@ -28,10 +27,8 @@
:depends-on (:scopes-core) :depends-on (:scopes-core)
:components ((:file "test/test-config") :components ((:file "test/test-config")
(:file "test/test-core") (:file "test/test-core")
(:file "test/test-forge") (:file "test/test-forge"))
(:file "test/test-sf"))
:perform (test-op (o c) :perform (test-op (o c)
(symbol-call :scopes/test-config :run) (symbol-call :scopes/test-config :run)
(symbol-call :scopes/test-core :run) (symbol-call :scopes/test-core :run)
;(symbol-call :scopes/test-forge :run) (symbol-call :scopes/test-forge :run)))
(symbol-call :scopes/test-sf :run)))

71
test/test-forge.lisp
View file

@ -5,6 +5,7 @@
(defpackage :scopes/test-forge (defpackage :scopes/test-forge
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:forge :scopes/forge) (:local-nicknames (:forge :scopes/forge)
(:util :scopes/util)
(:t :scopes/testing)) (:t :scopes/testing))
(:export #:run) (:export #:run)
(:import-from :scopes/testing #:deftest #:==)) (:import-from :scopes/testing #:deftest #:==))
@ -13,46 +14,42 @@
(defun run () (defun run ()
(let ((t:*test-suite* (t:test-suite "forge"))) (let ((t:*test-suite* (t:test-suite "forge")))
;(forge:*forge-env* (forge:forge-env))) (unwind-protect
(setf forge:*forge-env* (forge:forge-env)) (progn
(forge:setup-builtins) ;(forge:setup-builtins)
(test-iseq) (test-exec)
(test-exec) (test-def)
(test-def) (test-val)))
(test-const) (util:lgi (forge:stack forge:*forge-env*))
(test-var)
(t:show-result))) (t:show-result)))
(deftest test-iseq ()
(let ((seq (forge:make-iseq)))
(forge:isq-add seq 1)
(forge:isq-add seq 2)
(== (forge:isq-next seq) 1)
(== (forge:isq-end seq) 2)))
(deftest test-exec () (deftest test-exec ()
(forge:exec-str "4 2 +") ;(forge:exec-str "4 2 add")
(== (car (forge:dstack)) 6)) (forge:exec-list '(4 2 add))
(== (forge:popd) 6)
(forge:exec-list '(<comp dup mul /> in square reg))
(forge:exec-list '(7 square))
(== (forge:popd) 49)
(forge:exec-string "8 square")
(== (forge:popd) 64))
(deftest test-def () (deftest test-def ()
(forge:exec-str "(comp quote defer regc) quote defc regc") (forge:exec-list '(<comp in <comp swp reg /> in <def reg))
(forge:exec-str "(comp quote defer reg) defc def") (forge:exec-string "<def cube dup dup mul mul />")
(forge:exec-str "(dup *) def square") (forge:exec-list '(3 cube))
(forge:exec-str "7 square") (== (forge:popd) 27))
(== (car (forge:dstack)) 49))
(deftest test-const () (deftest test-val ()
(forge:exec-str "(defer wrap comp quote defer reg) defc const") (forge:exec-list '(<def const val in reg />))
(forge:exec-str "11 const eleven") (forge:exec-list '(7 const seven))
(forge:exec-str "eleven square") (forge:exec-list '(seven square))
(== (car (forge:dstack)) 121)) (== (forge:popd) 49)
(forge:exec-list '(<def var ptr const />))
(deftest test-var () (forge:exec-list '(3 var myvar))
(forge:exec-str "(defer wrap defer wrap comp quote defer reg) defc var") (forge:exec-list '(myvar get))
(forge:exec-str "7 var myvar") (== (forge:popd) 3)
(forge:exec-str "myvar get square") (forge:exec-list '(42 myvar put))
(== (car (forge:dstack)) 49) (forge:exec-list '(myvar get))
(forge:exec-str "8 myvar set") (== (forge:popd) 42)
(forge:exec-str "myvar get square") )
(== (car (forge:dstack)) 64))

55
test/test-sf.lisp
View file

@ -1,55 +0,0 @@
;;;; cl-scopes/test/test-forge
;;;; testing facility for scopes/forge
(defpackage :scopes/test-sf
(:use :common-lisp)
(:local-nicknames (:forge :scopes/forge/sf)
(:util :scopes/util)
(:t :scopes/testing))
(:export #:run)
(:import-from :scopes/testing #:deftest #:==))
(in-package :scopes/test-sf)
(defun run ()
(let ((t:*test-suite* (t:test-suite "forge/sf")))
(unwind-protect
(progn
;(forge:setup-builtins)
(test-exec)
(test-def)
(test-val)))
(util:lgi (forge:stack forge:*forge-env*))
(t:show-result)))
(deftest test-exec ()
;(forge:exec-str "4 2 add")
(forge:exec-list '(4 2 add))
(== (forge:popd) 6)
(forge:exec-list '(<comp dup mul /> in square reg))
(forge:exec-list '(7 square))
(== (forge:popd) 49)
(forge:exec-string "8 square")
(== (forge:popd) 64))
(deftest test-def ()
(forge:exec-list '(<comp in <comp swp reg /> in <def reg))
(forge:exec-string "<def cube dup dup mul mul />")
(forge:exec-list '(3 cube))
(== (forge:popd) 27))
(deftest test-val ()
(forge:exec-list '(<def const val in reg />))
(forge:exec-list '(7 const seven))
(forge:exec-list '(seven square))
(== (forge:popd) 49)
(forge:exec-list '(<def var ptr const />))
(forge:exec-list '(3 var myvar))
(forge:exec-list '(myvar get))
(== (forge:popd) 3)
(forge:exec-list '(42 myvar put))
(forge:exec-list '(myvar get))
(== (forge:popd) 42)
)

58
test/x-test-forge.lisp Normal file
View file

@ -0,0 +1,58 @@
;;;; cl-scopes/test/test-forge
;;;; testing facility for scopes/forge
(defpackage :scopes/test-forge
(:use :common-lisp)
(:local-nicknames (:forge :scopes/forge)
(:t :scopes/testing))
(:export #:run)
(:import-from :scopes/testing #:deftest #:==))
(in-package :scopes/test-forge)
(defun run ()
(let ((t:*test-suite* (t:test-suite "forge")))
;(forge:*forge-env* (forge:forge-env)))
(setf forge:*forge-env* (forge:forge-env))
(forge:setup-builtins)
(test-iseq)
(test-exec)
(test-def)
(test-const)
(test-var)
(t:show-result)))
(deftest test-iseq ()
(let ((seq (forge:make-iseq)))
(forge:isq-add seq 1)
(forge:isq-add seq 2)
(== (forge:isq-next seq) 1)
(== (forge:isq-end seq) 2)))
(deftest test-exec ()
(forge:exec-str "4 2 +")
(== (car (forge:dstack)) 6))
(deftest test-def ()
(forge:exec-str "(comp quote defer regc) quote defc regc")
(forge:exec-str "(comp quote defer reg) defc def")
(forge:exec-str "(dup *) def square")
(forge:exec-str "7 square")
(== (car (forge:dstack)) 49))
(deftest test-const ()
(forge:exec-str "(defer wrap comp quote defer reg) defc const")
(forge:exec-str "11 const eleven")
(forge:exec-str "eleven square")
(== (car (forge:dstack)) 121))
(deftest test-var ()
(forge:exec-str "(defer wrap defer wrap comp quote defer reg) defc var")
(forge:exec-str "7 var myvar")
(forge:exec-str "myvar get square")
(== (car (forge:dstack)) 49)
(forge:exec-str "8 myvar set")
(forge:exec-str "myvar get square")
(== (car (forge:dstack)) 64))