############################################################################
#
#	File:     eventgen.icn
#
#	Subject:  Procedures for meta-variant code generation
#
#	Author:   Ralph E. Griswold
#
#	Date:     May 23, 1996
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#  This program is designed to be linked with the output of the meta-variant
#  translator.
#
#  It is designed to insert event-reporting code in Icon programs.
#
############################################################################
#
#  Bug:  The invocable declaration is not handled properly.  "invocable all"
#        will get by, but some other forms produce syntax errors.  The
#        problem is in the meta-variant translator itself, not in this
#	 program.
#
############################################################################
#
#  Links:  strings
#
############################################################################

global procname

link strings

#  main() calls tp(), which is produced by the meta-variant
#  translation.

procedure main()

   write("$define MAssign 1")
   write("$define MValue 2")
   write("procedure noop()")
   write("end")

   Mp()

end

procedure Alt(e1, e2)			# e1 | e2

   return cat("(", e1, "|", e2, ")")

end

procedure Apply(e1, e2)		# e1 ! e2

   return cat("(", e1, "!", e2, ")")

end

procedure Arg(e)

   return e

end

procedure Asgnop(op, e1, e2)		# e1 op e2

   return cat("2(event(MAssign, ", image(e1) , "), ",
      e1, " ", op, " ", e2, ", event(MValue, ", e1, "))")

end

procedure Augscan(e1, e2)		# e1 ?:= e2

   return cat("(", e1, " ?:= ", e2, ")")

end

procedure Bamper(e1, e2)		# e1 & e2

   return cat("(", e1, " & ", e2, ")")

end

procedure Binop(op, e1, e2)		# e1 op e2

   return cat("(", e1, " ",  op, " ",  e2, ")")

end

procedure Body(s[])			# procedure body

   if procname == "main" then
      write("   if &source === &main then event := noop")

   every write(!s)

   return

end

procedure Break(e)			# break e

   return cat("break ", e)

end

procedure Case(e, clist)		# case e of { caselist }

   return cat("case ", e, " of {", clist, "}")

end

procedure Cclause(e1, e2)		# e1 : e2

   return cat(e1, " : ", e2, "\n")

end

procedure Clist(e1, e2)		# e1 ; e2 in case list

   return cat(e1, ";", e2)

end

procedure Clit(e)			# 's'

#  return cat("'", e, "'")
   return image(e)

end

procedure Compound(es[])		# { e1; e2; ... }
   local result

   if *es = 0 then return "{}\n"

   result := "{\n"
   every result ||:= !es || "\n"

   return cat(result, "}\n")

end

procedure Create(e)			# create e

   return cat("create ", e)

end

procedure Default(e)			# default: e

   return cat("default: ", e)

end

procedure End()			# end

   write("end")

   return

end

procedure Every(e)			# every e

   return cat("every ", e)

end

procedure EveryDo(e1, e2)		# every e1 do e2

   return cat("every ", e1, " do ", e2)

end

procedure Fail()			# fail

   return "fail"

end

procedure Field(e1, e2)		# e . f

   return cat("(", e1, ".", e2, ")")

end

procedure Global(vs[])		# global v1, v2, ...
   local result

   result := ""
   every result ||:= !vs || ", "

   write("global ", result[1:-2])
   
   return

end

procedure If(e1, e2)			# if e1 then e2

   return cat("if ", e1, " then ", e2)

end

procedure IfElse(e1, e2, e3)		# if e1 then e2 else e3

   return cat("if ", e1, " then ", e2, " else ", e3)

end

procedure Ilit(e)			# i

   return e

end

procedure Initial(s)			# initial e

   write("initial ", s)

   return

end

procedure Invocable(es[])		# invocable ... (problem)

   if \es then write("invocable all")
   else write("invocable ", es)

   return

end

procedure Invoke(e0, es[])		# e0(e1, e2, ...)
   local result

   if *es = 0 then return cat(e0, "()")

   result := ""
   every result ||:= !es || ", "

   return cat(e0, "(", result[1:-2], ")")

