RosettaCodeData/Task/Set-right-adjacent-bits/Quackery/set-right-adjacent-bits.quackery
2023-12-16 21:33:55 -08:00

48 lines
1.1 KiB
Text

[ 2 base put
nextword dup
$ '' = if
[ $ '"bin" needs a number after it.'
message put
bail ]
dup $->n iff
[ nip swap dip join ]
else
[ drop
char " swap join
$ '" is not binary.'
join message put
bail ]
base release ] builds bin ( [ $ --> [ $ )
[ [] unrot
times
[ dup 1 &
rot join swap
1 >> ]
drop
witheach echo ] is echobin ( n n --> )
[ dip dup times
[ 1 >> tuck | swap ]
drop ] is setrightbits ( n --> n )
say "n = 2; Width e = 4:"
cr cr
' [ bin 1000 bin 0100
bin 0010 bin 0001 ]
witheach
[ say "Input b: "
dup 4 echobin cr
say "Result: "
2 setrightbits
4 echobin cr cr ]
4 times
[ say "n = " i^ echo
say " Width e = 66:" cr
say "Input b: "
bin 010000000000100000000010000000010000000100000010000010000100010010
dup 66 echobin cr
say "Result: "
i^ setrightbits
66 echobin cr cr ]