proc load { name } {
  set sess [session]
  $sess load [file dirname $name] [file tail $name]
  return $sess
}

proc setnetwork { sess net }  {
  set net [$sess compile $net -fd]
  return $net
}

proc getencoding { net file } {
  set i 0 
  set eventc [$net event $i]
  puts $file "ENCODING"
  while {$eventc != "*unknown*"} {
    puts $file "$i $eventc";
    set i [expr $i+1]
    set eventc [$net event $i]
  }
  puts $file "$i nullevent321"
  puts $file "END ENCODING"
}  

proc alphacheck {list1 list2 list3} {
  set p1 0
  set p2 0
  set p3 0
  set l1 [llength $list1]
  set l2 [llength $list2]
  set l3 [llength $list3]
  while {$p1 < $l1} {
    set v1 [lindex $list1 $p1]
    if {$p2 < $l2} {
      set v2 [lindex $list2 $p2] 
    } else {
      set v2 "null"
    }
    if {$p3 < $l3} {
      set v3 [lindex $list3 $p3]
    } else {
      set v3 "null"
    }
    if {$v1 == $v2} {
      if {$v1 == $v3} {
        set p2 [expr $p2+1]
        set p3 [expr $p3+1]
      } else {
        set p2 [expr $p2+1]
      }
    } elseif {$v1 == $v3} {
      set p3 [expr $p3+1]
    } else {
      puts "Error: alphabet mismatch in parallel hierarchy"
      exit 3
    }
    set p1 [expr $p1+1]
  }
  if {($p2 < $l2) || ($p3 < $l3)} {
    puts "Error: alphabet mismatch in parallel hierarchy"
    exit 3
  }
}

proc tickoff {p l} {
  set newl {}
  set i 0
  while {$i < [llength $l]} {
    if {[$p event [lindex $l $i]] != "_tick"} {
      if {$newl != {}} {
        set newl "$newl [lindex $l $i]"
      } else {
        set newl [lindex $l $i]
      }
    }
    set i [expr $i+1]
  }
  return $newl
}

proc getleaves { net2 } {
  set pending "$net2"
  set leaves {}
  while {[llength $pending] > 0} {
    set next [lindex $pending 0]
    set pending [lrange $pending 1 end]
    set branches [$next parts]
    set b1 [lindex $branches 0]
    set b2 [lindex $branches 1]
    set alphabets [$next wiring]
    set a1 [lindex $alphabets 0]
    set a2 [lindex $alphabets 1]
    if {[$b1 operator] != "parallel"} {
      set leaves "$leaves $b1 $a1 stop"
    } else {
      set a [$b1 wiring]
      alphacheck $a1 [lindex $a 0] [lindex $a 1]
      set pending [linsert $pending 0 $b1]
    }
    if {[$b2 operator] != "parallel"} {
      set leaves "$leaves $b2 $a2 stop"
    } else {
      set a [$b2 wiring]
      alphacheck $a2 [lindex $a 0] [lindex $a 1]
      set pending "$pending $b2"
    }
  }
  return $leaves
}

proc printprocesses { list file } {
  while {[llength $list] > 0} {
    set proc [lindex $list 0]
    puts $file "PROCESS"
    puts $file [$proc name]
    puts $file "ALPHABET"
    set i [lsearch $list stop]
    puts $file [tickoff $proc [lrange $list 1 [expr $i-1]]]
    set list [lreplace $list 0 $i]
    set new [$proc compress normal -fd]
    set t [$new transitions]
    set a [$new acceptances]
    set d [$new divergences]
    set nstates [llength $d]
    set state 0
    while {$state < $nstates} {
      if {[lindex $d $state] != 0} {
        puts "Error: process [$new name] is divergent"
        exit 2
      }
      puts $file "STATE"
      puts $file $state
      puts $file "ACCEPTANCES"
      foreach acct [lindex $a $state] {
        puts $file $acct
      }
      puts $file "TRANSITIONS"
      foreach trans $t {
        if {[lindex $trans 0] == $state} {
          puts $file "[lindex $trans 1] [lindex $trans 2]"
        }
      }
      puts $file "ENDSTATE"
      set state [expr $state+1]
    }
    puts $file "END PROCESS"
  }   
}

proc compile { file net file2 } {
  set s [load $file]
  set n [setnetwork $s $net]
  set outputfile [open $file2 w]
  getencoding $n $outputfile
  set nettype [$n operator]
  if {$nettype != "parallel"} {
    puts "Error: process [$n name] is not a network"
    exit 1
  }
  printprocesses [getleaves $n] $outputfile
  close $outputfile
}
