summaryrefslogtreecommitdiff
path: root/ipl/procs/eventgen.icn
diff options
context:
space:
mode:
Diffstat (limited to 'ipl/procs/eventgen.icn')
-rw-r--r--ipl/procs/eventgen.icn495
1 files changed, 495 insertions, 0 deletions
diff --git a/ipl/procs/eventgen.icn b/ipl/procs/eventgen.icn
new file mode 100644
index 0000000..d312100
--- /dev/null
+++ b/ipl/procs/eventgen.icn
@@ -0,0 +1,495 @@
+############################################################################
+#
+# 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
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-08 06:43:28 +0000