#+HTML_HEAD: #+TITLE: 小蟬之核 / core of cicada-nymph #+AUTHOR: 謝宇恆 / XIE Yuheng * todo *** >< code generation for interfaces of data-structure *** >< the size of file *** >< better structure for IO functions * only one error-code->string is not enough *** >< write-with-color * for better report *** type check *** >< view the core as a special module * re-import core every time *** optimize with type info *** fast tangle *** debug-REPL *** 漢語 alias *** language-level support for creating and managing processes * module-meta *** core-test #+begin_src cicada-nymph :tangle core-test.cn :::::::: author: XIE Yuheng do: "* (core-test) finished" .s .l ======== #+end_src * writers *** note name of writers * the use of "." as prefix is inherited from Forth * table | . | pretty_write_integer | assembly | | .i | write_integer | core | | .s | write_string | assembly | | .l | linefeed | core | | .b | write-byte | | *** .l .i .b #+begin_src cicada-nymph :tangle core.cn : .l << -- >> 10 write-byte end ; define-function : .i << -- >> write-integer end ; define-function : .b << byte -- >> write-byte end ; define-function #+end_src * jojo-compiler-syntax *** 記條件轉跳 * one predicate can make two branchs three predicates can make four branchs three predicates may only make three branchs but indeed there must be an invisible branch *** literal-word:[if|else|then]? #+begin_src cicada-nymph :tangle core.cn : literal-word:if? << word[address, length] -- bool >> "if" string:equal? end ; define-function : literal-word:else? << word[address, length] -- bool >> "else" string:equal? end ; define-function : literal-word:then? << word[address, length] -- bool >> "then" string:equal? end ; define-function #+end_src *** jojo-compiler-syntax:if #+begin_src cicada-nymph :tangle core.cn : jojo-compiler-syntax:if << jo, string[address, length], literal-word:if -- address, jo, string[address, length] >> drop2 jo instruction,false?branch jojo-area,stay *jojo-area,current-free-address* xxx|swap|x 0 jojo-area,stay end ; define-function #+end_src *** jojo-compiler-syntax:else #+begin_src cicada-nymph :tangle core.cn : jojo-compiler-syntax:else << address, jo, string[address, length], literal-word:else -- address, jo, string[address, length] >> drop2 jo instruction,branch jojo-area,stay x|swap|xxx *jojo-area,current-free-address* xxxx|swap|x 0 jojo-area,stay << address, string[address, length], address >> *jojo-area,current-free-address* over sub *cell-size* div swap set end ; define-function #+end_src *** jojo-compiler-syntax:then #+begin_src cicada-nymph :tangle core.cn : jojo-compiler-syntax:then << address, jo, string[address, length], literal-word:then -- jo, string[address, length] >> drop2 x|swap|xxx *jojo-area,current-free-address* over sub *cell-size* div swap set end ; define-function #+end_src *** test if & else & then #+begin_src cicada-nymph :tangle core-test.cn : .12 << 1 2 -- >> 2 equal? if "(^-^)" .s 1 equal? if "\^o^/" .s else "_____" .s then else "_____" .s 1 equal? if "\^o^/" .s else "_____" .s then then end ; test-function : "* (testing) nested if & else & then" .s .l 1 2 .12 .l 6 2 .12 .l 1 6 .12 .l 6 6 .12 .l ; test-do #+end_src *** test if & else & then by factorial #+begin_src cicada-nymph :tangle core-test.cn : factorial << number -- number >> dup one? if end then dup sub1 factorial mul end ; test-function : "* (testing) if & else & then by factorial" .s .l 1 factorial 1 equal? 2 factorial 2 equal? and 3 factorial 6 equal? and 4 factorial 24 equal? and 5 factorial 120 equal? and 6 factorial 720 equal? and test end ; test-do #+end_src *** literal-word:loop? #+begin_src cicada-nymph :tangle core.cn : literal-word:loop? << word[address, length] -- bool >> "loop" string:equal? end ; define-function #+end_src *** jojo-compiler-syntax:loop #+begin_src cicada-nymph :tangle core.cn : jojo-compiler-syntax:loop << jo, string[address, length], literal-word:loop -- jo, string[address, length] >> drop2 jo tail-call jojo-area,stay x|over|xx jojo-area,stay end ; define-function #+end_src *** literal-word:recur? #+begin_src cicada-nymph :tangle core.cn : literal-word:recur? << word[address, length] -- bool >> "recur" string:equal? end ; define-function #+end_src *** jojo-compiler-syntax:recur #+begin_src cicada-nymph :tangle core.cn : jojo-compiler-syntax:recur << jo, string[address, length], literal-word:recur -- jo, string[address, length] >> drop2 x|over|xx jojo-area,stay end ; define-function #+end_src *** test loop & recur by factorial #+begin_src cicada-nymph :tangle core-test.cn : recur-factorial << number -- number >> dup one? if end then dup sub1 recur mul end ; test-function : "* (testing) recur by factorial" .s .l 1 recur-factorial 1 equal? 2 recur-factorial 2 equal? and 3 recur-factorial 6 equal? and 4 recur-factorial 24 equal? and 5 recur-factorial 120 equal? and 6 recur-factorial 720 equal? and test end ; test-do : loop-factorial,loop << counter, product -- product >> over one? if swap drop end then over mul swap sub1 swap loop ; define-function : loop-factorial << number -- number >> 1 loop-factorial,loop end ; define-function : "* (testing) loop by factorial" .s .l 1 loop-factorial 1 equal? 2 loop-factorial 2 equal? and 3 loop-factorial 6 equal? and 4 loop-factorial 24 equal? and 5 loop-factorial 120 equal? and 6 loop-factorial 720 equal? and test end ; test-do #+end_src *** test recur by fibonacci #+begin_src cicada-nymph << 0 1 1 2 3 5 8 13 21 34 55 89 144 233 >> : fibonacci << number -- number >> dup zero? if end then dup one? if end then dup sub1 recur swap sub1 sub1 recur add end ; define-function : "* test recur by fibonacci" .s .l 0 fibonacci 0 equal? 1 fibonacci 1 equal? and 2 fibonacci 1 equal? and 3 fibonacci 2 equal? and 4 fibonacci 3 equal? and 5 fibonacci 5 equal? and 6 fibonacci 8 equal? and 7 fibonacci 13 equal? and 8 fibonacci 21 equal? and 9 fibonacci 34 equal? and 10 fibonacci 55 equal? and 11 fibonacci 89 equal? and 12 fibonacci 144 equal? and 13 fibonacci 233 equal? and 14 fibonacci 377 equal? and 15 fibonacci 610 equal? and 16 fibonacci 987 equal? and 17 fibonacci 1597 equal? and 18 fibonacci 2584 equal? and 19 fibonacci 4181 equal? and 20 fibonacci 6765 equal? and test end ; test-do #+end_src *** more,syntax-rule-set:jojo-compiler #+begin_src cicada-nymph :tangle core.cn : more,syntax-rule-set:jojo-compiler << -- >> jojo-compiler:*syntax-rule-set* dup jo literal-word:if? jo jojo-compiler-syntax:if syntax-rule:add dup jo literal-word:else? jo jojo-compiler-syntax:else syntax-rule:add dup jo literal-word:then? jo jojo-compiler-syntax:then syntax-rule:add dup jo literal-word:loop? jo jojo-compiler-syntax:loop syntax-rule:add jo literal-word:recur? jo jojo-compiler-syntax:recur syntax-rule:add end ; define-function more,syntax-rule-set:jojo-compiler #+end_src * name & name-hash-table *** note * the name-hash-table is used both in cicada-nymph and cicada-language *** allocate ***** note * an interface of *un-initialized-memory* ***** allocate-memory #+begin_src cicada-nymph :tangle core.cn : allocate-memory << size -- address >> dup *un-initialized-memory,current-free-address* clear-memory *un-initialized-memory,current-free-address* swap << address as return value >> address *un-initialized-memory,current-free-address* add-set end ; define-function #+end_src *** *name-hash-table* * the following are some prime number ready to be used * 1000003 about 976 k * 1000033 * 1000333 * 100003 about 97 k * 100333 * 997 * 499 #+begin_src cicada-nymph :tangle core.cn 100333 << drop 13 >> : *name-hash-table,size* ; define-variable,with-tos *cell-size* 5 mul : *name-hash-table,unit* ; define-variable,with-tos *name-hash-table,size* *name-hash-table,unit* mul allocate-memory : *name-hash-table* ; define-variable,with-tos 0 : *name-hash-table,counter* ; define-variable,with-tos #+end_src *** *name-hash-table,string-area* #+begin_src cicada-nymph :tangle core.cn *name-hash-table,size* 32 mul : *name-hash-table,string-area,size* ; define-variable,with-tos *name-hash-table,string-area,size* allocate-memory : *name-hash-table,string-area* ; define-variable,with-tos *name-hash-table,string-area* : *name-hash-table,string-area,current-free-address* ; define-variable,with-tos #+end_src *** name-hash-table,string-area,stay #+begin_src cicada-nymph :tangle core.cn : name-hash-table,string-area,stay << string[address, length] -- >> tuck *name-hash-table,string-area,current-free-address* string->buffer! address *name-hash-table,string-area,current-free-address* add-set end ; define-function #+end_src *** make-string,for-name #+begin_src cicada-nymph :tangle core.cn : make-string,for-name << string[address, length] -- string-copy[address, length] >> *name-hash-table,string-area,current-free-address* xx|swap|x tuck name-hash-table,string-area,stay end ; define-function #+end_src *** name ***** note * a name is an index into name-hash-table * an entry can be viewed 1. as a point 2. as an orbit * in a name entry we have the following fields |------+---------------------| | name | name-string-address | | | name-string-length | |------+---------------------| | | orbit-length | | | orbiton | | | jo | |------+---------------------| 1. name-string-address 0 denotes name not used 2. orbit-length as an orbit its length gets updated 3. as a point it is on an orbit 4. jo 0 denotes name not used as jo ***** name->address #+begin_src cicada-nymph :tangle core.cn : name->address << name -- address >> *name-hash-table,unit* mul *name-hash-table* add end ; define-function #+end_src ***** name,used? #+begin_src cicada-nymph :tangle core.cn : name,used? << name -- bool >> name->address get zero? false? end ; define-function #+end_src ***** name,used-as-jo? #+begin_src cicada-nymph :tangle core.cn : name,used-as-jo? << name -- bool >> name->address *cell-size* 4 mul add get zero? not end ; define-function #+end_src ***** name->string #+begin_src cicada-nymph :tangle core.cn : name->string << name -- string[address, length] >> name->address 2 n-get end ; define-function #+end_src ***** name,get-orbit-length #+begin_src cicada-nymph :tangle core.cn : name,get-orbit-length << name -- orbit-length >> name->address *cell-size* 2 mul add get end ; define-function #+end_src ***** name,get-orbiton #+begin_src cicada-nymph :tangle core.cn : name,get-orbiton << name -- orbiton >> name->address *cell-size* 3 mul add get end ; define-function #+end_src ***** name,get-jo #+begin_src cicada-nymph :tangle core.cn : name,get-jo << name -- jo >> name->address *cell-size* 4 mul add get end ; define-function #+end_src ***** name,set-string #+begin_src cicada-nymph :tangle core.cn : name,set-string << string[address, length], name -- >> >:name make-string,for-name :name name->address 2 n-set end ; define-function #+end_src ***** name,set-orbit-length #+begin_src cicada-nymph :tangle core.cn : name,set-orbit-length << orbit-length, name -- >> name->address *cell-size* 2 mul add set end ; define-function #+end_src ***** name,set-orbiton #+begin_src cicada-nymph :tangle core.cn : name,set-orbiton << orbiton, name -- >> name->address *cell-size* 3 mul add set end ; define-function #+end_src ***** name,set-jo #+begin_src cicada-nymph :tangle core.cn : name,set-jo << jo, name -- >> name->address *cell-size* 4 mul add set end ; define-function #+end_src ***** name,no-collision? #+begin_src cicada-nymph :tangle core.cn : name,no-collision? << name -- bool >> dup name,get-orbiton equal? end ; define-function #+end_src *** name-hash-table ***** note interface * open addressing for we do not need to delete * math * hash * memory * insert * search * function * string->name * name->string ***** name-hash-table,hash * prime table size * linear probing #+begin_src cicada-nymph :tangle core.cn : name-hash-table,hash << number, counter -- index >> add *name-hash-table,size* mod end ; define-function #+end_src ***** string->finite-carry-sum #+begin_src cicada-nymph :tangle core.cn 16 : *max-carry-position* ; define-variable,with-tos : string->finite-carry-sum,loop << carry-sum, string[address, length], counter -- carry-sum >> over zero? if drop drop2 end then dup *max-carry-position* greater-than? if drop 0 << re-start from 0 >> then xx|over|x string:byte over 2 swap power mul x|swap|xxxx add xxx|swap|x add1 xx|swap|x string:byte-tail x|swap|xx loop ; define-function : string->finite-carry-sum << string[address, length] -- carry-sum >> 0 xx|swap|x << carry-sum >> 0 << counter >> string->finite-carry-sum,loop end ; define-function #+end_src ***** name-hash-table,search #+begin_src cicada-nymph :tangle core.cn : name-hash-table,search,loop << string[address, length], number, counter -- name, true -- name, false >> >:counter >:number >::string :number :counter name-hash-table,hash >:name :number 0 name-hash-table,hash >:orbit :name name,used? false? if :name false end then :name name->string ::string string:equal? if :name true end then :name name,get-orbit-length :counter equal? if :name false end then ::string :number :counter add1 loop ; define-function : name-hash-table,search << string[address, length] -- name, true -- name, false >> dup2 string->finite-carry-sum 0 name-hash-table,search,loop end ; define-function #+end_src ***** name-hash-table,insert * I found that (insert) can not re-use (search) #+begin_src cicada-nymph :tangle core.cn : name-hash-table,insert,loop << string[address, length], number, counter -- name, true -- name, false >> >:counter >:number >::string :number :counter name-hash-table,hash >:name :number 0 name-hash-table,hash >:orbit :name name,used? false? if ::string :name name,set-string :orbit :name name,set-orbiton :counter :orbit name,set-orbit-length 1 address *name-hash-table,counter* add-set :name true end then :name name->string ::string string:equal? if :name true end then :counter *name-hash-table,size* equal? if :name false end then ::string :number :counter add1 loop ; define-function : name-hash-table,insert << string[address, length] -- name, true -- name, false >> dup2 string->finite-carry-sum 0 name-hash-table,insert,loop end ; define-function #+end_src ***** string->name * error handling here #+begin_src cicada-nymph :tangle core.cn : string->name << string[address, length] -- name >> name-hash-table,insert false? if "* (string->name) *name-hash-table* is full!" .s .l end then end ; define-function #+end_src ***** note about report * report point orbit by orbit in the following format * {index} string # orbit-lenght * {index} string * {index} string * {index} string ***** name-hash-table,report #+begin_src cicada-nymph :tangle core.cn : name-hash-table,report,orbit << name, counter -- >> over name,get-orbit-length over less-than? if drop2 end then over name->string string->finite-carry-sum over name-hash-table,hash dup name,get-orbiton << name, counter, new-name, orbiton >> x|over|xxx name->string string->finite-carry-sum 0 name-hash-table,hash equal? if " {" .s dup write-number "} " .s name->string .s .l else drop then add1 loop ; define-function : name-hash-table,report,loop << name -- >> dup *name-hash-table,size* equal? if drop end then dup name,used? if dup name,no-collision? if << * {index} string # orbit-lenght >> "* {" .s dup write-number "} " .s dup name->string .s " # " .s dup name,get-orbit-length write-number .l dup 1 name-hash-table,report,orbit then then add1 loop ; define-function : name-hash-table,report << -- >> 0 name-hash-table,report,loop "* totally : " .s *name-hash-table,counter* write-number .l end ; define-function #+end_src ***** test string->name & name->string * set *name-hash-table,size* to a small number [for example 13] then use the following function and (name-hash-table,report) to do test #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) string->name & name->string" .s .l "a-000" dup2 string->name name->string string:equal? "a-111" dup2 string->name name->string string:equal? and "a-222" dup2 string->name name->string string:equal? and "a-333" dup2 string->name name->string string:equal? and "a-444" dup2 string->name name->string string:equal? and "a-555" dup2 string->name name->string string:equal? and "a-666" dup2 string->name name->string string:equal? and "a-777" dup2 string->name name->string string:equal? and "a-888" dup2 string->name name->string string:equal? and "a-999" dup2 string->name name->string string:equal? and "b-000" dup2 string->name name->string string:equal? and "b-111" dup2 string->name name->string string:equal? and "b-222" dup2 string->name name->string string:equal? and "b-333" dup2 string->name name->string string:equal? and "b-444" dup2 string->name name->string string:equal? and "b-555" dup2 string->name name->string string:equal? and "b-666" dup2 string->name name->string string:equal? and "b-777" dup2 string->name name->string string:equal? and "b-888" dup2 string->name name->string string:equal? and "b-999" dup2 string->name name->string string:equal? and test end ; test-do << name-hash-table,report >> #+end_src ***** name-hash-table,find-jo #+begin_src cicada-nymph :tangle core.cn : name-hash-table,find-jo << word[address, length] -- jo, true -- false >> name-hash-table,search if else drop false end then dup name,used-as-jo? if name,get-jo true end then drop false end ; define-function #+end_src ***** test name-hash-table,find-jo #+begin_src cicada-nymph : "* (testing) name-hash-table,find-jo" .s .l "add" name-hash-table,find-jo if name->string "add" string:equal? test else false test then ; test-do #+end_src * global-naming-stack & name-record *** note global-naming-stack * (define-*) push (undo) pop *** note name-record * *global-naming-stack* contain name-record * structure | name-record | old-jo | | | name | | | new-jo | *** *global-naming-stack* #+begin_src cicada-nymph :tangle core.cn 100 1024 mul : global-naming-stack:*size* ; define-variable,with-tos 3 *cell-size* mul : global-naming-stack:*unit* ; define-variable,with-tos global-naming-stack:*size* global-naming-stack:*unit* mul allocate-memory : *global-naming-stack* ; define-variable,with-tos *global-naming-stack* : global-naming-stack:*pointer* ; define-variable,with-tos #+end_src *** name-record:[get|set]-old-jo #+begin_src cicada-nymph :tangle core.cn : name-record:get-old-jo << name-record -- old-jo >> get end ; define-function : name-record:set-old-jo << old-jo, name-record -- >> set end ; define-function #+end_src *** name-record:[get|set]-name #+begin_src cicada-nymph :tangle core.cn : name-record:get-name << name-record -- name >> *cell-size* add get end ; define-function : name-record:set-name << name, name-record -- >> *cell-size* add set end ; define-function #+end_src *** name-record:[get|set]-new-jo #+begin_src cicada-nymph :tangle core.cn : name-record:get-new-jo << name-record -- new-jo >> *cell-size* 2 mul add get end ; define-function : name-record:set-new-jo << new-jo, name-record -- >> *cell-size* 2 mul add set end ; define-function #+end_src *** global-naming-stack:record-jo #+begin_src cicada-nymph :tangle core.cn : global-naming-stack:record-jo << jo, name -- >> dup name,get-jo global-naming-stack:*pointer* name-record:set-old-jo dup2 name,set-jo global-naming-stack:*pointer* name-record:set-name global-naming-stack:*pointer* name-record:set-new-jo global-naming-stack:*unit* address global-naming-stack:*pointer* add-set end ; define-function #+end_src *** global-naming-stack:delete-last-record #+begin_src cicada-nymph :tangle core.cn : global-naming-stack:delete-last-record << -- >> global-naming-stack:*unit* address global-naming-stack:*pointer* sub-set global-naming-stack:*pointer* name-record:get-old-jo global-naming-stack:*pointer* name-record:get-name name,set-jo end ; define-function #+end_src *** jo,find-name #+begin_src cicada-nymph :tangle core.cn : jo,find-name,loop << jo, current-record -- name, true -- false >> dup *global-naming-stack* equal? if drop2 false end then global-naming-stack:*unit* sub dup >:name-record over :name-record name-record:get-new-jo equal? if drop2 :name-record name-record:get-name true end then loop ; define-function : jo,find-name << jo -- name, true -- false >> global-naming-stack:*pointer* jo,find-name,loop end ; define-function #+end_src *** name-hash-table,record-jo,by-link #+begin_src cicada-nymph :tangle core.cn : name-hash-table,record-jo,by-link << link -- >> >:link :link link->jo :link link->name-string string->name global-naming-stack:record-jo end ; define-function #+end_src * jojo-compiler-syntax:quote *** quote-word? #+begin_src cicada-nymph :tangle core.cn : quote-word? << word[address, length] -- bool >> dup 1 less-or-equal? if drop2 false end then string:byte "'" string:byte equal? end ; define-function #+end_src *** jojo-compiler-syntax:quote #+begin_src cicada-nymph :tangle core.cn : jojo-compiler-syntax:quote << string[address, length], word[address, length] -- string[address, length] >> jo instruction,literal jojo-area,stay string:byte-tail string->name jojo-area,stay end ; define-function #+end_src *** more,syntax-rule-set:jojo-compiler #+begin_src cicada-nymph :tangle core.cn : more,syntax-rule-set:jojo-compiler << -- >> jojo-compiler:*syntax-rule-set* jo quote-word? jo jojo-compiler-syntax:quote syntax-rule:add end ; define-function more,syntax-rule-set:jojo-compiler #+end_src *** test jojo-compiler-syntax:quote #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) jojo-compiler-syntax:quote" .s .l 'testing--jojo-compiler-syntax:quote name->string "testing--jojo-compiler-syntax:quote" string:equal? test ; test-do #+end_src * scope-stack & offset-record *** *scope-stack* #+begin_src cicada-nymph :tangle core.cn 10 1024 mul : scope-stack:*size* ; define-variable,with-tos 2 *cell-size* mul : scope-stack:*unit* ; define-variable,with-tos scope-stack:*size* scope-stack:*unit* mul allocate-memory : *scope-stack* ; define-variable,with-tos *scope-stack* : scope-stack:*pointer* ; define-variable,with-tos #+end_src *** note offset-record * structure | offset-record | name | | | offset | specially | scope-delimiter | 0 | | | 0 | *** offset-record,[get|set]-name #+begin_src cicada-nymph :tangle core.cn : offset-record,get-name << offset-record -- name >> get end ; define-function : offset-record,set-name << name, offset-record -- >> set end ; define-function #+end_src *** offset-record,[get|set]-offset #+begin_src cicada-nymph :tangle core.cn : offset-record,get-offset << offset-record -- offset >> *cell-size* add get end ; define-function : offset-record,set-offset << offset, offset-record -- >> *cell-size* add set end ; define-function #+end_src *** offset-record,scope-delimiter? #+begin_src cicada-nymph :tangle core.cn : offset-record,scope-delimiter? << offset-record -- bool >> offset-record,get-name zero? end ; define-function #+end_src *** scope-stack:find * from the pointer to the base #+begin_src cicada-nymph :tangle core.cn : scope-stack:find,loop << name, cursor -- offset-record, true -- false >> dup *scope-stack* equal? if drop2 false end then scope-stack:*unit* sub >:cursor >:name :cursor offset-record,get-name :name equal? if :cursor true end then :name :cursor loop ; define-function : scope-stack:find << name -- offset-record, true -- false >> scope-stack:*pointer* scope-stack:find,loop end ; define-function #+end_src *** scope-stack:get-current-offset #+begin_src cicada-nymph :tangle core.cn : scope-stack:get-current-offset << -- offset >> *scope-stack* scope-stack:*pointer* equal? if "* (scope-stack:get-current-offset) fail" .s .l " for the scope-stack is empty" .s .l end then scope-stack:*pointer* scope-stack:*unit* sub dup offset-record,scope-delimiter? if drop 0 end then dup offset-record,get-name name->string count-front-colon *cell-size* mul swap offset-record,get-offset add end ; define-function #+end_src * await & awake *** note notation * table | 期待 [非局部退出點] | await [make non-local-exit-piont] | | 動意 [非局部退出信號] | awake [non-local-exit-signal] | *** *awaiting-stack* #+begin_src cicada-nymph :tangle core.cn 10 1024 mul : awaiting-stack:*size* ; define-variable,with-tos 4 *cell-size* mul : awaiting-stack:*unit* ; define-variable,with-tos awaiting-stack:*size* awaiting-stack:*unit* mul allocate-memory : *awaiting-stack* ; define-variable,with-tos *awaiting-stack* : awaiting-stack:*pointer* ; define-variable,with-tos #+end_src *** note action * structure | action | function | | | argument-stack | | | return-stack | | | name | *** action,[get|set]-function #+begin_src cicada-nymph :tangle core.cn : action,get-function << action -- function >> get end ; define-function : action,set-function << function, action -- >> set end ; define-function #+end_src *** action,[get|set]-argument-stack-pointer #+begin_src cicada-nymph :tangle core.cn : action,get-argument-stack-pointer << action -- argument-stack-pointer >> *cell-size* add get end ; define-function : action,set-argument-stack-pointer << argument-stack-pointer, action -- >> *cell-size* add set end ; define-function #+end_src *** action,[get|set]-return-stack-pointer #+begin_src cicada-nymph :tangle core.cn : action,get-return-stack-pointer << action -- return-stack-pointer >> *cell-size* 2 mul add get end ; define-function : action,set-return-stack-pointer << return-stack-pointer, action -- >> *cell-size* 2 mul add set end ; define-function #+end_src *** action,[get|set]-name #+begin_src cicada-nymph :tangle core.cn : action,get-name << action -- name >> *cell-size* 3 mul add get end ; define-function : action,set-name << name, action -- >> *cell-size* 3 mul add set end ; define-function #+end_src *** drop-awaiting-stack #+begin_src cicada-nymph :tangle core.cn : drop-awaiting-stack << -- >> awaiting-stack:*unit* address awaiting-stack:*pointer* sub-set end ; define-function #+end_src *** awaiting-stack:find * from the pointer to the base #+begin_src cicada-nymph :tangle core.cn : awaiting-stack:find,loop << name, cursor -- action, true -- false >> dup *awaiting-stack* equal? if drop2 false end then awaiting-stack:*unit* sub >:cursor >:name :cursor action,get-name :name equal? if :cursor true end then :name :cursor loop ; define-function : awaiting-stack:find << name -- action, true -- false >> awaiting-stack:*pointer* awaiting-stack:find,loop end ; define-function #+end_src *** await #+begin_src cicada-nymph :tangle core.cn : await << function, name -- >> >:name >:function snapshot-the-stack-pointer *the-stack-pointer-snapshot* >:argument-stack-pointer get-return-stack-pointer return-stack:*unit* 2 mul sub >:return-stack-pointer awaiting-stack:*pointer* >:action awaiting-stack:*unit* address awaiting-stack:*pointer* add-set :function :action action,set-function :argument-stack-pointer :action action,set-argument-stack-pointer :return-stack-pointer :action action,set-return-stack-pointer :name :action action,set-name jo drop-awaiting-stack :return-stack-pointer return-stack:insert-jo end ; define-function #+end_src *** action,apply #+begin_src cicada-nymph :tangle core.cn : action,apply << action -- >> >:action :action address awaiting-stack:*pointer* set :action action,get-return-stack-pointer :action action,get-function apply-with-return-point ; define-function #+end_src *** action,reset-the-stack #+begin_src cicada-nymph :tangle core.cn : action,reset-the-stack << -- >> awaiting-stack:*pointer* action,get-argument-stack-pointer set-argument-stack-pointer end ; define-function #+end_src *** awake #+begin_src cicada-nymph :tangle core.cn : awake << name -- >> >:name :name awaiting-stack:find if action,apply end then "* (awake) can not find action in awaiting-stack by : " .s :name name->string .s .l end ; define-function #+end_src *** test await & awake #+begin_src cicada-nymph :tangle core-test.cn : testing-awake << -- >> 'signal awake end ; test-function : testing-await << -- >> "after reset-the-stack" [ "before reset-the-stack" string:equal? test action,reset-the-stack "after reset-the-stack" string:equal? test end ] 'signal await "something in the stack" "before reset-the-stack" testing-awake end ; test-function : "* (testing) await & awake" .s .l testing-await ; test-do #+end_src * basic-REPL *** syntax-rule-set:*word-interpreter* #+begin_src cicada-nymph :tangle core.cn 1024 *cell-size* mul : *syntax-rule-set:word-interpreter,size* ; define-variable,with-tos << for cursor >> *cell-size* allocate-memory drop *syntax-rule-set:word-interpreter,size* allocate-memory : syntax-rule-set:*word-interpreter* ; define-variable,with-tos syntax-rule-set:*word-interpreter* syntax-rule-set:*word-interpreter* *cell-size* sub set #+end_src *** word-interpreter #+begin_src cicada-nymph :tangle core.cn : word-interpreter << word[address, length] -- unknown >> dup2 find-syntax if apply end then dup2 name-hash-table,find-jo if << function & primitive-function & variable >> xx|swap|x drop2 apply end then "* (word-interpreter) meets undefined word : " .s .s .l end ; define-function #+end_src *** word-interpreter-syntax:bye #+begin_src cicada-nymph :tangle core.cn : word-interpreter-syntax:bye << literal-word:bye -- >> drop2 'bye,basic-REPL awake ; define-function #+end_src *** bye,basic-REPL #+begin_src cicada-nymph :tangle core.cn : bye,basic-REPL << -- >> action,reset-the-stack drop-syntax-stack end ; define-function #+end_src *** basic-REPL :redefine: #+begin_src cicada-nymph :tangle core.cn : basic-REPL,loop << unknown -- unknown >> read-word word-interpreter loop ; define-function : basic-REPL << unknown -- unknown >> jo bye,basic-REPL 'bye,basic-REPL await syntax-rule-set:*word-interpreter* push-syntax-stack basic-REPL,loop end ; define-function #+end_src *** number with base ***** 記原理 * 現在的 number 就只是 "integer" 而已更多的數的類型將在 cicada 中實現 * 在 "integer" 這個函數中我將只支持對四種進位制的字符串的閱讀 * 十進制 10#1231 10#-1231 1231 -1231 * 二進制 2#101001 2#-101001 2#-1011_1001 "-" 和 "_" 的同時存在有點難讀此時可以用 2#1011_1001 negate 也就是說雖然允許用 "-" 來表示負數但是不鼓勵這樣做之所以允許這樣做是因爲在打印負數的時候需要這種表示方式不能把 "-123" 打印成 "123 negate" * 八進制 8#712537 8#-712537 * 十六進制 16#f123acb3 16#-F123ACB3 大寫小寫字母都可以 * one can use "_" to separate the number to make it more readable for example 2#1111_0101_0001 * actually, the base can be any 10 based number even greater then 36 but when the base is greater then 36 not all integer can be represented under this base for we only have 36 bytes ***** remove-byte! #+begin_src cicada-nymph :tangle core.cn : remove-byte!,loop << cursor, length, byte -- cursor >> >:byte >:length >:cursor :length zero? if :cursor end then :cursor get-byte :byte equal? if :cursor add1 :length sub1 :cursor string->buffer! :cursor :length sub1 :byte else :cursor add1 :length sub1 :byte then loop ; define-function : remove-byte! << string[address, length], byte -- string[address, length] >> x|over|xx >:address remove-byte!,loop >:cursor :address :cursor :address sub end ; define-function #+end_src ***** test remove-byte! #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) remove-byte!" .s .l "2#1001_1001" "_" string:byte remove-byte! "2#10011001" string:equal? "___2#1001___1001___" "_" string:byte remove-byte! "2#10011001" string:equal? and test ; test-do #+end_src ***** latin-byte? #+begin_src cicada-nymph :tangle core.cn : latin-byte? << byte -- bool >> dup "A" string:byte less-than? if drop false end then dup "Z" string:byte less-or-equal? if drop true end then dup "a" string:byte less-than? if drop false end then dup "z" string:byte less-or-equal? if drop true end then drop false end ; define-function #+end_src ***** latin-byte->number #+begin_src cicada-nymph :tangle core.cn : latin-byte->number << latin-byte -- number >> dup "A" string:byte less-than? if "* (latin-byte->number) the argument must be a latin-byte" .s .l " but the following byte is less-than 'A' : " .s .i .l end then dup "Z" string:byte less-or-equal? if "A" string:byte sub 10 add end then dup "a" string:byte less-than? if "* (latin-byte->number) the argument must be a latin-byte" .s .l " but the following byte is less-than 'a' but greater-then 'Z' : " .s .i .l end then dup "z" string:byte less-or-equal? if "a" string:byte sub 10 add end then "* (latin-byte->number) the argument must be a latin-byte" .s .l " but the following byte is greater-then 'z' : " .s .i .l end ; define-function #+end_src ***** number->latin-byte #+begin_src cicada-nymph :tangle core.cn : number->latin-byte << number -- latin-byte >> 10 sub "a" string:byte add end ; define-function #+end_src ***** wild-digit-string? #+begin_src cicada-nymph :tangle core.cn : wild-digit-string? << string[address, length] -- bool >> dup zero? if drop2 true end then over get-byte dup digit-byte? swap latin-byte? or if string:byte-tail loop then drop2 false end ; define-function #+end_src ***** wild-integer-string? #+begin_src cicada-nymph :tangle core.cn : wild-integer-string? << string[address, length] -- bool >> dup zero? if drop2 false end then dup2 string:byte "-" string:byte equal? if string:byte-tail wild-digit-string? end then wild-digit-string? end ; define-function #+end_src ***** test wild-integer-string? #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) wild-integer-string?" .s .l "" wild-integer-string? false? " " wild-integer-string? false? and "_asd" wild-integer-string? false? and " asd" wild-integer-string? false? and "asd" wild-integer-string? true? and "123" wild-integer-string? true? and "123asd" wild-integer-string? true? and test ; test-do #+end_src ***** base#wild-integer-string? * a string for the following format is viewed as a base#digit-string #[-] any "_" in the anywhere of the above string will be ignored #+begin_src cicada-nymph :tangle core.cn : base#wild-integer-string? << string[address, length] -- bool >> 128 allocate-local-memory >:string-address tuck :string-address string->buffer! :string-address swap "_" string:byte remove-byte! >:new-string-length >:new-string-address << dup2 .s .l 0 end >> :new-string-address :new-string-length "#" string:byte string:find-byte if else false end then >:address-of-# :new-string-address :address-of-# :new-string-address sub >::base-string :address-of-# add1 :address-of-# :new-string-address sub add1 :new-string-length swap sub >::wild-integer-string ::base-string digit-string? ::base-string string:empty? not and if else false end then ::wild-integer-string wild-integer-string? ::wild-integer-string string:empty? not and if true else false then end ; define-function #+end_src ***** test base#wild-integer-string? #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) base#wild-integer-string?" .s .l "#" base#wild-integer-string? false? "##" base#wild-integer-string? false? and "#___#" base#wild-integer-string? false? and " " base#wild-integer-string? false? and "______#__1___" base#wild-integer-string? false? and "___2___#__1___c29bf210019___漢字" base#wild-integer-string? false? and "1#1" base#wild-integer-string? true? and "123#1c29bf219g42" base#wild-integer-string? true? and "___2___#__1___c29bf210019___g42" base#wild-integer-string? true? and test ; test-do #+end_src ***** base#wild-integer-string->base-string #+begin_src cicada-nymph :tangle core.cn : base#wild-integer-string->base-string << string[address, length] -- string[address, length] >> >:length >:address :address :length "#" string:byte string:find-byte if else "* (base#wild-integer-string->base-string)" .s .l " the argument must be a base#wild-integer-string" .s .l " but the following string does not even have a '#' in it :" .s .l " " .s :address :length .s .l << to balance the argument-stack or not ??? >> << :address :length >> end then >:address-of-# :address :address-of-# :address sub end ; define-function #+end_src ***** base#wild-integer-string->wild-integer-string #+begin_src cicada-nymph :tangle core.cn : base#wild-integer-string->wild-integer-string << string[address, length] -- string[address, length] >> >:length >:address :address :length "#" string:byte string:find-byte if else "* (base#wild-integer-string->wild-integer-string)" .s .l " the argument must be a base#wild-integer-string" .s .l " but the following string does not even have a '#' in it :" .s .l " " .s :address :length .s .l << to balance the argument-stack or not ??? >> << :address :length >> end then >:address-of-# :address-of-# add1 :address-of-# :address sub add1 :length swap sub end ; define-function #+end_src ***** test base#wild-integer-string->base-string #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) base#wild-integer-string->base-string" .s .l << error "___2___ __1___c29bf210019___漢字" base#wild-integer-string->base-string >> "1#1" base#wild-integer-string->base-string "1" string:equal? "123#1c29bf219g42" base#wild-integer-string->base-string "123" string:equal? and "___2___#__1___c29bf210019___g42" base#wild-integer-string->base-string "___2___" string:equal? and test ; test-do : "* (testing) base#wild-integer-string->wild-integer-string" .s .l << error "___2___ __1___c29bf210019___漢字" base#wild-integer-string->wild-integer-string >> "1#1" base#wild-integer-string->wild-integer-string "1" string:equal? "123#1c29bf219g42" base#wild-integer-string->wild-integer-string "1c29bf219g42" string:equal? and "___2___#__1___c29bf210019___g42" base#wild-integer-string->wild-integer-string "__1___c29bf210019___g42" string:equal? and test ; test-do #+end_src ***** wild-integer-string->integer,with-base #+begin_src cicada-nymph :tangle core.cn : wild-integer-string->integer,with-base,loop << string[address, length], base, sum, counter -- integer >> >:counter >:sum >:base >:length >:address :length zero? if :sum end then :address get-byte >:byte :byte digit-byte? if :byte digit-byte->number then :byte latin-byte? if :byte latin-byte->number then :base :counter power mul :sum add >:sum :address add1 :length sub1 :base :sum :counter add1 loop ; define-function : wild-integer-string->integer,with-base << string[address, length], base -- integer >> >:base dup zero? if drop2 0 end then dup2 string:byte "-" string:byte equal? if string:byte-tail -1 >:sign else 1 >:sign then >::string ::string string-reverse! :base 0 0 wild-integer-string->integer,with-base,loop :sign mul ::string string-reverse! drop2 end ; define-function #+end_src ***** base#wild-integer-string->integer #+begin_src cicada-nymph :tangle core.cn : base#wild-integer-string->integer << string[address, length] -- integer >> 128 allocate-local-memory >:address tuck :address string->buffer! >:length :address :length "_" string:byte remove-byte! >::string ::string base#wild-integer-string->base-string >::base-string ::string base#wild-integer-string->wild-integer-string >::wild-integer-string ::base-string digit-string->number >:base ::wild-integer-string :base wild-integer-string->integer,with-base end ; define-function #+end_src ***** test base#wild-integer-string->integer #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) base#wild-integer-string->integer" .s .l "0#111" base#wild-integer-string->integer 0 0 power 1 mul 0 1 power 1 mul add 0 2 power 1 mul add equal? "1#111" base#wild-integer-string->integer 1 0 power 1 mul 1 1 power 1 mul add 1 2 power 1 mul add equal? and "10#123" base#wild-integer-string->integer "_1_0__#_1__2_3_" base#wild-integer-string->integer 10 0 power 3 mul 10 1 power 2 mul add 10 2 power 1 mul add tuck equal? xx|swap|x equal? and and "2#1000" base#wild-integer-string->integer "2#_1000_" base#wild-integer-string->integer 2 0 power 0 mul 2 1 power 0 mul add 2 2 power 0 mul add 2 3 power 1 mul add tuck equal? xx|swap|x equal? and and "2#1111_1111" base#wild-integer-string->integer 2 0 power 1 mul 2 1 power 1 mul add 2 2 power 1 mul add 2 3 power 1 mul add 2 4 power 1 mul add 2 5 power 1 mul add 2 6 power 1 mul add 2 7 power 1 mul add equal? and "16#f_f" base#wild-integer-string->integer 16 0 power 15 mul 16 1 power 15 mul add equal? and "100#111" base#wild-integer-string->integer 100 0 power 1 mul 100 1 power 1 mul add 100 2 power 1 mul add equal? and "64#zzz" base#wild-integer-string->integer 64 0 power 35 mul 64 1 power 35 mul add 64 2 power 35 mul add equal? and "36#zzzz" base#wild-integer-string->integer 36 0 power 35 mul 36 1 power 35 mul add 36 2 power 35 mul add 36 3 power 35 mul add equal? and test ; test-do #+end_src ***** note writers * a general function and three special ones * they all writer integer * I will implemented them by syntax when needed ***** .# #+begin_src cicada-nymph :tangle core.cn : .#,loop << number, base, cursor -- cursor >> >:cursor >:base >:number :number zero? if :cursor end then :number :base divmod >:mod >:div :mod 10 less-than? if :mod number->digit-byte else :mod number->latin-byte then :cursor set-byte :div :base :cursor add1 loop ; define-function : .# << integer, base -- >> over zero? if drop .i end then dup 36 greater-than? over 2 less-than? or if "* (.#) the base " .s .i " is not valid to write a number" .s .l " a base should in between 2 and 36 includingly" .s .l " the integer to be written is " .s .i .l end then dup .i "#" .s over negative? if swap negate swap "-" .s then 128 allocate-local-memory >:buffer :buffer .#,loop >:cursor :buffer :cursor :buffer sub string-reverse! .s end ; define-function #+end_src ***** .#2 .#8 .#16 #+begin_src cicada-nymph :tangle core.cn : .#2 2 .# " " .s end ; define-function : .#8 8 .# " " .s end ; define-function : .#16 16 .# " " .s end ; define-function #+end_src ***** test .# #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) .#" .s .l .s .l 0#111 0 .# .l << error 1#111 1 .# .l >> 10#123 10 .# .l 10#0 10 .# .l 2#1000 2 .# .l 2#1111_1111 2 .# .l 16#f_f 16 .# .l 36#zzzz 36 .# .l 2#1111_1111 .#2 .l 8#123 .#8 .l 16#fff .#16 .l ; dup2 test-do #+end_src *** init,syntax-rule-set:basic-REPL #+begin_src cicada-nymph :tangle core.cn : init,syntax-rule-set:basic-REPL << -- >> syntax-rule-set:*word-interpreter* dup jo integer-string? jo string->integer syntax-rule:add jo base#wild-integer-string? jo base#wild-integer-string->integer syntax-rule:add end ; define-function init,syntax-rule-set:basic-REPL #+end_src *** test REPL #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) REPL" .s .l 0#111 0 0 power 1 mul 0 1 power 1 mul add 0 2 power 1 mul add equal? 1#111 1 0 power 1 mul 1 1 power 1 mul add 1 2 power 1 mul add equal? and 10#123 _1_0__#_1__2_3_ equal? and _1_0__#_1__2_3_ 10 0 power 3 mul 10 1 power 2 mul add 10 2 power 1 mul add equal? and 2#1000 2#_1000_ equal? and 2#_1000_ 2 0 power 0 mul 2 1 power 0 mul add 2 2 power 0 mul add 2 3 power 1 mul add equal? and 2#1111_1111 2 0 power 1 mul 2 1 power 1 mul add 2 2 power 1 mul add 2 3 power 1 mul add 2 4 power 1 mul add 2 5 power 1 mul add 2 6 power 1 mul add 2 7 power 1 mul add equal? and 16#f_f 16 0 power 15 mul 16 1 power 15 mul add equal? and 100#111 100 0 power 1 mul 100 1 power 1 mul add 100 2 power 1 mul add equal? and 64#zzz 64 0 power 35 mul 64 1 power 35 mul add 64 2 power 35 mul add equal? and 36#zzzz 36 0 power 35 mul 36 1 power 35 mul add 36 2 power 35 mul add 36 3 power 35 mul add equal? and test ; test-do #+end_src * jojo-compiler *** jojo-compiler,dispatch-word :redefine: #+begin_src cicada-nymph :tangle core.cn : jojo-compiler,dispatch-word << jo, string[address, length], word[address, length] -- jo, string[address, length] >> dup2 find-syntax if apply end then dup2 name-hash-table,find-jo if xx|swap|x drop2 jojo-area,stay end then "* (jojo-compiler) meets undefined word : " .s .s .l global-naming-stack:delete-last-record 'jojo-compiler,dispatch-word,fail awake ; define-function #+end_src *** jojo-compiler,dispatch-word,fail #+begin_src cicada-nymph :tangle core.cn : jojo-compiler,dispatch-word,fail "* (jojo-compiler,dispatch-word,fail)" .s .l drop-syntax-stack action,reset-the-stack << scope-stack-pointer -- >> address scope-stack:*pointer* set 'undo-jojo-compiler awake ; define-function #+end_src *** jojo-compiler :redefine: #+begin_src cicada-nymph :tangle core.cn : jojo-compiler,loop << jo, string[address, length] -- >> dup2 string:space? if drop2 drop end then dup2 string:word-tail xx|swap|xx string:word jojo-compiler,dispatch-word loop ; define-function : jojo-compiler << jo, string[address, length] -- >> >::string >:jo << this is an ad hoc >> local-variable-table,clear scope-stack:*pointer* >:scope-stack-pointer 0 :scope-stack-pointer offset-record,set-name 0 :scope-stack-pointer offset-record,set-offset scope-stack:*unit* address scope-stack:*pointer* add-set :scope-stack-pointer jo jojo-compiler,dispatch-word,fail 'jojo-compiler,dispatch-word,fail await jojo-compiler:*syntax-rule-set* push-syntax-stack :jo ::string jojo-compiler,loop drop-syntax-stack address scope-stack:*pointer* set end ; define-function #+end_src * define-function *** init,name-hash-table,by-link * the function should be evaled right after (define-function) is redefined * be ware of the interface of (name-hash-table,search) * I simply implement it as a recursive function #+begin_src cicada-nymph :tangle core.cn : init,name-hash-table,by-link << link -- >> >:link :link zero? if end then :link link->next-link recur :link name-hash-table,record-jo,by-link end ; define-function #+end_src *** n-string->buffer! * this function return length #+begin_src cicada-nymph :tangle core.cn : n-string->buffer!,loop << string-1[address, length], ... string-2[address, length], buffer, n, cursor -- length >> >:cursor >:n >:buffer :n zero? if :buffer :cursor :buffer sub string-reverse! swap drop end then dup zero? if drop2 :buffer :n sub1 :cursor loop then dup2 add sub1 get-byte :cursor set-byte sub1 :buffer :n :cursor add1 loop ; define-function : n-string->buffer! << string-1[address, length], ... string-2[address, length], buffer, n -- length >> over n-string->buffer!,loop end ; define-function #+end_src *** test n-string->buffer! #+begin_src cicada-nymph :tangle core-test.cn : *test,buffer* 512 allocate-memory ; test-variable : "* (testing) n-string->buffer!" .s .l "/home" "/xyh" "/cicada" *test,buffer* 3 n-string->buffer! *test,buffer* swap "/home/xyh/cicada" string:equal? test ; test-do #+end_src *** undo-jojo-compiler #+begin_src cicada-nymph :tangle core.cn : undo-jojo-compiler action,reset-the-stack << *string-area,current-free-address* *jojo-area,current-free-address* string[address, length] >> " the following jojo is not made :" .s .l ":" .s .s .l ";" .s .l address *jojo-area,current-free-address* set address *string-area,current-free-address* set drop-syntax-stack end ; define-function #+end_src *** define-function :redefine: #+begin_src cicada-nymph :tangle core.cn : define-function << string[address, length] -- >> *string-area,current-free-address* xx|swap|x *jojo-area,current-free-address* xx|swap|x << *string-area,current-free-address* *jojo-area,current-free-address* string[address, length] >> jo undo-jojo-compiler 'undo-jojo-compiler await dup2 >::string ::string string:word >::name ::string string:word-tail >::body *explainer,function* 0 make-jo-head >:jo :jo ::name string->name global-naming-stack:record-jo *jojo-area,current-free-address* >:old-address :jo ::body jojo-compiler *jojo-area,current-free-address* :old-address sub *cell-size* div :jo jo,set-length drop2 drop drop end ; define-function #+end_src *** test function #+begin_src cicada-nymph : k 1 2 3 add add . end ; define-function k : k 1 2 3 end ; define-function k add add . << error >> : k no end ; define-function #+end_src * *to use the new naming mechanism* *** note * 這裏的函數需要處理鏈中的重複定義的珠重複定義者只有很少的幾個一是 jojo-compiler 以及相關的一是 define-function *** switch #+begin_src cicada-nymph :tangle core.cn *link* init,name-hash-table,by-link basic-REPL #+end_src * fix syntax about local-variable *** jojo-compiler-syntax:local-variable-get :redefine: #+begin_src cicada-nymph :tangle core.cn : jojo-compiler-syntax:local-variable-get << string[address, length], word[address, length] -- string[address, length] >> dup2 string->name scope-stack:find if jo instruction,local-variable,n-get jojo-area,stay << offset >> offset-record,get-offset jojo-area,stay << number >> count-front-colon jojo-area,stay end then "* (jojo-compiler-syntax:local-variable-get)" .s .l " local-variable not bound : " .s .s .l 'undo-jojo-compiler await ; define-function #+end_src *** jojo-compiler-syntax:local-variable-set :redefine: #+begin_src cicada-nymph :tangle core.cn : jojo-compiler-syntax:local-variable-set << string[address, length], word[address, length] -- string[address, length] >> string:byte-tail >::local-variable-name ::local-variable-name count-front-colon >:number ::local-variable-name string->name >:name :name scope-stack:find if jo instruction,local-variable,n-set jojo-area,stay << offset >> offset-record,get-offset jojo-area,stay :number jojo-area,stay end then scope-stack:get-current-offset >:current-offset :current-offset scope-stack:*pointer* offset-record,set-offset :name scope-stack:*pointer* offset-record,set-name scope-stack:*unit* address scope-stack:*pointer* add-set jo instruction,literal jojo-area,stay :number jojo-area,stay jo allocate-local-variable jojo-area,stay jo instruction,local-variable,n-set jojo-area,stay :current-offset jojo-area,stay :number jojo-area,stay end ; define-function #+end_src *** jojo-compiler-syntax:if :redefine: #+begin_src cicada-nymph :tangle core.cn : jojo-compiler-syntax:if << jo, string[address, length], literal-word:if -- scope-stack-pointer, address, jo, string[address, length] >> drop2 >::string >:jo jo instruction,false?branch jojo-area,stay scope-stack:*pointer* *jojo-area,current-free-address* :jo ::string 0 jojo-area,stay end ; define-function #+end_src *** jojo-compiler-syntax:else :redefine: #+begin_src cicada-nymph :tangle core.cn : jojo-compiler-syntax:else << scope-stack-pointer, address, jo, string[address, length], literal-word:else -- scope-stack-pointer, address, jo, string[address, length] >> drop2 >::string >:jo >:address >:scope-stack-pointer :scope-stack-pointer address scope-stack:*pointer* set jo instruction,branch jojo-area,stay scope-stack:*pointer* *jojo-area,current-free-address* :jo ::string 0 jojo-area,stay << set offset of (instruction,false?branch) over (instruction,branch) and its offset >> *jojo-area,current-free-address* :address sub *cell-size* div :address set end ; define-function #+end_src *** jojo-compiler-syntax:then :redefine: #+begin_src cicada-nymph :tangle core.cn : jojo-compiler-syntax:then << scope-stack-pointer, address, jo, string[address, length], literal-word:then -- jo, string[address, length] >> drop2 >::string >:jo >:address >:scope-stack-pointer *jojo-area,current-free-address* :address sub *cell-size* div :address set :jo ::string end ; define-function #+end_src *** more,syntax-rule-set:jojo-compiler #+begin_src cicada-nymph :tangle core.cn : more,syntax-rule-set:jojo-compiler << -- >> jojo-compiler:*syntax-rule-set* jo local-variable-get-word? jo jojo-compiler-syntax:local-variable-get syntax-rule:add jojo-compiler:*syntax-rule-set* jo local-variable-set-word? jo jojo-compiler-syntax:local-variable-set syntax-rule:add jojo-compiler:*syntax-rule-set* dup jo literal-word:if? jo jojo-compiler-syntax:if syntax-rule:add dup jo literal-word:else? jo jojo-compiler-syntax:else syntax-rule:add jo literal-word:then? jo jojo-compiler-syntax:then syntax-rule:add end ; define-function more,syntax-rule-set:jojo-compiler #+end_src * argument-stack:print *** argument-stack:print #+begin_src cicada-nymph :tangle core.cn : argument-stack:print,loop << address, counter -- >> dup zero? if drop2 end then sub1 swap dup get . *cell-size* add swap loop ; define-function : argument-stack:print << -- >> snapshot-the-stack-pointer *the-stack-pointer-snapshot* *the-stack* greater-or-equal? if *the-stack* << address as return value >> *the-stack-pointer-snapshot* *the-stack* sub *cell-size* div << counter as return value >> argument-stack:print,loop end then "below the stack " .s end ; define-function #+end_src *** argument-stack:pretty-print #+begin_src cicada-nymph :tangle core.cn : argument-stack:pretty-print << -- >> snapshot-the-stack-pointer .l " * " .s *the-stack-pointer-snapshot* *the-stack* sub << ad hoc for the BUG of div >> dup negative? if negate *cell-size* div negate else *cell-size* div then .i " * " .s " -- " .s argument-stack:print "--" .s .l end ; define-function #+end_src * define-variable,with-tos *** define-variable,with-tos :redefine: * not undo is needed for define-variable,with-tos #+begin_src cicada-nymph :tangle core.cn : define-variable,with-tos << value, string[address, length] -- >> >::string >:value ::string string:word >::name *explainer,variable* 0 make-jo-head >:jo :jo ::name string->name global-naming-stack:record-jo 1 :jo jo,set-length :value jojo-area,stay end ; define-function #+end_src *** test define-variable,with-tos #+begin_src cicada-nymph :tangle core-test.cn 233 : *three* ; test-variable,with-tos : add-three *three* add end ; test-function : fix-*three* 3 address *three* set end ; test-function : "* (testing) define-variable,with-tos" .s .l 1 add-three 234 equal? fix-*three* 1 add-three 4 equal? and test ; test-do #+end_src * alias *** note * there shall be no way to know a naming is an alias or not *** alias #+begin_src cicada-nymph :tangle core.cn : alias << alias[address, length], name[address, length] -- >> >::name >::alias ::name name-hash-table,find-jo if else "* (alias) fail" .s .l " because can not find name in name-hash-table" .s .l " alias : " .s ::alias .s .l " name : " .s ::name .s .l end then >:jo :jo ::alias string->name global-naming-stack:record-jo end ; define-function #+end_src *** test alias #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) alias" .s .l "adba" "add" alias 1 2 adba 3 equal? test ; test-do << error "ab" "ad" alias >> #+end_src * jojo-compiler-syntax:square-bar *** string:find-word #+begin_src cicada-nymph :tangle core.cn : string:find-word << string[address, length], word[address, length] -- sub-string[address, length], true -- false >> xx|over|xx string:space? if drop2 drop2 false end then xx|over|xx string:word xx|over|xx string:equal? if drop2 true end then xx|swap|xx string:word-tail xx|swap|xx loop ; define-function #+end_src *** test string:find-word #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) string:find-word" .s .l "111 222 333" "222" string:find-word if " 222 333" string:equal? test else false test then "111 222 333" "444" string:find-word if .l .s .l false test else true test then "111 222 [] 333" "[" string:find-word if " [] 333" string:equal? test else false test then ; test-do #+end_src *** note side-effect * side-effect on function [unnamed or named] is actually not so needed for function is mainly used to encode algorithm * but side-effect on function is always possible when needed *** note scope of named-local-variable * in named function or unnamed function the scope of named-local-variable is linear *** literal-word:square-bar? #+begin_src cicada-nymph :tangle core.cn : literal-word:square-bar? << word[address, length] -- bool >> "[" string:equal? end ; define-function #+end_src *** literal-word:square-ket? #+begin_src cicada-nymph :tangle core.cn : literal-word:square-ket? << word[address, length] -- bool >> "]" string:equal? end ; define-function #+end_src *** note memory usage * for the array can be nested we must allocate the memory in place a branch is there helping us to achieve this * [dup drop end] |-------------------| | branch | | offset to jo | |-------------------| | | |-------------------| | dup | | drop | | end | |-------------------| | literal | | address of the jo | |-------------------| *** jojo-compiler-syntax:square-bar #+begin_src cicada-nymph :tangle core.cn : jojo-compiler-syntax:square-bar << jo, string[address, length], literal-word:square-bar -- scope-stack-pointer, offset-address, new-jo, jo, string[address, length] >> drop2 >::string >:jo jo instruction,branch jojo-area,stay *jojo-area,current-free-address* >:offset-address 0 jojo-area,stay *explainer,function* 0 make-jo-head >:new-jo scope-stack:*pointer* >:scope-stack-pointer 0 :scope-stack-pointer offset-record,set-name 0 :scope-stack-pointer offset-record,set-offset scope-stack:*unit* address scope-stack:*pointer* add-set :scope-stack-pointer :offset-address :new-jo :jo ::string end ; define-function #+end_src *** jojo-compiler-syntax:square-ket #+begin_src cicada-nymph :tangle core.cn : jojo-compiler-syntax:square-ket << scope-stack-pointer, offset-address, new-jo, jo, string[address, length], literal-word:square-ket -- jo, string[address, length] >> drop2 >::string >:jo >:new-jo >:offset-address >:scope-stack-pointer :scope-stack-pointer address scope-stack:*pointer* set *jojo-area,current-free-address* :offset-address sub *cell-size* div :offset-address set jo instruction,literal jojo-area,stay :new-jo jojo-area,stay :jo ::string end ; define-function #+end_src *** more,syntax-rule-set:jojo-compiler #+begin_src cicada-nymph :tangle core.cn : more,syntax-rule-set:jojo-compiler << -- >> jojo-compiler:*syntax-rule-set* dup jo literal-word:square-bar? jo jojo-compiler-syntax:square-bar syntax-rule:add jo literal-word:square-ket? jo jojo-compiler-syntax:square-ket syntax-rule:add end ; define-function more,syntax-rule-set:jojo-compiler #+end_src *** test square-bar & square-ket by factorial #+begin_src cicada-nymph :tangle core-test.cn : testing-square-bar ["testing square-bar & square-ket" end] end ; test-function : "* (testing) square-bar & square-ket" .s .l testing-square-bar apply "testing square-bar & square-ket" string:equal? test ; test-do : apply-factorial << number -- number >> [dup one? if end then dup sub1 recur mul end] apply end ; test-function : "* (testing) square-bar & square-ket by factorial" .s .l 1 apply-factorial 1 equal? 2 apply-factorial 2 equal? and 3 apply-factorial 6 equal? and 4 apply-factorial 24 equal? and 5 apply-factorial 120 equal? and 6 apply-factorial 720 equal? and test end ; test-do #+end_src * jojo-compiler-syntax:name *** jojo-compiler-syntax:name #+begin_src cicada-nymph :tangle core.cn : jojo-compiler-syntax:name << string[address, length], word[address, length] -- string[address, length] >> drop2 jo instruction,literal jojo-area,stay dup2 string:word string->name jojo-area,stay string:word-tail end ; define-function #+end_src *** more,syntax-rule-set:jojo-compiler #+begin_src cicada-nymph :tangle core.cn : more,syntax-rule-set:jojo-compiler << -- >> jojo-compiler:*syntax-rule-set* ["name" string:equal? end] jo jojo-compiler-syntax:name syntax-rule:add end ; define-function more,syntax-rule-set:jojo-compiler #+end_src *** test jojo-compiler-syntax:name #+begin_src cicada-nymph :tangle core-test.cn : jojo-compiler-syntax:name,test << -- string[address, length] >> name test-name name->string end ; test-function : "* (testing) jojo-compiler-syntax:name" .s .l jojo-compiler-syntax:name,test "test-name" string:equal? test ; test-do #+end_src * jojo-compiler-syntax:base#wild-integer-string *** jojo-compiler-syntax:base#wild-integer-string #+begin_src cicada-nymph :tangle core.cn : jojo-compiler-syntax:base#wild-integer-string << string[address, length], word[address, length] -- string[address, length] >> jo instruction,literal jojo-area,stay base#wild-integer-string->integer jojo-area,stay end ; define-function #+end_src *** more,syntax-rule-set:jojo-compiler #+begin_src cicada-nymph :tangle core.cn : more,syntax-rule-set:jojo-compiler << -- >> jojo-compiler:*syntax-rule-set* jo base#wild-integer-string? jo jojo-compiler-syntax:base#wild-integer-string syntax-rule:add end ; define-function more,syntax-rule-set:jojo-compiler #+end_src * word-interpreter-syntax *** jo :syntax: ***** word-interpreter-syntax:jo #+begin_src cicada-nymph :tangle core.cn : word-interpreter-syntax:jo << literal-word:jo -- jo >> drop2 read-word >::word ::word name-hash-table,find-jo if end then "* (word-interpreter-syntax:jo) meet undefined word after jo : " .s ::word .s .l end ; define-function #+end_src ***** more,syntax-rule-set:basic-REPL #+begin_src cicada-nymph :tangle core.cn : more,syntax-rule-set:basic-REPL << -- >> syntax-rule-set:*word-interpreter* ["bye" string:equal? end] jo word-interpreter-syntax:bye syntax-rule:add syntax-rule-set:*word-interpreter* ["jo" string:equal? end] jo word-interpreter-syntax:jo syntax-rule:add end ; define-function more,syntax-rule-set:basic-REPL #+end_src *** if & else & then :syntax: ***** note ending jo * you do not need to use ending jo in code blocks formed by if else then because in a REPL things are different from function body and there is no such thing as the end of a function body in the REPL ***** note (end) in REPL * when use (end) in REPL nothing will happen this is because (word-interpreter) calls (end) and the jojo (word-interpreter) is pop out of return-stack just like meet (end) in the function-body of (word-interpreter) ***** word-interpreter-syntax:if,meet-true #+begin_src cicada-nymph :tangle core.cn : word-interpreter-syntax:if,meet-true,else << -- >> read-word "then" string:equal? if end then loop ; define-function : word-interpreter-syntax:if,meet-true << -- >> read-word dup2 "then" string:equal? if drop2 end then dup2 "else" string:equal? if drop2 word-interpreter-syntax:if,meet-true,else end then word-interpreter loop ; define-function #+end_src ***** word-interpreter-syntax:if,meet-false #+begin_src cicada-nymph :tangle core.cn : word-interpreter-syntax:if,meet-false,else << -- >> read-word dup2 "then" string:equal? if drop2 end then word-interpreter loop ; define-function : word-interpreter-syntax:if,meet-false << -- >> read-word dup2 "then" string:equal? if drop2 end then dup2 "else" string:equal? if drop2 word-interpreter-syntax:if,meet-false,else end then drop2 loop ; define-function #+end_src ***** word-interpreter-syntax:if #+begin_src cicada-nymph :tangle core.cn : word-interpreter-syntax:if << bool, literal-word:if -- >> drop2 if word-interpreter-syntax:if,meet-true else word-interpreter-syntax:if,meet-false then end ; define-function #+end_src ***** syntax-rule:add to syntax-rule-set:*word-interpreter* #+begin_src cicada-nymph :tangle core.cn syntax-rule-set:*word-interpreter* jo literal-word:if? jo word-interpreter-syntax:if syntax-rule:add #+end_src ***** test word-interpreter-syntax:if & else & then #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) word-interpreter-syntax:if & else & then" .s .l 1 one? if 111 then 111 equal? test 0 one? if 111 else 666 then 666 equal? test ; test-do #+end_src *** *circular-string-area* ***** note * no length in the area anymore [not like the string-area] * and ending each string here with a 0 ***** allocate-memory #+begin_src cicada-nymph :tangle core.cn 1024 1024 mul : *circular-string-area,size* ; define-variable,with-tos *circular-string-area,size* allocate-memory : *circular-string-area* ; define-variable,with-tos *circular-string-area* : *circular-string-area,current-free-address* ; define-variable,with-tos #+end_src *** double-quote :syntax: ***** circular-string-area,stay #+begin_src cicada-nymph :tangle core.cn : circular-string-area,stay << string[address, length] -- >> dup *circular-string-area,current-free-address* add *circular-string-area,size* *circular-string-area* add greater-or-equal? if *circular-string-area* address *circular-string-area,current-free-address* set then tuck *circular-string-area,current-free-address* string->buffer! address *circular-string-area,current-free-address* add-set 0 *circular-string-area,current-free-address* set-byte 1 address *circular-string-area,current-free-address* add-set end ; define-function #+end_src ***** word-interpreter-syntax:double-quote * in ASCII encode double-quote is 34 #+begin_src cicada-nymph :tangle core.cn : word-interpreter-syntax:double-quote,loop << cursor -- cursor >> read-byte dup 34 equal? if drop end then over set-byte add1 loop ; define-function : word-interpreter-syntax:double-quote << literal-word:double-quote -- string[address, length] >> drop2 1024 2 mul allocate-local-memory >:buffer :buffer word-interpreter-syntax:double-quote,loop >:cursor *circular-string-area,current-free-address* >:address :buffer :cursor :buffer sub dup >:length circular-string-area,stay :address :length end ; define-function #+end_src ***** syntax-rule:add to syntax-rule-set:*word-interpreter* #+begin_src cicada-nymph :tangle core.cn syntax-rule-set:*word-interpreter* jo literal-word:double-quote? jo word-interpreter-syntax:double-quote syntax-rule:add #+end_src ***** test word-interpreter-syntax:double-quote #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) word-interpreter-syntax:double-quote" .s .l 1 one? if "111" then "111" string:equal? test 0 one? if "111" else "___" then "___" string:equal? test ; test-do #+end_src *** address :syntax: ***** word-interpreter-syntax:address #+begin_src cicada-nymph :tangle core.cn : word-interpreter-syntax:address << literal-word:address -- address >> drop2 read-word >::word ::word name-hash-table,find-jo if else "* (word-interpreter-syntax:address) meet undefined word : " .s ::word .s .l end then >:jo :jo variable-jo? if else "* (word-interpreter-syntax:address) meet a not variable-jo : " .s ::word .s .l end then :jo *cell-size* add end ; define-function #+end_src ***** syntax-rule:add to syntax-rule-set:*word-interpreter* #+begin_src cicada-nymph :tangle core.cn syntax-rule-set:*word-interpreter* jo literal-word:address? jo word-interpreter-syntax:address syntax-rule:add #+end_src ***** test word-interpreter-syntax:address #+begin_src cicada-nymph :tangle core-test.cn 0 : word-interpreter-syntax:*testing-variable* ; test-variable,with-tos : "* (testing) word-interpreter-syntax:address" .s .l 666 address word-interpreter-syntax:*testing-variable* set word-interpreter-syntax:*testing-variable* 666 equal? test ; test-do << error address kkk >> #+end_src *** literal-word:name? #+begin_src cicada-nymph :tangle core.cn : literal-word:name? << word[address, length] -- bool >> "name" string:equal? end ; define-function #+end_src *** name :syntax: ***** word-interpreter-syntax:name #+begin_src cicada-nymph :tangle core.cn : word-interpreter-syntax:name << literal-word:name -- name >> drop2 read-word >::word ::word string->name end ; define-function #+end_src ***** syntax-rule:add to syntax-rule-set:*word-interpreter* #+begin_src cicada-nymph :tangle core.cn syntax-rule-set:*word-interpreter* jo literal-word:name? jo word-interpreter-syntax:name syntax-rule:add #+end_src ***** test word-interpreter-syntax:name #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) word-interpreter-syntax:name" .s .l name add name->string "add" string:equal? test name word-interpreter-syntax:*testing-variable* name->string "word-interpreter-syntax:*testing-variable*" string:equal? test name kkk name->string "kkk" string:equal? test ; test-do #+end_src *** quote ***** word-interpreter-syntax:quote #+begin_src cicada-nymph :tangle core.cn : word-interpreter-syntax:quote << quote-word -- name >> string:byte-tail string->name end ; define-function #+end_src ***** syntax-rule:add to syntax-rule-set:*word-interpreter* #+begin_src cicada-nymph :tangle core.cn syntax-rule-set:*word-interpreter* jo quote-word? jo word-interpreter-syntax:quote syntax-rule:add #+end_src ***** test word-interpreter-syntax:quote #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) word-interpreter-syntax:name" .s .l 'add name->string "add" string:equal? test 'kkk name->string "kkk" string:equal? test ; test-do #+end_src * *a little test* *** nested comment #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) nested comment in REPL" .s .l 1 << 2 3 4 >> 5 1 << 2 << 3 >> 4 >> 5 5 equal? 1 equal? add 5 equal? add 1 equal? add test end ; test-do : nested-comment-function-body 1 << 2 3 4 >> 5 1 << 2 << 3 >> 4 >> 5 5 equal? 1 equal? add 5 equal? add 1 equal? add test end ; test-function : "* (testing) nested comment in function body" .s .l nested-comment-function-body end ; test-do #+end_src *** return structured value #+begin_src cicada-nymph :tangle core-test.cn : callee << -- string[address, length] >> 512 allocate-conjugate-local-memory >:buffer "(callee ^-^) " >:length >:address :address :length :buffer string->buffer! :buffer :length end ; test-function : caller << -- string[address, length] >> 512 allocate-local-memory >:buffer "(caller O.o) " >:length >:address :address :length :buffer string->buffer! :buffer :length >::caller-string-1 callee >::callee-string 512 allocate-local-memory >:buffer "(caller o.O) " >:length >:address :address :length :buffer string->buffer! :buffer :length >::caller-string-2 512 allocate-local-memory >:buffer ::caller-string-1 ::callee-string ::caller-string-2 :buffer 3 n-string->buffer! >:length :buffer :length end ; test-function : "* (testing) return structured value" .s .l caller "(caller O.o) (callee ^-^) (caller o.O) " string:equal? test ; test-do #+end_src * syntax-rule-set & syntax-rule *** test endianness of n-get & n-set * big-endian is used in memory | value-1 | | value-2 | | value-3 | on stack << value-1, value-2, value-3 >> #+begin_src cicada-nymph :tangle core-test.cn 3 *cell-size* mul allocate-memory : *t* ; test-variable,with-tos : "* (testing) endianness of n-get & n-set" .s .l 1 2 3 *t* 3 n-set << re-occur when geting through >> *t* get 1 equal? *t* *cell-size* add get 2 equal? and *t* *cell-size* 2 mul add get 3 equal? and test *t* 3 n-get 3 equal? test 2 equal? test 1 equal? test ; test-do #+end_src *** syntax-rule-set:list * 最後寫到規則集合裏的被最先打印出來 * 下面的打印方式看似有些不簡潔是因爲我還沒有 integer->string 這樣的函數 [因爲沒有對字符串的動態內存管理] #+begin_src cicada-nymph :tangle core.cn : syntax-rule-set:list,loop << syntax-rule-set: cursor, counter -- >> xx|over|x equal? if drop drop2 end then " * " .s "(" .s add1 dup .i ")" .s .l swap dup syntax-rule:*unit* sub syntax-rule:get-predicate " " .s jo,find-name if name->string else " unnamed jo" then .s .l dup syntax-rule:*unit* sub syntax-rule:get-function " " .s jo,find-name if name->string else " unnamed jo" then .s .l *cell-size* sub *cell-size* sub swap loop ; define-function : syntax-rule-set:list << syntax-rule-set -- >> dup syntax-rule-set:get-border 0 syntax-rule-set:list,loop end ; define-function #+end_src *** syntax-rule:sub * firstly in (syntax-rule:sub,loop) cursor move from border down to address of syntax-rule-set secondly in (syntax-rule:sub,move) cursor move from founded place up to border #+begin_src cicada-nymph :tangle core.cn : syntax-rule:sub,move-one << cursor -- >> >:cursor :cursor 2 n-get :cursor *cell-size* 2 mul sub 2 n-set end ; define-function : syntax-rule:sub,move << syntax-rule-set: cursor -- >> >:cursor >:syntax-rule-set :syntax-rule-set syntax-rule-set:get-border >:border :cursor :border equal? if :border *cell-size* 2 mul sub :syntax-rule-set syntax-rule-set:set-border end then :cursor syntax-rule:sub,move-one :syntax-rule-set :cursor *cell-size* 2 mul add loop ; define-function : syntax-rule:sub,loop << syntax-rule-set: syntax-rule[predicate, function], cursor -- >> >:cursor >::syntax-rule >:syntax-rule-set :cursor :syntax-rule-set equal? if end then ::syntax-rule :cursor syntax-rule:*unit* sub syntax-rule:get equal2? if :syntax-rule-set :cursor syntax-rule:sub,move end then :syntax-rule-set ::syntax-rule :cursor *cell-size* 2 mul sub loop ; define-function : syntax-rule:sub << syntax-rule-set: syntax-rule[predicate, function] -- >> x|over|xx syntax-rule-set:get-border syntax-rule:sub,loop end ; define-function #+end_src *** test #+begin_src cicada-nymph syntax-rule-set:*word-interpreter* syntax-rule-set:list syntax-rule-set:*word-interpreter* jo literal-word:address? jo word-interpreter-syntax:address syntax-rule:add syntax-rule-set:*word-interpreter* jo literal-word:double-quote? jo word-interpreter-syntax:double-quote syntax-rule:add syntax-rule-set:*word-interpreter* syntax-rule-set:list syntax-rule-set:*word-interpreter* jo literal-word:address? jo word-interpreter-syntax:address syntax-rule:sub syntax-rule-set:*word-interpreter* syntax-rule-set:list syntax-rule-set:*word-interpreter* jo literal-word:double-quote? jo word-interpreter-syntax:double-quote syntax-rule:sub syntax-rule-set:*word-interpreter* syntax-rule-set:list #+end_src *** syntax-rule-set:mixin * the order matters #+begin_src cicada-nymph :tangle core.cn : syntax-rule-set:mixin,loop << base-syntax-rule-set: border, cursor -- >> dup2 equal? if drop2 drop end then dup syntax-rule:get >::syntax-rule x|over|xx ::syntax-rule syntax-rule:add syntax-rule:*unit* add loop ; define-function : syntax-rule-set:mixin << base-syntax-rule-set: syntax-rule-set -- >> dup syntax-rule-set:get-border swap syntax-rule-set:mixin,loop end ; define-function #+end_src *** syntax-rule-set:mixout #+begin_src cicada-nymph :tangle core.cn : syntax-rule-set:mixout,loop << base-syntax-rule-set: border, cursor -- >> dup2 equal? if drop2 drop end then dup syntax-rule:get >::syntax-rule x|over|xx ::syntax-rule syntax-rule:sub syntax-rule:*unit* add loop ; define-function : syntax-rule-set:mixout << base-syntax-rule-set: syntax-rule-set -- >> dup syntax-rule-set:get-border swap syntax-rule-set:mixout,loop end ; define-function #+end_src * stack-REPL *** note * print argument-stack in every loop *** stack-REPL #+begin_src cicada-nymph :tangle core.cn : stack-REPL,loop << unknown -- unknown >> read-word word-interpreter argument-stack:pretty-print loop ; define-function : stack-REPL << unknown -- unknown >> jo bye,basic-REPL 'bye,basic-REPL await syntax-rule-set:*word-interpreter* push-syntax-stack stack-REPL,loop end ; define-function #+end_src * eval-string *** note * (eval-string) is implemented by doing side-effect on reading-stack this is because syntax extension system is implemented by reader-macro * by implementing (eval-string) this way i can easily change the syntax be used to eval a string *** eval-string #+begin_src cicada-nymph :tangle core.cn : eval-string,loop << unknown -- unknown >> tos-reading-stack string:space? if end then read-word word-interpreter loop ; define-function : eval-string << string[address, length] -- unknown >> push-reading-stack eval-string,loop drop-reading-stack end ; define-function #+end_src *** test eval-string #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) eval-string" .s .l "1 2 3 add add" eval-string 6 equal? test " 1 2 3 add add " eval-string 6 equal? test " k 1 2 3 add add end " "define-function k" eval-string 6 equal? test k 6 equal? test ; test-do #+end_src * define-variable *** note string allocation * string should be allocated to a static area instead of dynamic area like *circular-string-area* thus we have (syntax,double-quote,define-variable) *** syntax,double-quote,define-variable * in ASCII encode double-quote is 34 #+begin_src cicada-nymph :tangle core.cn : syntax,double-quote,define-variable,loop << cursor -- cursor >> read-byte dup 34 equal? if drop end then over set-byte add1 loop ; define-function : syntax,double-quote,define-variable << literal-word:double-quote -- string[address, length] >> drop2 1024 2 mul allocate-local-memory >:buffer :buffer syntax,double-quote,define-variable,loop >:cursor :buffer :cursor :buffer sub make-string end ; define-function #+end_src *** define-variable #+begin_src cicada-nymph :tangle core.cn : define-variable << string[address, length] -- >> >::string ::string string:word >::name ::string string:word-tail >::body snapshot-the-stack-pointer *the-stack-pointer-snapshot* >:old-snapshot syntax-rule-set:*word-interpreter* jo literal-word:double-quote? jo syntax,double-quote,define-variable syntax-rule:add ::body eval-string syntax-rule-set:*word-interpreter* jo literal-word:double-quote? jo syntax,double-quote,define-variable syntax-rule:sub snapshot-the-stack-pointer *the-stack-pointer-snapshot* >:new-snapshot :new-snapshot :old-snapshot sub dup negative? if negate *cell-size* div "* (define-variable) fail to define variable : " .s ::name .s .l " because after eval the following body" .s .l " the stack is " .s .i " below what it use to be" .s .l ::body .s .l end then dup zero? if drop "* (define-variable) fail to define variable : " .s ::name .s .l " because after eval the following body" .s .l " the stack is still where it use to be" .s .l ::body .s .l end then *cell-size* div >:length ::name make-string >::name ::name *link* 0 make-link >:link :link address *link* set *explainer,variable* 0 make-jo-head >:jo :jo :link link,set-jo :link name-hash-table,record-jo,by-link :length :jo jo,set-length *jojo-area,current-free-address* :length n-set :length *cell-size* mul address *jojo-area,current-free-address* add-set end ; define-function #+end_src *** test #+begin_src cicada-nymph : define-variable:*testing-numbers* 1 2 3 ; define-variable define-variable:*testing-numbers* . . . << 3 2 1 >> address define-variable:*testing-numbers* get . << 1 >> : define-variable:*testing-string* "define-variable" ; define-variable define-variable:*testing-string* .s << define-variable >> << error >> : kkk 1 . 2 . 3 . ; define-variable << error >> 1 2 3 : kkk . . . ; define-variable #+end_src * system misc *** note linux *** init-syscall-number :32bit: #+begin_src cicada-nymph :tangle core.cn *cell-size* 4 equal? if 5 : syscall-number:*open* ; define-variable,with-tos 6 : syscall-number:*close* ; define-variable,with-tos 3 : syscall-number:*read* ; define-variable,with-tos 4 : syscall-number:*write* ; define-variable,with-tos 9 : syscall-number:*link* ; define-variable,with-tos 10 : syscall-number:*unlink* ; define-variable,with-tos 39 : syscall-number:*mkdir* ; define-variable,with-tos 40 : syscall-number:*rmdir* ; define-variable,with-tos 141 : syscall-number:*getdents* ; define-variable,with-tos 220 : syscall-number:*getdents64* ; define-variable,with-tos 106 : syscall-number:*stat* ; define-variable,with-tos 1 : syscall-number:*exit* ; define-variable,with-tos 43 : syscall-number:*times* ; define-variable,with-tos 20 : syscall-number:*getpid* ; define-variable,with-tos 183 : syscall-number:*getcwd* ; define-variable,with-tos 12 : syscall-number:*chdir* ; define-variable,with-tos then #+end_src *** init-syscall-number :64bit: #+begin_src cicada-nymph :tangle core.cn *cell-size* 8 equal? if 2 : syscall-number:*open* ; define-variable,with-tos 3 : syscall-number:*close* ; define-variable,with-tos 0 : syscall-number:*read* ; define-variable,with-tos 1 : syscall-number:*write* ; define-variable,with-tos 86 : syscall-number:*link* ; define-variable,with-tos 87 : syscall-number:*unlink* ; define-variable,with-tos 83 : syscall-number:*mkdir* ; define-variable,with-tos 84 : syscall-number:*rmdir* ; define-variable,with-tos 78 : syscall-number:*getdents* ; define-variable,with-tos 217 : syscall-number:*getdents64* ; define-variable,with-tos 4 : syscall-number:*stat* ; define-variable,with-tos 60 : syscall-number:*exit* ; define-variable,with-tos 100 : syscall-number:*times* ; define-variable,with-tos 39 : syscall-number:*getpid* ; define-variable,with-tos 79 : syscall-number:*getcwd* ; define-variable,with-tos 80 : syscall-number:*chdir* ; define-variable,with-tos then #+end_src *** error-code->string #+begin_src cicada-nymph :tangle core.cn : error-code->string << error-code -- string[address, length] >> dup -1 equal? if drop << EPERM >> "Operation not permitted " end then dup -2 equal? if drop << ENOENT >> "No such file or directory " end then dup -3 equal? if drop << ESRCH >> "No such process " end then dup -4 equal? if drop << EINTR >> "Interrupted system call " end then dup -5 equal? if drop << EIO >> "I/O error " end then dup -6 equal? if drop << ENXIO >> "No such device or address " end then dup -7 equal? if drop << E2BIG >> "Argument list too long " end then dup -8 equal? if drop << ENOEXEC >> "Exec format error " end then dup -9 equal? if drop << EBADF >> "Bad file number " end then dup -10 equal? if drop << ECHILD >> "No child processes " end then dup -11 equal? if drop << EAGAIN >> "Try again " end then dup -12 equal? if drop << ENOMEM >> "Out of memory " end then dup -13 equal? if drop << EACCES >> "Permission denied " end then dup -14 equal? if drop << EFAULT >> "Bad address " end then dup -15 equal? if drop << ENOTBLK >> "Block device required " end then dup -16 equal? if drop << EBUSY >> "Device or resource busy " end then dup -17 equal? if drop << EEXIST >> "File exists " end then dup -18 equal? if drop << EXDEV >> "Cross-device link " end then dup -19 equal? if drop << ENODEV >> "No such device " end then dup -20 equal? if drop << ENOTDIR >> "Not a directory " end then dup -21 equal? if drop << EISDIR >> "Is a directory " end then dup -22 equal? if drop << EINVAL >> "Invalid argument " end then dup -23 equal? if drop << ENFILE >> "File table overflow " end then dup -24 equal? if drop << EMFILE >> "Too many open files " end then dup -25 equal? if drop << ENOTTY >> "Not a typewriter " end then dup -26 equal? if drop << ETXTBSY >> "Text file busy " end then dup -27 equal? if drop << EFBIG >> "File too large " end then dup -28 equal? if drop << ENOSPC >> "No space left on device " end then dup -29 equal? if drop << ESPIPE >> "Illegal seek " end then dup -30 equal? if drop << EROFS >> "Read-only file system " end then dup -31 equal? if drop << EMLINK >> "Too many links " end then dup -32 equal? if drop << EPIPE >> "Broken pipe " end then dup -33 equal? if drop << EDOM >> "Math argument out of domain of func " end then dup -34 equal? if drop << ERANGE >> "Math result not representable " end then "unknow error-code : " .s .i .l "* (error-code->string) fail" << to balance the argument-stack >> end ; define-function #+end_src *** file-type-code->string #+begin_src cicada-nymph :tangle core.cn : file-type-code->string << file-type-code -- string[address, length] >> dup 1 equal? << DT_FIFO >> if drop "named pipe i.e. FIFO" end then dup 2 equal? << DT_CHR >> if drop "Character device" end then dup 4 equal? << DT_DIR >> if drop "directory" end then dup 6 equal? << DT_BLK >> if drop "block device" end then dup 8 equal? << DT_REG >> if drop "regular file" end then dup 10 equal? << DT_LNK >> if drop "symbolic link" end then dup 12 equal? << DT_SOCK >> if drop "UNIX domain socket" end then drop "unknow file type" end ; define-function #+end_src * port *** 記關於輸入輸出 * 接口設計分兩個層次 1. 底層的以 port 爲基礎的接口這裏應該如何設計還不確定可能會模仿操作系統所提供的接口 2. 高層的以 path 爲基礎的接口這裏將抽象掉 port 這個概念也就是每次簡單的讀寫都伴隨兩個對 port 的操作這樣接口就很簡單但是速度可能會非常慢 * 目前二者的接口差異是通過前綴 port:體現出來的 *** note linux header * 8 base number : O_ACCMODE 0003 O_RDONLY 00 O_WRONLY 01 O_RDWR 02 O_CREAT 0100 Not fcntl O_EXCL 0200 Not fcntl O_NOCTTY 0400 Not fcntl O_TRUNC 01000 Not fcntl O_APPEND 02000 O_NONBLOCK 04000 O_NDELAY O_NONBLOCK O_SYNC 04010000 O_FSYNC O_SYNC O_ASYNC 020000 O_LARGEFILE 0100000 O_DIRECTORY 0200000 O_NOFOLLOW 0400000 O_CLOEXEC 02000000 O_DIRECT 040000 O_NOATIME 01000000 O_PATH 010000000 O_DSYNC 010000 O_TMPFILE 020200000 *** note interface * open to read * create and update to write |--------+-----------------------| | create | fail if already exist | | update | fail if nor exist | |--------+-----------------------| * one should always know if a file exist or not when open it as output-port predicates are provided to help you to do so *** note syscall with string arguments * for syscall the arguments in stack look like << ..., arg3, arg2, arg1 >> so for read(port, buffer, size) we need << size, buffer, port >> but the interface (port:read) in cicada-nymph is << buffer, size, port >> thus we need a swap here and we should be careful for other interface functions in cicada-nymph *** port:open #+begin_src cicada-nymph :tangle core.cn : port:open << path[address, length] -- port, true -- error-code, false >> string->syscall-string >:syscall-path 0 << O_RDONLY >> :syscall-path syscall-number:*open* 2 syscall dup negative? if false end then true end ; define-function #+end_src *** port:create #+begin_src cicada-nymph :tangle core.cn : port:create << path[address, length] -- port, true -- error-code, false >> string->syscall-string >:syscall-path 8#644 << 2#110100100 >> 8#1102 << O_RDWR 0002 O_CREAT 0100 O_TRUNC 1000 >> :syscall-path syscall-number:*open* 3 syscall dup negative? if false end then true end ; define-function #+end_src *** port:update #+begin_src cicada-nymph :tangle core.cn : port:update << path[address, length] -- port, true -- error-code, false >> string->syscall-string >:syscall-path 8#644 << 110100100b >> 8#1002 << O_RDWR 0002 O_TRUNC 1000 >> :syscall-path syscall-number:*open* 3 syscall dup negative? if false end then true end ; define-function #+end_src *** port:close #+begin_src cicada-nymph :tangle core.cn : port:close << port -- true -- error-code, false >> syscall-number:*close* 1 syscall dup negative? if false end then drop true end ; define-function #+end_src *** port:read #+begin_src cicada-nymph :tangle core.cn : port:read << buffer, max-size, port -- counter, true -- error-code, false >> >:port swap :port syscall-number:*read* 3 syscall dup negative? if false end then true end ; define-function #+end_src *** port:write #+begin_src cicada-nymph :tangle core.cn : port:write << buffer, max-size, port -- counter, true -- error-code, false >> >:port swap :port syscall-number:*write* 3 syscall dup negative? if false end then true end ; define-function #+end_src *** test #+begin_src cicada-nymph : k << -- >> "kkk~" port:create if port:close if end then error-code->string .s .l end then error-code->string .s .l end ; define-function k : k << -- >> "kkk~" port:update if port:close if end then error-code->string .s .l end then error-code->string .s .l end ; define-function k : k << -- >> 64 allocate-local-memory dup "kkk~" port:open if 64 swap port:read if .s .l end then error-code->string .s .l end then error-code->string .s .l end ; define-function k #+end_src * file *** note interface * note that the concept of port is completely removed from the interface * file-tree two types of nodes 1. file 2. directory a leaf must be a file * the interface 1. use path as an argument 2. print error message on error instead of return error info or do non-local-exit *** 記元數據 * 訪問管理 1. 誰有權訪問這個文件 2. 他的權利是什麼 * 文件類型 [linux 沒有] * 文件大小 * 文件使用註釋 [linux 沒有] *** file:create #+begin_src cicada-nymph :tangle core.cn : file:create << path[address, length] -- >> >::path ::path string->syscall-string >:syscall-path 8#644 << 2#110100100 >> 8#0200 8#0100 bit-or << O_EXCL 0200 O_CREAT 0100 >> :syscall-path syscall-number:*open* 3 syscall dup negative? if "* (file:create) fail to open port for the following path :" .s .l " " .s ::path .s .l " " .s error-code->string .s .l end then port:close if end then "* (file:create) fail to close port for the following path :" .s .l " " .s ::path .s .l " " .s error-code->string .s .l end ; define-function #+end_src *** file:write #+begin_src cicada-nymph :tangle core.cn : file:write << string[address, length], path[address, length] -- >> >::path >::string ::path string->syscall-string >:syscall-path 8#644 << 2#110100100 >> 8#1002 << O_RDWR 0002 O_TRUNC 1000 >> :syscall-path syscall-number:*open* 3 syscall dup negative? if "* (file:write) fail to open port for the following path :" .s .l " " .s ::path .s .l " " .s error-code->string .s .l end then >:port ::string swap :port syscall-number:*write* 3 syscall dup negative? if "* (file:write) fail to write port for the following path :" .s .l " " .s ::path .s .l " " .s error-code->string .s .l end then >:counter << bytes been written >> :port port:close if end then "* (file:write) fail to close port for the following path : " .s .l " " .s ::path .s .l " " .s error-code->string .s .l end ; define-function #+end_src *** file:read #+begin_src cicada-nymph :tangle core.cn : file:read << string[address, max-length], path[address, length] -- counter >> >::path >::string ::path string->syscall-string >:syscall-path 0 << O_RDONLY >> :syscall-path syscall-number:*open* 2 syscall dup negative? if "* (file:read) fail to open port for the following path :" .s .l " " .s ::path .s .l " " .s error-code->string .s .l 0 end then >:port ::string swap :port syscall-number:*read* 3 syscall dup negative? if "* (file:read) fail to read port for the following path :" .s .l " " .s ::path .s .l " " .s error-code->string .s .l 0 end then >:counter << bytes been readed >> :port port:close if :counter end then "* (file:read) fail to close port for the following path : " .s .l " " .s ::path .s .l " " .s error-code->string .s .l 0 end ; define-function #+end_src *** file:remove #+begin_src cicada-nymph :tangle core.cn : file:remove << path[address, length] -- >> >::path ::path string->syscall-string >:syscall-path :syscall-path syscall-number:*unlink* 1 syscall dup negative? if "* (file:remove) fail for the following path :" .s .l " " .s ::path .s .l " " .s error-code->string .s .l end then drop end ; define-function #+end_src *** test file #+begin_src cicada-nymph :tangle core-test.cn : file,test << -- >> "kkk~" file:create "kkk took my baby away" dup >:length "kkk~" file:write "............................" >::string ::string "kkk~" file:read >:counter :counter :length equal? test "kkk took my baby away......." ::string string:equal? test "kkk~" file:remove end ; test-function : "* (testing) file" .s .l file,test ; test-do #+end_src * directory *** directory:create #+begin_src cicada-nymph :tangle core.cn : directory:create << path[address, length] -- >> >::path ::path string->syscall-string >:syscall-path 8#755 << 2#111101101 >> :syscall-path syscall-number:*mkdir* 2 syscall dup negative? if "* (directory:create) fail for the following path :" .s .l " " .s ::path .s .l " " .s error-code->string .s .l end then drop end ; define-function #+end_src *** directory:remove #+begin_src cicada-nymph :tangle core.cn : directory:remove << path[address, length] -- >> >::path ::path string->syscall-string >:syscall-path :syscall-path syscall-number:*rmdir* 1 syscall dup negative? if "* (directory:remove) fail for the following path :" .s .l " " .s ::path .s .l " " .s error-code->string .s .l end then drop end ; define-function #+end_src *** test #+begin_src cicada-nymph "kkk" directory:create "kkk" directory:remove #+end_src *** system-getdents64 #+begin_src cicada-nymph :tangle core.cn 0 : +getdents64,ino+ ; define-variable,with-tos 0 : +getdents64,off+ ; define-variable,with-tos 0 : +getdents64,reclen+ ; define-variable,with-tos 0 : +getdents64,type+ ; define-variable,with-tos 0 : +getdents64,name+ ; define-variable,with-tos 0 : +getdents64,end+ ; define-variable,with-tos : init,getdents64 << offset -- >> *cell-size* 4 equal? if dup address +getdents64,ino+ set 8 add dup address +getdents64,off+ set 8 add dup address +getdents64,reclen+ set 2 add dup address +getdents64,type+ set 1 add dup address +getdents64,name+ set 256 add address +getdents64,end+ set end then *cell-size* 8 equal? if dup address +getdents64,ino+ set 8 add dup address +getdents64,off+ set 8 add dup address +getdents64,reclen+ set 2 add dup address +getdents64,type+ set 1 add dup address +getdents64,name+ set 256 add address +getdents64,end+ set end then end ; define-function 0 init,getdents64 +getdents64,end+ : +getdents64,length+ ; define-variable,with-tos #+end_src *** test #+begin_src cicada-nymph : test,getdents64,print << -- >> "+getdents64,ino+ : " .s +getdents64,ino+ get . .l "+getdents64,off+ : " .s +getdents64,off+ get . .l "+getdents64,reclen+ : " .s +getdents64,reclen+ get-two-bytes . .l "+getdents64,type+ : " .s +getdents64,type+ get-byte file-type-code->string .s .l "+getdents64,name+ : " .s +getdents64,name+ dup 256 0 string:find-byte drop << drop 0 >> over sub .s .l .l end ; define-function : test,getdents64,loop,structure << end, cursor -- >> dup2 less-or-equal? if drop2 end then >:cursor :cursor init,getdents64 test,getdents64,print :cursor +getdents64,reclen+ get-two-bytes add loop ; define-function : test,getdents64,loop << port -- >> >:port 1024 allocate-local-memory >:getdents64-structure-list 1024 :getdents64-structure-list :port syscall-number:*getdents64* 3 syscall "* syscall returns : " .s dup .i .l dup negative? if error-code->string .s .l end then dup zero? if drop end then :getdents64-structure-list add :getdents64-structure-list test,getdents64,loop,structure :port loop ; define-function : test,getdents64 << path[address, length] -- >> >::path ::path port:open if else "* (test,getdents64) fail to open : " .s ::path .s .l " " .s error-code->string .s .l end then >:port :port test,getdents64,loop :port port:close if end then "* (test,getdents64) fail to close : " .s ::path .s .l " " .s error-code->string .s .l end ; define-function "play" test,getdents64 "play/kkk" test,getdents64 "." test,getdents64 "/" test,getdents64 #+end_src *** directory:empty? #+begin_src cicada-nymph :tangle core.cn : directory:empty? << path[address, length] -- bool >> >::path ::path port:open if else "* (directory:empty?) fail to open : " .s ::path .s .l " " .s error-code->string .s .l false end then >:port 128 allocate-local-memory >:getdents64-structure-list 128 :getdents64-structure-list :port syscall-number:*getdents64* 3 syscall 48 equal? << this call to equal? returns the needed bool >> :port port:close if end then "* (directory:empty?) fail to close : " .s ::path .s .l " " .s error-code->string .s .l false end ; define-function #+end_src *** test #+begin_src cicada-nymph "play" directory:empty? . .l "play/kkk" directory:empty? . .l "play/aaa" directory:empty? . .l "." directory:empty? . .l "/" directory:empty? . .l #+end_src *** directory:map #+begin_src cicada-nymph :tangle core.cn : directory:map,loop,apply << end, cursor, function -- >> >:function dup2 less-or-equal? if drop2 end then >:cursor >:end :cursor init,getdents64 :function apply :end :cursor +getdents64,reclen+ get-two-bytes add :function loop ; define-function : directory:map,loop << port, function -- >> >:function >:port 1024 allocate-local-memory >:getdents64-structure-list 1024 :getdents64-structure-list :port syscall-number:*getdents64* 3 syscall dup negative? if "* (directory:map,loop) syscall fail" .s .l " " .s error-code->string .s .l end then dup zero? if drop end then :getdents64-structure-list add :getdents64-structure-list :function directory:map,loop,apply :port :function loop ; define-function : directory:map << directory-path[address, length], function -- true -- false >> >:function >::directory-path ::directory-path port:open if else "* (directory:map) fail to open : " .s ::directory-path .s .l " " .s error-code->string .s .l end then >:port :port :function directory:map,loop :port port:close if end then "* (directory:map) fail to close : " .s ::directory-path .s .l " " .s error-code->string .s .l end ; define-function #+end_src *** test #+begin_src cicada-nymph : test,function << -- >> +getdents64,type+ get-byte 8 equal? if " " .s +getdents64,name+ dup 256 0 string:find-byte drop << drop 0 >> over sub .s .l then end ; define-function "play" jo test,function directory:map #+end_src *** directory:list-file #+begin_src cicada-nymph :tangle core.cn : directory:list-file << directory-path[address, length] -- >> [ << -- >> +getdents64,type+ get-byte 8 equal? if " " .s +getdents64,name+ dup 256 0 string:find-byte drop << drop 0 >> over sub .s .l then end ] directory:map end ; define-function #+end_src *** directory:list-directory #+begin_src cicada-nymph :tangle core.cn : directory:list-directory << directory-path[address, length] -- >> [ << -- >> +getdents64,type+ get-byte 4 equal? if +getdents64,name+ dup 256 0 string:find-byte drop << drop 0 >> over sub >::name ".." ::name string:equal? if end then "." ::name string:equal? if end then " " .s ::name .s .l end then end ] directory:map end ; define-function #+end_src *** test #+begin_src cicada-nymph "play" dup2 directory:list-file directory:list-directory "play/kkk" dup2 directory:list-file directory:list-directory "." dup2 directory:list-file directory:list-directory "/" dup2 directory:list-file directory:list-directory #+end_src *** directory:find-file #+begin_src cicada-nymph :tangle core.cn : directory:find-file << directory-path[address, length], file-name[address, length] -- bool >> xx|swap|xx false xx|swap|x [ << file-name[address, length], bool -- file-name[address, length], bool >> +getdents64,type+ get-byte 8 equal? not if end then >:bool >:file-name,lenght >:file-name,address :file-name,lenght +getdents64,name+ add get-byte zero? not if :file-name,address :file-name,lenght :bool end then :file-name,address :file-name,lenght +getdents64,name+ :file-name,lenght string:equal? if :file-name,address :file-name,lenght true end then :file-name,address :file-name,lenght :bool end ] directory:map xx|swap|x drop2 end ; define-function #+end_src *** directory:find-directory #+begin_src cicada-nymph :tangle core.cn : directory:find-directory << directory-path[address, length], file-name[address, length] -- bool >> xx|swap|xx false xx|swap|x [ << file-name[address, length], bool -- file-name[address, length], bool >> +getdents64,type+ get-byte 4 equal? not if end then >:bool >:file-name,lenght >:file-name,address :file-name,lenght +getdents64,name+ add get-byte zero? not if :file-name,address :file-name,lenght :bool end then :file-name,address :file-name,lenght +getdents64,name+ :file-name,lenght string:equal? if :file-name,address :file-name,lenght true end then :file-name,address :file-name,lenght :bool end ] directory:map xx|swap|x drop2 end ; define-function #+end_src *** test #+begin_src cicada-nymph : find-file,test << -- >> "play" "cn" directory:find-file . "play" "kkk" directory:find-file . "play" "no" directory:find-file . .l "playlay" "no" directory:find-file . .l end ; define-function find-file,test : find-directory,test << -- >> "play" "cn" directory:find-directory . "play" "kkk" directory:find-directory . "play" "no" directory:find-directory . .l "playlay" "no" directory:find-directory . .l end ; define-function find-directory,test #+end_src * system environment *** note linux ***** one directory * all files about cicada are stored in "/home//.cicada" ***** pid * pid is the key to all the linux system environment * command-line /proc//cmdline * environment-variable-list /proc//environ *** [init|get]-pid #+begin_src cicada-nymph :tangle core.cn 0 : *pid* ; define-variable,with-tos : init-pid << -- >> syscall-number:*getpid* 0 syscall address *pid* set end ; define-function : get-pid << -- pid >> *pid* end ; define-function #+end_src *** [init|get]-command-line #+begin_src cicada-nymph :tangle core.cn 512 allocate-memory : *address,command-line* ; define-variable,with-tos 512 : *length,command-line* ; define-variable,with-tos : init-command-line << -- >> 64 allocate-local-memory >:path-buffer :path-buffer >:cursor get-pid write-number,fill-buffer >::pid-string "/proc/" dup >:add-to-cursor :cursor string->buffer! :add-to-cursor :cursor add >:cursor ::pid-string dup >:add-to-cursor :cursor string->buffer! :add-to-cursor :cursor add >:cursor "/cmdline" dup >:add-to-cursor :cursor string->buffer! :add-to-cursor :cursor add >:cursor :path-buffer :cursor :path-buffer sub dup2 >::path port:open if else "* (init-command-line) fail to open : " .s ::path .s .l end then >:port *address,command-line* *length,command-line* :port port:read if else "* (init-command-line) fail to read : " .s ::path .s .l end then address *length,command-line* set end ; define-function : get-command-line << -- string[address, length] >> *address,command-line* *length,command-line* end ; define-function #+end_src *** [init|get]-environment-variable-list * the size of /proc//environ is limited to 4k #+begin_src cicada-nymph :tangle core.cn 1024 4 mul allocate-memory : *address,environment-variable-list* ; define-variable,with-tos 1024 4 mul : *length,environment-variable-list* ; define-variable,with-tos : init-environment-variable-list << -- >> 64 allocate-local-memory >:path-buffer :path-buffer >:cursor get-pid write-number,fill-buffer >::pid-string "/proc/" dup >:add-to-cursor :cursor string->buffer! :add-to-cursor :cursor add >:cursor ::pid-string dup >:add-to-cursor :cursor string->buffer! :add-to-cursor :cursor add >:cursor "/environ" dup >:add-to-cursor :cursor string->buffer! :add-to-cursor :cursor add >:cursor :path-buffer :cursor :path-buffer sub dup2 >::path port:open if else "* (init-environment-variable-list) fail to open : " .s ::path .s .l end then >:port *address,environment-variable-list* *length,environment-variable-list* :port port:read if else "* (init-environment-variable-list) fail to read : " .s ::path .s .l end then address *length,environment-variable-list* set end ; define-function : get-environment-variable-list << -- string[address, length] >> *address,environment-variable-list* *length,environment-variable-list* end ; define-function #+end_src *** find-environment-variable * the string used to find an environment-variable can not contain "=" no error handling on this #+begin_src cicada-nymph :tangle core.cn : find-environment-variable,loop << string[address, length], cursor -- string[address, length], true -- false >> dup get-environment-variable-list add greater-than? if drop drop2 false end then >:cursor >:length >:address :address :cursor :length compare-buffer not if :address :length :cursor 0 cursor->next-matching-byte add1 loop then :cursor :length add get-byte "=" string:byte equal? not if :address :length :cursor 0 cursor->next-matching-byte add1 loop then :cursor :length add add1 << over "=" >> >:find-address :find-address 0 cursor->next-matching-byte :find-address sub >:find-length :find-address :find-length end ; define-function : find-environment-variable << string[address, length] -- string[address, length], true -- false >> get-environment-variable-list drop find-environment-variable,loop end ; define-function #+end_src *** initialize system environment #+begin_src cicada-nymph :tangle core.cn init-pid init-command-line init-environment-variable-list #+end_src *** *home-directory* #+begin_src cicada-nymph :tangle core.cn : *home-directory* "HOME" find-environment-variable ; define-variable #+end_src *** report:environment-variable #+begin_src cicada-nymph :tangle core.cn : report:environment-variable,loop << environment-variable-list[address, length]-- >> dup2 string:space? if drop2 end then >:length >:address :address :length 0 string:find-byte drop add1 >:cursor :cursor :address sub >:length-of-one-variable :address :length-of-one-variable sub1 .s .l :cursor :length :length-of-one-variable sub loop ; define-function : report:environment-variable << -- >> get-environment-variable-list report:environment-variable,loop end ; define-function #+end_src *** report:command-line #+begin_src cicada-nymph :tangle core.cn : report:command-line,loop << command-line[address, length] -- >> dup2 string:space? if drop2 end then dup2 string:word .s 32 .b string:word-tail loop ; define-function : report:command-line << -- >> get-command-line report:command-line,loop end ; define-function #+end_src * work-directory *** work-directory:get #+begin_src cicada-nymph :tangle core.cn 512 allocate-memory : *buffer,work-directory* ; define-variable,with-tos : work-directory:get << -- directory[address, length] >> 512 *buffer,work-directory* syscall-number:*getcwd* 2 syscall dup negative? if "* (work-directory:get) fail" .s .l " " .s error-code->string .s .l end then *buffer,work-directory* swap sub1 << for the ending zero >> end ; define-function #+end_src *** work-directory:change #+begin_src cicada-nymph :tangle core.cn : work-directory:change << directory-path[address, length] -- >> >::directory-path ::directory-path string->syscall-string syscall-number:*chdir* 1 syscall dup negative? if "* (work-directory:change) fail" .s .l " can not change the work directory into : " .s ::directory-path .s .l " thus the argument in the stack is not consumed" .s .l " " .s error-code->string .s .l ::directory-path end then drop end ; define-function #+end_src *** pwd * print work-directory #+begin_src cicada-nymph :tangle core.cn : pwd << -- >> work-directory:get .s .l end ; define-function #+end_src *** cd * change work-directory #+begin_src cicada-nymph :tangle core.cn "cd" "work-directory:change" alias #+end_src *** test #+begin_src cicada-nymph pwd "/home" cd pwd "/////home/xyh////cicada/play" cd pwd "//././/home/xyh/././cicada/./" cd pwd #+end_src * path *** system-stat #+begin_src cicada-nymph :tangle core.cn 0 : +stat,dev+ ; define-variable,with-tos 0 : +stat,ino+ ; define-variable,with-tos 0 : +stat,mode+ ; define-variable,with-tos 0 : +stat,nlink+ ; define-variable,with-tos 0 : +stat,uid+ ; define-variable,with-tos 0 : +stat,gid+ ; define-variable,with-tos 0 : +stat,rdev+ ; define-variable,with-tos 0 : +stat,size+ ; define-variable,with-tos 0 : +stat,blksize+ ; define-variable,with-tos 0 : +stat,blocks+ ; define-variable,with-tos 0 : +stat,atime+ ; define-variable,with-tos 0 : +stat,atime_nsec+ ; define-variable,with-tos 0 : +stat,mtime+ ; define-variable,with-tos 0 : +stat,mtime_nsec+ ; define-variable,with-tos 0 : +stat,ctime+ ; define-variable,with-tos 0 : +stat,ctime_nsec+ ; define-variable,with-tos 0 : +stat,__unused4+ ; define-variable,with-tos 0 : +stat,__unused5+ ; define-variable,with-tos 0 : +stat,end+ ; define-variable,with-tos : init,stat << offset -- >> *cell-size* 4 equal? if dup address +stat,dev+ set *cell-size* add dup address +stat,ino+ set *cell-size* add dup address +stat,mode+ set 2 add dup address +stat,nlink+ set 2 add dup address +stat,uid+ set 2 add dup address +stat,gid+ set 2 add dup address +stat,rdev+ set *cell-size* add dup address +stat,size+ set *cell-size* add dup address +stat,blksize+ set *cell-size* add dup address +stat,blocks+ set *cell-size* add dup address +stat,atime+ set *cell-size* add dup address +stat,atime_nsec+ set *cell-size* add dup address +stat,mtime+ set *cell-size* add dup address +stat,mtime_nsec+ set *cell-size* add dup address +stat,ctime+ set *cell-size* add dup address +stat,ctime_nsec+ set *cell-size* add dup address +stat,__unused4+ set *cell-size* add dup address +stat,__unused5+ set *cell-size* add address +stat,end+ set end then *cell-size* 8 equal? if dup address +stat,dev+ set *cell-size* add dup address +stat,ino+ set *cell-size* add << note the following order changing this is linux' bad >> dup address +stat,nlink+ set 8 add dup address +stat,mode+ set 4 add dup address +stat,uid+ set 4 add dup address +stat,gid+ set 4 add 4 add << padding >> dup address +stat,rdev+ set *cell-size* add dup address +stat,size+ set *cell-size* add dup address +stat,blksize+ set *cell-size* add dup address +stat,blocks+ set *cell-size* add dup address +stat,atime+ set *cell-size* add dup address +stat,atime_nsec+ set *cell-size* add dup address +stat,mtime+ set *cell-size* add dup address +stat,mtime_nsec+ set *cell-size* add dup address +stat,ctime+ set *cell-size* add dup address +stat,ctime_nsec+ set *cell-size* add dup address +stat,__unused4+ set *cell-size* add dup address +stat,__unused5+ set *cell-size* add address +stat,end+ set end then end ; define-function 0 init,stat +stat,end+ : +stat,length+ ; define-variable,with-tos #+end_src *** test #+begin_src cicada-nymph : test,stat << path[address, length] -- >> string->syscall-string >:syscall-path +stat,length+ allocate-local-memory >:stat-structure :stat-structure :syscall-path syscall-number:*stat* 2 syscall dup negative? if dup . error-code->string .s .l end then drop :stat-structure init,stat "+stat,dev+ : " .s +stat,dev+ get . .l "+stat,ino+ : " .s +stat,ino+ get . .l *cell-size* 4 equal? if "+stat,mode+ : " .s +stat,mode+ get-two-bytes . .l "+stat,nlink+ : " .s +stat,nlink+ get-two-bytes . .l "+stat,uid+ : " .s +stat,uid+ get-two-bytes . .l "+stat,gid+ : " .s +stat,gid+ get-two-bytes . .l then *cell-size* 8 equal? if "+stat,nlink+ : " .s +stat,nlink+ get . .l "+stat,mode+ : " .s +stat,mode+ get-four-bytes . .l "+stat,uid+ : " .s +stat,uid+ get-four-bytes . .l "+stat,gid+ : " .s +stat,gid+ get-four-bytes . .l then "+stat,rdev+ : " .s +stat,rdev+ get . .l "+stat,size+ : " .s +stat,size+ get . .l "+stat,blksize+ : " .s +stat,blksize+ get . .l "+stat,blocks+ : " .s +stat,blocks+ get . .l "+stat,atime+ : " .s +stat,atime+ get . .l "+stat,atime_nsec+ : " .s +stat,atime_nsec+ get . .l "+stat,mtime+ : " .s +stat,mtime+ get . .l "+stat,mtime_nsec+ : " .s +stat,mtime_nsec+ get . .l "+stat,ctime+ : " .s +stat,ctime+ get . .l "+stat,ctime_nsec+ : " .s +stat,ctime_nsec+ get . .l "+stat,__unused4+ : " .s +stat,__unused4+ get . .l "+stat,__unused5+ : " .s +stat,__unused5+ get . .l end ; define-function "cn" test,stat "no" test,stat #+end_src *** note predicate * to use predicate to know more about the file-tree before calling a function that makes action on the file-tree *** path:nothing? #+begin_src cicada-nymph :tangle core.cn : path:nothing? << path[address, length] -- bool >> string->syscall-string >:syscall-path +stat,length+ allocate-local-memory >:stat-structure :stat-structure :syscall-path syscall-number:*stat* 2 syscall -2 equal? end ; define-function #+end_src *** path:file? #+begin_src cicada-nymph :tangle core.cn : path:file? << path[address, length] -- bool >> string->syscall-string >:syscall-path +stat,length+ allocate-local-memory >:stat-structure :stat-structure :syscall-path syscall-number:*stat* 2 syscall dup negative? if drop false end then drop :stat-structure init,stat *cell-size* 4 equal? if +stat,mode+ get-two-bytes then *cell-size* 8 equal? if +stat,mode+ get-four-bytes then 12 bit-right 8#0010 equal? << 0170000 S_IFDIR 0040000 /* Directory. */ S_IFCHR 0020000 /* Character device. */ S_IFBLK 0060000 /* Block device. */ S_IFREG 0100000 /* Regular file. */ S_IFIFO 0010000 /* FIFO. */ S_IFLNK 0120000 /* Symbolic link. */ S_IFSOCK 0140000 /* Socket. */ >> end ; define-function #+end_src *** path:directory? #+begin_src cicada-nymph :tangle core.cn : path:directory? << path[address, length] -- bool >> string->syscall-string >:syscall-path +stat,length+ allocate-local-memory >:stat-structure :stat-structure :syscall-path syscall-number:*stat* 2 syscall dup negative? if drop false end then drop :stat-structure init,stat *cell-size* 4 equal? if +stat,mode+ get-two-bytes then *cell-size* 8 equal? if +stat,mode+ get-four-bytes then 12 bit-right 8#0004 equal? << 0170000 S_IFDIR 00040000 /* Directory. */ S_IFCHR 00020000 /* Character device. */ S_IFBLK 00060000 /* Block device. */ S_IFREG 00100000 /* Regular file. */ S_IFIFO 00010000 /* FIFO. */ S_IFLNK 00120000 /* Symbolic link. */ S_IFSOCK 00140000 /* Socket. */ >> end ; define-function #+end_src *** test #+begin_src cicada-nymph "cn" path:nothing? . << 0 >> "core" path:nothing? . << 0 >> "ai" path:nothing? . << 1 >> "cn" path:file? . << 1 >> "core" path:file? . << 0 >> "ai" path:file? . << 0 >> "cn" path:directory? . << 0 >> "core" path:directory? . << 1 >> "ai" path:directory? . << 0 >> #+end_src *** 記字符串的謂詞 * 下面這兩個函數其實是在用遞歸函數實現正則表達式對字符串的匹配效果 * 是否應該設計正則表達式子語言 ? 還是總是直接使用遞歸函數 ? *** 記 unix 路徑格式 * "/" 相當於空格連續的 "//" 相當於連續的空格這種空格使用在字符串開頭時代表這是一個絕對路徑 * "." 相當於空格連續的 ".." 不算連續的空格有別的語義但是在這種空格使用在最前面的時候標誌這個這種空格使用在字符串開頭時代表這是一個相對路徑 * 而對於下面的兩個函數我簡單地要求 1. relative-path 不以 "/" 開頭的字符串 2. full-path 以 "/" 開頭的字符串 3. 並且在這裏我允許 path 內出現空格保留對這種路徑的處理能力只不過我不使用這種路徑而已 *** path:relative? * in ASCII "/" is 47 #+begin_src cicada-nymph :tangle core.cn : path:relative? << string[address, length] -- bool >> dup zero? if drop2 false end then string:byte 47 equal? not end ; define-function #+end_src *** path:full? * in ASCII "/" is 47 #+begin_src cicada-nymph :tangle core.cn : path:full? << string[address, length] -- bool >> dup zero? if drop2 false end then string:byte 47 equal? end ; define-function #+end_src *** test path:full? #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) path:full?" .s .l "/home" path:relative? false? "/home" path:full? true? and "home" path:relative? true? and "home" path:full? false? and test ; test-do #+end_src * poi *** 記 * poi 是利用文件系統所實現的登記機制所登記的 path 信息爲 path-syntax 所用 * module 也是用文件系統所實現的登記機制所登記的 path 信息爲 module 機制所用 *** note * poi denotes path-organizer it can give a name to a path one path one name * a path as a string must not contain any space bytes * a name should only consist of number or letter or "-" *** *poi-directory* * one directory to store the name path record "/home//.cicada/poi" #+begin_src cicada-nymph :tangle core.cn : *poi-directory,user,address* 512 allocate-memory ; define-variable : *poi-directory* *home-directory* "/.cicada/poi" *poi-directory,user,address* 2 n-string->buffer! *poi-directory,user,address* swap ; define-variable #+end_src *** poi:find * note that this function uses *circular-string-area* #+begin_src cicada-nymph :tangle core.cn : poi:find << name[address, length] -- path[address, length], true -- false >> >::name 512 allocate-local-memory >:buffer *poi-directory* "/" ::name "/path" :buffer 4 n-string->buffer! >:length :buffer :length path:file? not if false end then 512 allocate-local-memory >:read-buffer :read-buffer 512 :buffer :length file:read >:read-length *circular-string-area,current-free-address* >:path-address :read-buffer :read-length circular-string-area,stay :path-address :read-length true end ; define-function #+end_src *** poi:add #+begin_src cicada-nymph :tangle core.cn : poi:add << name[address, length], relative-path[address, length] -- >> >::relative-path >::name ::relative-path path:relative? not if "* (poi:add) the argument must be a relative-path" .s .l " but the following is not : " .s ::relative-path .s .l end then ::relative-path path:directory? not if "* (poi:add) the argument must be a relative-path to a existing directory" .s .l " but the following path is not to a directory : " .s ::relative-path .s .l end then ::name poi:find if "* (poi:add) can not add" .s .l " for the following poi already exist : " .s ::name .s .l " name is use as the following directory's name : " .s .s .l end then 512 allocate-local-memory >:buffer *poi-directory* "/" ::name :buffer 3 n-string->buffer! >:length :buffer :length directory:create *poi-directory* "/" ::name "/path" :buffer 4 n-string->buffer! >:length :buffer :length file:create 512 allocate-local-memory >:address,full-path work-directory:get "/" ::relative-path :address,full-path 3 n-string->buffer! >:length,full-path :address,full-path :length,full-path :buffer :length file:write end ; define-function #+end_src *** poi:sub #+begin_src cicada-nymph :tangle core.cn : poi:sub << name[address, length] -- >> >::name ::name poi:find not if "* (poi:sub) can not sub" .s .l " for the following poi does not exist : " .s ::name .s .l end then >::named-directory 512 allocate-local-memory >:buffer *poi-directory* "/" ::name "/path" :buffer 4 n-string->buffer! >:length :buffer :length file:remove *poi-directory* "/" ::name :buffer 3 n-string->buffer! >:length :buffer :length directory:remove end ; define-function #+end_src *** poi:up #+begin_src cicada-nymph :tangle core.cn : poi:up << name[address, length], relative-path[address, length] -- >> >::relative-path >::name ::relative-path path:relative? not if "* (poi:up) the argument must be a relative-path" .s .l " but the following is not : " .s ::relative-path .s .l end then ::relative-path path:directory? not if "* (poi:up) the argument must be a relative-path to a existing directory" .s .l " but the following directory is not exist : " .s ::relative-path .s .l end then ::name poi:find not if "* (poi:up) can not up" .s .l " for the following poi does not exist : " .s ::name .s .l end then >::named-directory 512 allocate-local-memory >:buffer *poi-directory* "/" ::name "/path" :buffer 4 n-string->buffer! >:length 512 allocate-local-memory >:address,full-path work-directory:get "/" ::relative-path :address,full-path 3 n-string->buffer! >:length,full-path :address,full-path :length,full-path :buffer :length file:write end ; define-function #+end_src *** poi:list #+begin_src cicada-nymph :tangle core.cn : poi:list << -- >> *poi-directory* [ << -- >> +getdents64,type+ get-byte 4 equal? if 512 allocate-local-memory >:path-buffer +getdents64,name+ dup 256 0 string:find-byte drop << drop 0 >> over sub >::name ".." ::name string:equal? if end then "." ::name string:equal? if end then " * " .s ::name .s .l " " .s *poi-directory* "/" ::name "/path" :path-buffer 4 n-string->buffer! >:path-length 512 allocate-local-memory >:reading-buffer :reading-buffer 512 :path-buffer :path-length file:read >:reading-length :reading-buffer :reading-length .s .l then end ] directory:map end ; define-function #+end_src *** poi:help #+begin_src cicada-nymph :tangle core.cn : poi:help << -- >> "* (poi:help)" .s .l " * cn poi add

