Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Sane framework for evaluating the attrs.

Laid the groundwork for how this should work, should be simple going forward.
  • Loading branch information...
commit fb639bd2ad02efbb299c141edbdee10c42910d77 1 parent 8cbf4cc
@adamalix adamalix authored
Showing with 31 additions and 56 deletions.
  1. +27 −54 src/ljs/ljs_cesk.ml
  2. +4 −2 src/ljs/ljs_kont.ml
View
81 src/ljs/ljs_cesk.ml
@@ -13,8 +13,8 @@ let interp_error pos message =
type closure =
| ExpClosure of S.exp * env
| ValClosure of value * env
- | PEClosure of S.prop * env
- | PVClosure of propv * env ;;
+ | AEClosure of S.exp option * env
+ | AVClosure of value option * env ;;
let exp_of clos = match clos with
| ExpClosure (expr, _) -> Some expr
@@ -171,6 +171,16 @@ let rec eval_cesk desugar clos store kont : (value * store) =
| Stack_overflow ->
raise (PrimErr (add_opt clos [] exp_of, String "s5_cesk_eval overflowed the Ocaml stack"))
end in
+
+ let rec eval_attrs attrsclos store kont =
+ begin match attrsclos, kont with
+ | AEClosure (exp, env), K.Object (None, codexpr, codeval, protoexpr, protoval, klass, ext, props, propsv, k) -> match exp with
+ | Some exp -> eval (ExpClosure (exp, env)) store kont
+ | _ -> (eval_attrs (AEClosure (codexpr, env))
+ store
+ (K.Object (None, None, None, protoexpr, protoval, klass, ext, props, propsv, k)))
+ end in
+
let rec apply p store func args = match func with
| Closure (env, xs, body) ->
let alloc_arg argval argname (store, env) =
@@ -223,61 +233,23 @@ let rec eval_cesk desugar clos store kont : (value * store) =
let store' = set_var store loc v in
eval (ValClosure (v, env)) store' k
(* Object cases *)
+ (* we have to tear this down here so we can pass it around in the object kont *)
| ExpClosure (S.Object (p, attrs, props), env), k ->
- begin
- let { S.primval = primexp; (* Opt *)
- S.code = codexp; (* Opt *)
- S.proto = protoexp; (* Opt *)
- S.extensible = ext;
- S.klass = kls; } = attrs in match primexp with
- (* we have a primexp, we can evaluate it *)
- | Some primexp ->
- (eval (ExpClosure (primexp, env))
- store
- (K.Object (None, codexp, None, protoexp, None, None, ext, kls, props, [])))
- (* no primexp, see if we have a codexp *)
- | _ -> match codexp with
- | Some codexp ->
- (eval (ExpClosure (codexp, env))
- store
- (K.Object (None, None, None, protoexp, None, None, ext, kls, props, [])))
- (* no primexp or codexp, jump straight to protoexp which we can represent as
- Undefined if we have none. *)
- | _ -> match protoexp with
- | Some protoexp ->
- (eval (ExpClosure (protoexp, env))
- store
- (K.Object (None, None, None, None, None, None, ext, kls, props, [])))
- | _ ->
- (* where do we go from here?
- gotta keep from duplicating this match effort *)
- (eval (ValClosure (Undefined, env))
- store
- (K.Object (None, None, None, None, Some Undefined, None, ext, kls, props, [])))
-
+ begin let { S.primval = primexp; (* Opt *)
+ S.code = codexp; (* Opt *)
+ S.proto = protoexp; (* Opt *)
+ S.extensible = ext;
+ S.klass = kls; } = attrs in
+ (eval_attrs (AEClosure (primexp, env))
+ store
+ (K.Object (None, codexp, None, protoexp, None, kls, ext, props, [], k)))
end
+ | ValClosure (primval, env),
+ K.Object (None, Some codexp, None, protoexp, None, klass, ext, props, propsv, k) ->
+ (eval_attrs (AEClosure (Some codexp, env))
+ store
+ (K.Object (Some primval, None, None, protoexp, None, klass, ext, props, propsv, k)))
-(* | ValClosure (p_val, env),
- K.Object (None, Some protoexp, None, codexp, None, None, ext, kls, props, propvs) ->
- begin match protoexp with
- | Some
- (eval (ExpClosure (protoexp, env))
- store
- (K.Object (Some p_val, None, None, codexp, None, None, ext, kls, props, propvs)))
-
- | ValClosure (proto_val, env),
- K.Object (p_val, None, None, Some codexp, None, None, ext, kls, props, propvs) ->
- (eval (ExpClosure (codexp, env))
- store
- (K.Object (p_val, None, Some proto_val, None, None, None, ext, kls, props, propvs)))
- *)
-(* | ValClosure (code_val, env),
- K.Object (Some p_val, None, Some proto_val, None,
- None, None, ext, kls, props, propvs) ->
- let attrsv = {
- code=code_val; proto=proto_val; primval=p_val;
- extensible=ext; klass=kls; } in
- eval (PEClosure (props, env)) store *)
(* Prop Cases *)
@@ -616,6 +588,7 @@ and arity_mismatch_err p xs args = interp_error p ("Arity mismatch, supplied " ^
let sv, store = eval se env store in
Accessor ({ getter = gv; setter = sv}, enum, config), store
*)
+
let err show_stack trace message =
if show_stack then begin
eprintf "%s\n" (string_stack_trace trace);
View
6 src/ljs/ljs_kont.ml
@@ -11,8 +11,10 @@ type id = string
type kont =
| SetBang of loc * kont
- (* primval * codexp opt * codeval opt * protoexp opt * protoval opt * *)
- | Object of value option * S.exp option * value option * S.exp option * value option * attrsv option * bool * string * (string * S.prop) list * (string * propv) list
+ (* attrs[ prim_val option * code_exp option * code_val * proto_exp option * value option * string * bool] * attrsv option * props option * propsv option *)
+ | Object of value option * S.exp option * value option * S.exp option * value option * string * bool * (string * S.prop) list * (string * propv) list * kont
+(* | Object of S.attrs option * attrsv option * string * bool (string * props) list * (string * props) list
+ | Attrs of value option * S.exp option * value option * S.exp option * value option * string * bool*)
| GetAttr of S.pattr * value option * S.exp option * kont
| SetAttr of S.pattr * value option * S.exp option * value option * S.exp option * kont
| GetObjAttr of S.oattr * kont
Please sign in to comment.
Something went wrong with that request. Please try again.