Permalink
Browse files

Sane framework for evaluating the attrs.

Laid the groundwork for how this should work, should be simple going forward.
  • Loading branch information...
1 parent 8cbf4cc commit fb639bd2ad02efbb299c141edbdee10c42910d77 @adamalix adamalix committed Nov 15, 2012
Showing with 31 additions and 56 deletions.
  1. +27 −54 src/ljs/ljs_cesk.ml
  2. +4 −2 src/ljs/ljs_kont.ml
View
@@ -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
@@ -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

0 comments on commit fb639bd

Please sign in to comment.