[1]->(setq s1 (hcl:make-stack :name 'my-stack)) #<stack :name my-stack :not-active :cstk 512 :ostk 512>
[2]->(defun foo (x) (loop (print x) (incf x) (hcl:resume))) foo [3]->(hcl:make-process s1 #'foo '(0)) 0 #<stack :name my-stack :not-active :cstk 512 :ostk 512>
[4]->(hcl:resume s1) 1 #<stack :name my-stack :not-active :cstk 512 :ostk 512> [5]-> 2 #<stack :name my-stack :not-active :cstk 512 :ostk 512>
動的共有変数とはプログラムのコンテクストとしては通常の変数であるが 自分自身を含む他のスタック空間上の動的共有変数とメモリ上の同一アドレス を共有しているものである。共有変数は参照、代入のコストが通常の変数と 同等であり、プログラム中の意味も通常のCommon Lispの変数と全く同じである。 似た概念にstatic closure中に閉じこめられた 変数があるが、これは共有関係を関数定義時に宣言する必要がある。 これに対しHCl の動的共有変数は関数の実行中であっても共有関係を変更 できるものであり、自由度が高い。
HCl では以下のようなマクロ、関数を用意して動的共有変数をサポートする。
(hcl:with-shared-variable ({var|(var init)|(var :process #'fn)}*) {(:equivalence {var}*)}* . body)簡単な例でwith-shared-variableマクロを説明する。最も簡単な例は以下の ようなものである。この例ではIN1,IN2,Qが共有変数として宣言されている。 関数NANDはIN1,IN2がともに1の場合にQ=0,それ以外でQ=1となる関数である。 Example
(defun NAND () (let (internal-q) (hcl:with-shared-variable (IN1 IN2 (Q 0)) (loop (hcl:resume) (setq internal-Q (if (and (= IN1 1)(= IN2 1)) 0 1)) (hcl:resume) (setq Q internal-Q) ;; update Q ))))この例では素子としてNANDを定義したに過ぎない。これを用いてRS-LATCHを 定義する場合、NANDの入出力を結線する必要がある。関数RS-LATCHは内部に 2個のNANDをプロセスとして含み、それがRS-LATCHを構成するように変数が 共有される。
(defun RS-LATCH () (hcl:with-shared-variable (IN1 IN2 (Q1 0) (Q2 1) (NAND1 :process #'NAND) (NAND2 :process #'NAND)) (:equivalence IN1 (NAND1 . IN1)) (:equivalence IN2 (NAND2 . IN1)) (:equivalence Q2 (NAND1 . IN2) (NAND2 . Q)) (:equivalence Q1 (NAND2 . IN1) (NAND1 . Q)) (loop (hcl:resume) (hcl:resume NAND1) (hcl:resume NAND2) (hcl:resume) (hcl:resume NAND1) (hcl:resume NAND2))))ここでNAND1,NAND2は共有変数であるが、その値はプロセスである。この場合は RS-LATCHを構成するNANDが代入されている。:equivalenceで始まるformは 共有関係の宣言である。この宣言においてはそのwith-shared-variableマクロ で宣言された共有変数はsymbolがそのまま、サブプロセス中の変数は(プロセス変数 . var) の形式で指定される。プロセスがさらにネストされている場合は(process subprocess subsubprocess ... . v の形式で指定できる。同時に複数の変数の共有関係が宣言できる。
[9]->(setq rs-ff (hcl:make-new-process #'RS-LATCH ())) #<stack :name rs-latch :parent nil :cstk 512 :ostk 512> [10]->(hcl:send-message rs-ff 'hcl:value 'Q0) 0 [11]->(hcl:send-message rs-ff 'hcl:value 'Q1) 1
[12]->(hcl:send-message rs-ff 'hcl:set-value 'Q0 100) 100 [13]->(hcl:send-message rs-ff 'hcl:value 'Q0) 100
[14]->(hcl:send-message rs-ff 'hcl:variable-list) (Q1 Q0 IN2 IN1)
[15]->(hcl:send-message rs-ff 'hcl:process-list) (NAND1 NAND2)
(hcl::stack-name
process )
で知ることができる。なお、
hcl::stack-name
でプロセス内トップレベル関数を知れるのは
hcl:with-shared-variableマクロでプロセスが初期化された場合のみである。
hcl:make-process
で初期化する場合はマニュアルで
(setf (hcl:stack-name stack ) name)
にのりstack構造体のnameスロットをセットしなければいけない。
[16]->(hcl:send-message rs-ff '(NAND1 . hcl:value) 'Q) 100 [17]->(hcl:stack-name rs-ff) rs-latch
[18]->(hcl:process-variable rs-ff 'q0) 100 [19]->(setf (hcl:process-variable rs-ff 'q0) 0) 0 [20]->(hcl:process-variable rs-ff 'q0) 0
[18]->(setq NAND3 (hcl:make-new-process #'NAND ())) #<stack :name nand :parent t :cstk 512 :ostk 512> [19]->(hcl:equivalence nand3 'in1 rs-ff 'q0) 0 [20]->(setf (hcl:process-value rs-ff 'q0) 10) 10 [21]->(hcl:process-value nand3 'in1) 10
[22]->(hcl:unlink-variable nand3 'in1) 10 [23]->(setf (hcl:process-value rs-ff 'q0) 0) 0 [24]->(hcl:process-value nand3 'in1) 10
ss1 (server) | towns (client) --------------------------------------------------------------------------------------------- [1]->(system "hostname") |[1]->(system "hostname") ss1 |towns 0 |0 [2]->(setq tcp (si:open-tcp-stream nil 5010)) |[2]->(setq tcp (si:open-tcp-stream "ss1" 5010) #<stream #<pointer 0x.> #<pointer 0x.>> |#<stream #<pointer 0x.> #<pointer 0x.>> [3]->(print '(1 2 3) tcp) |[3]->(read tcp) (1 2 3) | [4]->(force-output tcp) | t |(1 2 3) [5]->(read tcp) |[5]->(print 12345 tcp) |12345 |[6]->(force-output tcp) 12345 |t [6]->(close tcp) |[7]->(close tcp) ---------------------------------------------------------------------------------------------
[1]->(si:get-input-file-descriptor *standard-input*) 0 [2]->
[1]->(si:get-output-file-descriptor *standard-output*) 0 [2]->
[1]->(setq fd (si:get-output-file-descriptor *standard-output*)) 0 [2]->(si:select-input (ash 1 fd) 10) 1 [3]->(read-char *standard-input*) \Newline [4]->