Skip to content

Commit ac72831

Browse files
RexagonRexagon
committed
Add GetOpt.fif to libraries
1 parent 703afa1 commit ac72831

File tree

5 files changed

+151
-19
lines changed

5 files changed

+151
-19
lines changed

‎Cargo.lock

+16-16
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎cli/Cargo.toml

+2-2
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
name = "fift-cli"
33
description = "A CLI for the Fift esoteric language interpreter"
44
repository = "https://github.com/broxus/fift"
5-
version = "0.1.21"
5+
version = "0.1.22"
66
edition = "2021"
77
rust-version = "1.70"
88
include = ["src/**/*.rs", "src/**/*.fif", "LICENSE", "README.md"]
@@ -21,4 +21,4 @@ rustyline = { version = "12.0", default-features = false }
2121
unicode-width = "0.1"
2222

2323
fift = { path = "..", version = "=0.1.21" }
24-
fift-libs = { path = "../libs", version = "0.1.19" }
24+
fift-libs = { path = "../libs", version = "0.1.22" }

‎libs/Cargo.toml

+1-1
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
name = "fift-libs"
33
description = "A maintained collection of default Fift libraries"
44
repository = "https://github.com/broxus/fift"
5-
version = "0.1.19"
5+
version = "0.1.22"
66
edition = "2021"
77
rust-version = "1.70"
88
include = ["src/**/*.rs", "src/**/*.fif", "LICENSE", "LICENSE.fif", "README.md"]

‎libs/src/GetOpt.fif

