include "opname.m"; znode: Node; isused = array[Oend] of{ Oas => 1, Odas => 1, Oaddas => 1, Osubas => 1, Omulas => 1, Odivas => 1, Omodas => 1, Oexpas => 1, Oandas => 1, Ooras => 1, Oxoras => 1, Olshas => 1, Onothing => 1, Orshas => 1, Oinc => 1, Odec => 1, Opreinc => 1, Opredec => 1, Ocall => 1, Oraise => 1, Ospawn => 1, Osnd => 1, Orcv => 1, * => 0}; sideeffect := array[Oend] of{ Oas => 1, Odas => 1, Oaddas => 1, Osubas => 1, Omulas => 1, Odivas => 1, Omodas => 1, Oexpas => 1, Oandas => 1, Ooras => 1, Oxoras => 1, Olshas => 1, Orshas => 1, Oinc => 1, Odec => 1, Opreinc => 1, Opredec => 1, Ocall => 1, Oraise => 1, Ospawn => 1, Osnd => 1, Orcv => 1, Oadr => 1, Oarray => 1, Ocast => 1, Ochan => 1, Ocons => 1, Odiv => 1, Odot => 1, Oind => 1, Oindex => 1, Oinds => 1, Oindx => 1, Olen => 1, Oload => 1, Omod => 1, Oref => 1, * => 0}; opcommute = array[Oend] of{ Oeq => Oeq, Oneq => Oneq, Olt => Ogt, Ogt => Olt, Ogeq => Oleq, Oleq => Ogeq, Oadd => Oadd, Omul => Omul, Oxor => Oxor, Oor => Oor, Oand => Oand, * => 0}; oprelinvert = array[Oend] of{ Oeq => Oneq, Oneq => Oeq, Olt => Ogeq, Ogt => Oleq, Ogeq => Olt, Oleq => Ogt, * => 0}; isrelop := array[Oend] of{ Oeq => 1, Oneq => 1, Olt => 1, Oleq => 1, Ogt => 1, Ogeq => 1, Oandand => 1, Ooror => 1, Onot => 1, * => 0}; ipow(x: big, n: int): big{ inv: int; r: big; inv = 0; if(n < 0){ n = -n; inv = 1; } r = big 1; for(;;){ if(n&1) r *= x; if((n >>= 1) == 0) break; x *= x; } if(inv) r = big 1/r; return r;} rpow(x: real, n: int): real{ inv: int; r: real; inv = 0; if(n < 0){ n = -n; inv = 1; } r = 1.0; for(;;){ if(n&1) r *= x; if((n >>= 1) == 0) break; x *= x; } if(inv) r = 1.0/r; return r;} real2fix(v: real, t: ref Type): big{ return big(v/scale(t));} fix2fix(v: big, f: ref Type, t: ref Type): big{ return big(real v * (scale(f)/scale(t)));} fix2real(v: big, f: ref Type): real{ return real v * scale(f);} istuple(n: ref Node): int{ d: ref Decl; case(n.op){ Otuple => return 1; Oname => d = n.decl; if(d.importid != nil) d = d.importid; return d.store == Dconst && (n.ty.kind == Ttuple || n.ty.kind == Tadt); Odot => return 0; # istuple(n.left); } return 0;} tuplemem(n: ref Node, d: ref Decl): ref Node{ ty: ref Type; ids: ref Decl; ty = n.ty; n = n.left; for(ids = ty.ids; ids != nil; ids = ids.next){ if(ids.sym == d.sym) break; else n = n.right; } if(n == nil) fatal("tuplemem cannot cope !\n"); return n.left;} varcom(v: ref Decl): int{ n := v.init; n = fold(n); v.init = n; if(debug['v']) print("variable '%s' val %s\n", v.sym.name, expconv(n)); if(n == nil) return 1; tn := ref znode; tn.op = Oname; tn.decl = v; tn.src = v.src; tn.ty = v.ty; return initable(tn, n, 0);} initable(v, n: ref Node, allocdep: int): int{ case n.ty.kind{ Tiface or Tgoto or Tcase or Tcasel or Tcasec or Talt or Texcept => return 1; Tint or Tbig or Tbyte or Treal or Tstring or Tfix => if(n.op != Oconst) break; return 1; Tadt or Tadtpick or Ttuple => if(n.op == Otuple) n = n.left; else if(n.op == Ocall) n = n.right; else break; for(; n != nil; n = n.right) if(!initable(v, n.left, allocdep)) return 0; return 1; Tarray => if(n.op != Oarray) break; if(allocdep >= DADEPTH){ nerror(v, expconv(v)+"s initializer has arrays nested more than "+string allocdep+" deep"); return 0; } allocdep++; usedesc(mktdesc(n.ty.tof)); if(n.left.op != Oconst){ nerror(v, expconv(v)+"s size is not a constant"); return 0; } for(e := n.right; e != nil; e = e.right) if(!initable(v, e.left.right, allocdep)) return 0; return 1; Tany => return 1; Tref or Tlist or Tpoly or * => nerror(v, "can't initialize "+etconv(v)); return 0; } nerror(v, expconv(v)+"s initializer, "+expconv(n)+", is not a constant expression"); return 0;} ## merge together two sorted lists, yielding a sorted list#elemmerge(e, f: ref Node): ref Node{ r := rock := ref Node; while(e != nil && f != nil){ if(e.left.left.c.val <= f.left.left.c.val){ r.right = e; e = e.right; }else{ r.right = f; f = f.right; } r = r.right; } if(e != nil) r.right = e; else r.right = f; return rock.right;} ## recursively split lists and remerge them after they are sorted#recelemsort(e: ref Node, n: int): ref Node{ if(n <= 1) return e; m := n / 2 - 1; ee := e; for(i := 0; i < m; i++) ee = ee.right; r := ee.right; ee.right = nil; return elemmerge(recelemsort(e, n / 2), recelemsort(r, (n + 1) / 2));} ## sort the elems by index; wild card is first#elemsort(e: ref Node): ref Node{ n := 0; for(ee := e; ee != nil; ee = ee.right){ if(ee.left.left.op == Owild) ee.left.left.c = ref Const(big -1, 0.); n++; } return recelemsort(e, n);} sametree(n1: ref Node, n2: ref Node): int{ if(n1 == n2) return 1; if(n1 == nil || n2 == nil) return 0; if(n1.op != n2.op || n1.ty != n2.ty) return 0; if(n1.op == Oconst){ case(n1.ty.kind){ Tbig or Tbyte or Tint => return n1.c.val == n2.c.val; Treal => return n1.c.rval == n2.c.rval; Tfix => return n1.c.val == n2.c.val && tequal(n1.ty, n2.ty); Tstring => return n1.decl.sym == n2.decl.sym; } return 0; } return n1.decl == n2.decl && sametree(n1.left, n2.left) && sametree(n1.right, n2.right);} occurs(d: ref Decl, n: ref Node): int{ if(n == nil) return 0; if(n.op == Oname){ if(d == n.decl) return 1; return 0; } return occurs(d, n.left) + occurs(d, n.right);} ## left and right subtrees the same#folds(n: ref Node): ref Node{ if(hasside(n, 1)) return n; case(n.op){ Oeq or Oleq or Ogeq => n.c = ref Const(big 1, 0.0); Osub => n.c = ref Const(big 0, 0.0); Oxor or Oneq or Olt or Ogt => n.c = ref Const(big 0, 0.0); Oand or Oor or Oandand or Ooror => return n.left; * => return n; } n.op = Oconst; n.left = n.right = nil; n.decl = nil; return n;} ## constant folding for typechecked expressions#fold(n: ref Node): ref Node{ if(n == nil) return nil; if(debug['F']) print("fold %s\n", nodeconv(n)); n = efold(n); if(debug['F']) print("folded %s\n", nodeconv(n)); return n;} efold(n: ref Node): ref Node{ d: ref Decl; if(n == nil) return nil; left := n.left; right := n.right; case n.op{ Oname => d = n.decl; if(d.importid != nil) d = d.importid; if(d.store != Dconst){ if(d.store == Dtag){ n.op = Oconst; n.ty = tint; n.c = ref Const(big d.tag, 0.); } break; } case n.ty.kind{ Tbig => n.op = Oconst; n.c = ref Const(d.init.c.val, 0.); Tbyte => n.op = Oconst; n.c = ref Const(big byte d.init.c.val, 0.); Tint or Tfix => n.op = Oconst; n.c = ref Const(big int d.init.c.val, 0.); Treal => n.op = Oconst; n.c = ref Const(big 0, d.init.c.rval); Tstring => n.op = Oconst; n.decl = d.init.decl; Ttuple => *n = *d.init; Tadt => *n = *d.init; n = rewrite(n); # was call Texception => if(n.ty.cons == byte 0) fatal("non-const exception type in efold"); n.op = Oconst; * => fatal("unknown const type "+typeconv(n.ty)+" in efold"); } Oadd => left = efold(left); right = efold(right); n.left = left; n.right = right; if(n.ty == tstring && right.op == Oconst){ if(left.op == Oconst) n = mksconst(n.src, stringcat(left.decl.sym, right.decl.sym));Lines 1–500 of 1402. Load more
include "opname.m"; znode: Node; isused = array[Oend] of { Oas => 1, Odas => 1, Oaddas => 1, Osubas => 1, Omulas => 1, Odivas => 1, Omodas => 1, Oexpas => 1, Oandas => 1, Ooras => 1, Oxoras => 1, Olshas => 1, Onothing => 1, Orshas => 1, Oinc => 1, Odec => 1, Opreinc => 1, Opredec => 1, Ocall => 1, Oraise => 1, Ospawn => 1, Osnd => 1, Orcv => 1, * => 0 }; sideeffect := array[Oend] of { Oas => 1, Odas => 1, Oaddas => 1, Osubas => 1, Omulas => 1, Odivas => 1, Omodas => 1, Oexpas => 1, Oandas => 1, Ooras => 1, Oxoras => 1, Olshas => 1, Orshas => 1, Oinc => 1, Odec => 1, Opreinc => 1, Opredec => 1, Ocall => 1, Oraise => 1, Ospawn => 1, Osnd => 1, Orcv => 1, Oadr => 1, Oarray => 1, Ocast => 1, Ochan => 1, Ocons => 1, Odiv => 1, Odot => 1, Oind => 1, Oindex => 1, Oinds => 1, Oindx => 1, Olen => 1, Oload => 1, Omod => 1, Oref => 1, * => 0 }; opcommute = array[Oend] of { Oeq => Oeq, Oneq => Oneq, Olt => Ogt, Ogt => Olt, Ogeq => Oleq, Oleq => Ogeq, Oadd => Oadd, Omul => Omul, Oxor => Oxor, Oor => Oor, Oand => Oand, * => 0 }; oprelinvert = array[Oend] of { Oeq => Oneq, Oneq => Oeq, Olt => Ogeq, Ogt => Oleq, Ogeq => Olt, Oleq => Ogt, * => 0 }; isrelop := array[Oend] of { Oeq => 1, Oneq => 1, Olt => 1, Oleq => 1, Ogt => 1, Ogeq => 1, Oandand => 1, Ooror => 1, Onot => 1, * => 0 }; ipow(x: big, n: int): big { inv: int; r: big; inv = 0; if(n < 0){ n = -n; inv = 1; } r = big 1; for(;;){ if(n&1) r *= x; if((n >>= 1) == 0) break; x *= x; } if(inv) r = big 1/r; return r; } rpow(x: real, n: int): real { inv: int; r: real; inv = 0; if(n < 0){ n = -n; inv = 1; } r = 1.0; for(;;){ if(n&1) r *= x; if((n >>= 1) == 0) break; x *= x; } if(inv) r = 1.0/r; return r; } real2fix(v: real, t: ref Type): big { return big(v/scale(t)); } fix2fix(v: big, f: ref Type, t: ref Type): big { return big(real v * (scale(f)/scale(t))); } fix2real(v: big, f: ref Type): real { return real v * scale(f); } istuple(n: ref Node): int { d: ref Decl; case(n.op){ Otuple => return 1; Oname => d = n.decl; if(d.importid != nil) d = d.importid; return d.store == Dconst && (n.ty.kind == Ttuple || n.ty.kind == Tadt); Odot => return 0; # istuple(n.left); } return 0; } tuplemem(n: ref Node, d: ref Decl): ref Node { ty: ref Type; ids: ref Decl; ty = n.ty; n = n.left; for(ids = ty.ids; ids != nil; ids = ids.next){ if(ids.sym == d.sym) break; else n = n.right; } if(n == nil) fatal("tuplemem cannot cope !\n"); return n.left; } varcom(v: ref Decl): int { n := v.init; n = fold(n); v.init = n; if(debug['v']) print("variable '%s' val %s\n", v.sym.name, expconv(n)); if(n == nil) return 1; tn := ref znode; tn.op = Oname; tn.decl = v; tn.src = v.src; tn.ty = v.ty; return initable(tn, n, 0); } initable(v, n: ref Node, allocdep: int): int { case n.ty.kind{ Tiface or Tgoto or Tcase or Tcasel or Tcasec or Talt or Texcept => return 1; Tint or Tbig or Tbyte or Treal or Tstring or Tfix => if(n.op != Oconst) break; return 1; Tadt or Tadtpick or Ttuple => if(n.op == Otuple) n = n.left; else if(n.op == Ocall) n = n.right; else break; for(; n != nil; n = n.right) if(!initable(v, n.left, allocdep)) return 0; return 1; Tarray => if(n.op != Oarray) break; if(allocdep >= DADEPTH){ nerror(v, expconv(v)+"s initializer has arrays nested more than "+string allocdep+" deep"); return 0; } allocdep++; usedesc(mktdesc(n.ty.tof)); if(n.left.op != Oconst){ nerror(v, expconv(v)+"s size is not a constant"); return 0; } for(e := n.right; e != nil; e = e.right) if(!initable(v, e.left.right, allocdep)) return 0; return 1; Tany => return 1; Tref or Tlist or Tpoly or * => nerror(v, "can't initialize "+etconv(v)); return 0; } nerror(v, expconv(v)+"s initializer, "+expconv(n)+", is not a constant expression"); return 0; } # # merge together two sorted lists, yielding a sorted list # elemmerge(e, f: ref Node): ref Node { r := rock := ref Node; while(e != nil && f != nil){ if(e.left.left.c.val <= f.left.left.c.val){ r.right = e; e = e.right; }else{ r.right = f; f = f.right; } r = r.right; } if(e != nil) r.right = e; else r.right = f; return rock.right; } # # recursively split lists and remerge them after they are sorted # recelemsort(e: ref Node, n: int): ref Node { if(n <= 1) return e; m := n / 2 - 1; ee := e; for(i := 0; i < m; i++) ee = ee.right; r := ee.right; ee.right = nil; return elemmerge(recelemsort(e, n / 2), recelemsort(r, (n + 1) / 2)); } # # sort the elems by index; wild card is first # elemsort(e: ref Node): ref Node { n := 0; for(ee := e; ee != nil; ee = ee.right){ if(ee.left.left.op == Owild) ee.left.left.c = ref Const(big -1, 0.); n++; } return recelemsort(e, n); } sametree(n1: ref Node, n2: ref Node): int { if(n1 == n2) return 1; if(n1 == nil || n2 == nil) return 0; if(n1.op != n2.op || n1.ty != n2.ty) return 0; if(n1.op == Oconst){ case(n1.ty.kind){ Tbig or Tbyte or Tint => return n1.c.val == n2.c.val; Treal => return n1.c.rval == n2.c.rval; Tfix => return n1.c.val == n2.c.val && tequal(n1.ty, n2.ty); Tstring => return n1.decl.sym == n2.decl.sym; } return 0; } return n1.decl == n2.decl && sametree(n1.left, n2.left) && sametree(n1.right, n2.right); } occurs(d: ref Decl, n: ref Node): int { if(n == nil) return 0; if(n.op == Oname){ if(d == n.decl) return 1; return 0; } return occurs(d, n.left) + occurs(d, n.right); } # # left and right subtrees the same # folds(n: ref Node): ref Node { if(hasside(n, 1)) return n; case(n.op){ Oeq or Oleq or Ogeq => n.c = ref Const(big 1, 0.0); Osub => n.c = ref Const(big 0, 0.0); Oxor or Oneq or Olt or Ogt => n.c = ref Const(big 0, 0.0); Oand or Oor or Oandand or Ooror => return n.left; * => return n; } n.op = Oconst; n.left = n.right = nil; n.decl = nil; return n; } # # constant folding for typechecked expressions # fold(n: ref Node): ref Node { if(n == nil) return nil; if(debug['F']) print("fold %s\n", nodeconv(n)); n = efold(n); if(debug['F']) print("folded %s\n", nodeconv(n)); return n; } efold(n: ref Node): ref Node { d: ref Decl; if(n == nil) return nil; left := n.left; right := n.right; case n.op{ Oname => d = n.decl; if(d.importid != nil) d = d.importid; if(d.store != Dconst){ if(d.store == Dtag){ n.op = Oconst; n.ty = tint; n.c = ref Const(big d.tag, 0.); } break; } case n.ty.kind{ Tbig => n.op = Oconst; n.c = ref Const(d.init.c.val, 0.); Tbyte => n.op = Oconst; n.c = ref Const(big byte d.init.c.val, 0.); Tint or Tfix => n.op = Oconst; n.c = ref Const(big int d.init.c.val, 0.); Treal => n.op = Oconst; n.c = ref Const(big 0, d.init.c.rval); Tstring => n.op = Oconst; n.decl = d.init.decl; Ttuple => *n = *d.init; Tadt => *n = *d.init; n = rewrite(n); # was call Texception => if(n.ty.cons == byte 0) fatal("non-const exception type in efold"); n.op = Oconst; * => fatal("unknown const type "+typeconv(n.ty)+" in efold"); } Oadd => left = efold(left); right = efold(right); n.left = left; n.right = right; if(n.ty == tstring && right.op == Oconst){ if(left.op == Oconst) n = mksconst(n.src, stringcat(left.decl.sym, right.decl.sym));