add a new example, and replace example/Abort.rtero with example/trail.retro (thanks to kiyoshi)
FossilOrigin-Name: 436227c70472210ec807ec0f61d69da52cdebefc163ed216ebe78798610531cc
This commit is contained in:
crc
parent
6c2bcd26e4
commit
2c19e55b9a
3 changed files with 102 additions and 52 deletions
|
|
@ -1,52 +0,0 @@
|
||||||
There are people who consider `abort` to be the most
|
|
||||||
fundamental building block in writing programs. For
|
|
||||||
them, it is not just a debugging tool.
|
|
||||||
|
|
||||||
~~~
|
|
||||||
:s:shout (s-) '!_ s:prepend s:put nl 'Stack_:_ s:put dump-stack nl ;
|
|
||||||
{{
|
|
||||||
'Depth var
|
|
||||||
:message (-) 'abort_with_trail_invoked s:shout nl
|
|
||||||
'Do__reset__to_clear_stack. s:put nl ;
|
|
||||||
:put-name (a-) fetch d:lookup-xt
|
|
||||||
dup n:-zero? [ d:name s:put nl ] [ drop ] choose ;
|
|
||||||
---reveal---
|
|
||||||
:trail repeat pop put-name again ;
|
|
||||||
:abort (-?) depth !Depth message trail ;
|
|
||||||
:s:abort (s-) 's:abort_:_ s:prepend s:put nl abort ;
|
|
||||||
}}
|
|
||||||
~~~
|
|
||||||
|
|
||||||
`trail` leaves garbage on the stack.
|
|
||||||
This garbage is difficult to shake off since `trail`
|
|
||||||
destroys the contents of the return stack. The easiest
|
|
||||||
way I have found so far is to `reset` manually.
|
|
||||||
|
|
||||||
To test, run the following code interactively:
|
|
||||||
|
|
||||||
```
|
|
||||||
:a 'aaa s:abort ;
|
|
||||||
:b a ;
|
|
||||||
:c b ;
|
|
||||||
c
|
|
||||||
reset
|
|
||||||
```
|
|
||||||
|
|
||||||
## assert
|
|
||||||
|
|
||||||
~~~
|
|
||||||
:assert (q-) call [ abort ] -if ;
|
|
||||||
:assert.verbous (q-) call [ 'assert_:_fail s:abort ] -if ;
|
|
||||||
~~~
|
|
||||||
|
|
||||||
If `0;` is invoked with an empty stack, it fails and
|
|
||||||
kills the session.
|
|
||||||
|
|
||||||
```
|
|
||||||
:t 'before_ s:put 0; 'after s:put nl ;
|
|
||||||
'#0_t_nl_#1_t_nl s:evaluate
|
|
||||||
'reset_t s:evaluate (--_kills_session
|
|
||||||
```
|
|
||||||
|
|
||||||
If this is dangerous, place an assertion before `0;` .
|
|
||||||
|
|
||||||
31
example/sea-level-rise.retro
Normal file
31
example/sea-level-rise.retro
Normal file
|
|
@ -0,0 +1,31 @@
|
||||||
|
This is a small thing to calculate the potential impact of ice cap melt
|
||||||
|
on the global sea level.
|
||||||
|
|
||||||
|
~~~
|
||||||
|
:ice:ANTARTIC .26.54 .1000000 f:* ; (from_the_bedrock2_survey
|
||||||
|
:ice:GREENLAND .2900000 ; (from_web.viu.ca/earle/geol305
|
||||||
|
:ice:total ice:ANTARTIC ice:GREENLAND f:+ ;
|
||||||
|
:ice:rise<mm> ice:total .361 f:/ ;
|
||||||
|
:ice:rise<m> ice:rise<mm> .1000 f:/ ;
|
||||||
|
:ice:rise<m,adj> ice:rise<m> .0.91 f:* ;
|
||||||
|
|
||||||
|
ice:total 'Total_volume_(km^3):_ s:put f:put nl
|
||||||
|
ice:rise<mm> 'Rise_(mm):___________ s:put f:put nl
|
||||||
|
ice:rise<m> 'Rise_(m):____________ s:put f:put nl nl
|
||||||
|
|
||||||
|
ice:rise<m,adj> 'Rise_(m,_adjusted_for_density):_ s:put f:put nl
|
||||||
|
~~~
|
||||||
|
|
||||||
|
Output:
|
||||||
|
|
||||||
|
Total volume (km^3): 29440000.000000
|
||||||
|
Rise (mm): 81551.246537
|
||||||
|
Rise (m): 81.551247
|
||||||
|
|
||||||
|
Rise (m, adjusted for density): 74.211634
|
||||||
|
|
||||||
|
Sources:
|
||||||
|
|
||||||
|
- bedrock2 survey: https://www.the-cryosphere.net/7/375/2013/tc-7-375-2013.pdf
|
||||||
|
- greenland ice: https://web.viu.ca/earle/geol305/The%20Greenland%20Ice%20Sheet.pdf
|
||||||
|
- sea level rise: https://www.realworldvisuals.com/blog-1/could-rocks-cause-sea-levels-to-rise
|
||||||
71
example/trail.retro
Normal file
71
example/trail.retro
Normal file
|
|
@ -0,0 +1,71 @@
|
||||||
|
Some consider abort to be the most fundamental building block
|
||||||
|
in writing programs. `trail` and `listen` abort execution.
|
||||||
|
|
||||||
|
~~~
|
||||||
|
:s:shout (s-) '!!->_ s:prepend '_<-!! s:append s:put nl ;
|
||||||
|
{{
|
||||||
|
:put-name (a-) fetch d:lookup-xt
|
||||||
|
dup n:-zero? [ d:name s:put nl ] &drop choose ;
|
||||||
|
---reveal---
|
||||||
|
:trail (-0) '1_or_more_0s_left_on_the_stack s:shout
|
||||||
|
repeat pop put-name again ;
|
||||||
|
}}
|
||||||
|
~~~
|
||||||
|
|
||||||
|
`trail` adds at least one 0 ( FALSE flag ) on top of stack.
|
||||||
|
|
||||||
|
```
|
||||||
|
:t0 trail ;
|
||||||
|
:t1 t0 ;
|
||||||
|
:t2 t1 ;
|
||||||
|
t2
|
||||||
|
```
|
||||||
|
|
||||||
|
Example of `0;` killing a session:
|
||||||
|
|
||||||
|
```
|
||||||
|
:t 'before_ s:put 0; 'after s:put nl ;
|
||||||
|
#0 t (works
|
||||||
|
#1 t (works
|
||||||
|
reset t (kills_session
|
||||||
|
```
|
||||||
|
|
||||||
|
If this is dangerous, place a `guard` or a `check` before `0;` .
|
||||||
|
|
||||||
|
~~~
|
||||||
|
:d:ego (-s) d:last d:name compile:lit ; immediate
|
||||||
|
:s:prepend;put s:prepend s:put nl ;
|
||||||
|
:s:trail (s-0) '(_s:trail_)__ s:prepend;put trail ;
|
||||||
|
:s:listen (s-) '(_s:listen_)__ s:prepend;put listen ;
|
||||||
|
|
||||||
|
:guard (q-) call &trail -if ;
|
||||||
|
:check (q-) call &listen -if ;
|
||||||
|
|
||||||
|
:s:guard (sq-) call &drop &s:trail choose ;
|
||||||
|
:s:check (sq-) call &drop &s:listen choose ;
|
||||||
|
~~~
|
||||||
|
|
||||||
|
`check` is less noisy than `trail` .
|
||||||
|
|
||||||
|
```
|
||||||
|
:t0 (q-) 'Doing... s:put nl
|
||||||
|
d:ego '_charlie s:append swap s:guard
|
||||||
|
'Next... s:put nl ;
|
||||||
|
:u0 t0 ;
|
||||||
|
:v0 d:ego '_calling_u0 s:append s:put;nl u0 ;
|
||||||
|
nl nl
|
||||||
|
&TRUE v0 nl
|
||||||
|
&FALSE v0 nl
|
||||||
|
```
|
||||||
|
|
||||||
|
```
|
||||||
|
:t1 (q-) 'Doing... s:put nl
|
||||||
|
d:ego '_ckpt s:append swap s:check
|
||||||
|
'Next... s:put nl ;
|
||||||
|
:u1 t1 ;
|
||||||
|
:v1 d:ego '_calling_u1 s:append s:put;nl u1 ;
|
||||||
|
nl nl
|
||||||
|
&TRUE v1 nl
|
||||||
|
&FALSE v1 nl
|
||||||
|
```
|
||||||
|
|
||||||
Loading…
Reference in a new issue