+131
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,131 @@
1+
library GetOpt // Simple command-line options parser
2+
"Lists.fif" include
3+
4+
// May be used as follows:
5+
// begin-options
6+
// "h" { ."Help Message" 0 halt } short-option
7+
// "v" { parse-int =: verbosity } short-option-arg
8+
// "i" "--interactive" { true =: interactive } short-long-option
9+
// parse-options
10+
11+
// ( l -- l') computes tail of list l if non-empty; else ()
12+
{ dup null? ' cdr ifnot } : safe-cdr
13+
// ( l c -- l') deletes first c elements from list l
14+
{ ' safe-cdr swap times } : list-delete-first
15+
// ( l n c -- l' ) deletes c elements starting from n-th in list l
16+
recursive list-delete-range {
17+
dup 0<= { 2drop } {
18+
over 0<= { nip list-delete-first } {
19+
swap 1- swap rot uncons 2swap list-delete-range cons
20+
} cond } cond
21+
} swap !
22+
// ( n c -- ) deletes $n .. $(n+c-1) from the argument list $*
23+
{ swap 1- $* @ swap rot list-delete-range $* ! } : $*del..
24+
// ( s s' -- ? ) checks whether s' is a prefix of s
25+
{ tuck $len over $len over >= { $| drop $= } { 2drop drop false } cond
26+
} : $pfx?
27+
// ( s -- ? ) checks whether s is an option (a string beginning with '-')
28+
{ dup $len 1 > { "-" $pfx? } { drop false } cond } : is-opt?
29+
// ( s -- ? ) checks whether s is a digit option
30+
{ 2 $| drop 1 $| nip $>B 8 B>u@ dup 57 <= swap 48 >= and } : is-digit-opt?
31+
0 box constant disable-digit-opts
32+
// ( l -- s i or 0 ) finds first string in l beginning with '-'
33+
{ 0 { 1+ over null? { 2drop 0 true } {
34+
swap uncons over is-opt?
35+
{ disable-digit-opts @ { over is-digit-opt? not } { true } cond } { false } cond
36+
{ drop swap true } { nip swap false } cond
37+
} cond } until
38+
} : list-find-opt
39+
// ( -- s i or 0 ) finds first option in cmdline args
40+
{ $* @ list-find-opt } : first-opt
41+
' second : get-opt-flags
42+
' first : get-opt-exec
43+
// ( s t -- ? ) checks whether short/long option s matches description t
44+
{ third $= } : short-option-matches
45+
{ dup get-opt-flags 4 and 0= 3 + [] $=
46+
} : long-option-matches
47+
// ( t -- s -1 or 0 ) extracts help message from description
48+
{ dup get-opt-flags 4 and 0= 4 + over count over >
49+
{ [] true } { 2drop false } cond
50+
} : get-opt-help
51+
// ( s l -- t -1 or 0 ) finds short/long option s in list l
52+
{ swap 1 { swap short-option-matches } does assoc-gen
53+
} : lookup-short-option
54+
{ swap 1 { swap long-option-matches } does assoc-gen
55+
} : lookup-long-option
56+
// ( s -- s' null or s' s'' ) Splits long option --opt=arg at '='
57+
{ dup "=" $pos 1+ ?dup { tuck $| swap rot 1- $| drop swap } { null } cond
58+
} : split-longopt
59+
// ( l -- f or 0 ) Extracts global option flags from first entry of l
60+
{ dup null? { drop 0 } { car get-opt-flags -256 and } cond
61+
} : get-global-option-flags
62+
variable options-list
63+
// ( l -- i or 0 )
64+
// parses command line arguments according to option description list l
65+
// and returns index i of first incorrect option
66+
{ dup options-list ! get-global-option-flags
67+
256 and disable-digit-opts !
68+
{ first-opt dup 0= { true } {
69+
swap dup "--" $pfx? { // i s
70+
dup $len 2 = { drop dup 1 $*del.. 0 true } {
71+
split-longopt swap options-list @
72+
lookup-long-option not { drop true } { // i s' t f
73+
dup get-opt-exec swap get-opt-flags 3 and // i s' e f'
74+
2 pick null? { dup 1 = } { dup 0= negate } cond // i s' e f' f''
75+
dup 1 = { 2drop 2drop true } {
76+
{ drop nip over 1+ $() swap execute 2 $*del.. false } {
77+
' nip ifnot execute 1 $*del.. false
78+
} cond } cond } cond } cond } { // i s
79+
1 $| nip {
80+
dup $len 0= { drop 1 $*del.. false true } {
81+
1 $| swap options-list @ // i s' s l
82+
lookup-short-option not { drop true true } { // i s' t
83+
dup get-opt-exec swap get-opt-flags 3 and // i s' e f'
84+
?dup 0= { execute false } {
85+
2 pick $len { drop execute "" false } {
86+
2 = { nip null swap execute "" false } { // i e
87+
nip over 1+ $() swap execute 2 $*del.. false true
88+
} cond } cond } cond } cond } cond } until
89+
} cond
90+
} cond } until
91+
} : getopt
92+
// ( t -- ) Displays help message for one option
93+
{ dup get-opt-flags dup 4 and 2 pick third swap {
94+
."-" type ."/" over 3 [] type } {
95+
dup $len { dup "--" $pfx? { ."-" } ifnot type } {
96+
drop ."usage: " $0 type
97+
} cond } cond
98+
dup 3 and ?dup {
99+
2 = { ."[=<optarg>]" } { ."=<optarg>" } cond
100+
} if
101+
8 and { 9 emit } ifnot
102+
get-opt-help { type } { ."No help available" } cond cr
103+
} : show-opt-help
104+
// ( -- ) Displays options help message according to options-list
105+
{ options-list @ { dup null? not } {
106+
uncons swap show-opt-help
107+
} while drop
108+
} : show-options-help
109+
// ( l -- ) Parses options and throws an error on failure
110+
{ getopt ?dup {
111+
$() "cannot parse command line options near `" swap $+ +"`"
112+
show-options-help abort } if
113+
} : run-getopt
114+
anon constant opt-list-marker
115+
' opt-list-marker : begin-options
116+
{ opt-list-marker list-until-marker } : end-options
117+
{ end-options run-getopt } : parse-options
118+
// ( s e -- o ) Creates short/long option s with execution token e
119+
{ 0 rot triple } dup : short-option : long-option
120+
// ( s s' e -- o ) Creates a combined short option s and long option s' with execution token e
121+
{ 4 2swap 4 tuple } : short-long-option
122+
{ 1 rot triple } dup : short-option-arg : long-option-arg
123+
{ 2 rot triple } dup : short-option-?arg : long-option-?arg
124+
{ 5 2swap 4 tuple } : short-long-option-arg
125+
{ 6 2swap 4 tuple } : short-long-option-?arg
126+
// ( o s -- s' ) Adds help message to option
127+
' , : option-help
128+
// ( s f -- o ) Creates a generic help message
129+
{ swap 'nop rot "" 3 roll 4 tuple } : generic-help-setopt
130+
{ 0 generic-help-setopt } : generic-help
131+
256 constant disable-digit-options

‎libs/src/lib.rs

+1
Original file line numberDiff line numberDiff line change
@@ -58,5 +58,6 @@ define_libs!(
5858
lists => "Lists.fif",
5959
stack => "Stack.fif",
6060
ton_util => "TonUtil.fif",
61+
get_opt => "GetOpt.fif",
6162
]
6263
);

0 commit comments

Comments
 (0)