-
Notifications
You must be signed in to change notification settings - Fork 1
/
choose-stack.fs
77 lines (56 loc) · 2.08 KB
/
choose-stack.fs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
\ galope/choose-stack.fs
\ This file is part of Galope
\ http:https://programandala.net/en.program.galope.html
\ Author: Marcos Cruz (programandala.net), 2011, 2012, 2013, 2014,
\ 2016, 2017, 2018.
\ ==============================================================
\ Description
\ A stack used by `choose{` and `2choose`.
\ ==============================================================
\ Requirements
require ./one-minus-store.fs
require ./one-plus-store.fs
require ./two-choose.fs
\ ==============================================================
8 constant /choose-stack
\ Maximum size of the choose stack in cells. This is the maximum
\ number of nestings for `choose{ }choose` and `2choose{ }2choose`.
variable choose-stack-used
\ Cells used in the choose stack.
create choose-stack /choose-stack cells allot
: init-choose-stack ( -- ) 0 choose-stack-used ! ;
init-choose-stack
: choose-stack-tos ( -- a )
choose-stack-used @ 1- cells choose-stack + ;
\ Address of the top of choose stack.
: choose-stack-full? ( -- f )
choose-stack-used @ /choose-stack = ;
\ Is the choose stack full?
: choose-stack-empty? ( -- f )
choose-stack-used @ 0= ;
\ Is the choose stack empty?
: ?choose-stack-full ( -- )
choose-stack-full? abort" The choose stack is full." ;
\ Abort if the choose stack is full.
: >choose-stack ( n -- )
?choose-stack-full
choose-stack-used 1+! choose-stack-tos ! ;
\ Store _n_ in the choose stack.
: ?choose-stack-empty ( -- )
choose-stack-empty? abort" The choose stack is empty." ;
\ Abort if the choose stack is empty.
: <choose-stack ( -- n )
?choose-stack-empty
choose-stack-tos @ choose-stack-used 1-! ;
\ Fetch the top of the choose stack.
\ ==============================================================
\ Change log
\ 2016-07-22: Move from the old module <random_strings.fs>, improve
\ and rename the words, in order to reuse them for the new `2choose{
\ }2choose` and `choose{ }choose`.
\
\ 2017-11-15: Update `++` to `1+!`, and `--` to `1-!`.
\
\ 2018-05-01: Remove useless requirement of <module.fs>.
\
\ 2018-07-24: Improve file header.