prettyM3
returns Modula-3 code for an expression (or statement)
with embedded prettyprinting escapes.
nohex
is a purely internal flag.
If it is non-null, constants are in hex; otherwise they're in decimal.
<*>= [D->] procedure prettyM3(e, precedence, associativity, nohex) <local declarations forprettyM3
> initial {<initializeM3prec
andM3assoc
>} /precedence := 0 /associativity := "L" return case type(e) of { <cases forprettyM3
> default : impossible("Bad code to prettyM3") } end
DefinesprettyM3
(links are to index).
<cases for prettyM3
>= (<-U) [D->]
<cases forprettyM3
>+= (<-U) [<-D->] "list" : commaseparate(maplist2(prettyM3, e, M3prec[","]), ", $o") "set" : commaseparate(maplist2(prettyM3, sort(e), M3prec["AND"]), " AND $o") "eqn" : { o := M3op(e.op) M3bracket(prettyM3(e.left, M3prec[o]) || " " || o || " $o" || prettyM3(e.right, M3prec[o]), "=", precedence) } "table" : { # standard normal form <makes
represent tablee
, but elide additive and multiplicative units> "$t${" || s || "$}$b" } "string" : if e == "$pc" then "$$pc" else e "literal" : list_to_string(e.s) "integer" : string(e)
The old version printed in any old order, but the new version prints positive terms first, then negative terms, with the constant term last in its group.
<makes
represent tablee
, but elide additive and multiplicative units>= (<-U) { s := ""; leadingsign := "" <add positive terms tos
> leadingsign := " - $o" <add negative terms tos
> s := if s == "" then "0" else M3bracket(s, "+", precedence) }
<add positive terms to s
>= (<-U)
every e[k := 1 ~=== key(e)] > 0 do {
s ||:= leadingsign
s ||:= (1 ~= abs(e[k])) || "*" # print coefficient if not 1
s ||:= prettyM3(k, M3prec["*"])
leadingsign := " + $o"
}
if e[1] > 0 then s ||:= leadingsign || string(e[1])
<add negative terms to s
>= (<-U)
every e[k := 1 ~=== key(e)] < 0 do {
s ||:= leadingsign
s ||:= (1 ~= abs(e[k])) || "*" # print coefficient if not 1
s ||:= prettyM3(k, M3prec["*"])
}
if e[1] < 0 then s ||:= leadingsign || string(-e[1])
<old makes
represent tablee
, but elide additive and multiplicative units>= { # print constant term if nonzero if e[1] ~= 0 then { s := string(e[1]) ; leadingsign := " + $o" } else s := leadingsign := "" # print every nonconstant term k every k := 1 ~=== key(e) do { s ||:= if e[k] < 0 then " - " else leadingsign leadingsign := " + $o" s ||:= (1 ~= abs(e[k])) || "*" # print coefficient if not 1 s ||:= prettyM3(k, M3prec["*"]) } s := if s == "" then "0" else M3bracket(s, "+", precedence) }
<local declarations for prettyM3
>= (<-U) [D->]
local leadingsign
<cases for prettyM3
>+= (<-U) [<-D->]
"Eorb" : "Word.Or(${$t$c" || prettyM3(e.x) || ", $c" || prettyM3(e.y) || "$b$})"
"Eand" : { s := prettyM3(e.x, M3prec["AND"], "L")
t := prettyM3(e.y, M3prec["AND"], "R")
M3bracket(s || " AND $o" || t, "AND", precedence)
}
<cases for prettyM3
>+= (<-U) [<-D->]
"Eslice" : "Word.Extract(${$t$c" || prettyM3(e.x) || ", $c" || e.lo || ", " ||
e.n || "$b$})"
"Eshift" : "Word.Shift(${$t$c" || prettyM3(e.x) || ", $c" || e.n || "$b$})"
<cases for prettyM3
>+= (<-U) [<-D->]
"Enarrowu" : prettyM3(e.x, precedence, associativity) # checked, so must be identity
"Enarrows" : prettyM3(super_simplify(Eslice(e.x, 0, e.n)), precedence, associativity)
"Ewiden" : "Word.Insert(${$t$c" || prettyM3(e.x) ||
", $cMATCH_bits[" ||
prettyM3(super_simplify(Eslice(e.x, e.n-1, 1))) ||
"], $c" || e.n || ", $cWord.Size - " || e.n || "$b$})"
<cases for prettyM3
>+= (<-U) [<-D->]
"Ediv" : { s := prettyM3(e.x, M3prec["DIV"])
s ||:= " DIV " || e.n
M3bracket(s, "DIV", precedence)
}
"Emod" : { s := prettyM3(e.x, M3prec["MOD"])
s ||:= " MOD " || e.n
M3bracket(s, "MOD", precedence)
}
<cases for prettyM3
>+= (<-U) [<-D->]
"Semit" : { s := emittername || "$t(" || prettyM3(e.x, M3prec[","]) || ", $o" ||
e.n || ");$b"
M3bracket("$c" || s, "app", precedence)
}
<cases for prettyM3
>+= (<-U) [<-D->]
"Efitsu" : "Word.LT(${$t$c" || prettyM3(e.x) || ", $c" || (2^e.n) || "$b$})"
"Efitss" : "Word.LT(${$t$c" || prettyM3(addconst(e.x, 2^(e.n-1))) || ", $c" ||
(2^e.n) || "$b$})"
<cases for prettyM3
>+= (<-U) [<-D->]
"Eforce" | "Eforceable" : {
z := if type(e) == "Eforceable" then "_known" else ""
case s := prettyM3(e.x) of {
"$$pc" : "RBlocks.cur_pc" || z || "()"
"_c->loc" : "RBlocks.pc_location" || z || "(_c.loc)"
default : "RBlocks.location" || z || "$t${(" || s || ")$}$b"
}
}
<cases for prettyM3
>+= (<-U) [<-D->]
"Enot" : { s := "NOT " || prettyM3(e.x, M3prec["NOT"])
M3bracket(s, "NOT", precedence)
}
<cases for prettyM3
>+= (<-U) [<-D->]
"Enosimp" : prettyM3(e.x, precedence, associativity)
<cases for prettyM3
>+= (<-U) [<-D->]
"Sstmts" : "${" || commaseparate(maplist2(prettyM3, e.x), " $c") || "$}"
<cases for prettyM3
>+= (<-U) [<-D->]
"Gcall" : { l := []; every put(l, prettyM3(!e.args))
M3noreserve(e.name) || "(" || commaseparate(l) || ")"
}
"Einstance_input" : {
s := "NARROW(" || prettyM3(e.x) ||
", Encode." || e.cons.name || "Instance)." || e.name
M3bracket(s, ".", precedence)
}
"Einstance_tagged" : {
s := "ISTYPE(" || prettyM3(e.x) ||
", Encode." || e.cons.name || "Instance)"
M3bracket(s, "app", precedence)
}
I assume the if statement has been simplified, so there are no arms beyond
any else
arm
<cases for prettyM3
>+= (<-U) [<-D->]
"Sif" : { ifword := "IF "
s := ""
every a := !e.arms do {
s ||:= ifword || M3test(a.guard) || "$t$c" || prettyM3(a.x) || "$b"
ifword := "$cELSIF "
}
"${" || s || " $cEND;$}"
}
<cases for prettyM3
>+= (<-U) [<-D->]
"Efail" : error("Generate-time operation failed: ", e.msg)
<*>+= [<-D->] procedure M3test(guard) return if guard_always_satisfied(guard) then "TRUE THEN " else "$t${" || prettyM3(guard) || "$}$b THEN " end
DefinesM3test
(links are to index).
<cases for prettyM3
>+= (<-U) [<-D->]
"Stagcase" : { s := "TYPECASE " || prettyM3(e.x) || " OF$t${"
every c := kept_constructors(e.type) do
s ||:= "$n| Encode." || c.name || "Instance => $o$t${" ||
prettyM3(e.arms[c]) || "$}$b"
s || "$nELSE <* ASSERT FALSE *>$}$b$nEND; (* " || prettyM3(e.x) || "*)"
}
<cases for prettyM3
>+= (<-U) [<-D->]
"Sfail" : { s := "fail($t${" || image(escape_dollars(e.fmt))
every a := e.a1 | e.a2 | e.a3 do
s ||:= ", $o" || prettyM3(\a, M3prec[","])
s ||:= "$}$b);"
M3bracket(s, "app", precedence)
}
"Sepsilon" : "(* skip *)"
<cases for prettyM3
>+= (<-U) [<-D->]
"Sclosure" : prettyM3(\e.creation) | impossible("creating closure")
<cases for prettyM3
>+= (<-U) [<-D->]
"Glines" : { s := ""; every s ||:= prettyM3(!e.x) || "\n"; s }
"Gresynch" : "<* LINE " || e.line || " " || image(\e.file | "generated-code") || "*>"
<cases for prettyM3
>+= (<-U) [<-D->]
"Gblock" : { s := "${"
every s ||:= prettyM3(!e.decls) || ";$n"
if *e.decls > 0 then
s ||:= "BEGIN ${$t$c"
s ||:= commaseparate(maplist(prettyM3, e.stmts), "$c")
if *e.decls > 0 then
s ||:= "$b$cEND$}"
s || "$}"
}
"Gdecl" : { s := "VAR ${" || e.name
s ||:= " : " || prettyM3(\e.type)
s ||:= " := $t$c" || prettyM3(\e.init) || "$b"
s || "$}"
}
<cases for prettyM3
>+= (<-U) [<-D->]
"Gdeclnamearray" : {
/na_count := 0
/e.na.codename := "MATCH_name_" || e.na.field.field.name || "_" || (na_count +:= 1)
s := "CONST ${" || e.na.codename || " = ARRAY [0.." || (e.na.hi - 1) || "] OF TEXT {"
s ||:= "${$t"
every i := 0 to e.na.hi - 1 do {
s ||:= " $c" || (image(\e.na.tbl[i])|"NIL")
if i < e.na.hi - 1 then s ||:= ","
}
s || "$b$c$}}"
}
<local declarations for prettyM3
>+= (<-U) [<-D]
static na_count
<cases for prettyM3
>+= (<-U) [<-D->]
"Gcase" : { s := "CASE ${" || prettyM3(e.x) || "$} OF "
every s ||:= prettyM3(!e.arms)
"${" || s || "$nEND; (* CASE ${" || prettyM3(e.x) || "$} *)$}"
}
"Gcasearm" : { s := "$n| $t"
every i := 1 to *e.tags by 2 do {
if i > 1 then s ||:= ", $o"
s ||:= if e.tags[i] + 1 = e.tags[i+1] then e.tags[i]
else e.tags[i] || ".." || (e.tags[i+1]-1)
}
s ||:= " => " || "$t$c" || prettyM3(e.x)
"${" || s || "$b$b$}"
}
<cases for prettyM3
>+= (<-U) [<-D->]
"Ginrange" : { x := prettyM3(e.x, M3prec["<"])
if e.lo + 1 = e.hi then {
M3bracket(x || " = " || e.lo, "=", M3prec["AND"])
} else {
c1 := M3bracket(e.lo || " <= " || x, "<=", M3prec["AND"])
c2 := M3bracket(x || " < " || e.hi, "<", M3prec["AND"])
M3bracket(c1 || " AND " || c2, "AND", precedence)
}
}
"Gsetname" : "${VAR " || e.lhs || " := $t$o" || case type(e.name) of {
"string" : image(e.name)
"namearray" : e.name.codename || "[" || prettyM3(e.name.field) || "]"
default : impossible("type of node name field")
} || "$b$}"
"Gasgn" : "${" || e.lhs || " := $t$o" || prettyM3(e.x, M3prec["="]) || ";$b$}"
"Gcomment" : "(* " || e.s || " *)"
"Gcommented" :
prettyM3(e.e, precedence, associativity, nohex) || " (* " || e.comment || " *)"
<cases for prettyM3
>+= (<-U) [<-D->]
"Gnomatch" : "<* ASSERT FALSE *> (* no match *)"
"Tunsigned" : if \e.width < wordsize then
"[0.." || (2^e.width-1) || "]"
else
"Word.T"
<cases for prettyM3
>+= (<-U) [<-D]
"absolute_field" :
prettyM3(super_simplify(afieldexp(e)), precedence, associativity, nohex)
<*>+= [<-D->] global M3prec, M3assoc procedure M3bracket(s, op, p, a) /a := "L" return "${" || (if M3prec[op] > p | (M3prec[op] = p & M3assoc[p] == a) then s else "(" || s || ")") || "$}" end
DefinesM3assoc
,M3bracket
,M3prec
(links are to index).
<initializeM3prec
andM3assoc
>= (<-U) ops := ["N", ["low"], "L", [";"], "L", [","], "L", ["OR"], "L", ["AND"], "L", ["NOT"], "L", ["<=", "<", ">=", ">", "=", "#", "IN"], "L", ["+", "-", "&"], "L", ["MOD", "DIV", "*", "/"], "L", ["^"], "L", ["app"], "L", ["."], "N", ["high"] ] M3prec := table([]) # missed lookups break arithmetic comparisons M3assoc := table() every i := 1 to *ops by 2 do { every M3prec[!ops[i+1]] := i M3assoc[i] := ops[i] }
<*>+= [<-D->] procedure M3op(op) return if op == "!=" then "#" else op end
DefinesM3op
(links are to index).
<*>+= [<-D->] procedure M3noreserve(word) static reserved initial reserved := set([ "AND", "ANY", "ARRAY", "AS", "BEGIN", "BITS", "BRANDED", "BY", "CASE", "CONST", "DIV", "DO", "ELSE", "ELSIF", "END", "EVAL", "EXCEPT", "EXCEPTION", "EXIT", "EXPORTS", "FINALLY", "FOR", "FROM", "GENERIC", "IF", "IMPORT", "IN", "INTERFACE", "LOCK", "LOOP", "METHODS", "MOD", "MODULE", "NOT", "OBJECT", "OF", "OR", "OVERRIDES", "PROCEDURE", "RAISE", "RAISES", "READONLY", "RECORD", "REF", "REPEAT", "RETURN", "REVEAL", "ROOT", "SET", "THEN", "TO", "TRY", "TYPE", "TYPECASE", "UNSAFE", "UNTIL", "UNTRACED", "VALUE", "VAR", "WHILE", "WITH"]) return if member(reserved, word) then M3noreserve(word||"_") else word end
DefinesM3noreserve
(links are to index).
<*>+= [<-D] procedure Generate_M3() eqntoC := eqntoM3 pretty := prettyM3 gen_outer_decls := [literal( "CONST MATCH_bits = ARRAY [0..1] OF Word.T {0, Word.Not(0)}")] gen_file_header := "" fetchtab["type"] := "ADDRESS" fetchtab["add"] := "LOOPHOLE(%a+%o, Word.T)" fetchtab["pc"] := "%a" # fetchtab[8] := "LOOPHOLE(%a+(%o/ADRSIZE(CHAR)), UNTRACED REF [0..255])^" # fetchtab[16] := "LOOPHOLE(%a+(%o/ADRSIZE(CHAR)), UNTRACED REF [0..65535])^" # fetchtab[32] := "LOOPHOLE(%a+(%o/ADRSIZE(CHAR)), UNTRACED REF INTEGER)^" end
DefinesGenerate_M3
(links are to index).
s
>: U1, D2
s
>: U1, D2
prettyM3
>: U1, D2, D3, D4, D5, D6, D7, D8, D9, D10, D11, D12, D13, D14, D15, D16, D17, D18, D19, D20, D21, D22, D23, D24, D25, D26
M3prec
and M3assoc
>: U1, D2
prettyM3
>: U1, D2, D3
s
represent table e
, but elide additive and multiplicative units>: U1, D2
s
represent table e
, but elide additive and multiplicative units>: D1