55 lines
1.5 KiB
OCaml
55 lines
1.5 KiB
OCaml
type var = int
|
|
|
|
type t =
|
|
| Var of var
|
|
| Const of string
|
|
| Free of string
|
|
| Function of string * t list
|
|
|
|
type match_result = All of t | Some of t | None | MatchErr
|
|
|
|
let merge_result m1 m2 =
|
|
match (m1, m2) with
|
|
| All t1, All t2 -> if t1 = t2 then All t1 else MatchErr
|
|
| All t1, Some _ -> Some t1
|
|
| Some _, All t2 -> Some t2
|
|
| Some t1, Some t2 -> if t1 = t2 then Some t1 else MatchErr
|
|
| None, _ -> m2
|
|
| _, None -> m1
|
|
| _ -> MatchErr
|
|
|
|
let rec match_term x t1 t2 =
|
|
if x = t1 then if t1 = t2 then Some t2 else All t2
|
|
else
|
|
match (t1, t2) with
|
|
| Var v1, Var v2 -> if v1 = v2 then None else MatchErr
|
|
| Const s1, Const s2 -> if s1 = s2 then None else MatchErr
|
|
| Free s1, Free s2 -> if s1 = s2 then None else MatchErr
|
|
| Function (f1, ts1), Function (f2, ts2) ->
|
|
if f1 = f2 && List.(length ts1 = length ts2) then
|
|
List.(map2 (match_term x) ts1 ts2 |> fold_left merge_result None)
|
|
else MatchErr
|
|
| _ -> MatchErr
|
|
|
|
let rec inc_var = function
|
|
| Var v -> Var (v + 1)
|
|
| Const s -> Const s
|
|
| Free s -> Free s
|
|
| Function (f, ts) -> Function (f, List.map inc_var ts)
|
|
|
|
let rec occurs t = function
|
|
| Function (_, ts) -> List.exists (occurs t) ts
|
|
| s -> t = s
|
|
|
|
exception UnboundVariable
|
|
|
|
let to_string ~binders =
|
|
let open Format in
|
|
let rec aux = function
|
|
| Var v -> ( try List.nth binders v with _ -> raise UnboundVariable)
|
|
| Const c -> c
|
|
| Free f -> f
|
|
| Function (f, args) ->
|
|
sprintf "%s(%s)" f (String.concat ", " (List.map aux args))
|
|
in
|
|
aux
|