用 OCaml 实现一个嵌入式表达式语言

这篇文章的价值：在 Schema 驱动的 UI 系统里，条件渲染、字段校验、动态计算都需要一个表达式引擎。用字符串拼 JavaScript 再 eval 不安全也不可控。这篇文章分享用 OCaml 从零实现一个安全的嵌入式表达式语言的完整过程——Lexer、Parser、AST、Pattern Matching、类型推导、高阶函数——最终通过 js_of_ocaml 编译成 JavaScript，嵌入到前端 UI 框架里。如果你需要在产品中嵌入一个安全可控的计算引擎，这个方案可以参考。

为什么需要自己的表达式语言

在Schema 驱动 UI 那篇文章里，我们用 JSON 描述整个界面。但 JSON 是静态的——它描述不了"当 @age > 18 时显示这个字段"、"@price * @quantity 计算总价"这样的动态逻辑。

最简单的做法是用 JavaScript 的 eval() 或 new Function()。但这有两个致命问题：

• 安全性：eval() 可以执行任意代码。如果表达式来自用户输入（比如运营人员配置表单规则），这是一个巨大的安全漏洞
• 可控性：你没法限制表达式能做什么。它可以访问 DOM、发网络请求、修改全局状态。在一个"配置驱动"的系统里，你需要的是一个沙箱化的、只能做计算的引擎

所以我决定自己实现一个表达式语言。用 OCaml 写，通过 js_of_ocaml 编译成 JavaScript，嵌入到前端框架里。

语言长什么样

先看几个例子，感受一下这个语言的能力：

// 基本算术和比较
1 + 2                         // → 3
@price * @quantity            // → 引用表单字段计算
@age >= 18 and @country = "CN"  // → 条件判断

// LET 绑定
let tax = @price * 0.1 in
let total = @price + tax in
total                         // → 变量绑定和作用域

// 数组和记录
let items = [1, 2, 3] in
items[0]                      // → 1
let user = {name: "Alice", age: 30} in
user.name                     // → "Alice"

// Record Spread
let base = {x: 1, y: 2} in
{...base, z: 3}              // → {x: 1, y: 2, z: 3}

// 条件表达式
if @score >= 90 then "A"
else "B"                      // → OCaml 风格的 if-then-else

// Pattern Matching
match @status with
| "active" -> "在线"
| "idle" when @lastSeen > 60 -> "离开"
| "idle" -> "空闲"
| _ -> "离线"                 // → 带 guard 的模式匹配

// Lambda 和 Pipe
[1, 2, 3, 4]
|> FILTER(fun x -> x > 2)
|> MAP(fun x -> x * 10)      // → [30, 40]

// 类型定义
type User = {name: string, age: int} in
let u: User = {name: "Bob", age: 25} in
u.age                         // → 25

这不是一个玩具——它有 LET 绑定、Pattern Matching with Guards、Lambda、柯里化、Pipe 操作符、Record Spread、类型系统。但它也不是一个通用编程语言——没有循环、没有副作用、没有 IO。它是一个纯粹的计算引擎。

整体架构

表达式字符串
    ↓ Lexer (ocamllex)
Token 流
    ↓ Parser (menhir)
AST
    ↓ Type Inference (types.ml)
类型检查结果
    ↓ Evaluator (driver.ml + runtime.ml)
计算结果

    ↓ js_of_ocaml
编译成 .js，嵌入前端

经典的编译器前端架构。下面逐层展开。

Lexer：ocamllex

Lexer 把字符串切成 token 流。用 OCaml 的 ocamllex 工具生成：

(* lexer.mll *)
let keyword_table = [
  ("if", IF); ("then", THEN); ("else", ELSE);
  ("let", LET); ("in", IN);
  ("match", MATCH); ("with", WITH); ("when", WHEN);
  ("fun", FUN); ("type", TYPE);
  ("and", AND); ("or", OR);
  ("true", TRUE); ("false", FALSE); ("null", NULL);
]