" .s .l " * cn poi sub " .s .l " * cn poi up

" .s .l " * cn poi find " .s .l " * cn poi list" .s .l end ; define-function #+end_src *** test #+begin_src cicada-nymph "test-cicada-play" "./play" poi:add "test-cicada-play" poi:find if .s .l else "not found" .s .l then "test-cicada-play-2" "./play-2" poi:add "test-cicada-play-2" poi:find if .s .l else "not found" .s .l then "test-cicada-play" "./contribution" poi:up "test-cicada-play" poi:find if .s .l else "not found" .s .l then "test-cicada-play" poi:sub "test-cicada-play" poi:find if .s .l else "not found" .s .l then poi:list poi:help #+end_src * word-interpreter-syntax:path *** +word+? #+begin_src cicada-nymph :tangle core.cn : +word+? << string[address, length] -- bool >> dup 1 less-or-equal? if drop2 false end then over get-byte "+" string:byte equal? not if drop2 false end then add sub1 get-byte "+" string:byte equal? end ; define-function #+end_src *** +word+->word #+begin_src cicada-nymph :tangle core.cn : +word+->word << +word+[address, length] -- name[address, length] >> sub2 swap add1 swap end ; define-function #+end_src *** test #+begin_src cicada-nymph "+work+" +word+? . "work" +word+? . #+end_src *** note * path syntax can be implemented by a new *syntax-rule-set* but in the following I just simply implemented it as a syntax-rule in syntax-rule-set:*word-interpreter* *** note format #+begin_src cicada-nymph << the following 4 poi are built in +root+ +home+ +work+ +back+ >> path: +root+ home xyh cicada core core.cn ; path: +home+ cicada core core.cn ; "/home/xyh/cicada/core/core.cn" path: +back+ cicada core core.cn ; "../cicada/core/core.cn" path: +work+ core core.cn ; path: core core.cn ; path: +library+ hi.cn ; "/home/xyh/cicada/library/hi.cn" #+end_src *** path-syntax-word->path #+begin_src cicada-nymph :tangle core.cn : path-syntax-word->path << word[address, length] -- path[address, length] >> >::word ::word "+root+" string:equal? if "/" end then ::word "+work+" string:equal? if work-directory:get end then ::word "+home+" string:equal? if *home-directory* end then ::word "+back+" string:equal? if ".." end then ::word +word+? not if ::word end then ::word +word+->word poi:find if end then ::word 'bad-path-syntax-word awake ; define-function #+end_src *** word-interpreter-syntax:path #+begin_src cicada-nymph :tangle core.cn : bad-path-syntax-word,loop << -- >> read-word dup2 ";" string:equal? if .s 32 .b end then .s 32 .b loop ; define-function : word-interpreter-syntax:path,loop << cursor -- cursor >> >:cursor read-word >::word ";" ::word string:equal? if :cursor end then ::word path-syntax-word->path dup >:length :cursor string->buffer! :cursor :length add dup "/" string:byte swap set-byte add1 loop ; define-function : word-interpreter-syntax:path << literal-word:path: -- path[address, length] >> drop2 [ << word -- >> "* (word-interpreter-syntax:path) the following word is of bad syntax : " .s .l " " .s .s .l action,reset-the-stack << -- >> " the rest of the words in path syntax is as following :" .s .l " " .s bad-path-syntax-word,loop .l end ] 'bad-path-syntax-word await 512 allocate-local-memory >:buffer :buffer word-interpreter-syntax:path,loop >:cursor :cursor :buffer sub >:length *circular-string-area,current-free-address* >:address :buffer :length circular-string-area,stay :address :length end ; define-function #+end_src *** more,syntax-rule-set:basic-REPL #+begin_src cicada-nymph :tangle core.cn : more,syntax-rule-set:basic-REPL << -- >> syntax-rule-set:*word-interpreter* ["path:" string:equal? end] jo word-interpreter-syntax:path syntax-rule:add end ; define-function more,syntax-rule-set:basic-REPL #+end_src *** test #+begin_src cicada-nymph path: +root+ home xyh cicada core core.cn ; .s path: +home+ cicada core core.cn ; .s path: +back+ cicada core core.cn ; .s path: +work+ core core.cn ; .s path: core core.cn ; .s "module" "module" poi:add path: +module+ hi.cn ; .s "module" poi:sub << error >> path: +module+ hi.cn ; #+end_src * string *** string:full-of-the-same-byte? #+begin_src cicada-nymph :tangle core.cn : string:full-of-the-same-byte? << string[address, length], byte -- bool >> >:byte >::string ::string dup zero? if drop2 true end then string:byte :byte equal? not if false end then ::string string:byte-tail :byte loop ; define-function #+end_src *** test string:full-of-the-same-byte? #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) string:full-of-the-same-byte?" .s .l "aaa" "a" string:byte string:full-of-the-same-byte? true? "aba" "a" string:byte string:full-of-the-same-byte? false? add test ; test-do #+end_src *** string:any-word #+begin_src cicada-nymph :tangle core.cn : string:any-word << string[address, length] function : < word[address, length] -- bool > -- bool >> >:function >::string ::string string:space? if false end then ::string string:word :function apply if true end then ::string string:word-tail :function loop ; define-function #+end_src *** string:every-word #+begin_src cicada-nymph :tangle core.cn : string:every-word << string[address, length] function : < word[address, length] -- bool > -- bool >> >:function >::string ::string string:space? if true end then ::string string:word :function apply not if false end then ::string string:word-tail :function loop ; define-function #+end_src *** test string:every-word #+begin_src cicada-nymph :tangle core-test.cn : string:every-word,testing << -- >> "no no name no" ["name" string:equal? end] string:any-word true? "name name name" ["name" string:equal? end] string:every-word true? and "name name name" ["name" string:equal? not end] string:every-word false? and "no no name no" ["name" string:equal? end] string:every-word false? and test end ; test-function : "* (testing) string:every-word" .s .l string:every-word,testing ; test-do #+end_src *** string:word-end-back #+begin_src cicada-nymph :tangle core.cn : string:word-end-back << string[address, length] -- string[address, length] >> dup zero? if << no error handling the same empty-string is returned >> end then dup2 string:byte-back string:byte space-byte? not if end then string:byte-back loop ; define-function #+end_src *** string:word-begin-back #+begin_src cicada-nymph :tangle core.cn : string:word-begin-back,loop << string[address, length] -- string[address, length] >> dup zero? if << no error handling the current empty-string is returned >> end then dup2 string:byte-back string:byte space-byte? if end then dup2 string:byte-back string:byte bar-ket-byte? if end then string:byte-back loop ; define-function : string:word-begin-back << string[address, length] -- string[address, length] >> dup zero? if << no error handling the same empty-string is returned >> end then dup2 string:byte-back string:byte bar-ket-byte? if string:byte-back end then string:word-begin-back,loop end ; define-function #+end_src *** string:word-back #+begin_src cicada-nymph :tangle core.cn : string:word-back << string[address, length] -- string[address, length] >> string:word-end-back string:word-begin-back end ; define-function #+end_src *** test string:word-back #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) string:word-back" .s .l " aaa aaa aaa" string:word-tail dup2 " aaa aaa" string:equal? test string:word-back dup2 "aaa aaa aaa" string:equal? test string:word "aaa" string:equal? test ; test-do #+end_src * reading-stack *** unread-word #+begin_src cicada-nymph :tangle core.cn : unread-word << -- >> pop-reading-stack string:word-back push-reading-stack end ; define-function #+end_src *** test #+begin_src cicada-nymph : unread-word,test << -- >> "type a word : " .s read-word "* read-word : " .s .s .l unread-word read-word "* read-word again : " .s .s .l unread-word read-word "* read-word again : " .s .s .l end ; define-function unread-word,test #+end_src * 記模塊 *** 元數據之語法 * 舉例 #+begin_src cicada-nymph ::::::::: import: combinator math module: assembler do: "assembler loaded" .s .l ========= #+end_src * 元數據中所包含的信息應該只和如何運行這個程序有關因爲其他信息可能會在各個文件中重複這些可能重複的信息應該另行保存 * 有了元數據之後就可以對文件實現相對豐富的謂詞 * 元數據中所能包含的信息類型還有聲明這些信息的語法都是可以擴展的 * 語法關鍵詞都形如 "word:" 每次通過找下一個 "word:" 來確定其截止位置 * 遇不被識別的 "word:" 就忽略而找到下一個 "word:" *** 減載 * 或者說撤銷加載 (unload) 它利用 (undo) 來實現 *** 加載棧 * 加載棧記錄 1. 所有被加載的模塊的信息[模塊元數據字符串] 2. 模塊被加載的順序 3. 被加載的模塊是被直接加載還是間接加載 4. 時間路徑等等其他根系統狀態有關的元數據 * (import) 就利用了這些信息用以聞訊同時這些信息也可以幫助實現詳細的 report *** 模塊命名棧與全局命名棧 * 應該用兩種命名棧全局命名棧[global-naming-stack] 所有名字都沒有模塊前綴模塊命名棧[module-naming-stack] 所有名字都有模塊前綴 * 加載模塊時入 global-naming-stack 之後統一移到 module-naming-stack 這樣就不必更改定義者的接口了定義者只要向 global-naming-stack 中入值就行了根 module-naming-stack 有關的操作由其他函數另行完成 *** 模塊與文件一一對應 * 要求模塊與文件一一對應這種對應關係影響對模塊機制的理解與使用 * 在啓動時解釋器不會加載 core 之外的任何 module * 所加載者爲模塊而非文件不用路徑來加載模塊而預先登記其路徑然後直接通過模塊名來加載 * 我提供命令行函數來幫助在啓動時加載模塊 *** 循環引入 * 爲了處理循環引入我需要一個 importing-stack 用以記錄模塊之網中由一點之引入所形成的有向路只要在增添新的有向邊的時候不要形成圈就行了 * module-naming-stack *** note module-naming-stack * (define-*) push (undo) pop *** note name-record * *module-naming-stack* contain name-record * structure | name-record | old-jo | | | name | | | new-jo | *** *module-naming-stack* #+begin_src cicada-nymph :tangle core.cn 100 1024 mul : module-naming-stack:*size* ; define-variable,with-tos 3 *cell-size* mul : module-naming-stack:*unit* ; define-variable,with-tos module-naming-stack:*size* module-naming-stack:*unit* mul allocate-memory : *module-naming-stack* ; define-variable,with-tos *module-naming-stack* : module-naming-stack:*pointer* ; define-variable,with-tos #+end_src * moi *** note * like *** *module-directory* * one directory to store the name path record "/home//.cicada/module" #+begin_src cicada-nymph :tangle core.cn : *module-directory,user,address* 512 allocate-memory ; define-variable : *module-directory* *home-directory* "/.cicada/moi" *module-directory,user,address* 2 n-string->buffer! *module-directory,user,address* swap ; define-variable #+end_src *** moi:find * note that this function uses *circular-string-area* #+begin_src cicada-nymph :tangle core.cn : moi:find << name[address, length] -- path[address, length], true -- false >> >::name 512 allocate-local-memory >:buffer *module-directory* "/" ::name "/path" :buffer 4 n-string->buffer! >:length :buffer :length path:file? not if false end then 512 allocate-local-memory >:read-buffer :read-buffer 512 :buffer :length file:read >:read-length *circular-string-area,current-free-address* >:path-address :read-buffer :read-length circular-string-area,stay :path-address :read-length true end ; define-function #+end_src *** moi:add #+begin_src cicada-nymph :tangle core.cn : moi:add << name[address, length], relative-path[address, length] -- >> >::relative-path >::name ::relative-path path:relative? not if "* (moi:add) the argument must be a relative-path" .s .l " but the following is not : " .s ::relative-path .s .l end then ::relative-path path:file? not if "* (moi:add) the argument must be a relative-path to a existing file" .s .l " but the following path is not to a file : " .s ::relative-path .s .l end then ::name moi:find if "* (moi:add) can not add" .s .l " for the following module already exist : " .s ::name .s .l " name is use as the following directory's name : " .s .s .l end then 512 allocate-local-memory >:buffer *module-directory* "/" ::name :buffer 3 n-string->buffer! >:length :buffer :length directory:create *module-directory* "/" ::name "/path" :buffer 4 n-string->buffer! >:length :buffer :length file:create 512 allocate-local-memory >:address,full-path work-directory:get "/" ::relative-path :address,full-path 3 n-string->buffer! >:length,full-path :address,full-path :length,full-path :buffer :length file:write end ; define-function #+end_src *** moi:sub #+begin_src cicada-nymph :tangle core.cn : moi:sub << name[address, length] -- >> >::name ::name moi:find not if "* (moi:sub) can not sub" .s .l " for the following module does not exist : " .s ::name .s .l end then >::named-directory 512 allocate-local-memory >:buffer *module-directory* "/" ::name "/path" :buffer 4 n-string->buffer! >:length :buffer :length file:remove *module-directory* "/" ::name :buffer 3 n-string->buffer! >:length :buffer :length directory:remove end ; define-function #+end_src *** moi:up #+begin_src cicada-nymph :tangle core.cn : moi:up << name[address, length], relative-path[address, length] -- >> >::relative-path >::name ::relative-path path:relative? not if "* (moi:up) the argument must be a relative-path" .s .l " but the following is not : " .s ::relative-path .s .l end then ::relative-path path:file? not if "* (moi:up) the argument must be a relative-path to a existing file" .s .l " but the following file is not exist : " .s ::relative-path .s .l end then ::name moi:find not if "* (moi:up) can not up" .s .l " for the following module does not exist : " .s ::name .s .l end then >::named-directory 512 allocate-local-memory >:buffer *module-directory* "/" ::name "/path" :buffer 4 n-string->buffer! >:length 512 allocate-local-memory >:address,full-path work-directory:get "/" ::relative-path :address,full-path 3 n-string->buffer! >:length,full-path :address,full-path :length,full-path :buffer :length file:write end ; define-function #+end_src *** moi:list #+begin_src cicada-nymph :tangle core.cn : moi:list << -- >> *module-directory* [ << -- >> +getdents64,type+ get-byte 4 equal? if 512 allocate-local-memory >:path-buffer +getdents64,name+ dup 256 0 string:find-byte drop << drop 0 >> over sub >::name ".." ::name string:equal? if end then "." ::name string:equal? if end then " * " .s ::name .s .l " " .s *module-directory* "/" ::name "/path" :path-buffer 4 n-string->buffer! >:path-length 512 allocate-local-memory >:reading-buffer :reading-buffer 512 :path-buffer :path-length file:read >:reading-length :reading-buffer :reading-length .s .l then end ] directory:map end ; define-function #+end_src *** moi:help #+begin_src cicada-nymph :tangle core.cn : moi:help << -- >> "* (moi:help)" .s .l " * cn moi add

