ts-type-lisp-eval.ts

// ===================== 解析器 ====================
// 分成三步，避免爆栈
type Reject = never;
type Node = Token | Node[];
type Token = string | number;

type Spaces = ' ' | '\n';
type Pairs = '(' | ')';
type Splits = Spaces | Pairs;

// 解析一个数字表，降低调用栈
type _NumberMap = {
    "0":0,"1":1,"2":2,"3":3,"4":4,"5":5,"6":6,"7":7,"8":8,"9":9,"10":10,
    "11":11,"12":12,"13":13,"14":14,"15":15,"16":16,"17":17,"18":18,"19":19,"20":20,
    "21":21,"22":22,"23":23,"24":24,"25":25,"26":26,"27":27,"28":28,"29":29,"30":30,
    "31":31,"32":32,"33":33,"34":34,"35":35,"36":36,"37":37,"38":38,"39":39,"40":40,
    "41":41,"42":42,"43":43,"44":44,"45":45,"46":46,"47":47,"48":48,"49":49,"50":50,
    "51":51,"52":52,"53":53,"54":54,"55":55,"56":56,"57":57,"58":58,"59":59,"60":60,
    "61":61,"62":62,"63":63,"64":64,"65":65,"66":66,"67":67,"68":68,"69":69,"70":70,
    "71":71,"72":72,"73":73,"74":74,"75":75,"76":76,"77":77,"78":78,"79":79,"80":80,
    "81":81,"82":82,"83":83,"84":84,"85":85,"86":86,"87":87,"88":88,"89":89,"90":90,
    "91":91,"92":92,"93":93,"94":94,"95":95,"96":96,"97":97,"98":98,"99":99, "100": 100}

type ParseNumber<S extends string>
    = S extends keyof _NumberMap ? _NumberMap[S]
    : Reject;

// 分词
type _ParseWord<S extends string>
    = S extends `${infer _}${Splits}${infer _}` ? Reject
    : S extends `${number}` ? _TokenResult<ParseNumber<S>>
    : _TokenResult<S>
type _TokenResult<T extends Token> = { Result: T }

type Tokenize<S extends string, Result extends Token[] = []>
    = S extends '' ? Result
    : S extends `(${infer Next}` ? Tokenize<Next, [...Result, '(']>
    : S extends `)${infer Next}` ? Tokenize<Next, [...Result, ')']>
    : S extends `${Spaces}${infer Next}` ? Tokenize<Next, Result>
    : S extends `${infer _Word}${Splits}${infer _}` ? (
        _ParseWord<_Word> extends _TokenResult<infer Word> ? (
            S extends `${Word}${infer Next}` ? Tokenize<Next, [...Result, Word]> : Reject
        ) : Reject
    )
    : [...Result, S];

// 解析
type _ParseResult<Result extends Node[], Next extends Token[]>
    = { Result: Result, Next: Next }

type _Parse<TS extends Token[]>
    = TS extends ['(', ...infer _Next] ? (
        _Next extends Token[] ?
        _Parse<_Next> extends _ParseResult<infer Result, infer Next> ? 
        _Parse<Next> extends _ParseResult<infer NextResult, infer NextNext> ?
        _ParseResult<[Result, ...NextResult], NextNext>
        : Reject
        : Reject
        : Reject
    )
    : TS extends [')', ...infer _Next] ? (
        _Next extends Token[] ?
            _ParseResult<[], _Next>
        : Reject
    )
    : TS extends [infer Word, ...infer _Next] ? (
        Word extends Token ?
        _Next extends Token[] ?
        _Parse<_Next> extends _ParseResult<infer Result, infer Next> ? _ParseResult<[Word, ...Result], Next> 
        : Reject
        : Reject
        : Reject
    )
    : _ParseResult<[], []>;

type Parse<S extends string> = _Parse<Tokenize<S>> extends _ParseResult<infer Result, infer _> ? Result : Reject;

// ===================== 测试解析 ====================
// type TestParser = Parse<`
//     (define f (x) 
//         (if (x == 0) 
//             x 
//             (+ (f (- x 1)) x)))
//     (f 5)
// `>