rule token = parse
  | [' ' '\t' '\n']  { token lexbuf }       (* 跳过空白 *)
  | "//" [^'\n']* '\n'  { token lexbuf }     (* 单行注释 *)
  | "/*"              { comment lexbuf }      (* 多行注释 *)
  | '-'? ['0'-'9']+ as i  { NUM (int_of_string i) }
  | '"'              { read_string (Buffer.create 16) lexbuf }
  | ['a'-'z''A'-'Z']['a'-'z''A'-'Z''0'-'9''_']* as id {
      match keyword_of_string id with
      | Some token -> token
      | None -> IDENT id
    }
  | '@' ['a'-'z''A'-'Z']+ as id {
      CONTEXT_VAR (String.sub id 1 (String.length id - 1))
    }
  | "->"  { ARROW }
  | "|>"  { PIPE }
  | "??"  { NULLCOALESCE }
  | "..." { DOTDOTDOT }
  | ...

值得注意的是 @ 前缀变量（CONTEXT_VAR）。在表达式里写 @price，Lexer 会识别为上下文变量——求值时从外部传入的 context 对象里查找。这是表达式语言和宿主环境的接口。

字符串处理支持转义字符和字符串插值（"Hello ${name}"），Lexer 检测到 ${ 模式时标记为 INTERP_STRING，后续在求值阶段递归解析插值表达式。

AST：数据即程序

AST 是整个语言的核心数据结构。OCaml 的代数数据类型（ADT）表达这个再合适不过：

(* ast.ml *)
type pattern =
  | PInt of int          (* 匹配整数字面量 *)
  | PBool of bool        (* 匹配布尔值 *)
  | PString of string    (* 匹配字符串 *)
  | PVar of string       (* 绑定变量 *)
  | PArray of pattern list    (* 解构数组 [x, y, z] *)
  | PRecord of (string * pattern) list  (* 解构记录 {name, age} *)
  | PAny                 (* 通配符 _ *)

type expr =
  | Num of int | Float of float | Bool of bool
  | String of string | InterpString of string | Null
  | Var of string
  (* 数据结构 *)
  | Array of expr list
  | ArrayAccess of expr * expr
  | Record of (string * expr) list
  | RecordAccess of expr * string
  | RecordSpread of expr * (string * expr) list
  (* 算术和逻辑 *)
  | Add of expr * expr | Sub of expr * expr
  | Mul of expr * expr | Div of expr * expr
  | Gt of expr * expr | Lt of expr * expr | ...
  | And of expr * expr | Or of expr * expr | Eq of expr * expr
  | NullCoalesce of expr * expr
  (* 控制流 *)
  | If of expr * expr * expr
  | Let of string * type_expr option * expr * expr
  | Match of expr * (guarded_pattern * expr) list
  (* 函数 *)
  | FuncDef of string * string list * expr
  | Lambda of string list * expr
  | App of expr * expr      (* 柯里化应用 f x *)
  | Pipe of expr * expr     (* x |> f *)
  (* 类型系统 *)
  | TypeDef of type_decl * expr
  | Seq of expr * expr

and guarded_pattern = pattern * expr option

几个设计决策值得说明：

• Let 带可选类型注解：Let of string * type_expr option * expr * expr——let x: int = 5 in ... 或 let x = 5 in ... 都合法
• Match 的 case 是 guarded_pattern * expr：guarded_pattern = pattern * expr option，expr option 就是可选的 when guard
• App 是二元的：f x y 解析为 App(App(f, x), y)——标准的柯里化表示

Parser：menhir

Parser 用 menhir（OCaml 的 LR parser generator）定义。优先级从低到高：

(* parser.mly *)
%nonassoc IN
%nonassoc ARROW
%left SEMICOLON
%left PIPE
%nonassoc ELSE THEN
%left BAR
%left NULLCOALESCE
%left AND OR
%left EQ
%left LT GT LTE GTE
%left PLUS MINUS
%left TIMES DIV
%nonassoc APP           (* 柯里化函数应用 *)
%left DOT
%nonassoc LBRAKET       (* 数组访问 *)

Pattern Matching 的语法规则：

match_cases:
  | guarded_pattern ARROW expr                     { [($1, $3)] }
  | BAR guarded_pattern ARROW expr                 { [($2, $4)] }
  | guarded_pattern ARROW expr BAR match_cases     { ($1, $3) :: $5 }
  | BAR guarded_pattern ARROW expr BAR match_cases { ($2, $4) :: $6 }

guarded_pattern:
  | pattern                  { ($1, None) }
  | pattern WHEN expr        { ($1, Some $3) }

pattern:
  | NUM { PInt $1 }
  | UNDERSCORE { PAny }
  | bool_literal { PBool $1 }
  | STRING { PString $1 }
  | IDENT { PVar $1 }
  | LBRAKET array_patterns RBRAKET { PArray $2 }
  | LBRACE record_pattern_fields RBRACE { PRecord $2 }

第一个 BAR（|）是可选的，所以可以写：

// 两种风格都行
match x with
  1 -> "one"
| 2 -> "two"
| _ -> "other"

match x with
| 1 -> "one"
| 2 -> "two"
| _ -> "other"

Record pattern 支持 shorthand：{name} 等价于 {name: name}，和 JavaScript 的解构语法一致。

求值器：Pattern Matching 的实现

求值器是一个递归函数 eval_expr : env -> expr -> value * env。大部分节点的求值都很直白（加法就是加、比较就是比），最有意思的是 Pattern Matching。

核心是 pattern_matches 函数——给一个值和一个模式，返回匹配成功时的变量绑定（Some env）或失败（None）：

let rec pattern_matches value = function
  | PInt i ->
      (match value with
       | VInt i' when i' = i -> Some Env.empty
       | _ -> None)
  | PString s ->
      (match value with
       | VString s' when s' = s -> Some Env.empty
       | _ -> None)
  | PVar name ->
      (* 变量模式：总是匹配，绑定变量名 *)
      Some (Env.singleton name value)
  | PArray patterns ->
      (match value with
       | VArray elements ->
           if List.length patterns <> List.length elements then None
           else
             (* 递归匹配每个元素 *)
             let matches = List.mapi
               (fun i pat -> pattern_matches (List.nth elements i) pat)
               patterns in
             if List.exists (fun x -> x = None) matches then None
             else Some (merge_all_envs matches)
       | _ -> None)
  | PRecord pattern_fields ->
      (match value with
       | VRecord value_fields ->
           (* 对每个模式字段，在值的记录里查找并递归匹配 *)
           let matches = List.map (fun (key, pat) ->
             match List.assoc_opt key value_fields with
             | Some field_value -> pattern_matches field_value pat
             | None -> None
           ) pattern_fields in
           if List.exists (fun x -> x = None) matches then None
           else Some (merge_all_envs matches)
       | _ -> None)
  | PAny -> Some Env.empty

Match 表达式的求值逻辑——从上到下尝试每个 case，匹配成功且 guard 通过时求值 body：

| Match (e1, cases) ->
    let v1, _ = eval_expr env e1 in
    let rec try_match v = function
      | [] -> failwith "Match error: no pattern matches"
      | ((pattern, guard_opt), body) :: rest ->
          match pattern_matches v pattern with
          | Some pattern_env ->
              let merged_env = Env.union ... pattern_env env in
              (* 检查 guard *)
              let guard_passes = match guard_opt with
                | None -> true
                | Some guard_expr ->
                    match eval_expr merged_env guard_expr with
                    | VBool b, _ -> b
                    | _ -> failwith "Guard must be boolean"
              in
              if guard_passes then eval_expr merged_env body
              else try_match v rest    (* guard 失败，继续下一个 case *)
          | None -> try_match v rest   (* 模式不匹配，继续 *)
    in
    try_match v1 cases

关键点：pattern_env 和当前 env 合并后传给 guard 和 body。这意味着 guard 可以引用模式绑定的变量：

match user with
| {name, age} when age > 18 -> CONCAT(name, " is adult")
//  ↑ name 和 age 在 guard 里可用
| {name} -> CONCAT(name, " is minor")

柯里化和 Pipe

函数应用支持柯里化——如果参数不够，返回一个新的闭包：

| App (func_expr, arg_expr) ->
    (* 收集所有参数 *)
    let func_base, collected_args = collect_args func_expr [arg_val] in
    match find_closure func_base with
    | VClosure (params, body, closure_env) ->
        let n_params = List.length params in
        let n_args = List.length collected_args in
        if n_args < n_params then
          (* 部分应用：返回新闭包 *)
          let applied = take n_args params in
          let remaining = drop n_args params in
          let env' = bind_params closure_env applied collected_args in
          (VClosure (remaining, body, env'), env)
        else if n_args = n_params then
          (* 完全应用：求值 body *)
          let env' = bind_params closure_env params collected_args in
          eval_expr env' body
        else
          failwith "Too many arguments"

Pipe 操作符（|>）把左侧的值作为右侧函数的第一个参数：

// 这两个等价
[1, 2, 3] |> MAP(fun x -> x * 2)
MAP([1, 2, 3], fun x -> x * 2)

// 可以链式调用
[1, 2, 3, 4, 5]
|> FILTER(fun x -> x > 2)     // → [3, 4, 5]
|> MAP(fun x -> x * 10)       // → [30, 40, 50]
|> SUM                         // → 120

实现上，Pipe 会根据右侧的类型做不同的处理：如果是函数调用 FUNC(args)，就把左侧值插入为第一个参数；如果是变量名，就把它当作单参数函数调用；如果是 Lambda，直接应用。

类型系统

这个语言有一个完整的类型推导系统。类型表示：

type typ =
  | TInt | TFloat | TBool | TString | TDate | TNull
  | TArray of typ
  | TRecord of (string * typ) list
  | TFunction of typ list * typ
  | TUnion of typ list        (* int | string *)
  | TAny                      (* 动态类型 *)
  | TName of string           (* 用户定义类型引用 *)

类型推导是双向的：

// 从值推导类型
let x = 42 in ...              // x : int
let arr = [1, 2, 3] in ...     // arr : int[]
let u = {name: "Alice"} in ... // u : {name: string}

// 从类型注解检查
let x: int = 42 in ...         // OK
type User = {name: string, age: int} in
let u: User = {name: "Bob", age: 25} in ...  // OK

类型系统支持结构化子类型（structural subtyping）——Record 类型的子类型关系基于字段是否包含，而不是名字是否相同：

let is_subtype t1 t2 =
  match (t1, t2) with
  | _, TAny -> true              (* 所有类型都是 Any 的子类型 *)
  | TInt, TFloat -> true         (* Int 可以用在 Float 的位置 *)
  | TNull, _ -> true             (* Null 可以是任何类型 *)
  | TRecord f1, TRecord f2 ->
      (* 结构化子类型：f1 包含 f2 的所有字段 *)
      List.for_all (fun (k2, v2) ->
        match List.assoc_opt k2 f1 with
        | Some v1 -> is_subtype v1 v2
        | None -> false
      ) f2
  | ...

If-then-else 的类型推导使用 unify——两个分支的类型取并集，如果不兼容就返回 Union 类型：

| If (_, then_expr, else_expr) ->
    let t1 = infer_type env then_expr in
    let t2 = infer_type env else_expr in
    simplify_type (unify t1 t2)
    // if ... then 1 else 2.0  → float（Int 提升为 Float）
    // if ... then 1 else "a"  → int | string（Union 类型）

内置函数库

除了语言本身的特性，还有一个丰富的内置函数库，按类别组织：

高阶函数的实现需要特殊处理——内置函数需要调用用户传入的 Lambda。这里用了一个引用来打破循环依赖：

(* builtin.ml *)
(* 引用 eval_expr，由 driver.ml 初始化 *)
let eval_closure_ref : (value Env.t -> expr -> value) ref =
  ref (fun _ _ -> failwith "eval_closure not initialized")

let apply_closure closure args =
  match closure with
  | VClosure (params, body, closure_env) ->
      let env' = bind_params closure_env params args in
      !eval_closure_ref env' body
  | _ -> failwith "Expected a function"

(* driver.ml 初始化 *)
let () =
  Builtin.eval_closure_ref := fun env expr ->
    let result, _ = eval_expr env expr in
    result

这是 OCaml 里处理模块间循环依赖的经典模式——用 ref 做延迟绑定。

编译到 JavaScript

整个 OCaml 代码通过 js_of_ocaml 编译成一个 JavaScript 文件，发布为 npm 包 @gigaboo/expr：

// JavaScript 端使用
import { libexpr } from '@gigaboo/expr';

// 简单求值
libexpr.eval('1 + 2');                    // → 3
libexpr.eval('LET x = 10 IN x * 2');     // → 20

// 带上下文求值（@ 变量从这里取值）
libexpr.evalInContext('@price * @qty', {
  price: 99.9,
  qty: 3
});                                       // → 299.7

// 类型推导
libexpr.inferType('LET x = [1, 2] IN x'); // → "int[]"

在 Schema 驱动 UI 里的实际用法：

// ComponentSchema 里的条件渲染
{
  "type": "TextField",
  "props": { "label": "公司名称" },
  "when": "@employmentType = \"employed\"",
  "validation": {
    "rule": "LEN(@companyName) >= 2",
    "message": "公司名称至少2个字符"
  }
}

// 前端渲染器调用表达式引擎
const shouldShow = libexpr.evalInContext(
  schema.when,
  formState  // { employmentType: "employed", ... }
);
if (shouldShow) {
  renderComponent(schema);
}

真值表生成：让业务人员自己验证规则

做 Schema 驱动表单时发现一个问题：业务人员（产品经理、运营）配置条件规则时，经常不确定自己写的逻辑对不对。比如一个审批流规则 isManager and (amount > 1000 or isUrgent)，他们很难在脑子里穷举所有情况。

但他们会用 Excel。很多业务人员验证逻辑的方式就是在 Excel 里手动列一个真值表——把所有变量组合列出来，逐行检查结果是否符合预期。

既然有了表达式求值器，这件事可以自动化。给一个布尔表达式，自动生成完整的真值表：

libexpr.analyze('a and (b or c)');

// 输出：
// -------------------
// | a | b | c | result |
// -------------------
// | T | T | T | T      |
// | T | T | F | T      |
// | T | F | T | T      |
// | T | F | F | F      |
// | F | T | T | F      |
// | F | T | F | F      |
// | F | F | T | F      |
// | F | F | F | F      |
// -------------------

实现方式：从表达式 AST 里递归收集所有变量名，生成 2^n 个布尔组合，逐个求值。

let rec collect_vars = function
  | Var name -> [name]
  | And (e1, e2) | Or (e1, e2) -> collect_vars e1 @ collect_vars e2
  | _ -> []

let rec gen_combinations = function
  | [] -> [[]]
  | v :: vs ->
      let rest = gen_combinations vs in
      List.map (fun l -> (v, true) :: l) rest
      @ List.map (fun l -> (v, false) :: l) rest

let analyze_expr expr =
  let vars = List.sort_uniq String.compare (collect_vars expr) in
  let combinations = gen_combinations vars in
  List.map (fun env ->
    let env_map = (* 把 [(name, bool)] 转成求值环境 *) in
    let result = eval_expr env_map expr in
    (env, result)
  ) combinations

在产品里，这个功能被集成到表单规则的配置界面：业务人员写完条件表达式后，点一下"验证"就能看到真值表，直观地确认每种情况下的行为是否符合预期。不需要发布上线再测试，也不需要找开发帮忙检查逻辑。

为什么用 OCaml

用 OCaml 写表达式引擎，不是因为它多酷，而是因为它的几个特性让这类工作异常顺手：

• 代数数据类型 + Pattern Matching：AST 定义和递归求值用 ADT 写出来极其自然。写 match expr with Add(e1, e2) -> ... 比写一堆 if-else 或 visitor pattern 清爽太多
• ocamllex + menhir：工业级的 Lexer/Parser 生成器，直接从语法定义生成高效的解析代码。不需要手写递归下降
• js_of_ocaml：编译到 JavaScript 的成熟方案。生成的 JS 文件可以直接当 npm 包发布，对调用方完全透明
• 类型安全：OCaml 的类型系统保证了求值器的穷尽性——如果你在 AST 里加了一个新节点但忘了处理，编译器会报错

总结

这个表达式语言的设计目标是：在配置驱动的 UI 系统里，提供一个安全、可控、表达力足够的计算引擎。

它的能力边界很清晰：

• 能做的：算术、比较、逻辑运算、条件分支、模式匹配、数组/记录操作、高阶函数、类型检查
• 不能做的：循环、副作用、IO、访问 DOM、发网络请求

这个"不能做"恰恰是它的价值——在一个运营人员可以配置表单规则的系统里，你希望表达式引擎只能做计算，不能做任何危险的事情。

完整的实现大约 1000 行 OCaml 代码（lexer + parser + AST + evaluator + type system + builtins）。如果你也需要在产品中嵌入表达式引擎，OCaml + js_of_ocaml 是一个值得考虑的方案。

这篇文章是 Schema 驱动系列的延伸。系列其他文章：Schema 驱动表单（上）：数据模型与渲染器、Schema 驱动表单（下）：表达式引擎与通用 UI 渲染