You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

能否控制F# Computation Expression匹配顺序实现细粒度控制？

avatar
云上老周
2026-6-15
基于F#计算表达式实现三段式程序构建器的问题

我希望用F#的计算表达式（Computation Expression）语法构造对象，目标是通过单个计算表达式，让编译器自动匹配合适的重载来适配类型。最终要实现一个构建器，支持用户编写三段式代码：

  • 输入段：静态可分析的输入读取逻辑
  • 指令段：执行具体操作的逻辑
  • 结果段：返回计算结果

期望的使用示例如下：

program {
  // 输入段：静态可分析的输入读取
  let! x = Input.read "x"
  and! y = Input.read "y"
  // ...
  
  // 指令段：执行操作
  // ...
  do! InstrFree.show message
  
  // 结果段：返回计算结果
  return x + y
}

虽然用普通函数也能实现该功能，但我想探索计算表达式语法的可能性。下面是一段无法编译的自包含代码，请问如何调整构建器对象让示例正常工作？

type Input<'a> =
  {
    Keys : Set<string>
    TryRead : Map<string, obj> -> 'a option
  }

module Input =

  let read (key : string) : Input<'a> =
    {
      Keys = Set.singleton key
      TryRead =
        fun m ->
          match Map.tryFind key m with
          | Some (:? 'a as a) -> Some a
          | _ -> None
    }

  let map2 (f : 'a -> 'b -> 'c) (x : Input<'a>) (y : Input<'b>) =
    {
      Keys = Set.union x.Keys y.Keys
      TryRead =
        fun m ->
          match x.TryRead m with
          | Some a ->
            match y.TryRead m with
            | Some b -> Some (f a b)
            | None -> None
          | None -> None
    }

type Instr<'a> =
  | Load of string * (string -> 'a)
  | Show of string * (unit -> 'a)

module Instr =

  let map (f : 'a -> 'b) (x : Instr<'a>) : Instr<'b> =
    match x with
    | Load (key, unpack) -> Load (key, unpack >> f)
    | Show (key, unpack) -> Show (key, unpack >> f)

type InstrFree<'a> =
  | Just of 'a
  | Free of Instr<InstrFree<'a>>

module InstrFree =

  let just x =
    Just x

  let rec bind (f : 'a -> InstrFree<'b>) (x : InstrFree<'a>) : InstrFree<'b> =
    match x with
    | Just a -> f a
    | Free instr ->
      Instr.map (bind f) instr
      |> Free

  let show (message : string) =
    InstrFree.Free (Instr.Show (message, fun () -> Just ()))

type Program<'i, 'o> =
  {
    Input : Input<'i>
    Output : 'i -> InstrFree<'o>
  }

module Program =

  let chain (x : Program<'i, 'j>) (y : Program<'j, 'o>) : Program<'i, 'o> =
    {
      Input = Input.map2 (fun a _ -> a) x.Input y.Input
      Output =
        fun i ->
          let f = x.Output i
          f
          |> InstrFree.bind (fun j -> y.Output j)
    }

type ProgramBuilder() =
  member this.MergeSources(x, y) =
    Input.map2 (fun a b -> a, b) x y

  member this.BindReturn(x, y) =
    {
      Input = x
      Output = y
    }

  member this.BindReturn(x, f) =
    {
      Input = x
      Output = fun i -> InstrFree.just (f i)
    }

  member this.Bind(x, f) =
    {
      Input = x.Input
      Output =
        fun i ->
          let a = x.Output i
          a |> InstrFree.bind f
    }

  member this.Combine(a, b) =
    Program.chain a b


let program = ProgramBuilder()

let a =
  program {
    let! x = Input.read "x"

    return x + 1
  }

// 无法编译
let b =
  program {
    let! x = Input.read "x"
    and! y = Input.read "y"

    return x * y
  }

// 无法编译
let c =
  program {
    let! x = Input.read "x"
    and! y = Input.read "y"

    let message = $"x + y = %i{x + y}"

    do! InstrFree.show message
  }

问题分析与修改方案

原代码的核心问题在于ProgramBuilder缺少对以下场景的支持：

  1. let! ... and!并行绑定的完整处理逻辑
  2. do!指令段操作的绑定逻辑
  3. 输入类型Input<'a>到Program<'a, 'a>的自动提升
  4. 完善的Return和Zero成员以支持不同场景

以下是修改后的完整代码，关键修改点已标注：

type Input<'a> =
  {
    Keys : Set<string>
    TryRead : Map<string, obj> -> 'a option
  }

module Input =

  let read (key : string) : Input<'a> =
    {
      Keys = Set.singleton key
      TryRead =
        fun m ->
          match Map.tryFind key m with
          | Some (:? 'a as a) -> Some a
          | _ -> None
    }

  let map2 (f : 'a -> 'b -> 'c) (x : Input<'a>) (y : Input<'b>) =
    {
      Keys = Set.union x.Keys y.Keys
      TryRead =
        fun m ->
          match x.TryRead m with
          | Some a ->
            match y.TryRead m with
            | Some b -> Some (f a b)
            | None -> None
          | None -> None
    }

type Instr<'a> =
  | Load of string * (string -> 'a)
  | Show of string * (unit -> 'a)

module Instr =

  let map (f : 'a -> 'b) (x : Instr<'a>) : Instr<'b> =
    match x with
    | Load (key, unpack) -> Load (key, unpack >> f)
    | Show (key, unpack) -> Show (key, unpack >> f)

type InstrFree<'a> =
  | Just of 'a
  | Free of Instr<InstrFree<'a>>

module InstrFree =

  let just x = Just x

  let rec bind (f : 'a -> InstrFree<'b>) (x : InstrFree<'a>) : InstrFree<'b> =
    match x with
    | Just a -> f a
    | Free instr -> Instr.map (bind f) instr |> Free

  let show (message : string) =
    Free (Instr.Show (message, fun () -> Just ()))

type Program<'i, 'o> =
  {
    Input : Input<'i>
    Output : 'i -> InstrFree<'o>
  }

module Program =

  let chain (x : Program<'i, 'j>) (y : Program<'j, 'o>) : Program<'i, 'o> =
    {
      Input = Input.map2 (fun a _ -> a) x.Input y.Input
      Output = fun i -> x.Output i |> InstrFree.bind (fun j -> y.Output j)
    }

  // 将Input<'a>包装为Program<'a, 'a>
  let fromInput (input : Input<'a>) : Program<'a, 'a> =
    {
      Input = input
      Output = fun i -> InstrFree.just i
    }

  // 无输入的Program，用于do!和纯操作
  let unitProgram (instr : InstrFree<unit>) : Program<unit, unit> =
    {
      Input = { Keys = Set.empty; TryRead = fun _ -> Some () }
      Output = fun _ -> instr
    }

type ProgramBuilder() =
  // 处理单个let!：将Input<'a>转为Program<'a, 'a>
  member this.Bind(input : Input<'a>, f : 'a -> Program<'b, 'c>) : Program<'a * 'b, 'c> =
    let mergedInput = Input.map2 (fun a b -> (a, b)) input f.Input
    {
      Input = mergedInput
      Output = fun (a, b) ->
        let progA = InstrFree.just a
        progA |> InstrFree.bind (fun aVal -> f aVal.Output b)
    }

  // 处理并行let! ... and!
  member this.Bind((inputA : Input<'a>, inputB : Input<'b>), f : 'a * 'b -> Program<'c, 'd>) : Program<'a * 'b * 'c, 'd> =
    let mergedInput = Input.map2 (fun ab c -> (ab, c)) (Input.map2 (fun a b -> (a, b)) inputA inputB) f.Input
    {
      Input = mergedInput
      Output = fun ((a, b), c) ->
        let progAB = InstrFree.just (a, b)
        progAB |> InstrFree.bind (fun abVal -> f abVal.Output c)
    }

  // 处理do!：绑定InstrFree<unit>
  member this.Bind(prog : Program<'i, unit>, f : unit -> Program<'i, 'o>) : Program<'i, 'o> =
    {
      Input = prog.Input
      Output = fun i -> prog.Output i |> InstrFree.bind (fun () -> f ().Output i)
    }

  // 处理do!的简化：直接接受InstrFree<unit>
  member this.Bind(instr : InstrFree<unit>, f : unit -> Program<'i, 'o>) : Program<'i, 'o> =
    this.Bind(Program.unitProgram instr, f)

  // 基础Return：将值转为Program<'a, 'a>
  member this.Return(x : 'a) : Program<'a, 'a> =
    {
      Input = { Keys = Set.empty; TryRead = fun _ -> Some x }
      Output = fun i -> InstrFree.just i
    }

  // ReturnFrom：直接返回Program
  member this.ReturnFrom(prog : Program<'i, 'o>) = prog

  // MergeSources：用于并行绑定的输入合并
  member this.MergeSources(x : Input<'a>, y : Input<'b>) = (x, y)

  // Combine：合并两个Program
  member this.Combine(a : Program<'i, 'j>, b : Program<'j, 'o>) = Program.chain a b

  // Zero：无操作的Program，用于空分支
  member this.Zero() : Program<unit, unit> =
    {
      Input = { Keys = Set.empty; TryRead = fun _ -> Some () }
      Output = fun _ -> InstrFree.just ()
    }


let program = ProgramBuilder()

// 现在可正常编译
let a =
  program {
    let! x = Input.read "x"
    return x + 1
  }

// 现在可正常编译
let b =
  program {
    let! x = Input.read "x"
    and! y = Input.read "y"
    return x * y
  }

// 现在可正常编译
let c =
  program {
    let! x = Input.read "x"
    and! y = Input.read "y"
    let message = $"x + y = %i{x + y}"
    do! InstrFree.show message
    return x + y
  }

关键修改说明

  1. 输入类型提升：添加Program.fromInput逻辑，将Input<'a>自动转为Program<'a, 'a>，让let!可以直接绑定输入读取操作。
  2. 并行绑定支持：扩展MergeSources和对应的Bind重载，处理let! ... and!的并行输入合并逻辑，将多个输入合并为元组类型的输入。
  3. do!指令支持：添加针对InstrFree<unit>的Bind重载，让指令段的操作可以直接通过do!绑定到计算表达式中。
  4. 完善核心成员：添加Return、ReturnFrom、Zero等计算表达式必备成员，覆盖更多场景的语法支持。
  5. 输入合并逻辑优化：调整Bind中的输入合并逻辑，确保多个输入的Keys被正确合并，保持静态可分析性。

内容的提问来源于stack exchange，提问作者sdgfsdh

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级，最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分)， 限时 9.9 元起

产品介绍相关文档
相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级，最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分)， 限时 9.9 元起

产品介绍相关文档
火山引擎 最新活动
全面开放
Doubao-Seedance-2.5全新模型升级

模型再升级,30秒超长叙事, 模态参考扩容

HOT
方舟Codingplan

模型自由，工具不限，最新支持 Deepseek-V4 系列、GLM-5.3 系列

HOT
方舟Agent plan

超全模态模型 × Harness 升级，最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列

HOT
新用户特惠专场

大模型19元起，Al应用9.9元畅享，新人首购爆款尽享优惠

最近更新时间：2026.06.15 12:00:55