// ===================== 基本运算 ====================
// 用于生成长度为 N 的数组
export type NArray<T, N extends number> = N extends N ? (number extends N ? T[] : _NArray<T, N, []>) : never
type _NArray<T, N extends number, R extends unknown[]> = R['length'] extends N ? R : _NArray<T, N, [T, ...R]>
type NArrayNumber<L extends number> = NArray<number, L>

 // 加法
export type Add<M extends number, N extends number> = [...NArrayNumber<M>, ...NArrayNumber<N>]['length']

 // 减法
export type Subtract<M extends number, N extends number> =
  NArrayNumber<M> extends [...x: NArrayNumber<N>, ...rest: infer R] ? R['length'] : unknown

 // 主要用于辅助推导乘除法; 否则会因为 Subtract 返回类型为 number | unknown 报错
type _Subtract<M extends number, N extends number> =
  NArrayNumber<M> extends [...x: NArrayNumber<N>, ...rest: infer R] ? R['length'] : -1

 // 乘法
type _Multiply<M extends number, N extends number, res extends unknown[]> =
  N extends 0 ? res['length'] : _Multiply<M, _Subtract<N, 1>, [...NArray<number, M>, ...res]>
export type Multiply<M extends number, N extends number> = _Multiply<M, N, []>

 // 除法
type _DivideBy<M extends number, N extends number, res extends unknown[]> =
  M extends 0 ? res["length"] : _Subtract<M, N> extends -1 ? unknown : _DivideBy<_Subtract<M, N>, N, [unknown, ...res]>
export type DividedBy<M extends number, N extends number> = N extends 0 ? unknown : _DivideBy<M, N, []>

// 取模
type _Mod<M extends number, N extends number> = 
  M extends 0 ? M : _Subtract<M, N> extends -1 ? M : _Mod<_Subtract<M, N>, N>
export type Mod<M extends number, N extends number> = _Mod<M, N>

// ===================== 求值器 ====================
type _Func<Args extends string[], Body extends Node> = { args: Args, body: Body }
type _Value = number | _Func<string[], Node>
type _EvalEnv = { [name: string]: _Value }
type _MergeEnv<Env extends _EvalEnv, Append extends _EvalEnv> = Omit<Env, keyof Append> & Append;
type _EvalResult<Result extends number, Env extends _EvalEnv> = { Result: Result; Env: Env };

type EvalStat<N extends Node, Env extends _EvalEnv>
    = N extends ['def', infer Name, infer Args, infer Body] ? (
          Name extends string ?
          Args extends string[] ?
          Body extends Node ?
            _EvalResult<0, _MergeEnv<Env, {[N in Name]: { args: Args, body: Body }}>>
          : Reject
          : Reject
          : Reject
    )
    : N extends ['def', infer Name, infer Expr] ? (
        Name extends string ?
        Expr extends Node ?
        EvalExpr<Expr, Env> extends _EvalResult<infer R, infer _> ?
        _EvalResult<0, _MergeEnv<Env, { [N in Name]: R }>>
        : Reject
        : Reject
        : Reject
    )
    : EvalExpr<N, Env>;

