Interpreter for LispKit Lisp (based on Henderson's "Functional Programming Application & Implementation")

llast.py

from dataclasses import dataclass

@dataclass
class Alpha:
    s : str

@dataclass
class Num:
    n : int

@dataclass
class Cons:
    car : any
    cdr : any

def to_string(e):
    match e:
        case Num(n):
            return str(n)
        case Alpha(s):
            return s
        case Cons(hd, tl):
            return f"({to_string(hd)}{to_string_tl(tl)})"

def to_string_tl(tl):
    match tl:
        case Alpha("NIL"):
            return ""
        case Cons(hd, tl1):
            return f" {to_string(hd)}{to_string_tl(tl1)}"
        case _:
            return f" . {to_string(tl)}"

lleval.py

import llparser as p
from llast import Alpha, Num, Cons, to_string

def eval_(e, n, v):
    match e:
        case Alpha("NIL"):
            return e
        case Alpha(s):
            return assoc(e, n, v)
        case Num(_):
            return e
        case Cons(Alpha("QUOTE"), Cons(e1, Alpha("NIL"))):
            return e1
        case Cons(Alpha("ATOM"), Cons(e1, Alpha("NIL"))):
            match eval_(e1, n, v):
                case Alpha(_):
                    return Alpha("T")
                case Num(_):
                    return Alpha("T")
                case _:
                    return Alpha("F")
        case Cons(Alpha("CONS"), Cons(e1, Cons(e2, Alpha("NIL")))):
            return Cons(eval_(e1, n, v), eval_(e2, n, v))
        case Cons(Alpha("CAR"), Cons(e1, Alpha("NIL"))):
            match eval_(e1, n, v):
                case Cons(e2, _):
                    return e2
                case e_:
                    raise ValueError(f"Cannot take CAR of non-cons {e_}")
        case Cons(Alpha("CDR"), Cons(e1, Alpha("NIL"))):
            match eval_(e1, n, v):
                case Cons(_, e2):
                    return e2
                case e_:
                    raise ValueError(f"Cannot take CDR of non-cons {e_}")
        case Cons(Alpha("EQ"), Cons(e1, Cons(e2, Alpha("NIL")))):
            return eq(eval_(e1, n, v), eval_(e2, n, v))
        case Cons(Alpha("LEQ"), Cons(e1, Cons(e2, Alpha("NIL")))):
            return numop(eval_(e1, n, v), eval_(e2, n, v), lambda x,y: Alpha("T") if x <= y else Alpha("F"))
        case Cons(Alpha("ADD"), Cons(e1, Cons(e2, Alpha("NIL")))):
            return numop(eval_(e1, n, v), eval_(e2, n, v), lambda x,y: Num(x+y))
        case Cons(Alpha("SUB"), Cons(e1, Cons(e2, Alpha("NIL")))):
            return numop(eval_(e1, n, v), eval_(e2, n, v), lambda x,y: Num(x-y))
        case Cons(Alpha("MUL"), Cons(e1, Cons(e2, Alpha("NIL")))):
            return numop(eval_(e1, n, v), eval_(e2, n, v), lambda x,y: Num(x*y))
        case Cons(Alpha("DIV"), Cons(e1, Cons(e2, Alpha("NIL")))):
            return numop(eval_(e1, n, v), eval_(e2, n, v), lambda x,y: Num(x//y))
        case Cons(Alpha("REM"), Cons(e1, Cons(e2, Alpha("NIL")))):
            return numop(eval_(e1, n, v), eval_(e2, n, v), lambda x,y: Num(x%y))
        case Cons(Alpha("IF"), Cons(e1, Cons(e2, Cons(e3, Alpha("NIL"))))):
            match eval_(e1, n, v):
                case Alpha("T"):
                    return eval_(e2, n, v)
                case Alpha("F"):
                    return eval_(e3, n, v)
                case v:
                    raise ValueError(f"Non-boolean value {v} in if-condition")
        case Cons(Alpha("LAMBDA"), Cons(e1, Cons(e2, Alpha("NIL")))):
            return Cons(Cons(e1, e2), Cons(n, v))
        case Cons(Alpha("LET"), Cons(e1, e2)):
            n_ = Cons(vars_(e2), n)
            v_ = Cons(evlis(exprs(e2), n, v), v)
            return eval_(e1, n_, v_)
        case Cons(Alpha("LETREC"), Cons(e1, e2)):
            n_ = Cons(vars_(e2), n)
            v_ = Cons(Alpha("PENDING"), v)
            v_.car = evlis(exprs(e2), n_, v_)
            return eval_(e1, n_, v_)
        case Cons(e1, e2):
            match eval_(e1, n, v):
                case Cons(Cons(args, e3), Cons(n_, v_)):
                    return eval_(e3, Cons(args, n_), Cons(evlis(e2, n, v), v_))
                case e_:
                    raise ValueError(f"Non-function {e_} found at func position")

def assoc(x, n, v):
    match n:
        case Alpha("NIL"):
            raise ValueError(f"Variable {x} not found")
        case Cons(n1, ns):
            if member(x, n1):
                return locate(x, n1, v.car)
            else:
                return assoc(x, ns, v.cdr)
        case _:
            raise ValueError(f"Invalid name list {n} passed to assoc")

def member(x, n1):
    match n1:
        case Alpha("NIL"):
            return False
        case Cons(y, n2):
            return x == y or member(x, n2)

def locate(x, n1, v1):
    if x == n1.car:
        return v1.car
    else:
        return locate(x, n1.cdr, v1.cdr)

def eq(x, y):
    match x, y:
        case Num(n), Num(m):
            res = n == m
        case Alpha(s), Alpha(t):
            res = s == t
        case _:
            res = False
    return Alpha("T" if res else "F")

def numop(x, y, f):
    match x, y:
        case Num(n), Num(m):
            return f(n, m)
        case _:
            raise ValueError(f"Numeric op on non-numeric values {x} and {y}")

def vars_(es):
    match es:
        case Alpha("NIL"):
            return Alpha("NIL")
        case Cons(Cons(n,v), es_):
            return Cons(n, vars_(es_))
        case _:
            raise ValueError(f"Cannot get vars of {es}")

def exprs(es):
    match es:
        case Alpha("NIL"):
            return Alpha("NIL")
        case Cons(Cons(n,v), es_):
            return Cons(v, exprs(es_))
        case _:
            raise ValueError(f"Cannot get exprs of {es}")

def evlis(es, n, v):
    match es:
        case Alpha("NIL"):
            return Alpha("NIL")
        case Cons(e, es_):
            return Cons(eval_(e, n, v), evlis(es_, n, v))
        case _:
            raise ValueError(f"Cannot get evlis of {es}")

def run(s):
    return to_string(eval_(p.parse(s), Alpha("NIL"), Alpha("NIL")))

llparser.py

import string

import lltokens as t
import llast as a

def lex(s):
    s = s.replace("(", " ( ").replace(")", " ) ").replace(".", " . ")
    for token in s.split():
        match token:
            case "(":
                yield t.Lparen()
            case ")":
                yield t.Rparen()
            case ".":
                yield t.Dot()
            case _ if all((c in string.ascii_letters) for c in token):
                yield t.Alpha(token)
            case _ if all((c in string.digits) for c in token):
                yield t.Num(int(token))
            case _:
                raise ValueError(f"Unable to lex {token}")

def parse(s):
    tokens = list(lex(s))[::-1]
    return parse_exp(tokens)

def parse_exp(tokens):
    match tokens.pop():
        case t.Lparen():
            return parse_list(tokens)
        case t.Num(n):
            return a.Num(n)
        case t.Alpha(s):
            return a.Alpha(s)
        case token:
            raise ValueError(f"Unexpected token {token} at start of expression")

def parse_list(tokens):
    items = []
    tail = a.Alpha("NIL")

    while tokens[-1] not in (t.Dot(), t.Rparen()):
        items.append(parse_exp(tokens))

    if tokens[-1] == t.Dot():
        tokens.pop()
        tail = parse_exp(tokens)
        if tokens[-1] != t.Rparen():
            raise ValueError(f"Unexpected token {tokens[-1]} found at end of dotted list")
    tokens.pop()

    for item in reversed(items):
        tail = a.Cons(item, tail)
    return tail

lltokens.py

from dataclasses import dataclass

@dataclass
class Lparen:
    pass

@dataclass
class Rparen:
    pass

@dataclass
class Dot:
    pass

@dataclass
class Alpha:
    s : str

@dataclass
class Num:
    n : int

test_lleval.py

import lleval as m

def test_nil():
    assert m.run("(EQ (QUOTE ()) (QUOTE NIL))") == "T"

def test_quote():
    assert m.run("(QUOTE 1)") == "1"
    assert m.run("(QUOTE TEST)") == "TEST"
    assert m.run("(QUOTE (1 2))") == "(1 2)"
    assert m.run("(QUOTE (1 . 2))") == "(1 . 2)"

def test_atom():
    assert m.run("(ATOM 1)") == "T"
    assert m.run("(ATOM (QUOTE X))") == "T"
    assert m.run("(ATOM (ADD 1 2))") == "T"

    assert m.run("(ATOM (QUOTE (1 2)))") == "F"
    assert m.run("(ATOM (QUOTE (1 . 2)))") == "F"

def test_list():
    assert m.run("(CONS 1 2)") == "(1 . 2)"
    assert m.run("(CONS 1 (QUOTE NIL))") == "(1)"
    assert m.run("(CONS 1 (QUOTE (2 3)))") == "(1 2 3)"

    assert m.run("(CAR (CONS 1 2))") == "1"

    assert m.run("(CDR (CONS 1 2))") == "2"
    assert m.run("(CDR (QUOTE (1 2)))") == "(2)"
    assert m.run("(CDR (CDR (QUOTE (1 2))))") == "NIL"

def test_comp():
    assert m.run("(LEQ 1 2)")  == "T"
    assert m.run("(LEQ 2 1)")  == "F"
    assert m.run("(EQ 1 1)")  == "T"
    assert m.run("(EQ 1 2)")  == "F"

def test_arithmetic():
    assert m.run("(ADD 1 2)")  == "3"
    assert m.run("(SUB 1 2)")  == "-1"
    assert m.run("(MUL 1 2)")  == "2"
    assert m.run("(DIV 1 2)")  == "0"
    assert m.run("(REM 1 2)")  == "1"

def test_if():
    assert m.run("(IF (QUOTE T) 1 2)") == "1"
    assert m.run("(IF (QUOTE F) 1 2)") == "2"
    assert m.run("(IF (EQ 1 1) (SUB 2 1) (ADD 2 0))") == "1"
    assert m.run("(IF (LEQ 3 1) (SUB 2 1) (ADD 2 0))") == "2"

    assert m.run("(ADD (IF (QUOTE T) 3 2) 1)") == "4"

def test_let():
    assert m.run("(LET X (X . 1))") == "1"
    assert m.run("(LET Y (X . 1) (Y . 2))") == "2"
    assert m.run("(LET (ADD X Y) (X . 1) (Y . 2))") == "3"
    assert m.run("(LET (ADD X Y) (X . (SUB 2 1)) (Y . (MUL 2 1)))") == "3"

    assert m.run("(SUB (LET (ADD X Y) (X . 1) (Y . 2)) 2)") == "1"

def test_lambda():
    assert m.run("((LAMBDA (X) (ADD X 1)) 1)") == "2"
    assert m.run("((LAMBDA (X Y) (ADD (MUL X X) (MUL Y Y))) 3 4)") == "25"

    assert m.run("(LET (INC 1) (INC . (LAMBDA (X) (ADD X 1))))") == "2"
    assert m.run("(LET ((REPEAT INC) 1) "
                     "(INC . (LAMBDA (X) (ADD X 1))) "
                     "(REPEAT . (LAMBDA (F) (LAMBDA (X) (F (F X))))))") == "3"

def test_letrec():
    assert m.run("(LETREC (FACTORIAL 5) "
                     "(FACTORIAL . "
                         "(LAMBDA (X) (IF (EQ X 0) 1 (MUL X (FACTORIAL (SUB X 1)))))))") == "120"
    assert m.run("(LETREC (FACTORIAL 5) "
                     "(FACTORIAL . (LAMBDA (X) (IF (EQ X 0) 1 (MUL X (FACTORIAL (DEC X)))))) "
                     "(DEC . (LAMBDA (X) (SUB X 1))))") == "120"

    assert m.run("(LETREC (ODD 17) "
                     "(ODD . (LAMBDA (X) (IF (EQ X 0) (QUOTE F) (EVEN (DEC X))))) "
                     "(EVEN . (LAMBDA (X) (IF (EQ X 0) (QUOTE T) (ODD (DEC X))))) "
                     "(DEC . (LAMBDA (X) (SUB X 1))))") == "T"
    assert m.run("(LETREC (EVEN 17) "
                     "(ODD . (LAMBDA (X) (IF (EQ X 0) (QUOTE F) (EVEN (DEC X))))) "
                     "(EVEN . (LAMBDA (X) (IF (EQ X 0) (QUOTE T) (ODD (DEC X))))) "
                     "(DEC . (LAMBDA (X) (SUB X 1))))") == "F"

    assert m.run("(LETREC (MAP DOUBLE (QUOTE (1 2 3 4 5))) "
                     "(MAP . (LAMBDA (F XS) (IF (EQ XS (QUOTE NIL)) XS (CONS (F (CAR XS)) (MAP F (CDR XS)))))) "
                     "(DOUBLE . (LAMBDA (X) (MUL X 2))))") == "(2 4 6 8 10)"