4.3BSD/usr/contrib/icon/samples/prefix.icn

#
#          I N F I X - T O - P R E F I X   C O N V E R S I O N
#

#  This program accepts infix expressions from standard input and
#  writes the corresponding prefix expressions to standard output.

procedure main()
   while write(prefix(read()))
end

procedure prefix(s)
   s := strip(s)
   return lassoc(s,'+-' | '*/') | rassoc(s,'^') | s
end

procedure strip(s)
   while s ? (="(" & s <- tab(bal(')')) & pos(-1))
   return s
end

procedure lassoc(s,c)
   local j
   s ? every j := bal(c)
   return form(s,\j)
end

procedure rassoc(s,c)
   local j
   return form(s,s ? bal(c))
end

procedure form(s,k)
   local a1, a2, op
   s ? {
      a1 := tab(k)
      op := move(1)
      a2 := tab(0)
      }
   return op || "(" || prefix(a1) || "," || prefix(a2) || ")"
end