type EvalExpr<N extends Node, Env extends _EvalEnv>
    = N extends ['+', infer L, infer R] ? (
        L extends Node ?
        R extends Node ?
        EvalExpr<L, Env> extends _EvalResult<infer LR, infer _> ?
        EvalExpr<R, Env> extends _EvalResult<infer RR, infer _> ?
        Add<LR, RR> extends infer _Tmp ?
         _Tmp extends number ? _EvalResult<_Tmp, Env> : Reject
        : Reject
        : Reject
        : Reject
        : Reject
        : Reject
    )
    : N extends ['-', infer L, infer R] ? (
        L extends Node ?
        R extends Node ?
        EvalExpr<L, Env> extends _EvalResult<infer LR, infer _> ?
        EvalExpr<R, Env> extends _EvalResult<infer RR, infer _> ?
        Subtract<LR, RR> extends infer _Tmp ?
         _Tmp extends number ? _EvalResult<_Tmp, Env> : Reject
        : Reject
        : Reject
        : Reject
        : Reject
        : Reject
    )
    : N extends ['==', infer L, infer R] ? (
        L extends Node ?
        R extends Node ?
        EvalExpr<L, Env> extends _EvalResult<infer LR, infer _> ?
        EvalExpr<R, Env> extends _EvalResult<infer RR, infer _> ?
        LR extends RR ? _EvalResult<1, Env> : _EvalResult<0, Env>
        : Reject
        : Reject
        : Reject
        : Reject
    )
    : N extends ['if', infer Test, infer Consequent, infer Alternate] ? (
        Test extends Node ?
        Consequent extends Node ?
        Alternate extends Node ?
        EvalExpr<Test, Env> extends _EvalResult<infer TR, infer _> ? (
            TR extends 0 
            ? (EvalExpr<Alternate, Env> extends _EvalResult<infer AR, infer _> ? _EvalResult<AR, Env>: Reject)
            : (EvalExpr<Consequent, Env> extends _EvalResult<infer CR, infer _> ? _EvalResult<CR, Env>: Reject)
        ) : Reject
        : Reject
        : Reject
        : Reject
    )
    : N extends [infer Name, ...infer Args] ? (
        Name extends string ?
        Args extends Node[] ?
        Env[Name] extends _Func<infer Names, infer Body> ?
        _EvalArgs<Args, Env> extends _EvalArgsResult<infer Values> ?
        _FuncEnv<Names, Values> extends _FuncEnvResult<infer FuncEnv> ?
        EvalExpr<Body, _MergeEnv<Env, FuncEnv>> extends _EvalResult<infer R, infer _> ?
            _EvalResult<R, Env>
        : Reject
        : Reject
        : Reject
        : Reject
        : Reject
        : Reject
    )
    : N extends number ? _EvalResult<N, Env>
    : N extends string ? (
        Env[N] extends infer _Tmp ?
        _Tmp extends number ?
        _EvalResult<_Tmp, Env>
        : Reject
        : Reject
    )
    : Reject;


type _EvalArgsResult<R extends number[]> = { result: R }
type _EvalArgs<Args extends Node[], Env extends _EvalEnv>
    = Args extends [] ? _EvalArgsResult<[]>
    : Args extends [infer Head, ...infer Next] ? (
        Head extends Node ?
        Next extends Node[] ?
        EvalExpr<Head, Env> extends _EvalResult<infer R, infer _> ?
        _EvalArgs<Next, Env> extends _EvalArgsResult<infer RS> ?
            _EvalArgsResult<[R, ...RS]>
        : Reject
        : Reject
        : Reject 
        : Reject
    )
    : Reject;

type _FuncEnvResult<R extends _EvalEnv> = { result: R }
type _FuncEnv<Names extends string[], Values extends number[]> 
    = Names extends [] ? _FuncEnvResult<{}>
    : Names extends [infer Name, ...infer NextNames] ? (
        Values extends [infer Value, ...infer NextValues] ?
        Name extends string ?
        Value extends number ?
        NextNames extends string[] ?
        NextValues extends number[] ?
        _FuncEnv<NextNames, NextValues> extends _FuncEnvResult<infer NextEnv> ? 
            _FuncEnvResult<{ [N in Name]: Value } & NextEnv>
        : Reject
        : Reject
        : Reject
        : Reject
        : Reject
        : Reject
    )
    : Reject;

type _EvalProgram<Stats extends Node[], Env extends _EvalEnv>
    = Stats extends [] ? _EvalResult<0, Env> 
    : Stats extends [infer Stat, ...infer Next] ? (
        Stat extends Node ?
        Next extends Node[] ?
            EvalStat<Stat, Env> extends _EvalResult<infer R, infer NextEnv> ? 
                Next extends [] ? _EvalResult<R, NextEnv> : _EvalProgram<Next, NextEnv>
            : Reject
        : Reject
        : Reject
    )
    : Reject 

type EvalProgram<S extends string>
    = _EvalProgram<Parse<S>, {}> // extends _EvalResult<infer R, infer _> ? R : Reject; 

type Test = EvalProgram<`
    (def acc (x) 
        (if (== x 0) 
            x
            (+ x (acc (- x 1))) 
        )
    )

    (acc 5)
`>