" .s .l " * cn moi sub " .s .l " * cn moi up

" .s .l " * cn moi find " .s .l " * cn moi list" .s .l end ; define-function #+end_src *** test #+begin_src cicada-nymph "test-cicada-play" "./play" moi:add "test-cicada-play" moi:find if .s .l else "not found" .s .l then "test-cicada-play-2" "./play-2" moi:add "test-cicada-play-2" moi:find if .s .l else "not found" .s .l then "test-cicada-play" "./contribution" moi:up "test-cicada-play" moi:find if .s .l else "not found" .s .l then "test-cicada-play" moi:sub "test-cicada-play" moi:find if .s .l else "not found" .s .l then moi:list moi:help #+end_src * module-stack & module-info *** 記用法 * 遞歸引入返回時入此棧 * 其中保存的值用於問詢引入的模塊之狀態比如記錄是否帶有測試加載比如記錄測試成功與失敗的次數 *** *module-stack* #+begin_src cicada-nymph :tangle core.cn 10 1024 mul : module-stack:*size* ; define-variable,with-tos 8 *cell-size* mul : module-stack:*unit* ; define-variable,with-tos module-stack:*size* module-stack:*unit* mul allocate-memory : *module-stack* ; define-variable,with-tos *module-stack* : module-stack:*pointer* ; define-variable,with-tos #+end_src *** note * *module-stack* contain module-info * structure | module-info | meta-string address | | | meta-string length | | | name | | | name-record-begin | | | name-record-end | | | tested-flag | | | success-counter | | | fail-counter | *** module-info:[get|set]-meta-string #+begin_src cicada-nymph :tangle core.cn : module-info:get-meta-string << module-info -- meta-string[address, length] >> 2 n-get end ; define-function : module-info:set-meta-string << meta-string[address, length], module-info -- >> xx|swap|x make-string x|swap|xx 2 n-set end ; define-function #+end_src *** module-info:[get|set]-name #+begin_src cicada-nymph :tangle core.cn : module-info:get-name << module-info -- name >> *cell-size* 2 mul add get end ; define-function : module-info:set-name << name, module-info -- >> *cell-size* 2 mul add set end ; define-function #+end_src *** module-info:[get|set]-name-record-begin #+begin_src cicada-nymph :tangle core.cn : module-info:get-name-record-begin << module-info -- name >> *cell-size* 3 mul add get end ; define-function : module-info:set-name-record-begin << name, module-info -- >> *cell-size* 3 mul add set end ; define-function #+end_src *** module-info:[get|set]-name-record-end #+begin_src cicada-nymph :tangle core.cn : module-info:get-name-record-end << module-info -- name >> *cell-size* 4 mul add get end ; define-function : module-info:set-name-record-end << name, module-info -- >> *cell-size* 4 mul add set end ; define-function #+end_src *** module-info:[get|set]-tested-flag #+begin_src cicada-nymph :tangle core.cn : module-info:get-tested-flag << module-info -- name >> *cell-size* 5 mul add get end ; define-function : module-info:set-tested-flag << name, module-info -- >> *cell-size* 5 mul add set end ; define-function #+end_src *** module-info:[get|set|inc]-success-counter #+begin_src cicada-nymph :tangle core.cn : module-info:get-success-counter << module-info -- name >> *cell-size* 6 mul add get end ; define-function : module-info:set-success-counter << name, module-info -- >> *cell-size* 6 mul add set end ; define-function : module-info:inc-success-counter << module-info -- >> *cell-size* 6 mul add 1 swap add-set end ; define-function #+end_src *** module-info:[get|set|inc]-fail-counter #+begin_src cicada-nymph :tangle core.cn : module-info:get-fail-counter << module-info -- name >> *cell-size* 7 mul add get end ; define-function : module-info:set-fail-counter << name, module-info -- >> *cell-size* 7 mul add set end ; define-function : module-info:inc-fail-counter << module-info -- >> *cell-size* 7 mul add 1 swap add-set end ; define-function #+end_src *** module-stack:find * from the base to the pointer #+begin_src cicada-nymph :tangle core.cn : module-stack:find,loop << name, cursor -- module-info, true -- false >> dup module-stack:*pointer* equal? if drop2 false end then >:cursor >:name :cursor module-info:get-name :name equal? if :cursor true end then :name :cursor module-stack:*unit* add loop ; define-function : module-stack:find << name -- module-info, true -- false >> *module-stack* module-stack:find,loop end ; define-function #+end_src * importing-stack & importing-record *** 記用法 * 遞歸引入展開時入此棧返回時出此棧 * 其中保存的值在 eval-string 的過程中可以用到比如探測循環引入比如記錄當前的模塊是否帶測試引入 *** *importing-stack* & *testing-flag* #+begin_src cicada-nymph :tangle core.cn 10 1024 mul : importing-stack:*size* ; define-variable,with-tos 2 *cell-size* mul : importing-stack:*unit* ; define-variable,with-tos *cell-size* allocate-memory drop *cell-size* allocate-memory : *testing-flag* ; define-variable,with-tos importing-stack:*size* importing-stack:*unit* mul allocate-memory : *importing-stack* ; define-variable,with-tos *importing-stack* : importing-stack:*pointer* ; define-variable,with-tos #+end_src *** note * structure | importing-record | name | | | testing-flag | *** importing-record:[get|set]-name #+begin_src cicada-nymph :tangle core.cn : importing-record:get-name << module-info -- name >> get end ; define-function : importing-record:set-name << name, module-info -- >> set end ; define-function #+end_src *** importing-record:[get|set]-testing-flag #+begin_src cicada-nymph :tangle core.cn : importing-record:get-testing-flag << module-info -- bool >> *cell-size* add get end ; define-function : importing-record:set-testing-flag << bool, module-info -- >> *cell-size* add set end ; define-function #+end_src *** importing-stack:find * from the base to the pointer #+begin_src cicada-nymph :tangle core.cn : importing-stack:find,loop << name, cursor -- importing-record, true -- false >> dup importing-stack:*pointer* equal? if drop2 false end then >:cursor >:name :cursor importing-record:get-name :name equal? if :cursor true end then :name :cursor importing-stack:*unit* add loop ; define-function : importing-stack:find << name -- importing-record, true -- false >> *importing-stack* importing-stack:find,loop end ; define-function #+end_src *** importing-stack:drop #+begin_src cicada-nymph :tangle core.cn : importing-stack:drop << -- >> importing-stack:*unit* address importing-stack:*pointer* sub-set end ; define-function #+end_src *** t #+begin_src cicada-nymph :tangle core.cn : t << -- >> *testing-flag* get if 0 *testing-flag* set "* (testing) *testing-flag* off" .s .l end else 1 *testing-flag* set "* (testing) *testing-flag* on" .s .l end then ; define-function #+end_src * global-naming-stack & module-naming-stack *** --------------------------------- *** 記接口 * 每個模塊都對應於 module-naming-stack 中的兩個 name-record 一個開始一個結束因此接口就要圍繞這對值來設計 * undo 中關於 global-naming-stack 和 module-naming-stack 的部分可以利用這裏的接口 * (clear-naming) name-record-begin <-- name-record-end (prefix-naming) name-record-begin --> name-record-end (expose-naming) name-record-begin --> name-record-end *** --------------------------------- *** module-naming-stack:record-jo #+begin_src cicada-nymph :tangle core.cn : module-naming-stack:record-jo << jo, name -- >> dup name,get-jo module-naming-stack:*pointer* name-record:set-old-jo dup2 name,set-jo module-naming-stack:*pointer* name-record:set-name module-naming-stack:*pointer* name-record:set-new-jo module-naming-stack:*unit* address module-naming-stack:*pointer* add-set end ; define-function #+end_src *** module-naming-stack:delete-last-record #+begin_src cicada-nymph :tangle core.cn : module-naming-stack:delete-last-record << -- >> module-naming-stack:*unit* address module-naming-stack:*pointer* sub-set module-naming-stack:*pointer* name-record:get-old-jo module-naming-stack:*pointer* name-record:get-name name,set-jo end ; define-function #+end_src *** --------------------------------- *** global-naming-stack:clear-naming #+begin_src cicada-nymph :tangle core.cn : global-naming-stack:clear-naming << name-record-begin, name-record-end -- >> dup2 equal? if drop2 end then global-naming-stack:*unit* sub dup >:name-record :name-record name-record:get-old-jo :name-record name-record:get-name name,set-jo loop ; define-function #+end_src *** module-naming-stack:clear-naming #+begin_src cicada-nymph :tangle core.cn : module-naming-stack:clear-naming << name-record-begin, name-record-end -- >> dup2 equal? if drop2 end then module-naming-stack:*unit* sub dup >:name-record :name-record name-record:get-old-jo :name-record name-record:get-name name,set-jo loop ; define-function #+end_src *** --------------------------------- *** global-naming-stack:prefix-naming #+begin_src cicada-nymph :tangle core.cn : global-naming-stack:prefix-naming << name-record-begin, name-record-end, prefix[name-index] -- >> >:prefix >:end >:begin :end :begin equal? if end then 512 allocate-local-memory >:buffer :prefix name->string " " :begin name-record:get-name name->string :buffer 3 n-string->buffer! >:length :begin name-record:get-new-jo :buffer :length string->name module-naming-stack:record-jo :begin global-naming-stack:*unit* add :end :prefix loop ; define-function #+end_src *** module-naming-stack:expose-naming #+begin_src cicada-nymph :tangle core.cn : module-naming-stack:expose-naming << name-record-begin, name-record-end -- >> >:end >:begin :end :begin equal? if end then :begin name-record:get-new-jo :begin name-record:get-name name->string string:word-tail string:byte-tail string->name global-naming-stack:record-jo :begin module-naming-stack:*unit* add :end loop ; define-function #+end_src *** --------------------------------- * undo *** 記撤銷 * 因爲 name-hash-table 的存在導致我實現 undo 這個特性的機制必須是去記錄差別而不能是記錄歷史 * 具體地在每個 undo-point 之後所有對 jo 的 redefine 都需要被記錄在需要退回到這個 undo-point 之時恢復這些被從 name-hash-table 中踢出去的 jo * 這樣每一個 jo 被踢出 name-hash-table 時會存入 jo name 的對子在 undo-stack 中 * 注意每一次重新定義都對應一次恢復 * 缺點是這樣在兩個 undo-point 之間對一個 jo 的多次重複定義就帶來了一些沒必要的恢復 * 優點是這樣就避免了對多次重複定義的 jo 的特殊處理不論是在效率上還是實現的簡潔性上這種實現方式都是更優的 *** note global states * jojo-area * string-area * name-hash-table * global-naming-stack * module-naming-stack * importing-stack * syntax-backup-area * syntax-stack and syntax-rule-set in it *** *undo-stack* #+begin_src cicada-nymph :tangle core.cn 60 1024 mul : undo-stack:*size* ; define-variable,with-tos 7 *cell-size* mul : undo-stack:*unit* ; define-variable,with-tos undo-stack:*size* undo-stack:*unit* mul allocate-memory : *undo-stack* ; define-variable,with-tos *undo-stack* : undo-stack:*pointer* ; define-variable,with-tos #+end_src *** note undo-point * *undo-stack* contain undo-point * structure | undo-point | jojo-area | | | string-area | | | global-naming-stack | | | module-naming-stack | | | syntax-backup-area | | | number of syntax-rule-sets | | | importing-stack | * the undo-point used to undo will be used to reset the pointer of undo-stack [the current-free-address of undo-stack] *** interface of ***** undo-point:[get|set]-jojo-area #+begin_src cicada-nymph :tangle core.cn : undo-point:get-jojo-area << undo-point -- jojo-area current-free-address >> get end ; define-function : undo-point:set-jojo-area << jojo-area current-free-address, undo-point -- >> set end ; define-function #+end_src ***** undo-point:[get|set]-string-area #+begin_src cicada-nymph :tangle core.cn : undo-point:get-string-area << undo-point -- jojo-area current-free-address >> *cell-size* add get end ; define-function : undo-point:set-string-area << jojo-area current-free-address, undo-point -- >> *cell-size* add set end ; define-function #+end_src ***** undo-point:[get|set]-global-naming-stack #+begin_src cicada-nymph :tangle core.cn : undo-point:get-global-naming-stack << undo-point -- jojo-area current-free-address >> *cell-size* 2 mul add get end ; define-function : undo-point:set-global-naming-stack << jojo-area current-free-address, undo-point -- >> *cell-size* 2 mul add set end ; define-function #+end_src ***** undo-point:[get|set]-module-naming-stack #+begin_src cicada-nymph :tangle core.cn : undo-point:get-module-naming-stack << undo-point -- jojo-area current-free-address >> *cell-size* 3 mul add get end ; define-function : undo-point:set-module-naming-stack << jojo-area current-free-address, undo-point -- >> *cell-size* 3 mul add set end ; define-function #+end_src ***** undo-point:[get|set]-syntax-backup-area #+begin_src cicada-nymph :tangle core.cn : undo-point:get-syntax-backup-area << undo-point -- jojo-area current-free-address >> *cell-size* 4 mul add get end ; define-function : undo-point:set-syntax-backup-area << jojo-area current-free-address, undo-point -- >> *cell-size* 4 mul add set end ; define-function #+end_src ***** undo-point:[get|set]-number-of-syntax-rule-sets #+begin_src cicada-nymph :tangle core.cn : undo-point:get-number-of-syntax-rule-sets << undo-point -- jojo-area current-free-address >> *cell-size* 5 mul add get end ; define-function : undo-point:set-number-of-syntax-rule-sets << jojo-area current-free-address, undo-point -- >> *cell-size* 5 mul add set end ; define-function #+end_src ***** undo-point:[get|set]-importing-stack #+begin_src cicada-nymph :tangle core.cn : undo-point:get-importing-stack << undo-point -- jojo-area current-free-address >> *cell-size* 6 mul add get end ; define-function : undo-point:set-importing-stack << jojo-area current-free-address, undo-point -- >> *cell-size* 6 mul add set end ; define-function #+end_src *** *syntax-backup-area* #+begin_src cicada-nymph :tangle core.cn 20 1024 mul *cell-size* mul : *syntax-backup-area,size* ; define-variable,with-tos *syntax-backup-area,size* allocate-memory : *syntax-backup-area* ; define-variable,with-tos *syntax-backup-area* : *syntax-backup-area,current-free-address* ; define-variable,with-tos #+end_src *** undo-point:create ***** 記 * 將 undo-point 這個數據結構入 undo-stack 並返回剛入棧的數據結構的地址 ***** undo-point:create,copy-syntax,one-syntax-rule-set #+begin_src cicada-nymph :tangle core.cn : undo-point:create,copy-syntax,one-syntax-rule-set << syntax-rule-set -- >> >:syntax-rule-set :syntax-rule-set syntax-rule-set:get-border >:border :border :syntax-rule-set sub *cell-size* div >:n :syntax-rule-set *syntax-backup-area,current-free-address* set *cell-size* address *syntax-backup-area,current-free-address* add-set :n *syntax-backup-area,current-free-address* set *cell-size* address *syntax-backup-area,current-free-address* add-set :syntax-rule-set :n n-get *syntax-backup-area,current-free-address* :n n-set *cell-size* :n mul address *syntax-backup-area,current-free-address* add-set end ; define-function #+end_src ***** undo-point:create,copy-syntax #+begin_src cicada-nymph :tangle core.cn : undo-point:create,copy-syntax << cursor -- >> dup syntax-stack:*pointer* equal? if drop end then dup get undo-point:create,copy-syntax,one-syntax-rule-set *cell-size* add loop ; define-function #+end_src ***** undo-point:create #+begin_src cicada-nymph :tangle core.cn : undo-point:create << -- undo-point >> undo-stack:*pointer* >:undo-point undo-stack:*unit* address undo-stack:*pointer* add-set *jojo-area,current-free-address* :undo-point undo-point:set-jojo-area *string-area,current-free-address* :undo-point undo-point:set-string-area global-naming-stack:*pointer* :undo-point undo-point:set-global-naming-stack module-naming-stack:*pointer* :undo-point undo-point:set-module-naming-stack importing-stack:*pointer* :undo-point undo-point:set-importing-stack *syntax-backup-area,current-free-address* :undo-point undo-point:set-syntax-backup-area syntax-stack:*address* undo-point:create,copy-syntax syntax-stack:*pointer* syntax-stack:*address* sub *cell-size* div :undo-point undo-point:set-number-of-syntax-rule-sets :undo-point end ; define-function #+end_src *** undo-point:restore ***** undo-point:restore-jojo-area #+begin_src cicada-nymph :tangle core.cn : undo-point:restore-jojo-area << undo-point -- >> undo-point:get-jojo-area address *jojo-area,current-free-address* set end ; define-function #+end_src ***** undo-point:restore-string-area #+begin_src cicada-nymph :tangle core.cn : undo-point:restore-string-area << undo-point -- >> undo-point:get-string-area address *string-area,current-free-address* set end ; define-function #+end_src ***** undo-point:restore-global-naming-stack #+begin_src cicada-nymph :tangle core.cn : undo-point:restore-global-naming-stack << undo-point -- >> undo-point:get-global-naming-stack >:old-record :old-record global-naming-stack:*pointer* global-naming-stack:clear-naming :old-record address global-naming-stack:*pointer* set end ; define-function #+end_src ***** undo-point:restore-module-naming-stack #+begin_src cicada-nymph :tangle core.cn : undo-point:restore-module-naming-stack << undo-point -- >> undo-point:get-module-naming-stack >:old-record :old-record module-naming-stack:*pointer* module-naming-stack:clear-naming :old-record address module-naming-stack:*pointer* set end ; define-function #+end_src ***** 記語法棧的備份 * 複製出去的時候從頭到尾[從棧底到棧頂]掃描語法棧複製回來的時候從頭到尾掃描語法備份區 * 規則集本身做爲數據結構的存在是 | | border | |----------+-----------| | syntax-rule-set | predicate | | | function | |----------+-----------| | | predicate | | | function | |----------+-----------| | | ... | * 語法棧中的每一個規則集在備份中的存在是 | address | | length | | jo | | jo | | ... | 此處把 jo 按順序複製回 address 所代表的規則集然後重置 current-free-address 就行了並不必知道 jo 的語義 ***** undo-point:restore-syntax-backup-area,set-syntax #+begin_src cicada-nymph :tangle core.cn : undo-point:restore-syntax-backup-area,set-syntax << cursor, syntax-rule-set-copy, number-of-syntax-rule-sets -- cursor >> dup zero? if drop2 end then >:number-of-syntax-rule-sets >:syntax-rule-set-copy >:cursor :syntax-rule-set-copy get >:syntax-rule-set :syntax-rule-set-copy *cell-size* add get >:n :syntax-rule-set :cursor set :syntax-rule-set-copy *cell-size* 2 mul add :n n-get :syntax-rule-set :n n-set *cell-size* :n mul :syntax-rule-set add :syntax-rule-set syntax-rule-set:set-border :cursor *cell-size* add :syntax-rule-set-copy *cell-size* :n 2 add mul add :number-of-syntax-rule-sets sub1 loop ; define-function #+end_src ***** undo-point:restore-syntax-backup-area #+begin_src cicada-nymph :tangle core.cn : undo-point:restore-syntax-backup-area << undo-point -- >> >:undo-point :undo-point undo-point:get-syntax-backup-area >:old-address :undo-point undo-point:get-number-of-syntax-rule-sets >:number-of-syntax-rule-sets syntax-stack:*address* :old-address :number-of-syntax-rule-sets undo-point:restore-syntax-backup-area,set-syntax >:cursor :cursor address syntax-stack:*pointer* set :old-address address *syntax-backup-area,current-free-address* set end ; define-function #+end_src ***** undo-point:restore-importing-stack #+begin_src cicada-nymph :tangle core.cn : undo-point:restore-importing-stack << undo-point -- >> undo-point:get-importing-stack address importing-stack:*pointer* set end ; define-function #+end_src ***** undo-point:restore-undo-stack #+begin_src cicada-nymph :tangle core.cn : undo-point:restore-undo-stack << undo-point -- >> address undo-stack:*pointer* set end ; define-function #+end_src *** undo #+begin_src cicada-nymph :tangle core.cn : undo << undo-point -- >> >:undo-point :undo-point undo-point:restore-jojo-area :undo-point undo-point:restore-string-area :undo-point undo-point:restore-global-naming-stack :undo-point undo-point:restore-module-naming-stack :undo-point undo-point:restore-syntax-backup-area :undo-point undo-point:restore-importing-stack :undo-point undo-point:restore-undo-stack end ; define-function #+end_src *** test undo #+begin_src cicada-nymph undo-point:create : *undo-point* ; define-variable,with-tos : test,undo << -- >> "testing undo" .s .l end ; define-function test,undo << testing undo >> *undo-point* undo test,undo << undefined >> *undo-point* << undefined >> << with global-naming-stack >> undo-point:create : *undo-point* ; define-variable,with-tos : test,undo << -- >> "before undo" .s .l end ; define-function test,undo << before undo >> : test,undo << -- >> "after undo" .s .l end ; define-function test,undo << after undo >> *undo-point* undo test,undo << undefined >> *undo-point* << undefined >> #+end_src *** test undo with syntax-stack #+begin_src cicada-nymph undo-point:create : *undo-point* ; define-variable,with-tos syntax-rule-set:*word-interpreter* jo integer-string? jo hi syntax-rule:add syntax-rule-set:*word-interpreter* push-syntax-stack 123 drop2 << hi >> syntax-stack:*pointer* syntax-stack:*address* sub *cell-size* div . << 2 >> << report:syntax >> *undo-point* undo 123 . << 123 >> syntax-stack:*pointer* syntax-stack:*address* sub *cell-size* div . << 1 >> << report:syntax >> #+end_src *** test undo with alias #+begin_src cicada-nymph undo-point:create : *undo-point* ; define-variable,with-tos : test,undo << -- >> "testing undo" .s .l end ; define-function "t,u" "test,undo" alias test,undo << testing undo >> t,u << testing undo >> *undo-point* undo test,undo << undefined >> t,u << undefined >> *undo-point* << undefined >> << with global-naming-stack >> undo-point:create : *undo-point* ; define-variable,with-tos : test,undo << -- >> "before undo" .s .l end ; define-function "t,u" "test,undo" alias test,undo << before undo >> t,u << before undo >> : test,undo << -- >> "after undo" .s .l end ; define-function test,undo << after undo >> t,u << before undo >> "t,u" "test,undo" alias t,u << after undo >> *undo-point* undo test,undo << undefined >> t,u << undefined >> *undo-point* << undefined >> #+end_src * pre-module:*syntax-rule-set* #+begin_src cicada-nymph :tangle core.cn : pre-module:*syntax-rule-set:size* 1024 *cell-size* mul ; define-variable << for cursor >> *cell-size* allocate-memory drop : pre-module:*syntax-rule-set* pre-module:*syntax-rule-set:size* allocate-memory ; define-variable pre-module:*syntax-rule-set* pre-module:*syntax-rule-set* *cell-size* sub set #+end_src * syntax-rule-set:*post-module* #+begin_src cicada-nymph :tangle core.cn : post-module:*syntax-rule-set:size* 1024 *cell-size* mul ; define-variable << for cursor >> *cell-size* allocate-memory drop : syntax-rule-set:*post-module* post-module:*syntax-rule-set:size* allocate-memory ; define-variable syntax-rule-set:*post-module* syntax-rule-set:*post-module* *cell-size* sub set #+end_src * module-buffer *** module-meta-begin-word? #+begin_src cicada-nymph :tangle core.cn : module-meta-begin-word? << string[address, length] -- bool >> dup 6 less-than? if drop2 false end then ":" string:byte string:full-of-the-same-byte? end ; define-function #+end_src *** module-meta-end-word? #+begin_src cicada-nymph :tangle core.cn : module-meta-end-word? << string[address, length] -- bool >> dup 6 less-than? if drop2 false end then "=" string:byte string:full-of-the-same-byte? end ; define-function #+end_src *** module-meta-word? #+begin_src cicada-nymph :tangle core.cn : module-meta-word? << string[address, length] -- bool >> dup2 module-meta-begin-word? if drop2 true end then dup2 module-meta-end-word? if drop2 true end then dup 1 less-or-equal? if drop2 false end then >:length >:address :address :length add sub1 get-byte >:last-byte :address :length add sub1 sub1 get-byte >:the-byte-before-last-byte :last-byte ":" string:byte equal? not if false end then :the-byte-before-last-byte ":" string:byte equal? if false end then true end ; define-function #+end_src *** test module-meta-begin-word? & module-meta-begin-word? #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) module-meta-begin-word? & module-meta-begin-word?" .s .l "::::::" module-meta-begin-word? true? "======" module-meta-end-word? true? and ":::::" module-meta-begin-word? false? and "=====" module-meta-end-word? false? and ":::><:::" module-meta-begin-word? false? and "===><===" module-meta-end-word? false? and test ; test-do #+end_src *** 記謂詞 * 作用於 module-buffer 的函數均假設 module-buffer 格式良好在調用它們之前應該利用有關謂詞保證其格式良好 * 謂詞是針對 module-buffer 的 [即針對字符串的] 而不是針對文件的否則就會重複閱讀文件 *** module-buffer:good-format? #+begin_src cicada-nymph :tangle core.cn : module-buffer:good-format? << module-buffer[address, length] -- bool >> dup2 string:space? if drop2 false end then dup2 string:word module-meta-begin-word? not if drop2 false end then jo module-meta-end-word? string:any-word end ; define-function #+end_src *** test module-buffer:good-format? #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) module-buffer:good-format" .s .l " ::::::::: import: combinator math module: assembler ========= hi kkk took my baby away! " module-buffer:good-format? true? " ::::::::: import: combinator math module: assembler hi kkk took my baby away! " module-buffer:good-format? false? and test ; test-do #+end_src *** module-buffer:get-code-string #+begin_src cicada-nymph :tangle core.cn : module-buffer:get-code-string << module-buffer[address, length] -- meta-string[address, length] >> dup2 string:word module-meta-end-word? if string:word-tail end then string:word-tail loop ; define-function #+end_src *** module-buffer:get-meta-string #+begin_src cicada-nymph :tangle core.cn : module-buffer:get-meta-string,loop << module-buffer[address, length] -- cursor >> dup2 string:word module-meta-end-word? if string:word-tail drop end then string:word-tail loop ; define-function : module-buffer:get-meta-string << module-buffer[address, length] -- meta-string[address, length] >> dup2 module-buffer:get-meta-string,loop >:cursor drop >:address :address :cursor :address sub end ; define-function #+end_src *** test module-buffer:get-meta-string #+begin_src cicada-nymph :tangle core-test.cn : "* (testing) module-buffer:get-meta-string" .s .l " ::::::::: import: combinator math module: assembler ========= hi kkk took my baby away! " module-buffer:get-meta-string " ::::::::: import: combinator math module: assembler =========" string:equal? test ; test-do #+end_src * import & load & load-with-test *** 記避免相互遞歸函數 * 沒有相互遞歸函數 (load) (import) 不可相互調用加載[load] 不是遞歸函數而待引入[import] 是遞歸函數而覺 * 分析一下遞歸函數每次分析遞歸函數就是要知道 1. 如何展開每個遞歸調用就是展開展開就是返回棧增加一珠珠分配內存給局部數據 2. 如何收回每次函數退出就是收回 3. 比如 pre-function recur post-function end 其中 pre-function 是展開過程中調用的函數調用它們的順序是珠珠入棧的順序而 post-function 是收回過程中調用的函數調用它們的順序是珠珠出棧的順序考錄返回棧之變化情況就很清楚啦這次 1. 展開入引入棧 2. 遞歸遞歸發生在對語法關鍵詞 "import:" 的處理過程中 3. 返回入加載棧解釋代碼 *** name->module-prefix #+begin_src cicada-nymph :tangle core.cn : name->module-prefix << name -- module-prefix >> >:name 512 allocate-local-memory >:buffer "|" :name name->string "|" :buffer 3 n-string->buffer! >:length :buffer :length string->name end ; define-function #+end_src *** import #+begin_src cicada-nymph :tangle core.cn : import << module-name-string[address, length] -- >> >::module-name-string ::module-name-string string->name >:module-name-index :module-name-index name->module-prefix >:module-prefix :module-name-index module-stack:find if drop end then :module-name-index importing-stack:find if "* (import) circular import of : " .s ::module-name-string .s .l 'fail-to-load awake then ::module-name-string moi:find not if "* (import) can not find module : " .s ::module-name-string .s .l 'fail-to-load awake then >::module-path 64 1024 mul allocate-local-memory >:buffer :buffer 64 1024 mul ::module-path file:read >:length :buffer :length module-buffer:good-format? not if "* (import) fail to import module : " .s ::module-name-string .s .l " for the file is not well formated cicada-nymph source code" .s .l 'fail-to-load awake then :buffer :length module-buffer:get-meta-string >::meta-string :buffer :length module-buffer:get-code-string >::code-string false module-stack:*pointer* module-info:set-tested-flag false importing-stack:*pointer* importing-record:set-testing-flag :module-name-index importing-stack:*pointer* importing-record:set-name importing-stack:*unit* address importing-stack:*pointer* add-set global-naming-stack:*pointer* >:global-name-record-before-import pre-module:*syntax-rule-set* push-syntax-stack ::meta-string eval-string drop-syntax-stack global-naming-stack:*pointer* >:global-name-record-begin syntax-rule-set:*word-interpreter* push-syntax-stack ::code-string eval-string drop-syntax-stack global-naming-stack:*pointer* >:global-name-record-end syntax-rule-set:*post-module* push-syntax-stack ::meta-string eval-string drop-syntax-stack importing-stack:drop module-naming-stack:*pointer* >:module-name-record-begin :global-name-record-begin :global-name-record-end :module-prefix global-naming-stack:prefix-naming module-naming-stack:*pointer* >:module-name-record-end :global-name-record-before-import global-naming-stack:*pointer* global-naming-stack:clear-naming :global-name-record-before-import address global-naming-stack:*pointer* set :module-name-record-begin module-stack:*pointer* module-info:set-name-record-begin :module-name-record-end module-stack:*pointer* module-info:set-name-record-end ::meta-string module-stack:*pointer* module-info:set-meta-string :module-name-index module-stack:*pointer* module-info:set-name module-stack:*unit* address module-stack:*pointer* add-set end ; define-function #+end_src *** module-syntax:unknow-meta-word #+begin_src cicada-nymph :tangle core.cn : module-syntax:unknow-meta-word,loop << -- >> read-word module-meta-word? if unread-word end then loop ; define-function : module-syntax:unknow-meta-word << meta-word -- >> drop2 module-syntax:unknow-meta-word,loop end ; define-function #+end_src *** pre-module-syntax ***** meta-literal-word:import? #+begin_src cicada-nymph :tangle core.cn : meta-literal-word:import? << word[address, length] -- bool >> "import:" string:equal? end ; define-function #+end_src ***** pre-module-syntax:import * import module and expose-naming one by one #+begin_src cicada-nymph :tangle core.cn : pre-module-syntax:import,loop << -- unknow >> read-word >::word ::word string->name >:name ::word module-meta-word? if unread-word end then ::word import :name module-stack:find not if "* (pre-module-syntax:import,loop) after import module : " .s :name name->string .s .l " still can not find it in the module-stack" .s .l end then >:module-info :module-info module-info:get-name-record-begin :module-info module-info:get-name-record-end module-naming-stack:expose-naming loop ; define-function : pre-module-syntax:import << meta-literal-word:import -- unknow >> drop2 pre-module-syntax:import,loop end ; define-function #+end_src ***** add syntax-rule * the order matters #+begin_src cicada-nymph :tangle core.cn pre-module:*syntax-rule-set* syntax-rule-set:*word-interpreter* syntax-rule-set:mixin pre-module:*syntax-rule-set* jo module-meta-word? jo module-syntax:unknow-meta-word syntax-rule:add pre-module:*syntax-rule-set* jo module-meta-begin-word? jo drop2 syntax-rule:add pre-module:*syntax-rule-set* jo module-meta-end-word? jo drop2 syntax-rule:add pre-module:*syntax-rule-set* jo meta-literal-word:import? jo pre-module-syntax:import syntax-rule:add #+end_src *** post-module-syntax ***** meta-literal-word:do? #+begin_src cicada-nymph :tangle core.cn : meta-literal-word:do? << word[address, length] -- bool >> "do:" string:equal? end ; define-function #+end_src ***** post-module-syntax:do #+begin_src cicada-nymph :tangle core.cn : post-module-syntax:do,loop << -- >> read-word >::word ::word module-meta-word? if unread-word end then ::word word-interpreter loop ; define-function : post-module-syntax:do << meta-literal-word:do -- >> drop2 post-module-syntax:do,loop end ; define-function #+end_src ***** add syntax-rule #+begin_src cicada-nymph :tangle core.cn syntax-rule-set:*post-module* syntax-rule-set:*word-interpreter* syntax-rule-set:mixin syntax-rule-set:*post-module* jo module-meta-word? jo module-syntax:unknow-meta-word syntax-rule:add syntax-rule-set:*post-module* jo module-meta-begin-word? jo drop2 syntax-rule:add syntax-rule-set:*post-module* jo module-meta-end-word? jo drop2 syntax-rule:add syntax-rule-set:*post-module* jo meta-literal-word:do? jo post-module-syntax:do syntax-rule:add #+end_src *** test #+begin_src cicada-nymph << in system shell cn moi add hi module/hi.cn cn moi add hihi module/hihi.cn >> "hihi" import hihi << undefined >> : *test-module-info* name hihi module-stack:find if else "* can not found hihi" .s .l then ; define-variable *test-module-info* module-info:get-meta-string .s .l *test-module-info* module-info:get-name name->string .s .l hihi << undefined >> *test-module-info* module-info:get-name-record-begin *test-module-info* module-info:get-name-record-end module-naming-stack:expose-naming hihi #+end_src *** load #+begin_src cicada-nymph :tangle core.cn : load << module-name-string[address, length] -- >> >::module-name-string ::module-name-string undo-point:create reading-stack:*pointer* << module-name-string[address, length], undo-point reading-stack:*pointer* -- >> [ action,reset-the-stack << module-name-string[address, length], undo-point reading-stack:*pointer* -- >> address reading-stack:*pointer* set undo "* (load) can not load : " .s .s .l end ] 'fail-to-load await ::module-name-string string->name >:module-name-index :module-name-index name->module-prefix >:module-prefix :module-name-index module-stack:find if drop "* (load) the following module is already loaded : " .s ::module-name-string .s .l 'fail-to-load awake then :module-name-index importing-stack:find if "* (load) circular import of : " .s ::module-name-string .s .l 'fail-to-load awake then ::module-name-string moi:find not if "* (load) can not find module : " .s ::module-name-string .s .l 'fail-to-load awake then >::module-path 64 1024 mul allocate-local-memory >:buffer :buffer 64 1024 mul ::module-path file:read >:length :buffer :length module-buffer:good-format? not if "* (load) fail to import module : " .s ::module-name-string .s .l " for the file is not well formated cicada-nymph source code" .s .l 'fail-to-load awake then :buffer :length module-buffer:get-meta-string >::meta-string :buffer :length module-buffer:get-code-string >::code-string false module-stack:*pointer* module-info:set-tested-flag false importing-stack:*pointer* importing-record:set-testing-flag :module-name-index importing-stack:*pointer* importing-record:set-name importing-stack:*unit* address importing-stack:*pointer* add-set global-naming-stack:*pointer* >:global-name-record-before-import pre-module:*syntax-rule-set* push-syntax-stack ::meta-string eval-string drop-syntax-stack global-naming-stack:*pointer* >:global-name-record-begin syntax-rule-set:*word-interpreter* push-syntax-stack ::code-string eval-string drop-syntax-stack global-naming-stack:*pointer* >:global-name-record-end syntax-rule-set:*post-module* push-syntax-stack ::meta-string eval-string drop-syntax-stack importing-stack:drop module-naming-stack:*pointer* >:module-name-record-begin :global-name-record-begin :global-name-record-end :module-prefix global-naming-stack:prefix-naming module-naming-stack:*pointer* >:module-name-record-end :global-name-record-before-import global-naming-stack:*pointer* global-naming-stack:clear-naming :global-name-record-before-import address global-naming-stack:*pointer* set :module-name-record-begin module-stack:*pointer* module-info:set-name-record-begin :module-name-record-end module-stack:*pointer* module-info:set-name-record-end ::meta-string module-stack:*pointer* module-info:set-meta-string :module-name-index module-stack:*pointer* module-info:set-name module-stack:*unit* address module-stack:*pointer* add-set drop drop drop2 end ; define-function #+end_src *** test #+begin_src cicada-nymph << in system shell cn moi add hi module/hi.cn cn moi add hihi module/hihi.cn >> "hihi" load hihi << undefined >> : *test-module-info* name hihi module-stack:find if else "* can not found hihi" .s .l then ; define-variable *test-module-info* module-info:get-meta-string .s .l *test-module-info* module-info:get-name name->string .s .l hihi << undefined >> *test-module-info* module-info:get-name-record-begin *test-module-info* module-info:get-name-record-end module-naming-stack:expose-naming hihi report:memory "no" load "hihi" load report:memory #+end_src *** load-with-test #+begin_src cicada-nymph :tangle core.cn : load-with-test << module-name-string[address, length] -- >> >::module-name-string ::module-name-string undo-point:create reading-stack:*pointer* << module-name-string[address, length], undo-point reading-stack:*pointer* -- >> [ action,reset-the-stack << module-name-string[address, length], undo-point reading-stack:*pointer* -- >> address reading-stack:*pointer* set undo "* (load-with-test) can not load : " .s .s .l end ] 'fail-to-load await ::module-name-string string->name >:module-name-index :module-name-index name->module-prefix >:module-prefix :module-name-index module-stack:find if drop "* (load-with-test) the following module is already loaded : " .s ::module-name-string .s .l 'fail-to-load awake then :module-name-index importing-stack:find if "* (load-with-test) circular import of : " .s ::module-name-string .s .l 'fail-to-load awake then ::module-name-string moi:find not if "* (load-with-test) can not find module : " .s ::module-name-string .s .l 'fail-to-load awake then >::module-path 64 1024 mul allocate-local-memory >:buffer :buffer 64 1024 mul ::module-path file:read >:length :buffer :length module-buffer:good-format? not if "* (load-with-test) fail to import module : " .s ::module-name-string .s .l " for the file is not well formated cicada-nymph source code" .s .l 'fail-to-load awake then :buffer :length module-buffer:get-meta-string >::meta-string :buffer :length module-buffer:get-code-string >::code-string true module-stack:*pointer* module-info:set-tested-flag 0 module-stack:*pointer* module-info:set-success-counter 0 module-stack:*pointer* module-info:set-fail-counter true importing-stack:*pointer* importing-record:set-testing-flag :module-name-index importing-stack:*pointer* importing-record:set-name importing-stack:*unit* address importing-stack:*pointer* add-set global-naming-stack:*pointer* >:global-name-record-before-import pre-module:*syntax-rule-set* push-syntax-stack ::meta-string eval-string drop-syntax-stack global-naming-stack:*pointer* >:global-name-record-begin syntax-rule-set:*word-interpreter* push-syntax-stack ::code-string eval-string drop-syntax-stack global-naming-stack:*pointer* >:global-name-record-end syntax-rule-set:*post-module* push-syntax-stack ::meta-string eval-string drop-syntax-stack importing-stack:drop module-naming-stack:*pointer* >:module-name-record-begin :global-name-record-begin :global-name-record-end :module-prefix global-naming-stack:prefix-naming module-naming-stack:*pointer* >:module-name-record-end :global-name-record-before-import global-naming-stack:*pointer* global-naming-stack:clear-naming :global-name-record-before-import address global-naming-stack:*pointer* set :module-name-record-begin module-stack:*pointer* module-info:set-name-record-begin :module-name-record-end module-stack:*pointer* module-info:set-name-record-end ::meta-string module-stack:*pointer* module-info:set-meta-string :module-name-index module-stack:*pointer* module-info:set-name "* (load-with-test) load : " .s ::module-name-string .s .l " success : " .s module-stack:*pointer* module-info:get-success-counter .i .l " fali : " .s module-stack:*pointer* module-info:get-fail-counter .i .l module-stack:*unit* address module-stack:*pointer* add-set drop drop drop2 end ; define-function #+end_src *** test-function #+begin_src cicada-nymph :tangle core.cn : test-function << string[address, length] -- >> importing-stack:*pointer* importing-stack:*unit* sub importing-record:get-testing-flag if define-function end then drop2 end ; define-function #+end_src *** test-variable #+begin_src cicada-nymph :tangle core.cn : test-variable << string[address, length] -- >> importing-stack:*pointer* importing-stack:*unit* sub importing-record:get-testing-flag if define-variable end then drop2 end ; define-function #+end_src *** test-variable,with-tos #+begin_src cicada-nymph :tangle core.cn : test-variable,with-tos << string[address, length] -- >> importing-stack:*pointer* importing-stack:*unit* sub importing-record:get-testing-flag if define-variable,with-tos end then drop2 end ; define-function #+end_src *** test-do #+begin_src cicada-nymph :tangle core.cn : test-do << string[address, length] -- >> importing-stack:*pointer* importing-stack:*unit* sub importing-record:get-testing-flag if eval-string end then drop2 end ; define-function #+end_src *** the function test #+begin_src cicada-nymph :tangle core.cn : test << bool -- >> if " (success)" .s .l module-stack:*pointer* module-info:inc-success-counter else " (fail)" .s .l module-stack:*pointer* module-info:inc-fail-counter then end ; define-function #+end_src *** test #+begin_src cicada-nymph << in system shell cn moi add hi module/hi.cn cn moi add hihi module/hihi.cn >> "hihi" load-with-test hihi << undefined >> : *test-module-info* name hihi module-stack:find if else "* can not found hihi" .s .l then ; define-variable *test-module-info* module-info:get-meta-string .s .l *test-module-info* module-info:get-name name->string .s .l hihi << undefined >> *test-module-info* module-info:get-name-record-begin *test-module-info* module-info:get-name-record-end module-naming-stack:expose-naming hihi report:memory "no" load-with-test "hihi" load-with-test report:memory #+end_src *** test with gamber #+begin_src cicada-nymph "gamber" load-with-test #+end_src * type * report *** report:memory #+begin_src cicada-nymph :tangle core.cn : report:memory << -- >> "* *un-initialized-memory*" .s .l " * size : " .s *un-initialized-memory,size* . .l " * used : " .s *un-initialized-memory,current-free-address* *un-initialized-memory* sub . .l " * free : " .s *un-initialized-memory,size* *un-initialized-memory,current-free-address* *un-initialized-memory* sub sub . .l "* *string-area*" .s .l " * size : " .s *string-area,size* . .l " * used : " .s *string-area,current-free-address* *string-area* sub . .l " * free : " .s *string-area,size* *string-area,current-free-address* *string-area* sub sub . .l "* *jojo-area*" .s .l " * size : " .s *jojo-area,size* . .l " * used : " .s *jojo-area,current-free-address* *jojo-area* sub . .l " * free : " .s *jojo-area,size* *jojo-area,current-free-address* *jojo-area* sub sub . .l end ; define-function #+end_src *** report:syntax #+begin_src cicada-nymph :tangle core.cn : report:syntax << -- >> "* jojo-compiler:*syntax-rule-set* :" .s .l jojo-compiler:*syntax-rule-set* syntax-rule-set:list "* syntax-rule-set:*word-interpreter* :" .s .l syntax-rule-set:*word-interpreter* syntax-rule-set:list "* tos-syntax-stack :" .s .l tos-syntax-stack syntax-rule-set:list end ; define-function #+end_src *** global-naming-stack:list-by-jo-predicate * 最後寫到珠典裏的被最先打印出來 #+begin_src cicada-nymph :tangle core.cn : global-naming-stack:list-by-jo-predicate,loop << jo-predicate, counter, cursor -- >> dup global-naming-stack:*pointer* equal? if drop drop drop end then >:cursor >:counter >:jo-predicate :cursor name-record:get-new-jo :jo-predicate apply if " " .s :counter .i ". " .s :counter add1 >:counter :cursor name-record:get-name name->string .s .l then :jo-predicate :counter :cursor global-naming-stack:*unit* add loop ; define-function : global-naming-stack:list-by-jo-predicate << jo-predicate -- >> 1 *global-naming-stack* global-naming-stack:list-by-jo-predicate,loop end ; define-function #+end_src *** report:global-naming-stack * different types of words in link are showed separately #+begin_src cicada-nymph :tangle core.cn : report:global-naming-stack << -- >> "* all primitive-function in global-naming-stack :" .s .l jo primitive-function-jo? global-naming-stack:list-by-jo-predicate "* all function in global-naming-stack :" .s .l jo function-jo? global-naming-stack:list-by-jo-predicate "* all variable in global-naming-stack :" .s .l jo variable-jo? global-naming-stack:list-by-jo-predicate end ; define-function #+end_src *** report:system #+begin_src cicada-nymph :tangle core.cn : report:system << -- >> "* (system) " .s *cell-size* 8 mul .i "bit" .s " " .s platform .s .l end ; define-function #+end_src * hi #+begin_src cicada-nymph :tangle core.cn 0 : *hi,random-base* ; define-variable,with-tos : hi,random << -- random-number >> 0 syscall-number:*times* 1 syscall 13 mod << *hi,random-base* *hi,random-base* add1 13 mod address *hi,random-base* set >> end ; define-function : hi,say << number -- >> dup 0 equal? if drop "cica cica da yaya !!!" .s .l end then dup 1 equal? if drop "hi ^-^" .s .l end then dup 2 equal? if drop "hello :)" .s .l end then dup 3 equal? if drop "hey *^-^*" .s .l end then dup 4 equal? if drop "hiya \^o^/" .s .l end then dup 5 equal? if drop "I wish you a lovely day" .s .l end then dup 6 equal? if drop "I wish you a lovely day { or night :P }" .s .l end then dup 7 equal? if drop "o.o" .s .l end then dup 8 equal? if drop "O.o" .s .l end then dup 9 equal? if drop "o.O" .s .l end then drop "lovely ^3^" .s .l end ; define-function : hi << -- >> hi,random hi,say end ; define-function #+end_src * help #+begin_src cicada-nymph :tangle core.cn : help << -- >> "* helpful documentations will be written soon" .s .l " please wait ^-^" .s .l end ; define-function #+end_src * command line interface *** command-function:unknow-function #+begin_src cicada-nymph :tangle core.cn : command-function:unknow-function << -- >> "* (cicada-nymph) unknow command-line-function : " .s get-command-line string:word-tail string:word .s .l " good bye ^-^/" .s .l bye ; define-function #+end_src *** command-function:stack-REPL #+begin_src cicada-nymph :tangle core.cn : command-function:stack-REPL << -- >> .l "* (cicada-nymph) " .s hi report:system "* (stack-REPL) is where you are now" .s .l " eval a word print the stack" .s .l argument-stack:pretty-print jo stack-REPL reset-top-level-REPL ; define-function #+end_src *** command-function:basic-REPL #+begin_src cicada-nymph :tangle core.cn : command-function:basic-REPL << -- >> .l "* (cicada-nymph) " .s hi report:system "* (basic-REPL) is where you are now" .s .l " this REPL does not print any thing automaticly" .s .l jo basic-REPL reset-top-level-REPL ; define-function #+end_src *** command-function:poi * cn poi add

