GeoffChurch

:- use_module(library(reif)).

phrase_t(P, I, O, T) :- phrase(call(P, T), I, O).

if_(If, Then, Else, I, O) :-
    if_(phrase_t(If, I, M),
	phrase(Then, M, O),
	phrase(Else, M, O)).

% Example:

GeoffChurch

import Data.Void ( Void )

dneFalse :: ((Void -> Void) -> Void) -> Void
dneFalse f = f id

dneTrue :: ((() -> Void) -> Void) -> ()
dneTrue _ = ()

GeoffChurch

accept(DCG, Xs) :-
    call(DCG, initial, Q),
    accept(DCG, Q, Xs, []).

accept(DCG, Q, [], []) :-
    call(DCG, final, Q).
accept(DCG, Q, [X|Xs], S) :-
    call(DCG, delta, Q, X, S, Q1, S1),
    accept(DCG, Q1, Xs, S1).

GeoffChurch

mi_dcg_clause, [] --> [natnum(0)].
mi_dcg_clause, [natnum(X)] --> [natnum(s(X))].
mi_dcg_clause, [always_infinite] --> [always_infinite].

mi_dcg --> [].
mi_dcg --> mi_dcg_clause, mi_dcg.

%% Original version from https://www.metalevel.at/acomip/ :

mi_ldclause(natnum(0), Rest, Rest).

GeoffChurch

def relabel(xs, f):
    clazz = type(xs[0])
    new_clazz = type(f"{clazz}_relabeled", (clazz,), {"__str__" : f})
    for x in xs:
        x.__class__ = new_clazz

def norms_abnorms(subgroups, G):
    norms = []
    abnorms = []
    for s in subgroups:

GeoffChurch

rewrite(L, R), [Skip] --> [Skip], rewrite(L, R).        % Skip the current head.
rewrite(L, R), R --> L.                                 % Match the current prefix and return.
rewrite(Rules) --> {member(L-R, Rules)}, rewrite(L, R). % Try a single rule.

normalize(P) --> P, normalize(P). % If at first you succeed, try, try again.
normalize(P) --> \+P.             % P failed so list remains the same.

% Single-step rewrite with {"ab"->"x", "ca"->"y"}:
% ?- phrase(rewrite([[a,b]-[x], [c,a]-[y]]), [a,b,c,a,b,c], Out).
% Out = [a, b, c, x, c] ;

GeoffChurch

eos([], []).

% Relates a list to a partitioning of its elements into two subsequences (append/3 for subsequences).
list_subseq_subseq([]) --> eos.
list_subseq_subseq([H|S]) --> [H], list_subseq_subseq(S).
list_subseq_subseq([H|S]), [H] --> list_subseq_subseq(S).

% Relates a list to a partitioning of its elements into nonempty subsequences (append/2 for nonempty subsequences).
list_subseqs([], []).
list_subseqs([H|T], [[H|PT]|Ps]) :-

GeoffChurch

% Implementation of call-by-name lambda calculus in Prolog using logic variables as lambda variables
%
% The grammar is:
% Term ::= Term-Term % abstraction: LHS is function body; RHS is parameter (Y-X instead of λX.Y)
%        | Term+Term % application: LHS is function; RHS is argument (F+X instead of (F X))

eval(Y-X, Y-X). % abstractions are left as-is
eval(F+X, Y) :-
    copy_term(F,B), % copy before destructive unification of parameter in case F appears elsewhere
    eval(B, Y0-X), % eval into what must be an abstraction and unify X with parameter

GeoffChurch

:- use_module(library(clpfd)).

%% at(Dimensions, Index, Array, Element) -- array access.
at([], [], X, X).
at([D|Ds], [I|Is], A, X) :-
    length(A, D),
    nth1(I, A, AI),
    at(Ds, Is, AI, X).

%% `Ds` is the size of each dimension of an array. `Is` is the list of all indices into an array with those dimensions.

GeoffChurch

-- Lazy subsets of potentially infinite list (from https://stackoverflow.com/a/36101787).
subsets :: [a] -> [[a]]
subsets l = [] : go [[]] l
  where
    go _ [] = []
    go seen (cur : rest) = let next = (cur :) <$> seen in next ++ go (seen ++ next) rest

-- Lazy product of potentially infinite lists.
product :: [a] -> [b] -> [(a, b)]
product l r = go1 ([], l) ([], r)