Untitled
unknown
plain_text
7 months ago
2.7 kB
7
Indexable
Never
(* File: one_step_exp_cps_eval.ml *) open Common;; let rec app_exn_handler env ex_k i = (match ex_k with | ExnContVarCPS exi -> (match lookup_exn_cont env exi with | None -> Failed | Some (_k, _env) -> app_exn_handler _env _k i ) | EmptyExnContCPS -> UncaughtException i | UpdateExnContCPS (l, _k) -> let rec find_ex l i = (match l with | [] -> app_exn_handler env _k i | (None, v)::rem -> Intermediate (env, v) | (n, v)::rem -> if n = Some i then Intermediate (env, v) else find_ex rem i ) in find_ex l i ) let rec app_cont_to_value env k v = match k with | External -> Final v | ContVarCPS (_k) -> (match lookup_cont env _k with | None -> Failed | Some (_k, _env) -> app_cont_to_value _env _k v) | FnContCPS (y, e) -> Intermediate((ValueBinding (y, v))::env, e) | ExnMatch ex_k -> (match v with | IntVal i -> app_exn_handler env ex_k i | _ -> Failed ) let rec one_step_exp_cps_eval env exp_cps = match exp_cps with | ConstCPS (k, c) -> app_cont_to_value env k (const_to_val c) | VarCPS (k, x) -> (match lookup_value env x with | None -> Failed | Some v -> app_cont_to_value env k v) | MonOpAppCPS (k, op, x, e) -> (match lookup_value env x with | None -> Failed | Some v -> (match monOpApply op v with | Exn n -> app_exn_handler env e n | Value v' -> app_cont_to_value env k v' ) ) | BinOpAppCPS (k, op, x, y, e) -> (match (lookup_value env x, lookup_value env y) with | None, None | None, _ | _, None -> Failed | Some v1, Some v2 -> (match binOpApply op v1 v2 with | Exn n -> app_exn_handler env e n | Value v -> app_cont_to_value env k v ) ) | IfCPS (b, e1, e2) -> (match lookup_value env b with | Some (BoolVal true) -> Intermediate (env, e1) | Some (BoolVal false) -> Intermediate (env, e2) | _ -> Failed ) | FunCPS (k, x, ek, e, p) -> app_cont_to_value env k (CPSClosureVal (x, ek, e, p, env)) | FixCPS (k, f, x, ek, e, p) -> app_cont_to_value env k (CPSRecClosureVal (f, x, ek, e, p, env)) | AppCPS (k, f, x, eps) -> (match lookup_value env x with | Some v -> (match lookup_value env f with | None -> Failed | Some CPSClosureVal (y, fk, ek, e, p') -> Intermediate (ValueBinding(y, v)::ContBinding(fk, (k, env))::ExnContBinding(ek, (eps, env))::p', e) | Some CPSRecClosureVal (g, y, fk, ek, e, p') -> Intermediate (ValueBinding(y, v)::ValueBinding(g, (CPSRecClosureVal (g, y, fk, ek, e, p')))::ContBinding(fk, (k, env))::ExnContBinding(ek, (eps, env))::p', e) | _ -> Failed ) | _ -> Failed ) | _ -> Failed