* cn poi sub * cn poi up

* cn poi find * cn poi list #+begin_src cicada-nymph :tangle core.cn : command-function:poi << -- >> get-command-line string:word-tail string:word-tail >::command-line ::command-line string:space? if poi:help bye then ::command-line string:word >::sub-function-name ::command-line string:word-tail >::command-line-arguments ::sub-function-name "help" string:equal? if poi:help bye then ::sub-function-name "add" string:equal? if ::command-line-arguments string:word ::command-line-arguments string:word-tail string:word poi:add bye then ::sub-function-name "sub" string:equal? if ::command-line-arguments string:word poi:sub bye then ::sub-function-name "up" string:equal? if ::command-line-arguments string:word ::command-line-arguments string:word-tail string:word poi:up bye then ::sub-function-name "find" string:equal? if ::command-line-arguments string:word poi:find if .s .l else "no found" .s .l then bye then ::sub-function-name "list" string:equal? if poi:list bye then "* (command-function:poi) meets argument that (command-function:poi) can not understand" .s .l " it is the following command-line that is confusing (command-function:poi) :" .s .l " " .s report:command-line .l " to get some help info you can type :" .s .l " cn poi help" .s .l " good bye ^-^/" .s .l bye ; define-function #+end_src *** command-function:moi * cn module add

