diff options
author | Son Ho | 2023-12-21 14:37:43 +0100 |
---|---|---|
committer | Son Ho | 2023-12-21 14:37:43 +0100 |
commit | 8835d87df111d09122267fadc9a32f16b52d234a (patch) | |
tree | 43a1fd0e3ec0e8b94834744396b86bbd3084c888 /compiler/PureUtils.ml | |
parent | e90b23a0d42e2ea6805c88d6eaa4f9e5370a1dc1 (diff) |
Make good progress on merging the fwd/back functions
Diffstat (limited to '')
-rw-r--r-- | compiler/PureUtils.ml | 19 |
1 files changed, 14 insertions, 5 deletions
diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index 6e86578c..6579e84c 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -321,14 +321,23 @@ let destruct_apps (e : texpression) : texpression * texpression list = (** Make an [App (app, arg)] expression *) let mk_app (app : texpression) (arg : texpression) : texpression = + let raise_or_return msg = + if !Config.fail_hard then raise (Failure msg) + else + let e = App (app, arg) in + (* Dummy type - TODO: introduce an error type *) + let ty = app.ty in + { e; ty } + in match app.ty with | TArrow (ty0, ty1) -> (* Sanity check *) - assert (ty0 = arg.ty); - let e = App (app, arg) in - let ty = ty1 in - { e; ty } - | _ -> raise (Failure "Expected an arrow type") + if ty0 <> arg.ty then raise_or_return "App: wrong input type" + else + let e = App (app, arg) in + let ty = ty1 in + { e; ty } + | _ -> raise_or_return "Expected an arrow type" (** The reverse of {!destruct_apps} *) let mk_apps (app : texpression) (args : texpression list) : texpression = |