module til-eblock-desugar
imports liblib TIL-eblocks
strategies

  io-til-eblock-desugar =
    io-wrap(til-eblock-desugar)

  til-eblock-desugar =
    bottomup(try(FunCallToEBlock))
    ; innermost(
        EBlockEBlock
	<+ NoStatements
	<+ MovePostStatementsInFront
        <+ HoistEBlockFromFunCall 
	<+ HoistEBlockFromBinOp 
	<+ HoistEBlockFromAssign 
	<+ HoistEBlockFromProcCall 
//	<+ HoistEBlockFromWrite 
	<+ HoistEBlockFromIf 
	<+ HoistEBlockFromWhile 
	<+ HoistEBlockFromFor
      )
    ; bottomup(try(flatten-block))

rules

  FunCallToEBlock :
    FunCall(f, e*) -> 
    EBlock([Declaration(x), Assign(x, FunCall(f, e*))], Var(x), [])
    where new => x

  NoStatements :
    EBlock([], e, []) -> e

  MovePostStatementsInFront :
    EBlock(st1*, e, st2*@[_|_]) -> 
    EBlock([Declaration(x), st1*, Assign(x, e), st2*], Var(x), [])
    where new => x

  EBlockEBlock :
    EBlock(st1*, EBlock(st2*, e, st3*), st4*) ->
    EBlock([st1*, st2*], e, [st3*, st4*])

  HoistEBlockFromFunCall :
    FunCall(f, e1*) -> EBlock(st1*, FunCall(f, e2*), [])
    where <collect-eblocks> e1* => (st1*, e2*)

  HoistEBlockFromBinOp :
    op#([e1, e2]) -> EBlock(st1*, op#([e1', e2']), [])
    where <is-bin-op> op
	; <collect-eblocks> [e1, e2] => (st1*, [e1', e2'])

  is-bin-op =
    ?"Or" <+ ?"And" <+ ?"Neq" <+ ?"Equ" <+ ?"Gt" <+ ?"Lt" <+ ?"Sub"
    <+ ?"Add" <+ ?"Mod" <+ ?"Div" <+ ?"Mul"

  HoistEBlockFromAssign :
    Assign(x, EBlock(st1*, e, st2*)) -> Block([st1*, st2*, Assign(x, e)])

  HoistEBlockFromProcCall :
    ProcCall(f, e1*) -> Block([st*, ProcCall(f, e2*)])
    where <collect-eblocks> e1* => (st*, e2*)

//  HoistEBlockFromWrite :
//    Write(EBlock(st1*, e, st2*)) -> Block([st1*, Write(e), st2*])

  HoistEBlockFromIf :
    IfElse(EBlock(st1*, e, st2*), st3*, st4*) -> 
    Block([st1*, IfElse(e, [st2*,st3*], [st2*,st4*])])

  HoistEBlockFromIf :
    IfThen(EBlock(st1*, e, st2*), st3*) -> 
    Block([st1*, IfElse(e, [st2*,st3*], st2*)])

  HoistEBlockFromWhile :
    While(EBlock(st1*, e, st2*), st3*) -> 
    Block([st1*, While(e, [st2*,st3*,st1*])])

  HoistEBlockFromFor :
    For(x, e1, e2, st1*) -> 
    Block([st2*, For(x, e1', e2', st1*)])
    where <collect-eblocks> [e1, e2] => (st2*, [e1', e2'])

  collect-eblocks = 
    fetch(?EBlock(_,_,_))
    ; map({where(new => x); !([Declaration(x), Assign(x, <id>)], Var(x))})
    ; unzip
    ; (concat, id)

  
  flatten-block =
    Block(
      foldr(![], \ (Block(st2*), st3*) -> [st2*, st3*] \ 
                     <+ \ (st, st*) -> [st | st*] \ )
      ; partition(?Declaration(_))
      ; conc
    )