SLEEP + Prolog + Closures = Much Fun!

[Giorgio]

Hallo Sleep scripters and developers,

I hope you would submit follow up's and comments about the script im
pasting with this post. It exploits what I've understood exploring
closure realm for fun and personal gaining of knowledge. Indeed, I'm
considering SLEEP closures and related functions from another point of
view after the time spent at writing this lenghty snippet. I hope to
go deeply into other compelling features in the near future. Please
correct my code writing approach if you come up with concerns while
examining the script: There is more than one way of doing it..for
sure!

Best regards to you all, Giorgio.


## A prologuesque script written by me (Giorgio Arata) during my
## very first SLEEP closure mechanism and features exploration.

## Note: Expressly thanks to Adriahn at PerlMonks.org for his good
(ie. inspiring) articles.

include("object.sl");

debug(debug() | 5);

# define some utility functions

sub isString
{
if (typeOf($1) ismatch '.*\.StringValue$')
{
return 1;
}
return 0;
}

sub isObject
{
if (typeOf($1) ismatch '.*\.ObjectValue$')
{
return 1;
}
return 0;
}

sub isArray
{
if (typeOf($1) ismatch '.*\.ListContainer$')
{
return 1;
}
return 0;
}

# define our MyVar object

sub MyVar::init
{
this('$value $ID');
local('$rnd');
$rnd = { return ((ticks() * rand(round([Integer MAX_VALUE] /
10000)))); };
$value = @_[0];
$ID = invoke($rnd);
}

sub MyVar::print
{
println("MyVar( $+ $ID $+ ): $value");
}

sub MyVar::type
{
return $type;
}

sub MyVar::value
{
return $value;
}

sub MyVar::ID
{
return $ID;
}

sub MyVar::defined
{
if ($value !is $null)
{
return 1;
}
return 0;
}

sub MyVar::bound
{
if ([$this defined])
{
return 1;
}
return 0;
}

sub MyVar::bind
{
if ([$this bound])
{
return 0;
}
# just override hosted value leaving $this intact
$value = iff([$1 type] eq "MyVar", [$1 value], $1);
return 1;
}

sub MyVar::reset
{
#$value = $null;
[$this init];
}

sub MyVar::equal
{
if ([$1 ID] eq [$this ID] && [$1 value] eq $null && [$this value] eq
$null)
{
return 1;
}
if ([$1 bound] && [$this bound] && [$1 value] eq [$this value])
{
return 1;
}
return 0;
}

sub unify {
$v1 = iff(isObject($1) && [$1 type] eq "MyVar", $1, newObject
("MyVar", $1));
$v2 = iff(isObject($2) && [$2 type] eq "MyVar", $2, newObject
("MyVar", $2));
if ([$v1 equal: $v2])
{
[$3];
}
else if ([$v1 bind: $v2])
{
[$3];
[$v1 reset];
}
else if ([$v2 bind: $v1])
{
[$3];
[$v2 reset];
}
return(0);
}

global('$__var__');
global('$v1 $v2 $v3 $v4');
$v1 = newObject("MyVar");
$v2 = newObject("MyVar", "hello");
$v3 = newObject("MyVar");
$v4 = newObject("MyVar", "hello");

sub ok
{
local('$msg');
if (@_[0] && size(@_) > 1) {
foreach $msg (concat(sublist(@_, 1), "\n"))
{

[[System out] print: $msg];
}
}
}

