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