* cn module sub * cn module up

* cn module find * cn module list #+begin_src cicada-nymph :tangle core.cn : command-function:moi << -- >> get-command-line string:word-tail string:word-tail >::command-line ::command-line string:space? if moi:help bye then ::command-line string:word >::sub-function-name ::command-line string:word-tail >::command-line-arguments ::sub-function-name "help" string:equal? if moi:help bye then ::sub-function-name "add" string:equal? if ::command-line-arguments string:word ::command-line-arguments string:word-tail string:word moi:add bye then ::sub-function-name "sub" string:equal? if ::command-line-arguments string:word moi:sub bye then ::sub-function-name "up" string:equal? if ::command-line-arguments string:word ::command-line-arguments string:word-tail string:word moi:up bye then ::sub-function-name "find" string:equal? if ::command-line-arguments string:word moi:find if .s .l else "no found" .s .l then bye then ::sub-function-name "list" string:equal? if moi:list bye then "* (command-function:moi) meets argument that (command-function:moi) can not understand" .s .l " it is the following command-line that is confusing (command-function:moi) :" .s .l " " .s report:command-line .l " to get some help info you can type :" .s .l " cn module help" .s .l " good bye ^-^/" .s .l bye ; define-function #+end_src *** command-function:load #+begin_src cicada-nymph :tangle core.cn : command-function:load << -- >> get-command-line string:word-tail string:word-tail >::command-line ::command-line string:space? if "* (command-function:load) is called with no argument" .s .l " it should be called with a name of module" .s .l bye then ::command-line string:word load bye ; define-function #+end_src *** command-function:load-with-test #+begin_src cicada-nymph :tangle core.cn : command-function:load-with-test << -- >> get-command-line string:word-tail string:word-tail >::command-line ::command-line string:space? if "* (command-function:load-with-test) is called with no argument" .s .l " it should be called with a name of module" .s .l bye then ::command-line string:word load-with-test bye ; define-function #+end_src *** command-function:no-function #+begin_src cicada-nymph :tangle core.cn : command-function:no-function << -- >> command-function:stack-REPL end ; define-function #+end_src *** command:dispatch #+begin_src cicada-nymph :tangle core.cn : command:dispatch << -- >> get-command-line string:word-tail dup2 string:space? if drop2 command-function:no-function end then string:word >::1st-word ::1st-word "basic-REPL" string:equal? if command-function:basic-REPL end then ::1st-word "stack-REPL" string:equal? if command-function:stack-REPL end then ::1st-word "poi" string:equal? if command-function:poi end then ::1st-word "moi" string:equal? if command-function:moi end then ::1st-word "load" string:equal? if command-function:load end then ::1st-word "load-with-test" string:equal? if command-function:load-with-test end then command-function:unknow-function end ; define-function #+end_src * *the story begin* #+begin_src cicada-nymph :tangle core.cn command:dispatch #+end_src * test #+begin_src cicada-nymph "core-test" load-with-test report:system report:memory report:global-naming-stack << report:syntax report:command-line report:environment-variable >> #+end_src