ftp.cs.arizona.edu/ftp.cs.arizona.edu.tar/ftp.cs.arizona.edu/icon/imt/procs/sandgen.icn

Text File | 1994-10-01 | 7KB | 491 lines

############################################################################
#
#    File:     sandgen.icn
#
#    Subject:  Procedures for "evaluation sandwiches" code
#
#    Author:   Ralph E. Griswold
#
#    Date:     September 30, 1994
#
############################################################################
#
#  This program is designed to be linked with the output of the meta-
#  translator.  These procedures produce "evaluation sandwiches"
#  so that program execution can be monitored.
#
#  See "Evaluation Sandwiches", Icon Analyst 6, pp. 8-10, 1991.
#
############################################################################
#
#  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:  cat
#
############################################################################

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

global code_gen

procedure main()

   code_gen := sandwich            # so it can be changed easily

   write("link prepost")        # link the sandwich slices

   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

#  Generate "evaluation sandwich" code.

procedure sandwich(s[])

   push(s, "(pre(), post(")
   put(s, "))")

   return cat ! s

end