ok ([[new String : "MyVar"] equals: [$v1 type]], '1. ', '($1 eq
"MyVar")', ' ', 'new unbound var');
ok (not([$v1 bound]), '2. ', '( $v1 )', ' ', 'is not bound');
ok (not([$v1 defined]), '3. ', '( $v1 )', ' ', 'and undefined');
ok ([$v1 equal: $v1], '4a. ', '($v1 eq $v1)', ' ', "var equal to
itself" );
ok ([$v2 equal: $v2], '4b. ', '($v2 eq $v2)', ' ', "var equal to
itself" );
ok (not([$v1 equal: $v3]), '5. ', '($v1 !eq $v3)', ' ', "unbound var
not equal to other unbound var");
ok ([$v2 equal: $v4], '6. ', '($v2 eq $v4)', ' ', 'bound vars with
same content equal');
ok (not([$v2 bind: $v1]), '7. ', '($v2 bind $v1)', ' ', 'cannot bind
bound var');
ok ([$v1 bind: $v2], '8. ', '($v1 bind $v2)', ' ', 'can bind unbound
var');
ok(not([$v2 bind: $v1]), '9. ', '!($v2 bind $v1)', ' ', 'cannot bind
bound var');
ok([[new String : [$v1 value]] equals: "hello"], '10. ', '( $v1 )', '
', 'to correct value');
println();

sub male {
unify("frank", $1, $2);
unify("dean", $1, $2);
}

# print out all the males
$__var__ = newObject("MyVar");
male($__var__, {println([$__var__ value] . " is male");});
println("");

sub isMale {
local('$closure'); # local (single quoted declaration) gotcha..
try
{
$closure = {throw $name . " is male";};
let($closure, $name => $1);
male($1, $closure);
println($1 . " is not male");
}
catch $exception
{
println($exception);
}
}

isMale("dean");
isMale("judy");
println("");

sub female {
unify("ella", $1, $2);
unify("judy", $1, $2);
}

sub acts {
unify("frank", $1, $2);
unify("dean", $1, $2);
unify("judy", $1, $2);
}

sub sings {
unify("frank", $1, $2);
unify("dean", $1, $2);
unify("ella", $1, $2);
unify("judy", $1, $2);
}

sub person {
male($1, $2);
female($1, $2);
}

sub actor {
local('$closure');
$closure = { acts($x, $y); };
let($closure, $x => $1, $y => $2);
male($1, $closure);
}

sub actress {
local('$closure');
$closure = { acts($x, $y); };
let($closure, $x => $1, $y => $2);
female($1, $closure);
}

# print out all of the actors
$__var__ = newObject("MyVar");
actor($__var__, {println( [$__var__ value] . " is an actor ");});
println();

# print out all of the actresses
$__var__ = newObject("MyVar");
actress($__var__, {println( [$__var__ value] . " is an actress ");});
println();

# is ella an actress
sub isActress {
local('$closure'); # local (single quoted declaration) gotcha..
try
{
$closure = {throw $name . " is actress";};
let($closure, $name => $1);
actress($1, $closure);
println($1 . " is not actress");
} catch $exception
{
println($exception);
}
}

isActress("ella");
isActress("judy");
println();

sub unify_all {
local('$v1 $v2 $a $b $closure');
$a = copy($1); $b = copy($2);
if (isArray($a) && isArray($b)) {
if (size($a) eq 0 && size($b) eq 0) {
inline($3);
} else if (size($a) eq size($b)) {
$v1 = shift($a);
$v2 = shift($b);
$closure = { unify_all($x, $y, $z); };
let($closure, $x => $a, $y => $b, $z => $3);
unify($v1, $v2, $closure);
}
}
return(0);
}

sub sang_with {
unify_all(@('frank', 'judy'), @($1, $2), $3);
unify_all(@('frank', 'dean'), @($1, $2), $3);
}

$__var__ = newObject("MyVar");
sang_with('frank', $__var__, { println("frank sang with " . [$__var__
value]); });
sang_with($__var__, 'dean', { println("dean sang with " . [$__var__
value]); });
println();

sub sangWithAnActor {
local('$closure $name');
try
{
if (isString($1))
{
$name = $1;
}
else if (isString($2))
{
$name = $2;
}
[[System out] print: $name . " "];
$closure = { sang_with($x, $y, { throw "did sing with an
actor"; }); };
let($closure, $x => $1, $y => $2);
actor($1, $closure);
println("did not sing with an actor");
} catch $exception
{
println($exception);
}
}

sangWithAnActor("frank", newObject("MyVar"));
sangWithAnActor("ella", newObject("MyVar"));
sangWithAnActor(newObject("MyVar"), "dean");

[Raphael Mudge]

You and I would have fun over a beer. I like the fact that you're
using the Sleep object oriented programming stuff. I find it very
useful but suspect not too many people use it. Also for detecting
types you can use -isarray to detect if something is an array.

Here I use yield to implement backtracking in Sleep. Your code is
probably faster as yield has a lot of overhead.

java -jar sleep.jar --time money.sl
9567
+ 1085
-----------
10652
analyzed 4524967 solutions
time: 425.742s <-- not proud
of this number, but hey it works :)

It can simplify things though. I look forward to playing with your
examples later.

# prolog.sl

sub backtrack
{
local('$var $next $slist');

if (size($1) > 1)
{
$slist = sublist($1, 1);
foreach $var ($1[0])
{
while $next ([$this: $slist])
{
yield @($var, $next);
}
}
}
else
{
foreach $var ($1[0])
{
yield $var;
}
}
}

sub subsets
{
return lambda(
{
local('$n');
while $n (backtrack(@data))
{
yield $n;
}
}, @data => @_);
}

Now this this code you can do the infamous SEND + MORE = MONEY puzzle:

include("prolog.sl");

# Come up with assignments 0..9 to S, E, N, D, M, O, R, Y such that
# SEND + MORE = MONEY

@digits = @(0, 2, 3, 4, 5, 6, 7, 8, 9);

sub isAnswer
{
local('$S $E $N $D $M $O $R $Y');
($S, $E, $N, $D, $M, $O, $R, $Y) = $1;

if ( (int("$S$E$N$D") + int("$M$O$R$E")) == int("$M$O$N$E$Y"))
{
# make sure there are no duplicates
if (size(putAll(%(), $1, { return 1; })) == 8)
{
return 1;
}
}
}

$x = 0;
# S E N D
M O R Y
while $potential (flatten(backtrack(@(@digits, @digits, @digits,
@digits, @(1), @digits, @digits, @digits))))
{
if (isAnswer($potential))
{
local('$S $E $N $D $M $O $R $Y');
($S, $E, $N, $D, $M, $O, $R, $Y) = $potential;

println(" $S$E$N$D");
println(" + $M$O$R$E");
println("-----------");
println(" $M$O$N$E$Y");

println(" analyzed $x solutions");
return;
}

$x++;
}

I forgot what this thing does and don't want to say the wrong thing,
I ported it from an Erlang list comprehension example:

include("prolog.sl");

global('@digits $solution $X $Y');

@digits = @(-5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5);

while $solution (backtrack(@(@digits, @digits)))
{
($X, $Y) = $solution;

if ((($X * $X) + ($Y * $Y)) == 25)
{
println("$X $+ , $Y");
}
}

And there is this classic here:

# father.sl

include("prolog.sl");

@people = @("adam", "shem", "cain", "abel", "eve", "noah");

%male["adam"] = 1;
%male["seth"] = 1;
%male["cain"] = 1;
%male["abel"] = 1;
%male["noah"] = 1;

%female["eve"] = 1;

%parent["adam"]["cain"] = 1;
%parent["adam"]["abel"] = 1;
%parent["eve"]["cain"] = 1;
%parent["eve"]["abel"] = 1;
%parent["noah"]["shem"] = 1;

sub father_of
{
return filter({ return iff(%parent[$1[0]][$1[1]], $1); }, subsets
(filter({ return iff(%male[$1], $1); }, @people), @people));
}

sub mother_of
{
return filter({ return iff(%parent[$1[0]][$1[1]], $1); }, subsets
(filter({ return iff(%female[$1], $1); }, @people), @people));
}

println("Fajer");
printAll(father_of());

println("Madre");
printAll(mother_of());

-- Raphael