end

procedure Key(s)			# &s

   return cat("&", s)

end

procedure Limit(e1, e2)		# e1 \ e2

   return cat("(", e1, "\\", e2, ")")

end

procedure Link(vs[])			# link "v1, v2, ..."

   local result

   result := ""
   every result ||:= !vs || ", "

   write("link ", result[1:-2])

   return

end

procedure List(es[])			# [e1, e2, ... ]
   local result

   if *es = 0 then return "[]"

   result := ""
   every result ||:= !es || ", "

   return cat("[", result[1:-2], "]")

end

procedure Local(vs[])			# local v1, v2, ...
   local result

   result := ""
   every result ||:= !vs || ", "

   write("local ", result[1:-2])
   
   return

end

procedure Next()			# next

   return "next"

end

procedure Not(e)			# not e

   return cat("not(", e, ")")

end

procedure Null()			# &null

   return ""

end

procedure Paren(es[])			# (e1, e2, ... )
   local result

   if *es = 0 then return "()"

   result := ""
   every result ||:= !es || ", "

   return cat("(", result[1:-2], ")")

end

procedure Pdco(e0, es[])		# e0{e1, e2, ... }
   local result

   if *es = 0 then return cat(e0, "{}")

   result := ""
   every result ||:= !es || ", "

   return cat(e0, "{", result[1:-2], "}")

end

procedure Proc(s, es[])		# procedure s(v1, v2, ...)
   local result, e

   if *es = 0 then write("procedure ", s, "()")

   result := ""
   every e := !es do
      if \e == "[]" then result[-2:0] := e || ", "
      else result ||:= (\e | "") || ", "

   write("procedure ", s, "(", result[1:-2], ")")

   procname := s			# needed later

   return

end

procedure Record(s, es[])		# record s(v1, v2, ...)
   local result, field

   if *es = 0 then write("record ", s, "()")

   result := ""
   every field := !es do
      result ||:= (\field | "") || ", "

   write("record ", s, "(", result[1:-2], ")")

   return

end

procedure Repeat(e)			# repeat e

   return cat("repeat ", e)

end

procedure Return(e)			# return e

   return cat("return ", e)

end

procedure Rlit(e)

   return e

end

procedure Scan(e1, e2)			# e1 ? e2

   return cat("(", e1 , " ? ", e2, ")")

end

procedure Section(op, e1, e2, e3)	# e1[e2 op  e3]

   return cat(e1, "[", e2, op, e3, "]")

end

procedure Slit(s)			# "s"

   return image(s)

end

procedure Static(ev[])			# static v1, v2, ..
   local result

   result := ""
   every result ||:= !ev || ", "

   write("static ", result[1:-2])
   
   return

end

procedure Subscript(e1, e2)		# e1[e2]

   return cat(e1, "[", e2, "]")

end

procedure Suspend(e)			# suspend e

   return cat("suspend ", e)

end

procedure SuspendDo(e1, e2)		# suspend e1 do e2

   return cat("suspend ", e1, " do ", e2)

end

procedure To(e1, e2)			# e1 to e2

   return cat("(", e1, " to ", e2, ")")

end

procedure ToBy(e1, e2, e3)		# e1 to e2 by e3

   return cat("(", e1, " to ", e2, " by ", e3, ")")

end

procedure Repalt(e)			# |e

   return cat("(|", e, ")")

end

procedure Unop(op, e)			# op e

   return cat("(", op, e, ")")

end

procedure Until(e)			# until e

   return cat("until ", e)

end

procedure UntilDo(e1, e2)		# until e1 do e2

   return cat("until ", e1, " do ", e2)

end

procedure Var(s)			# v

   return s

end

procedure While(e)			# while e

   return cat("while ", e)

end

procedure WhileDo(e1, e2)		# while e1 do e2

   return cat("while ", e1, " do ", e2)

end