path: root/ipl/procs/identgen.icn

############################################################################
#
#	File:     identgen.icn
#
#	Subject:  Procedures for meta-translation code generation
#
#	Author:   Ralph E. Griswold
#
#	Date:     August 3, 2000
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#  This program is designed to be linked with the output of the meta-
#  translator.  As given here, they produce an identity translation.
#  Modifications can be made to effect different translations.
#
############################################################################
#
#  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-translator itself, not in this program.
#
############################################################################
#
#  Links:  strings
#
############################################################################

link strings				# cat(s1, s2, ... )

global code_gen

procedure main()

   code_gen := cat			# so it can be changed easily

   Mp()					# call meta-procedure

end

procedure Alt(e1, e2)			# e1 | e2

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

end

procedure Apply(e1, e2)		# e1 ! e2

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

end

procedure Arg(e)

   return e

end

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

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

end

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

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

end

procedure Bamper(e1, e2)		# e1 & e2

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

end

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

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

end

procedure Body(es[])			# procedure body

   every write(!es)

   return

end

procedure Break(e)			# break e

   return code_gen("break ", e)

end

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

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

end

procedure Cclause(e1, e2)		# e1 : e2

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

end

procedure Clist(cclause1, cclause2)		# cclause1 ; cclause2

   return code_gen(cclause1, ";", cclause2)

end

procedure Clit(c)			# 'c'

   return image(c)

end

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

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

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

   return code_gen(result, "}\n")

end

procedure Create(e)			# create e

   return code_gen("create ", e)

end

procedure Default(e)			# default: e

   return code_gen("default: ", e)

end

procedure End()			# end

   write("end")

   return

end

procedure Every(e)			# every e

   return code_gen("every ", e)

end

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

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

end

procedure Fail()			# fail

   return "fail"

end

procedure Field(e, f)		# e . f

   return code_gen("(", e, ".", f, ")")

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 code_gen("if ", e1, " then ", e2)

end

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

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

end

procedure Ilit(i)			# i

   return i

end

procedure Initial(e)			# initial e

   write("initial ", e)

   return

end

procedure Invocable(ss[])		# invocable s1, s2, ... (problem)

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

   return

end

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

   if *es = 0 then return code_gen(e, "()")

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

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

end

procedure Key(s)			# &s

   return code_gen("&", s)

end

procedure Limit(e1, e2)		# e1 \ e2

   return code_gen("(", 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 code_gen("[", 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 code_gen("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 code_gen("(", result[1:-2], ")")

end

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

   if *es = 0 then return code_gen(e, "{}")

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

   return code_gen(e, "{", result[1:-2], "}")

end

procedure Proc(n, vs[])		# procedure n(v1, v2, ...)
   local result, v

   if *vs = 0 then write("procedure ", n, "()")

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

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

   return

end

procedure Record(n, fs[])		# record n(f1, f2, ...)
   local result, field

   if *fs = 0 then write("record ", n, "()")

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

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

   return

end

procedure Repeat(e)			# repeat e

   return code_gen("repeat ", e)

end

procedure Return(e)			# return e

   return code_gen("return ", e)

end

procedure Rlit(r)			# r

   return r

end

procedure Scan(e1, e2)			# e1 ? e2

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

end

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

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

end

procedure Slit(s)			# "s"

   return image(s)

end

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

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

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

end

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

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

end

procedure Suspend(e)			# suspend e

   return code_gen("suspend ", e)

end

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

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

end

procedure To(e1, e2)			# e1 to e2

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

end

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

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

end

procedure Repalt(e)			# |e

   return code_gen("(|", e, ")")

end

procedure Unop(op, e)			# op e

   return code_gen("(", op, e, ")")

end

procedure Until(e)			# until e

   return code_gen("until ", e)

end

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

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

end

procedure Var(v)			# v

   return v

end

procedure While(e)			# while e

   return code_gen("while ", e)

end

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

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

end