Project

General

Profile

Revision e8f55c25 src/corelang.ml

View differences:

src/corelang.ml
404 404
  | _                                  -> false
405 405
  in ((*Format.eprintf "coretype_equal %a %a = %B@." Printers.pp_var_type_dec_desc ty1 Printers.pp_var_type_dec_desc ty2 res;*) res)
406 406

  
407
let tag_true = "true"
408
let tag_false = "false"
409 407
let tag_default = "default"
410 408

  
411 409
let const_is_bool c =
......
579 577
let sort_handlers hl =
580 578
 List.sort (fun (t, _) (t', _) -> compare t t') hl
581 579

  
582
let num_10 = Num.num_of_int 10
583

  
584
let cst_real_to_num n i =
585
  Num.(n // (num_10 **/ (num_of_int i)))
586

  
580
  
587 581
let rec is_eq_const c1 c2 =
588 582
  match c1, c2 with
589
  | Const_real (n1, i1, _), Const_real (n2, i2, _)
590
    -> let n1 = cst_real_to_num n1 i1 in
591
       let n2 = cst_real_to_num n2 i2 in
592
	    Num.eq_num n1 n2
583
  | Const_real r1, Const_real r2
584
    -> Real.eq r1 r1 
593 585
  | Const_struct lcl1, Const_struct lcl2
594 586
    -> List.length lcl1 = List.length lcl2
595 587
    && List.for_all2 (fun (l1, c1) (l2, c2) -> l1 = l2 && is_eq_const c1 c2) lcl1 lcl2
......
1414 1406
        
1415 1407
let mk_eq l e1 e2 =
1416 1408
  mkpredef_call l "=" [e1; e2]
1417
      
1409

  
1410

  
1411
let rec partial_eval e =
1412
  let pa = partial_eval in
1413
  let edesc =
1414
    match e.expr_desc with
1415
    | Expr_const _ -> e.expr_desc 
1416
    | Expr_ident id -> e.expr_desc
1417
    | Expr_ite (g,t,e) -> (
1418
       let g, t, e = pa g, pa t, pa e in
1419
       match g.expr_desc with
1420
       | Expr_const (Const_tag tag) when (tag = tag_true) -> t.expr_desc
1421
       | Expr_const (Const_tag tag) when (tag = tag_false) -> e.expr_desc
1422
       | _ -> Expr_ite (g, t, e)
1423
    )
1424
    | Expr_tuple t ->
1425
       Expr_tuple (List.map pa t)
1426
    | Expr_arrow (e1, e2) ->
1427
       Expr_arrow (pa e1, pa e2) 
1428
    | Expr_fby (e1, e2) ->
1429
       Expr_fby (pa e1, pa e2)
1430
    | Expr_pre e ->
1431
       Expr_pre (pa e)
1432
    | Expr_appl (op, args, opt) ->
1433
       let args = pa args in
1434
       if Basic_library.is_expr_internal_fun e then
1435
         Basic_library.partial_eval op args opt
1436
       else
1437
         Expr_appl (op, pa e, opt)
1438
    | Expr_array el ->
1439
       Expr_array (List.map pa el)
1440
    | Expr_access (e, d) ->
1441
       Expr_access (pa e, d)
1442
    | Expr_power (e, d) ->
1443
       Expr_power (pa e, d)
1444
    | Expr_when (e, id, l) ->
1445
       Expr_when (pa e, id, l)
1446
    | Expr_merge (id, gl) -> 
1447
       Expr_merge(id, List.map (fun (l, e) -> l, pa e) gl)
1448
  in
1449
  { e with expr_desc = edesc }
1450

  
1418 1451
    (* Local Variables: *)
1419 1452
    (* compile-command:"make -C .." *)
1420 1453
    (* End: *)

Also available in: Unified diff