Ignore:
Timestamp:
Dec 2, 2011, 3:13:04 PM (8 years ago)
Author:
tranquil
Message:
  • new form of translation written in graphUtilites (mainly as a test before implementation in Matita)
  • rewritten multiplication in RTLasbToRTL
File:
1 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D2.2/8051/src/utilities/graphUtilities.ml

    r1580 r1584  
    8282    NodeMap.filter is_reachable g
    8383
     84  let rec put_rev freshl stmts src dests graph =
     85    match stmts, dests with
     86      | [], [next] -> (src, NodeMap.add src (skip next) graph)
     87      | [last], _ ->
     88        (src, NodeMap.add src (fill_succs last dests) graph)
     89      | last :: stmts, _ ->
     90        let new_l = freshl () in
     91        let graph = NodeMap.add new_l (fill_succs last dests) graph in
     92        (new_l, snd (put_rev freshl stmts src [new_l] graph))
     93      | _ ->
     94        invalid_arg "successors of statement and translation do not match"
     95
     96  let replace freshl lbl stmts succs g =
     97    let succs = match succs with
     98      | Some x -> x
     99      | None -> successors (NodeMap.find lbl g) in
     100
     101    snd (put_rev freshl (List.rev stmts) lbl succs g)
     102
     103  let replace'
     104      (freshl : unit -> node)
     105      (freshr : 'u -> 't -> 'u * 'r)
     106      (lbl : node)
     107      (stmts : (statement, 'r, 't) BList.t)
     108      (succs : node list option)
     109      (def : 'u)
     110      (g : t)
     111      : 'u * t =
     112    let succs = match succs with
     113      | Some x -> x
     114      | None -> successors (NodeMap.find lbl g) in
     115    let (def, l) = BList.compile freshr def stmts in
     116    (def, snd (put_rev freshl l lbl succs g))
     117
     118  let insert freshl lbl stmts g =
     119    let stmt = NodeMap.find lbl g in
     120    let succs = successors (NodeMap.find lbl g) in
     121    put_rev freshl (stmt :: List.rev stmts) lbl succs g
     122
     123  let insert' freshl freshr lbl stmts def g =
     124    let stmt = NodeMap.find lbl g in
     125    let succs = successors (NodeMap.find lbl g) in
     126    let (def, l) = BList.compile freshr def stmts in
     127    let (lbl, g) = put_rev freshl (stmt :: l) lbl succs g in
     128    (def, lbl, g)
     129
    84130end
    85131
     
    155201
    156202  let translate_with_redirects' freshl freshr f def g =
    157 
    158     let rec put_rev stmts src dests def graph =
    159       match stmts, dests with
    160         | BNil, [next] -> (def, Trg.NodeMap.add src (Trg.skip next) graph)
    161         | BCons (last, BNil), _ ->
    162           (def, Trg.NodeMap.add src (Trg.fill_succs last dests) graph)
    163         | BCons (last, stmts), _ ->
    164           let new_l = freshl () in
    165           let graph = Trg.NodeMap.add new_l (Trg.fill_succs last dests) graph in
    166           put_rev stmts src [new_l] def graph
    167         | BNew f_stmts, _ ->
    168           let (def, new_r) = freshr def in
    169           let stmts = f_stmts new_r in
    170           put_rev stmts src dests def graph
    171         | _ ->
    172           invalid_arg "successors of statement and translation do not match" in
    173 
    174     let trans lbl stmt (def, graph) =
     203    let f' def lbl stmt =
    175204      let (stmts, redirects) = f lbl stmt in
    176       let succs = match redirects with
    177         | Some x -> x
    178         | None -> Src.successors stmt in
    179       put_rev (b_rev stmts) lbl succs def graph in
    180 
    181     Src.NodeMap.fold trans g (def, Trg.NodeMap.empty)
     205      let (def, stmts) = BList.compile freshr def stmts in
     206      (def, stmts, redirects) in
     207    translate_with_redirects freshl f' def g
    182208
    183209  let translate' freshl freshr f =
    184210    let f' lbl stmt = (f lbl stmt, None) in
    185211    translate_with_redirects' freshl freshr f'
     212
    186213
    187214
Note: See TracChangeset for help on using the changeset viewer.