Skip to content

Instantly share code, notes, and snippets.

@Garciat
Last active May 22, 2021 16:10
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save Garciat/5391cb757780265d3b8b3865ff97f01c to your computer and use it in GitHub Desktop.
package example.playground.parserclass;
import lombok.AllArgsConstructor;
import lombok.EqualsAndHashCode;
import lombok.RequiredArgsConstructor;
import lombok.Value;
import lombok.experimental.Delegate;
import java.util.function.BiFunction;
import java.util.function.Function;
import java.util.function.Predicate;
import java.util.function.Supplier;
// ---
interface Hk<W, A> {
default Hk<W, A> unwrap() {
return this;
}
}
class Lazy {
static <W, A> Hk<W, A> lazy(Supplier<Hk<W, A>> f) {
return new Hk<>() {
@Override
public Hk<W, A> unwrap() {
return f.get();
}
};
}
}
// ---
interface Show<A> {
String show(A a);
static <A> Show<A> builtin() {
return Object::toString;
}
}
interface Eq<A> {
boolean eq(A x, A y);
static <A> Eq<A> builtin() {
return Object::equals;
}
}
interface Ord<A> extends Eq<A> {
Ord<Character> CHAR = of(Character::compare);
int cmp(A x, A y);
@Override
default boolean eq(A x, A y) {
return cmp(x, y) == 0;
}
static <A> Ord<A> of(BiFunction<A, A, Integer> f) {
return f::apply;
}
}
// ---
abstract class TyEq<A, B> {
private TyEq() {}
public abstract B castLTR(A a);
public abstract A castRTL(B b);
public abstract <C> TyEq<A, C> compose(TyEq<B, C> eqBC);
public abstract TyEq<B, A> rot();
public abstract <X> TyEq<Hk<A, X>, Hk<B, X>> liftL();
public abstract <X> TyEq<Hk<X, A>, Hk<X, B>> liftR();
public <W> Hk<W, B> castLTR(Hk<W, A> a) {
return this.<W>liftR().castLTR(a);
}
public <W> Hk<W, A> castRTL(Hk<W, B> b) {
return this.<W>liftR().castRTL(b);
}
static <A> TyEq<A, A> refl() {
return new Refl<>();
}
@Value
@EqualsAndHashCode(callSuper = false)
private static class Refl<A> extends TyEq<A, A> {
@Override
public A castLTR(A a) {
return a;
}
@Override
public A castRTL(A a) {
return a;
}
@Override
public <C> TyEq<A, C> compose(TyEq<A, C> eqBC) {
return eqBC;
}
@Override
public TyEq<A, A> rot() {
return this;
}
@Override
public <X> TyEq<Hk<A, X>, Hk<A, X>> liftL() {
return refl();
}
@Override
public <X> TyEq<Hk<X, A>, Hk<X, A>> liftR() {
return refl();
}
}
}
// ---
interface Functor<W> {
<A, B> Hk<W, B> map(Function<A, B> f, Hk<W, A> fa);
default <A, B> Hk<W, B> mapConst(Supplier<B> f, Hk<W, A> fa) {
return map(a -> f.get(), fa);
}
// ---
static <W> Wrap<W> wrap(Functor<W> fw) {
return new Wrap<>(fw);
}
class Mu {}
@RequiredArgsConstructor
class Wrap<W> implements Hk<Functor.Mu, W>, Functor<W> {
private final @Delegate Functor<W> self;
static <W> Wrap<W> narrow(Hk<Functor.Mu, W> fw) {
return (Wrap<W>) fw;
}
}
}
interface Applicative<W> extends Functor<W> {
<A> Hk<W, A> pure(A a);
<A, B, C> Hk<W, C> liftA2(BiFunction<A, B, C> f, Hk<W, A> pa, Hk<W, B> pb);
// (<*)
default <A> Hk<W, A> followedBy(Hk<W, A> pa, Hk<W, ?> px) {
return liftA2((a, x) -> a, pa, px);
}
// ---
static <W> Applicative.Wrap<W> wrap(Applicative<W> fw) {
return new Applicative.Wrap<>(fw, fw);
}
class Mu {}
@RequiredArgsConstructor
class Wrap<W> implements Hk<Applicative.Mu, W>, Applicative<W> {
private final @Delegate Functor<W> functor;
private final @Delegate Applicative<W> applicative;
static <W> Applicative.Wrap<W> narrow(Hk<Applicative.Mu, W> fw) {
return (Applicative.Wrap<W>) fw;
}
}
}
interface Alternative<W> extends Applicative<W> {
<A> Hk<W, A> empty();
<A> Hk<W, A> alt(Hk<W, A> fa1, Hk<W, A> fa2);
default <A> Hk<W, Fwd<A>> some(Hk<W, A> fa) {
return liftA2(Fwd::cons, fa, Lazy.lazy(() -> many(fa)));
}
default <A> Hk<W, Fwd<A>> many(Hk<W, A> fa) {
return alt(some(fa), pure(Fwd.nil()));
}
// ---
static <W> Alternative.Wrap<W> wrap(Alternative<W> fw) {
return new Alternative.Wrap<>(fw, fw, fw);
}
class Mu {}
@RequiredArgsConstructor
class Wrap<W> implements Hk<Alternative.Mu, W>, Alternative<W> {
private final @Delegate Functor<W> functor;
private final @Delegate Applicative<W> applicative;
private final @Delegate Alternative<W> alternative;
static <W> Alternative.Wrap<W> narrow(Hk<Alternative.Mu, W> fw) {
return (Alternative.Wrap<W>) fw;
}
}
}
// ---
@Value
class Unit {
private Unit() {}
static Unit get() {
return new Unit();
}
}
// ---
abstract class Maybe<A> {
private Maybe() {}
abstract <R> R accept(Visitor<R, A> visitor);
<R> R match(Function<A, R> just, Supplier<R> nothing) {
return accept(new Visitor<>() {
@Override
public R visit(Nothing<A> value) {
return nothing.get();
}
@Override
public R visit(Just<A> value) {
return just.apply(value.getA());
}
});
}
<B> Maybe<B> map(Function<A, B> f) {
return accept(new Visitor<>() {
@Override
public Maybe<B> visit(Nothing<A> value) {
return new Nothing<>();
}
@Override
public Maybe<B> visit(Just<A> value) {
return new Just<>(f.apply(value.getA()));
}
});
}
<B> Maybe<B> flatMap(Function<A, Maybe<B>> f) {
return accept(new Visitor<>() {
@Override
public Maybe<B> visit(Nothing<A> value) {
return new Nothing<>();
}
@Override
public Maybe<B> visit(Just<A> value) {
return f.apply(value.getA());
}
});
}
Maybe<A> orElse(Supplier<Maybe<A>> fa) {
return accept(new Visitor<>() {
@Override
public Maybe<A> visit(Nothing<A> value) {
return fa.get();
}
@Override
public Maybe<A> visit(Just<A> value) {
return value;
}
});
}
static <A> Maybe<A> nothing() {
return new Nothing<>();
}
static <A> Maybe<A> just(A a) {
return new Just<>(a);
}
interface Visitor<R, A> {
R visit(Nothing<A> value);
R visit(Just<A> value);
}
@Value
@EqualsAndHashCode(callSuper = false)
public static class Nothing<A> extends Maybe<A> {
@Override
<R> R accept(Visitor<R, A> visitor) {
return visitor.visit(this);
}
}
@Value
@EqualsAndHashCode(callSuper = false)
public static class Just<A> extends Maybe<A> {
A a;
@Override
<R> R accept(Visitor<R, A> visitor) {
return visitor.visit(this);
}
}
}
// ---
@Value
@AllArgsConstructor(staticName = "of")
class Pair<A, B> {
A fst;
B snd;
<C, D> Pair<C, D> bimap(Function<A, C> fac, Function<B, D> fbd) {
return new Pair<>(fac.apply(getFst()), fbd.apply(getSnd()));
}
static <A, B, C> Function<Pair<A, B>, Pair<C, B>> mappingFst(Function<A, C> f) {
return pab -> pab.bimap(f, Function.identity());
}
}
// ---
abstract class Fwd<A> {
abstract <R> R accept(Visitor<R, A> visitor);
static <A> Fwd<A> nil() {
return new Nil<>();
}
static <A> Fwd<A> cons(A a, Fwd<A> as) {
return new Cons<>(a, as);
}
interface Visitor<R, A> {
R visit(Nil<A> value);
R visit(Cons<A> value);
}
@Value
@EqualsAndHashCode(callSuper = false)
static class Nil<A> extends Fwd<A> {
@Override
<R> R accept(Visitor<R, A> visitor) {
return visitor.visit(this);
}
}
@Value
@EqualsAndHashCode(callSuper = false)
static class Cons<A> extends Fwd<A> {
A value;
Fwd<A> next;
@Override
<R> R accept(Visitor<R, A> visitor) {
return visitor.visit(this);
}
}
}
// ---
interface ParserClass<W, T> extends Alternative<W> {
<A> Hk<W, A> tokenPrim(Function<T, Maybe<A>> f);
Hk<W, Unit> eof();
default <A> Hk<W, A> ann(Hk<W, A> pa, String name) {
return pa;
}
// ---
default Hk<W, T> satisfy(Predicate<T> p) {
return tokenPrim(t -> p.test(t) ? Maybe.just(t) : Maybe.nothing());
}
default Hk<W, T> element(Eq<T> eqT, T t) {
return satisfy(t2 -> eqT.eq(t, t2));
}
// ---
default ParserClassChar<W> asChar(TyEq<T, Character> tyEq) {
ParserClass<W, Character> cls = ParserClass.Wrap.narrow(tyEq.castLTR(ParserClass.wrap(this)));
return new ParserClassChar.Wrap<>(cls, cls, cls, cls);
}
// ---
default <A> Parser<W, T, A> fluent(Hk<W, A> pa) {
return Parser.of(this, pa);
}
// ---
static <W, T> ParserClass.Wrap<W, T> wrap(ParserClass<W, T> fw) {
return new ParserClass.Wrap<>(fw, fw, fw, fw);
}
class Mu {}
@RequiredArgsConstructor
class Wrap<W, T> implements Hk<Hk<ParserClass.Mu, W>, T>, ParserClass<W, T> {
private final @Delegate Functor<W> functor;
private final @Delegate Applicative<W> applicative;
private final @Delegate Alternative<W> alternative;
private final @Delegate ParserClass<W, T> parserClass;
static <W, T> ParserClass.Wrap<W, T> narrow(Hk<Hk<ParserClass.Mu, W>, T> fw) {
return (ParserClass.Wrap<W, T>) fw;
}
}
}
interface ParserClassChar<W> extends ParserClass<W, Character> {
default Hk<W, Character> char_(char c) {
return ann(element(Eq.builtin(), c), String.format("'%c'", c));
}
default Hk<W, Unit> spaces() {
return mapConst(Unit::get, many(satisfy(Character::isWhitespace)));
}
default Hk<W, Character> digit() {
return ann(satisfy(Character::isDigit), "digit");
}
default Hk<W, Character> letter() {
return ann(satisfy(Character::isAlphabetic), "letter");
}
@RequiredArgsConstructor
class Wrap<W> implements ParserClassChar<W> {
private final @Delegate Functor<W> functor;
private final @Delegate Applicative<W> applicative;
private final @Delegate Alternative<W> alternative;
private final @Delegate ParserClass<W, Character> pc;
}
}
/**
* Fluent interface for {@link ParserClass}
*/
interface Parser<W, T, A> extends Hk<W, A> {
ParserClass<W, T> cls();
Hk<W, A> self();
@Override
default Hk<W, A> unwrap() {
return self();
}
// Functor
default <B> Parser<W, T, B> map(Function<A, B> f) {
return kmap(pa -> cls().map(f, pa));
}
// Applicative
default <B> Parser<W, T, B> appliedTo(Hk<W, Function<A, B>> pf) {
return kmap(pa -> cls().liftA2((a, f) -> f.apply(a), pa, pf));
}
default Parser<W, T, A> followedBy(Hk<W, ?> px) {
return kmap(pa -> cls().followedBy(pa, px));
}
// Alternative
default Parser<W, T, Fwd<A>> some() {
return kmap(pa -> cls().some(pa));
}
default Parser<W, T, Fwd<A>> many() {
return kmap(pa -> cls().many(pa));
}
// ParserClass
// (Administrative)
default <B> Parser<W, T, B> kmap(Function<Hk<W, A>, Hk<W, B>> f) {
return of(cls(), f.apply(Parser.this.self()));
}
static <W, T, A> Parser<W, T, A> of(ParserClass<W, T> pc, Hk<W, A> pa) {
return new Parser<>() {
@Override
public ParserClass<W, T> cls() {
return pc;
}
@Override
public Hk<W, A> self() {
return pa;
}
};
}
}
// ---
abstract class ParserData<T, A> implements Hk<Hk<ParserData.Mu, T>, A> {
private ParserData() {}
public abstract <R> R accept(Visitor<R, T, A> visitor);
public static <T, A> ParserData<T, A> narrow(Hk<Hk<Mu, T>, A> hk) {
return (ParserData<T, A>) hk.unwrap();
}
public static class Mu {}
interface Visitor<R, T, A> {
// Functor
<X> R visit(Map<T, X, A> value);
// Applicative
R visit(Pure<T, A> value);
<X, Y> R visit(LiftA2<T, X, Y, A> value);
R visit(FollowedBy<T, A> value);
// Alternative
R visit(Empty<T, A> value);
R visit(Alt<T, A> value);
<X> R visit(TyEq<A, Fwd<X>> teq, Many<T, X> value);
<X> R visit(TyEq<A, Fwd<X>> teq, Some<T, X> value);
// ParserClass
R visit(TokenPrim<T, A> value);
R visit(TyEq<A, Unit> teq, Eof<T> value);
R visit(TyEq<A, T> teq, Element<T> value);
// - Char
R visit(TyEq<T, Character> eqT, TyEq<A, Character> eqA, Digit value);
R visit(TyEq<T, Character> eqT, TyEq<A, Character> eqA, Letter letter);
}
// Functor
@Value
@EqualsAndHashCode(callSuper = false)
public static class Map<T, A, B> extends ParserData<T, B> {
Function<A, B> f;
ParserData<T, A> pa;
@Override
public <R> R accept(Visitor<R, T, B> visitor) {
return visitor.visit(this);
}
}
// Applicative
@Value
@EqualsAndHashCode(callSuper = false)
public static class Pure<T, A> extends ParserData<T, A> {
A value;
@Override
public <R> R accept(Visitor<R, T, A> visitor) {
return visitor.visit(this);
}
}
@Value
@EqualsAndHashCode(callSuper = false)
public static class LiftA2<T, A, B, C> extends ParserData<T, C> {
BiFunction<A, B, C> f;
ParserData<T, A> pa;
ParserData<T, B> pb;
@Override
public <R> R accept(Visitor<R, T, C> visitor) {
return visitor.visit(this);
}
}
@Value
@EqualsAndHashCode(callSuper = false)
public static class FollowedBy<T, A> extends ParserData<T, A> {
ParserData<T, A> pa;
ParserData<T, ?> px;
@Override
public <R> R accept(Visitor<R, T, A> visitor) {
return visitor.visit(this);
}
}
// Alternative
@Value
@EqualsAndHashCode(callSuper = false)
public static class Empty<T, A> extends ParserData<T, A> {
@Override
public <R> R accept(Visitor<R, T, A> visitor) {
return visitor.visit(this);
}
}
@Value
@EqualsAndHashCode(callSuper = false)
public static class Alt<T, A> extends ParserData<T, A> {
ParserData<T, A> pa1;
ParserData<T, A> pa2;
@Override
public <R> R accept(Visitor<R, T, A> visitor) {
return visitor.visit(this);
}
}
@Value
@EqualsAndHashCode(callSuper = false)
public static class Many<T, A> extends ParserData<T, Fwd<A>> {
ParserData<T, A> pa;
@Override
public <R> R accept(Visitor<R, T, Fwd<A>> visitor) {
return visitor.visit(TyEq.refl(), this);
}
}
@Value
@EqualsAndHashCode(callSuper = false)
public static class Some<T, A> extends ParserData<T, Fwd<A>> {
ParserData<T, A> pa;
@Override
public <R> R accept(Visitor<R, T, Fwd<A>> visitor) {
return visitor.visit(TyEq.refl(), this);
}
}
// ParserClass
@Value
@EqualsAndHashCode(callSuper = false)
public static class TokenPrim<T, A> extends ParserData<T, A> {
Function<T, Maybe<A>> f;
@Override
public <R> R accept(Visitor<R, T, A> visitor) {
return visitor.visit(this);
}
}
@Value
@EqualsAndHashCode(callSuper = false)
public static class Eof<T> extends ParserData<T, Unit> {
@Override
public <R> R accept(Visitor<R, T, Unit> visitor) {
return visitor.visit(TyEq.refl(), this);
}
}
@Value
@EqualsAndHashCode(callSuper = false)
public static class Element<T> extends ParserData<T, T> {
Eq<T> eqT;
T t;
@Override
public <R> R accept(Visitor<R, T, T> visitor) {
return visitor.visit(TyEq.refl(), this);
}
}
@Value
@EqualsAndHashCode(callSuper = false)
public static class Digit extends ParserData<Character, Character> {
@Override
public <R> R accept(Visitor<R, Character, Character> visitor) {
return visitor.visit(TyEq.refl(), TyEq.refl(), this);
}
}
@Value
@EqualsAndHashCode(callSuper = false)
public static class Letter extends ParserData<Character, Character> {
@Override
public <R> R accept(Visitor<R, Character, Character> visitor) {
return visitor.visit(TyEq.refl(), TyEq.refl(), this);
}
}
}
class ParserDataInstances {
@RequiredArgsConstructor
static class ShowI<T> implements Show<ParserData<T, ?>> {
private final Show<T> showT;
@Override
public String show(ParserData<T, ?> pa) {
return go(pa);
}
private <A> String go(Hk<Hk<ParserData.Mu, T>, A> pa) {
return ParserData.narrow(pa).accept(new ParserData.Visitor<>() {
@Override
public <X> String visit(ParserData.Map<T, X, A> value) {
return "map(f, " + go(value.getPa()) + ")";
}
@Override
public String visit(ParserData.Pure<T, A> value) {
return "pure(a)";
}
@Override
public <X, Y> String visit(ParserData.LiftA2<T, X, Y, A> value) {
return "liftA2(f, " + go(value.getPa()) + ", " + go(value.getPb()) + ")";
}
@Override
public String visit(ParserData.FollowedBy<T, A> value) {
return "followedBy(" + go(value.getPa()) + ", " + go(value.getPx()) + ")";
}
@Override
public String visit(ParserData.Empty<T, A> value) {
return "empty";
}
@Override
public String visit(ParserData.Alt<T, A> value) {
return "alt(" + go(value.getPa1()) + ", " + go(value.getPa2()) + ")";
}
@Override
public <X> String visit(TyEq<A, Fwd<X>> teq, ParserData.Many<T, X> value) {
return "many(" + go(value.getPa()) + ")";
}
@Override
public <X> String visit(TyEq<A, Fwd<X>> teq, ParserData.Some<T, X> value) {
return "some(" + go(value.getPa()) + ")";
}
@Override
public String visit(ParserData.TokenPrim<T, A> value) {
return "tokenPrim(f)";
}
@Override
public String visit(TyEq<A, Unit> teq, ParserData.Eof<T> value) {
return "eof()";
}
@Override
public String visit(TyEq<A, T> teq, ParserData.Element<T> value) {
return "element(" + showT.show(value.getT()) + ")";
}
@Override
public String visit(TyEq<T, Character> eqT, TyEq<A, Character> eqA, ParserData.Digit value) {
return "digit()";
}
@Override
public String visit(TyEq<T, Character> eqT, TyEq<A, Character> eqA, ParserData.Letter letter) {
return "letter()";
}
});
}
}
@RequiredArgsConstructor
static class FunctorI<T> implements Functor<Hk<ParserData.Mu, T>> {
@Override
public <A, B> Hk<Hk<ParserData.Mu, T>, B> map(Function<A, B> f, Hk<Hk<ParserData.Mu, T>, A> pa) {
return new ParserData.Map<>(f, ParserData.narrow(pa));
}
}
@RequiredArgsConstructor
static class ApplicativeI<T> implements Applicative<Hk<ParserData.Mu, T>> {
private final @Delegate Functor<Hk<ParserData.Mu, T>> functor;
@Override
public <A> Hk<Hk<ParserData.Mu, T>, A> pure(A a) {
return new ParserData.Pure<>(a);
}
@Override
public <A, B, C> Hk<Hk<ParserData.Mu, T>, C> liftA2(BiFunction<A, B, C> f, Hk<Hk<ParserData.Mu, T>, A> pa, Hk<Hk<ParserData.Mu, T>, B> pb) {
return new ParserData.LiftA2<>(f, ParserData.narrow(pa), ParserData.narrow(pb));
}
@Override
public <A> Hk<Hk<ParserData.Mu, T>, A> followedBy(Hk<Hk<ParserData.Mu, T>, A> pa, Hk<Hk<ParserData.Mu, T>, ?> px) {
return new ParserData.FollowedBy<>(ParserData.narrow(pa), ParserData.narrow(px));
}
}
@RequiredArgsConstructor
static class AlternativeI<T> implements Alternative<Hk<ParserData.Mu, T>> {
private final @Delegate Functor<Hk<ParserData.Mu, T>> functor;
private final @Delegate Applicative<Hk<ParserData.Mu, T>> applicative;
@Override
public <A> Hk<Hk<ParserData.Mu, T>, A> empty() {
return new ParserData.Empty<>();
}
@Override
public <A> Hk<Hk<ParserData.Mu, T>, A> alt(Hk<Hk<ParserData.Mu, T>, A> fa1, Hk<Hk<ParserData.Mu, T>, A> fa2) {
return new ParserData.Alt<>(ParserData.narrow(fa1), ParserData.narrow(fa2));
}
@Override
public <A> Hk<Hk<ParserData.Mu, T>, Fwd<A>> some(Hk<Hk<ParserData.Mu, T>, A> fa) {
return new ParserData.Some<>(ParserData.narrow(fa));
}
@Override
public <A> Hk<Hk<ParserData.Mu, T>, Fwd<A>> many(Hk<Hk<ParserData.Mu, T>, A> fa) {
return new ParserData.Many<>(ParserData.narrow(fa));
}
}
@RequiredArgsConstructor
static class ParserClassI<T> implements ParserClass<Hk<ParserData.Mu, T>, T> {
private final @Delegate Functor<Hk<ParserData.Mu, T>> functor;
private final @Delegate Applicative<Hk<ParserData.Mu, T>> applicative;
private final @Delegate Alternative<Hk<ParserData.Mu, T>> alternative;
@Override
public <A> Hk<Hk<ParserData.Mu, T>, A> tokenPrim(Function<T, Maybe<A>> f) {
return new ParserData.TokenPrim<>(f);
}
@Override
public Hk<Hk<ParserData.Mu, T>, Unit> eof() {
return new ParserData.Eof<>();
}
@Override
public Hk<Hk<ParserData.Mu, T>, T> element(Eq<T> eqT, T t) {
return new ParserData.Element<>(eqT, t);
}
@Override
public ParserClassChar<Hk<ParserData.Mu, T>> asChar(TyEq<T, Character> tyEq) {
var parserClassC = tyEq
.<Hk<Mu, Hk<ParserData.Mu, T>>>liftR()
.castLTR(ParserClass.wrap(this));
return new ParserClassCharI<>(
tyEq,
functor,
applicative,
alternative,
ParserClass.Wrap.narrow(parserClassC));
}
}
@RequiredArgsConstructor
static class ParserClassCharI<T> implements ParserClassChar<Hk<ParserData.Mu, T>> {
private final TyEq<T, Character> teq;
private final @Delegate Functor<Hk<ParserData.Mu, T>> functor;
private final @Delegate Applicative<Hk<ParserData.Mu, T>> applicative;
private final @Delegate Alternative<Hk<ParserData.Mu, T>> alternative;
private final @Delegate ParserClass<Hk<ParserData.Mu, T>, Character> parserClass;
@Override
public Hk<Hk<ParserData.Mu, T>, Character> digit() {
return teq.<ParserData.Mu>liftR().<Character>liftL().castRTL(new ParserData.Digit());
}
@Override
public Hk<Hk<ParserData.Mu, T>, Character> letter() {
return teq.<ParserData.Mu>liftR().<Character>liftL().castRTL(new ParserData.Letter());
}
}
}
class ParserDataReinterpret {
public static <W, T, A> Hk<W, A> interpret(ParserClass<W, T> pc, ParserData<T, A> pa) {
return pa.accept(new ParserData.Visitor<>() {
@Override
public <X> Hk<W, A> visit(ParserData.Map<T, X, A> value) {
var px = interpret(pc, value.getPa());
return pc.map(value.getF(), px);
}
@Override
public Hk<W, A> visit(ParserData.Pure<T, A> value) {
return pc.pure(value.getValue());
}
@Override
public <X, Y> Hk<W, A> visit(ParserData.LiftA2<T, X, Y, A> value) {
var px = interpret(pc, value.getPa());
var py = interpret(pc, value.getPb());
return pc.liftA2(value.getF(), px, py);
}
@Override
public Hk<W, A> visit(ParserData.FollowedBy<T, A> value) {
var pa_ = interpret(pc, value.getPa());
var px_ = interpret(pc, value.getPx());
return pc.followedBy(pa_, px_);
}
@Override
public Hk<W, A> visit(ParserData.Empty<T, A> value) {
return pc.empty();
}
@Override
public Hk<W, A> visit(ParserData.Alt<T, A> value) {
var pa1 = interpret(pc, value.getPa1());
var pa2 = interpret(pc, value.getPa2());
return pc.alt(pa1, pa2);
}
@Override
public <X> Hk<W, A> visit(TyEq<A, Fwd<X>> teq, ParserData.Many<T, X> value) {
var pa = interpret(pc, value.getPa());
return teq.castRTL(pc.many(pa));
}
@Override
public <X> Hk<W, A> visit(TyEq<A, Fwd<X>> teq, ParserData.Some<T, X> value) {
var pa = interpret(pc, value.getPa());
return teq.castRTL(pc.some(pa));
}
@Override
public Hk<W, A> visit(ParserData.TokenPrim<T, A> value) {
return pc.tokenPrim(value.getF());
}
@Override
public Hk<W, A> visit(TyEq<A, Unit> teq, ParserData.Eof<T> value) {
return teq.castRTL(pc.eof());
}
@Override
public Hk<W, A> visit(TyEq<A, T> teq, ParserData.Element<T> value) {
return teq.castRTL(pc.element(value.getEqT(), value.getT()));
}
@Override
public Hk<W, A> visit(TyEq<T, Character> eqT, TyEq<A, Character> eqA, ParserData.Digit value) {
return eqA.castRTL(pc.asChar(eqT).digit());
}
@Override
public Hk<W, A> visit(TyEq<T, Character> eqT, TyEq<A, Character> eqA, ParserData.Letter letter) {
return eqA.castRTL(pc.asChar(eqT).letter());
}
});
}
}
// ---
interface Stream<T> {
Maybe<Pair<T, Stream<T>>> read();
}
@Value
class StringStream implements Stream<Character> {
String s;
int i;
@Override
public Maybe<Pair<Character, Stream<Character>>> read() {
if (i < s.length()) {
return Maybe.just(Pair.of(s.charAt(i), new StringStream(s, i+1)));
} else {
return Maybe.nothing();
}
}
static StringStream of(String s) {
return new StringStream(s, 0);
}
}
abstract class RealParser<T, A> implements Hk<RealParser.Mu1<T>, A> {
public abstract Maybe<Pair<A, Stream<T>>> parse(Stream<T> ts);
public static <T, A> RealParser<T, A> narrow(Hk<Mu1<T>, A> hk) {
return new Lazy<>(hk);
}
public static <T, A> RealParser<T, A> of(Function<Stream<T>, Maybe<Pair<A, Stream<T>>>> f) {
return new Fun<>(f);
}
public static class Mu {}
public static class Mu1<T> implements Hk<Mu, T> {}
@Value
@EqualsAndHashCode(callSuper = false)
private static class Fun<T, A> extends RealParser<T, A> {
Function<Stream<T>, Maybe<Pair<A, Stream<T>>>> f;
@Override
public Maybe<Pair<A, Stream<T>>> parse(Stream<T> ts) {
return f.apply(ts);
}
}
@Value
@EqualsAndHashCode(callSuper = false)
private static class Lazy<T, A> extends RealParser<T, A> {
Hk<Mu1<T>, A> hk;
@Override
public Maybe<Pair<A, Stream<T>>> parse(Stream<T> ts) {
return ((RealParser<T, A>) hk.unwrap()).parse(ts);
}
}
}
class RealParserInstance<T> implements ParserClass<RealParser.Mu1<T>, T> {
@Override
public <A, B> Hk<RealParser.Mu1<T>, B> map(Function<A, B> f, Hk<RealParser.Mu1<T>, A> pa) {
var pa_ = RealParser.narrow(pa);
return RealParser.of(ts -> pa_.parse(ts).map(Pair.mappingFst(f)));
}
@Override
public <A> Hk<RealParser.Mu1<T>, A> pure(A a) {
return RealParser.of((ts -> Maybe.just(Pair.of(a, ts))));
}
@Override
public <A, B, C> Hk<RealParser.Mu1<T>, C> liftA2(BiFunction<A, B, C> f, Hk<RealParser.Mu1<T>, A> pa, Hk<RealParser.Mu1<T>, B> pb) {
var pa_ = RealParser.narrow(pa);
var pb_ = RealParser.narrow(pb);
return RealParser.of(ts -> pa_.parse(ts).flatMap(ra -> pb_.parse(ra.getSnd()).map(rb -> Pair.of(f.apply(ra.getFst(), rb.getFst()), rb.getSnd()))));
}
@Override
public <A> Hk<RealParser.Mu1<T>, A> empty() {
return RealParser.of(ts -> Maybe.nothing());
}
@Override
public <A> Hk<RealParser.Mu1<T>, A> alt(Hk<RealParser.Mu1<T>, A> fa1, Hk<RealParser.Mu1<T>, A> fa2) {
var fa1_ = RealParser.narrow(fa1);
var fa2_ = RealParser.narrow(fa2);
return RealParser.of(ts -> fa1_.parse(ts).orElse(() -> fa2_.parse(ts)));
}
@Override
public <A> Hk<RealParser.Mu1<T>, A> tokenPrim(Function<T, Maybe<A>> f) {
return RealParser.of(ts -> ts.read().flatMap(rt -> f.apply(rt.getFst()).map(a -> Pair.of(a, rt.getSnd()))));
}
@Override
public Hk<RealParser.Mu1<T>, Unit> eof() {
return RealParser.of(ts -> ts.read().match(t -> Maybe.nothing(), () -> Maybe.just(Pair.of(Unit.get(), ts))));
}
}
// ---
public class Program {
public static void main(String[] args) {
var pd_parser = Program.<Character>parserData();
var pd_show = new ParserDataInstances.ShowI<Character>(Show.builtin());
var p = example1(pd_parser);
var p_ = ParserDataReinterpret.interpret(new RealParserInstance<>(), ParserData.narrow(p));
System.out.println(p);
System.out.println(pd_show.show(ParserData.narrow(p)));
System.out.println(RealParser.narrow(p_).parse(StringStream.of("")));
// 2
System.out.println(pd_show.show(ParserData.narrow(example2(parserData()))));
System.out.println(RealParser.narrow(example2(new RealParserInstance<>())).parse(StringStream.of("1234.abc")));
}
private static <T> ParserDataInstances.ParserClassI<T> parserData() {
var pd_functor = new ParserDataInstances.FunctorI<T>();
var pd_applicative = new ParserDataInstances.ApplicativeI<T>(pd_functor);
var pd_alternative = new ParserDataInstances.AlternativeI<T>(pd_functor, pd_applicative);
return new ParserDataInstances.ParserClassI<>(pd_functor, pd_applicative, pd_alternative);
}
public static <W, T> Hk<W, Integer> example1(ParserClass<W, T> pc) {
var pi = pc.liftA2(Integer::sum, pc.pure(1), pc.pure(2));
return Parser.of(pc, pi).followedBy(pc.eof());
}
public static <W> Hk<W, String> example2(ParserClass<W, Character> pc) {
var pcc = pc.asChar(TyEq.refl());
return pc.fluent(pcc.digit())
.many()
.followedBy(pcc.char_('.'))
.<String>appliedTo(
pc.fluent(pcc.letter())
.many()
.map(cs -> ds -> "digits: " + ds + "; chars: " + cs))
.followedBy(pc.eof());
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment