Lisp problem

[B. Pym]

How can I write this function simply? (in Common Lisp)
-- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.
('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')
-- The order is not important.
If the string has 3 dots, the value is a list of length 8.

SP-Forth

REQUIRE /STRING lib/include/string.f
REQUIRE PLACE ~mak/place.f
REQUIRE { ~ac/lib/locals.f
REQUIRE StringReplace2 ~nn\lib\string.f
REQUIRE printf<[ ~ilya\Lib\win\System\printf.f
REQUIRE list-all ~ygrek/lib/list/all.f \ all words for cons pair lists
list ALSO!
REQUIRE CASE-INS lib/ext/caseins.f \ Case-insensitive.

: get-bin-digits ( u n -- ...) 0 do dup 1 and swap 2 / loop drop ;

: str-0-term ( adr) count + 0 swap c! ;

create form-str 257 allot
0 value cnt
0 value power

: dotty { adr len -- }
\ Doesn't terminate output string with 0-byte.
form-str adr len s" ." s" %d" StringReplace2
form-str str-0-term
len - to cnt drop
1 cnt 0 do 2 * loop to power
power 0 do
printf<[ i cnt get-bin-digits form-str count ]>
type cr
loop
;

s" apple.bun.c" dotty

===>
apple0bun0c
apple0bun1c
apple1bun0c
apple1bun1c


s" apple.bun.c.d" dotty

===>
apple0bun0c0d
apple0bun0c1d
apple0bun1c0d
apple0bun1c1d
apple1bun0c0d
apple1bun0c1d
apple1bun1c0d
apple1bun1c1d

[B. Pym]

Post by B. Pym
SP-Forth
REQUIRE /STRING lib/include/string.f
REQUIRE PLACE ~mak/place.f
REQUIRE { ~ac/lib/locals.f
REQUIRE StringReplace2 ~nn\lib\string.f
REQUIRE printf<[ ~ilya\Lib\win\System\printf.f
REQUIRE list-all ~ygrek/lib/list/all.f \ all words for cons pair lists
list ALSO!
REQUIRE CASE-INS lib/ext/caseins.f \ Case-insensitive.

These are the only requires that are actually needed:

REQUIRE { ~ac/lib/locals.f
REQUIRE StringReplace2 ~nn\lib\string.f
REQUIRE printf<[ ~ilya\Lib\win\System\printf.f
REQUIRE CASE-INS lib/ext/caseins.f \ Case-insensitive.

[B. Pym]

Post by B. Pym

How can I write this function simply? (in Common Lisp)
-- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.
('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')
-- The order is not important.
If the string has 3 dots, the value is a list of length 8.

SP-Forth

Using a list.

REQUIRE { ~ac/lib/locals.f
REQUIRE StringReplace2 ~nn\lib\string.f
REQUIRE printf<[ ~ilya\Lib\win\System\printf.f
REQUIRE list-all ~ygrek/lib/list/all.f \ all words for cons pair lists
list ALSO!
REQUIRE CASE-INS lib/ext/caseins.f \ Case-insensitive.

: get-bin-digits ( u n -- ...) 0 do dup 1 and swap 2 / loop drop ;

: str-0-term ( adr) count + 0 swap c! ;

: s-keep ( cadr len -- adr) here place here 256 allot ;

create form-str 257 allot
0 value cnt
0 value mylist

: dotty { adr len -- }
\ Doesn't terminate output string with 0-byte.
form-str adr len s" ." s" %d" StringReplace2
form-str str-0-term
len - to cnt drop
%[ \ Start a list.
1 cnt 0 do 2 * loop
0 do
printf<[ i cnt get-bin-digits form-str count ]>
s-keep % \ Add to list.
loop
]%
;

s" apple.bun.c.d" dotty to mylist
cr s" Length of list is " type mylist length . cr
mylist :noname count type cr ; iter

===>
Length of list is 8

apple0bun0c0d
apple0bun0c1d
apple0bun1c0d
apple0bun1c1d
apple1bun0c0d
apple1bun0c1d
apple1bun1c0d
apple1bun1c1d



Just for fun, let's add up the lengths of the strings
in the list.

0 mylist :noname count nip + ; iter .
===>
104

Let's convert the strings to uppercase.

REQUIRE UPPERCASE ~ac/lib/string/uppercase.f

mylist :noname count uppercase ; iter
mylist :noname count type cr ; iter
===>
APPLE0BUN0C0D
APPLE0BUN0C1D
APPLE0BUN1C0D
APPLE0BUN1C1D
APPLE1BUN0C0D
APPLE1BUN0C1D
APPLE1BUN1C0D
APPLE1BUN1C1D

Let's sort by the penultimate character.

: get-ch ( cadr n -- chr ) drop 11 + c@ ;

mylist :noname count get-ch swap count get-ch swap < ; sort

mylist :noname count type cr ; iter
===>
APPLE0BUN0C0D
APPLE0BUN1C0D
APPLE1BUN0C0D
APPLE1BUN1C0D
APPLE0BUN0C1D
APPLE0BUN1C1D
APPLE1BUN0C1D
APPLE1BUN1C1D

Filtering. Make a new list that
only has strings containing "N0".

%[ mylist
:noname
dup count s" N0" StringGetPos
if % else drop then ;
iter
]%

:noname count type cr ; iter
===>
APPLE0BUN0C0D
APPLE1BUN0C0D
APPLE0BUN0C1D
APPLE1BUN0C1D

[B. Pym]

Post by B. Pym
Let's sort by the penultimate character.
mylist :noname count get-ch swap count get-ch swap < ; sort

: get-ch ( adr -- chr ) 12 + c@ ;

mylist :noname get-ch swap get-ch swap < ; sort

[Bernd Linsel]

-> news://comp.lang.lisp
Thank you.

[a***@spenarnc.xs4all.nl]

Post by B. Pym

How can I write this function simply? (in Common Lisp)
-- Given a string 'a.bc.' -- replace each dot(.) with 0 or 1.
('a0bc0' 'a0bc1' 'a1bc0' 'a1bc1')
-- The order is not important.
If the string has 3 dots, the value is a list of length 8.

SP-Forth
REQUIRE /STRING lib/include/string.f
REQUIRE PLACE ~mak/place.f
REQUIRE { ~ac/lib/locals.f
REQUIRE StringReplace2 ~nn\lib\string.f
REQUIRE printf<[ ~ilya\Lib\win\System\printf.f
REQUIRE list-all ~ygrek/lib/list/all.f \ all words for cons pair lists
list ALSO!
REQUIRE CASE-INS lib/ext/caseins.f \ Case-insensitive.
: get-bin-digits ( u n -- ...) 0 do dup 1 and swap 2 / loop drop ;
: str-0-term ( adr) count + 0 swap c! ;
create form-str 257 allot
0 value cnt
0 value power
: dotty { adr len -- }
\ Doesn't terminate output string with 0-byte.
form-str adr len s" ." s" %d" StringReplace2
form-str str-0-term
len - to cnt drop
1 cnt 0 do 2 * loop to power
power 0 do
printf<[ i cnt get-bin-digits form-str count ]>
type cr
loop
;
s" apple.bun.c" dotty
===>
apple0bun0c
apple0bun1c
apple1bun0c
apple1bun1c
s" apple.bun.c.d" dotty
===>
apple0bun0c0d
apple0bun0c1d
apple0bun1c0d
apple0bun1c1d
apple1bun0c0d
apple1bun0c1d
apple1bun1c0d
apple1bun1c1d

A glaring disadvantage of Forth against lisp, that the result
of lisp is ready to be reused. One hardly use this example as
an application, more of a component.
Forth just dumps the results on the screen.

Groetjes Albert

[Travis Bemann]

Post by a***@spenarnc.xs4all.nl
A glaring disadvantage of Forth against lisp, that the result
of lisp is ready to be reused. One hardly use this example as
an application, more of a component.
Forth just dumps the results on the screen.

This sort of thing is part of why I created zeptoscript, a high-level,
dynamic language built on top of zeptoforth.

For instance, in zeptoscript, one can do:

zscript-list import

: split { string delimiter -- parts }
0 { parts }
begin
string delimiter 1 ['] = bind find-index if { index }
0 index string >slice duplicate parts cons to parts
index 1+ string >len over - string >slice to string
false
else
string duplicate parts cons rev-list>cells
true
then
until
;

: add-gaps { parts -- parts-with-gaps }
parts >len { len }
len 0> if
len 1- 2 * 1+ make-cells { parts-with-gaps }
parts parts-with-gaps 1 [: { part index parts-with-gaps }
part index 2 * parts-with-gaps !+
;] bind iteri
parts-with-gaps
else
0cells
then
;

: insert-bits { parts -- parts-with-bits }
parts >len { len }
len 0> if
parts add-gaps { parts-with-gaps }
s" 0" s" 1" { 0bit 1bit }
0 { variants }
1 len 1- lshift 0 ?do
parts-with-gaps duplicate { these-parts }
len 1- 0 ?do
j i rshift 1 and 0<> if 1bit else 0bit then
len 1- i - 2 * 1- these-parts !+
loop
these-parts variants cons to variants
loop
variants rev-list>cells
else
0cells
then
;

: variants-with-bits { string -- strings }
string [char] . split insert-bits [: 0bytes join ;] map
;

With this you get:

s" foo.bar.baz.quux" variants-with-bits [: type space ;] iter
foo0bar0baz0quux foo0bar0baz1quux foo0bar1baz0quux foo0bar1baz1quux
foo1bar0baz0quux foo1bar0baz1quux foo1bar1baz0quux foo1bar1baz1quux ok

(Without the line wrap, of course.)

VARIANTS-WITH-BITS of course returns an array rather than a string, and
can easily be fed into something other than [: TYPE SPACE ;] ITER

This kind of thing is hard to do well in Forth, but with zeptoscript I
get a high-level language which while having the flavor and syntax of
Forth, enabling easily working with high level data structures (in this
example I work with arrays, byte arrays, and lists, including nested ones).

Travis

[Travis Bemann]

Post by Travis Bemann

Post by a***@spenarnc.xs4all.nl
A glaring disadvantage of Forth against lisp, that the result
of lisp is ready to be reused. One hardly use this example as
an application, more of a component.
Forth just dumps the results on the screen.

This sort of thing is part of why I created zeptoscript, a high-level,
dynamic language built on top of zeptoforth.

Correction, I forgot a DROP:

zscript-list import

: split { string delimiter -- parts }
0 { parts }
begin
string delimiter 1 ['] = bind find-index if { index }
0 index string >slice duplicate parts cons to parts
index 1+ string >len over - string >slice to string
false
else
drop \ Forgotten word
string duplicate parts cons rev-list>cells
true
then
until
;

: add-gaps { parts -- parts-with-gaps }
parts >len { len }
len 0> if
len 1- 2 * 1+ make-cells { parts-with-gaps }
parts parts-with-gaps 1 [: { part index parts-with-gaps }
part index 2 * parts-with-gaps !+
;] bind iteri
parts-with-gaps
else
0cells
then
;

: insert-bits { parts -- parts-with-bits }
parts >len { len }
len 0> if
parts add-gaps { parts-with-gaps }
s" 0" s" 1" { 0bit 1bit }
0 { variants }
1 len 1- lshift 0 ?do
parts-with-gaps duplicate { these-parts }
len 1- 0 ?do
j i rshift 1 and 0<> if 1bit else 0bit then
len 1- i - 2 * 1- these-parts !+
loop
these-parts variants cons to variants
loop
variants rev-list>cells
else
0cells
then
;

: variants-with-bits { string -- strings }
string [char] . split insert-bits [: 0bytes join ;] map
;

Post by Travis Bemann
s" foo.bar.baz.quux" variants-with-bits [: type space ;] iter
foo0bar0baz0quux foo0bar0baz1quux foo0bar1baz0quux foo0bar1baz1quux
foo1bar0baz0quux foo1bar0baz1quux foo1bar1baz0quux foo1bar1baz1quux  ok
(Without the line wrap, of course.)
VARIANTS-WITH-BITS of course returns an array rather than a string, and
can easily be fed into something other than [: TYPE SPACE ;] ITER
This kind of thing is hard to do well in Forth, but with zeptoscript I
get a high-level language which while having the flavor and syntax of
Forth, enabling easily working with high level data structures (in this
example I work with arrays, byte arrays, and lists, including nested ones).

Travis