/[svn]/runtime/eval.ml
ViewVC logotype

Diff of /runtime/eval.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 694 by abate, Tue Jul 10 17:55:30 2007 UTC revision 695 by abate, Tue Jul 10 17:56:03 2007 UTC
# Line 5  Line 5 
5  exception MultipleDeclaration of id  exception MultipleDeclaration of id
6  type env = t Env.t  type env = t Env.t
7    
8    let empty = Env.empty
9    
10  let eval_unary_op = ref (fun _ -> assert false)  let eval_unary_op = ref (fun _ -> assert false)
11  let eval_binary_op = ref (fun _ _ -> assert false)  let eval_binary_op = ref (fun _ _ -> assert false)
12    
13    let enter_value = Env.add
14    let enter_values l env =
15      List.fold_left (fun env (x,v) -> Env.add x v env) env l
16    
17    let find_value = Env.find
18    
19  (* To write tail-recursive map-like iteration *)  (* To write tail-recursive map-like iteration *)
20    
21  let make_accu () = Pair(nil,Absent)  let make_accu () = Pair(nil,Absent)
# Line 105  Line 113 
113    let v = eval env l.Typed.let_body in    let v = eval env l.Typed.let_body in
114    let (disp,bind) = Typed.dispatcher_let_decl l in    let (disp,bind) = Typed.dispatcher_let_decl l in
115    let (_,bindings) = run_dispatcher disp v in    let (_,bindings) = run_dispatcher disp v in
116    List.map    List.fold_left
117      (fun (x,i) -> (x, if (i == -1) then v else bindings.(i)))      (fun env (x,i) ->
118           let v = if (i == -1) then v else bindings.(i) in
119           enter_value x v env
120        )
121        env
122      (IdMap.get bind)      (IdMap.get bind)
123    
124  and eval_rec_funs env l =  and eval_rec_funs env l =
# Line 122  Line 134 
134      List.fold_left      List.fold_left
135        (fun env (f, _ ,s) -> Env.add f (Delayed s) env)        (fun env (f, _ ,s) -> Env.add f (Delayed s) env)
136        env slots in        env slots in
137    List.map (fun (f, e, s) -> s := eval env' e; (f, !s)) slots    List.iter (fun (_, e, s) -> s := eval env' e) slots;
138      env'
139    
140  and eval_map env brs v =  and eval_map env brs v =
141    map (eval_map_aux env brs) v    map (eval_map_aux env brs) v
# Line 135  Line 148 
148        eval_map_aux env brs acc' y        eval_map_aux env brs acc' y
149    | String_latin1 (_,_,_,_) | String_utf8 (_,_,_,_) as v ->    | String_latin1 (_,_,_,_) | String_utf8 (_,_,_,_) as v ->
150        eval_map_aux env brs acc (normalize v)        eval_map_aux env brs acc (normalize v)
151      | Concat (x,y) ->
152          let acc = eval_map_aux env brs acc x in
153          eval_map_aux env brs acc y
154    | _ -> acc    | _ -> acc
155    
156  and eval_transform env brs v =  and eval_transform env brs v =
# Line 150  Line 166 
166        if Types.Char.is_empty (brs.Typed.br_accept)        if Types.Char.is_empty (brs.Typed.br_accept)
167        then eval_transform_aux env brs acc q        then eval_transform_aux env brs acc q
168        else eval_transform_aux env brs acc (normalize v)        else eval_transform_aux env brs acc (normalize v)
169      | Concat (x,y) ->
170          let acc = eval_transform_aux env brs acc x in
171          eval_transform_aux env brs acc y
172    | _ -> acc    | _ -> acc
173    
174    
# Line 171  Line 190 
190          set_cdr acc acc';          set_cdr acc acc';
191          eval_xtrans_aux env brs acc' q          eval_xtrans_aux env brs acc' q
192        else eval_xtrans_aux env brs acc (normalize v)        else eval_xtrans_aux env brs acc (normalize v)
193      | Concat (x,y) ->
194          let acc = eval_xtrans_aux env brs acc x in
195          eval_xtrans_aux env brs acc y
196    | Pair (x,y) ->    | Pair (x,y) ->
197        let acc =        let acc =
198          match eval_branches env brs x with          match eval_branches env brs x with
# Line 425  Line 447 
447        eval_map_aux env brs acc' y        eval_map_aux env brs acc' y
448    | Value.String_latin1 (_,_,_,_) | Value.String_utf8 (_,_,_,_) as v ->    | Value.String_latin1 (_,_,_,_) | Value.String_utf8 (_,_,_,_) as v ->
449        eval_map_aux env brs acc (normalize v)        eval_map_aux env brs acc (normalize v)
450      | Value.Concat (x,y) ->
451          let acc = eval_map_aux env brs acc x in
452          eval_map_aux env brs acc y
453    | _ -> acc    | _ -> acc
454    
455  and eval_transform env brs v =  and eval_transform env brs v =
# Line 439  Line 464 
464        if not brs.brs_accept_chars        if not brs.brs_accept_chars
465        then eval_transform_aux env brs acc v        then eval_transform_aux env brs acc v
466        else eval_transform_aux env brs acc (normalize v)        else eval_transform_aux env brs acc (normalize v)
467      | Value.Concat (x,y) ->
468          let acc = eval_transform_aux env brs acc x in
469          eval_transform_aux env brs acc y
470    | _ -> acc    | _ -> acc
471    
472    
# Line 460  Line 488 
488          set_cdr acc acc';          set_cdr acc acc';
489          eval_xtrans_aux env brs acc' q          eval_xtrans_aux env brs acc' q
490        else eval_xtrans_aux env brs acc (normalize v)        else eval_xtrans_aux env brs acc (normalize v)
491      | Value.Concat (x,y) ->
492          let acc = eval_xtrans_aux env brs acc x in
493          eval_xtrans_aux env brs acc y
494    | Value.Pair (x,y) ->    | Value.Pair (x,y) ->
495        let acc =        let acc =
496          match eval_branches env brs x with          match eval_branches env brs x with
Legend:
Removed from v.694  
changed lines
  Added in v.695
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5