summaryrefslogtreecommitdiff
path: root/ipl/procs/sandgen.icn
diff options
context:
space:
mode:
Diffstat (limited to 'ipl/procs/sandgen.icn')
-rw-r--r--ipl/procs/sandgen.icn494
1 files changed, 494 insertions, 0 deletions
diff --git a/ipl/procs/sandgen.icn b/ipl/procs/sandgen.icn
new file mode 100644
index 0000000..aac4917
--- /dev/null
+++ b/ipl/procs/sandgen.icn
@@ -0,0 +1,494 @@
+############################################################################
+#
+# File: sandgen.icn
+#
+# Subject: Procedures for "evaluation sandwiches" code
+#
+# Author: Ralph E. Griswold
+#
+# Date: November 19, 1997
+#
+############################################################################
+#
+# This file is in the public domain.
+#
+############################################################################
+#
+# 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: strings
+#
+############################################################################
+
+link strings
+
+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
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-17 07:15:35 +0000