How do I synthesize pattern matches?

If you use Extensible variant types to extend the variant, you must also extend the pattern match.In addition, if you try to synthesize extensions between two independent variants, you must synthesize two independent functions (using pattern matches internally) (Plus.open_eval and Neg.open_eval in the example below).

To achieve this, the following example defines a synthetic function called orElse with an exception.
However, it is disappointing that the exception is being used.
Is there an idiom or a standard way to do something like "synthesize pattern matches" such as moving to the next designated pattern match if the pattern match fails?

 exception PartialMatchFailure

(*f pattern match fails, detect as an exception and move on to the next function*)
letorElse fg x =
  tryf x with PartialMatchFailure->g x

module Lang=structure
  module Type = structure
    type'a expr =..
    type'a expr+=
         Num —int->int expr
       | App: ('a->'b) expr*'a expr->'b expr
  end
  include Type

  type reval = {f:'a.a expr->'a}

  let open_eval(type a)(eval:reval)(exp:a exp):a=
    match exp with
      Numi ->i
    | App(f, x) - > eval.ff(eval.fx)
    | _->raise PartialMatchFailure

end

(*Lang Enhancements*)
module Plus=structure
  module Type = structure
    type'a Lang.expr+= 
         Plus: (int->int->int) Lang.expr
  end
  include Type

  let open_eval(type a)(val:Lang.reval)(expr:aLang.expr):a= 
    match expr with
      Plus->(+)
    | x->raise PartialMatchFailure

  let show —type a.a Lang.expr ->string=function
      Plus->"plus"
    | Lang.App_-> "app"
    | Lang.Num_-> "num"
    | _->"no match"
end

(*Expand not related to Lang's Plus*)
module Neg=structure
  module Type = structure
    type'a Lang.expr+= 
         Neg: (int->int->int) Lang.expr
  end
  include Type

  let open_eval(type a)(val:Lang.reval)(expr:aLang.expr):a= 
    match expr with
      Neg->(-)
    | x->raise PartialMatchFailure
end

(*Composition of two independent variant extensions (Plus, Neg)*)
modulePlusNegLang=struct
  (*Include can be used to prepare molds*)
  include Lang.Type
  include Plus.Type
  include Neg.Type

  let receipt: 'a.a.a Lang.expr->'a=
    funx->
      let reval=Lang.{f=eval} in
      (*Use orElse to synthesize open_eval*)
      (Neg.open_eval reval
       |>orElse (Plus.open_eval)
       |>orElse(Lang.open_val reval))x

  let()=
    even
      (App
         (App(Plus, App(App(Neg,Num21),Num21),
          App(App(Plus,Num21),Num21)))
    | > print_int
end

ocaml

2022-09-30 17:22

1 Answers

I think it's a functional language implementation method for inheriting classes.

You may want to implement each eval function as a reval->reval, which is a function that extends functions, and then connect them by function synthesis before taking a fixed point.Next, we changed the name to object-oriented, but that's the implementation.

These techniques are also used in the mapper.ml module for ppx extensions inside the OCaml compiler.

However, the pitfall is that if there is even one constructor case that hasn't been implemented yet... if you get that constructor, it will loop indefinitely and die...

type'at=..
type self={f:'a.'at->'a}

moduleNumApp=structure
  module Type = structure
    type'at+=
        Num—int->int
      | App:('a->'b)t*'at->'bt
  end
  open Type

  let extend (self:self): self= 
    letf(type a)(t:at):a=
      match with
      | Numi ->i
      | App(f, x) - > self.ff(self.fx)
      | e->self.fe
    in
    { f=f}

end

module Plus=structure
  module Type = structure
    type'at+= 
      | Plus: (int->int->int)t
  end
  open Type

  let extend (self:self): self=
    letf(type a)(t:at):a=
      match with
        Plus->(+)
      | e->self.fe
    in
    { f=f}
end

module Neg=structure
  module Type = structure
    type'at+= 
      | Neg: (int->int->int)t
  end
  open Type

  let extend (self:self): self=
    letf(type a)(t:at):a=
      match with
      | Neg->(-)
      | e->self.fe
    in
    { f=f}
end

includeNumApp.Type
include Plus.Type
include Neg.Type

let rec fix (self:self->self): self=
  {f=funx->(self(fix self))).fx}

let fixed = fix(funx->NumApp.extend(Plus.extend(Neg.extendx)))

lette=App
  (App(Plus, App(App(Neg,Num21),Num21),
      App(App(Plus,Num21),Num21))

letv=print_int@@fixed.fe

2022-09-30 17:22

If you have any answers or tips

Popular Tags

python x 4647

android x 1593

java x 1494

javascript x 1427

c x 927

c++ x 878

ruby-on-rails x 696

php x 692

python3 x 685

html x 656