Logos

logos.md

Some horribly hacky Raku code that pretends to be a barely functional logic language

use lib 'lib';
use Logos;

enum < tom sally bob mark floppy book >;

fact :person(sally);
fact :person(mark);
fact :person(bob);

fact :dog(floppy);

fact :likes(tom, floppy);
fact :likes(tom, sally);
fact :likes(sally, bob);
fact :likes(tom, mark);

say ques :likes(*);          #  ((tom sally) (sally bob) (tom floppy) (tom mark))
say ques :likes(tom, *);     #  ((sally) (floppy) (mark))
say ques :likes(sally, *);   #  ((bob))
say ques :likes(tom, sally); #  True
say ques :likes(sally, tom); #  False

pred :gives(tom, book, *) => [
    :likes(tom, *),
    :person(*),
];

say ques :gives(tom, book, *); # (sally mark)

and here's the lib.

unit module Logos;
use MONKEY-SEE-NO-EVAL;

my %logo{Any};
my %preds{Any};

sub fact( *%fact ) is export {
    my $key   = %fact.keys.head;
    my $value = %fact.values.head.List;
    if $value.elems == 1 { $value .= head }
    if !%logo{$key} { %logo{$key} = SetHash.new( $value ) }
    else { %logo{$key}{ $value } = True }
    return ':%s(%s)'.sprintf($key, $value.perl);
}

sub ques( *%ques ) is export {
    my $key = %ques.keys.head;
    if !%logo{$key} && %preds{$key} -> $pred {
        return EVAL $pred;
    }
    my $value = %ques.values.head.List;
    if $value.elems == 1 { $value .= head }
    if %logo{$key}:exists {
        if $value.grep(Whatever) {
            with $value.grep(* !~~ Whatever).head -> $def {
                my $i = $value.grep(* !~~ Whatever, :k).head.Int;
                %logo{$key}.keys
                  .grep( *.head.[$i] eq $def )
                  .map( (* ∖ $def).keys )
            }
            else { %logo{$key}.keys }
        }
        else {
            so %logo{$key}.keys.first(* eqv $value);
        }
    }
    else { Nil }
}

sub pred( %pred ) is export {
    my $key   = %pred.keys.head;
    my @values = %pred.values.flat.map(-> $v { EVAL "ques $v.perl()" });
    my $pred = "( [∩] @values.perl() ).keys";
    %preds{$key.keys} = $pred;
}