home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / compiler / Pr_lam.sml < prev    next >
Encoding:
Text File  |  1996-07-03  |  5.8 KB  |  162 lines  |  [TEXT/R*ch]
  1. local
  2.   open Mixture Const Prim Lambda Asynt;
  3. in
  4.  
  5. (* Printing lambda expressions for debugging purposes. *)
  6.  
  7. fun printPrimTest printer = fn
  8.     PTeq => msgString "eq"
  9.   | PTnoteq => msgString "noteq"
  10.   | PTnoteqimm a => (msgString "noteqimm "; printer a)
  11.   | PTlt => msgString "lt"
  12.   | PTle => msgString "le"
  13.   | PTgt => msgString "gt"
  14.   | PTge => msgString "ge"
  15. ;
  16.  
  17. val rec printPrim = fn
  18.     Pidentity => msgString "identity"
  19.   | Pget_global (qualid, stamp) =>
  20.       (msgString "get_global "; printQualId qualid;
  21.        msgString "/"; msgInt stamp)
  22.   | Pset_global (qualid, stamp) =>
  23.       (msgString "set_global "; printQualId qualid;
  24.        msgString "/"; msgInt stamp)
  25.   | Pdummy n => (msgString "dummy "; msgInt n)
  26.   | Pupdate => msgString "update"
  27.   | Ptest btest => (msgString "test:"; printBoolTest btest)
  28.   | Pmakeblock ctag => (msgString "makeblock "; printCTag ctag)
  29.   | Ptag_of => msgString "tag_of"
  30.   | Pfield n => (msgString "field "; msgInt n)
  31.   | Psetfield n => (msgString "setfield "; msgInt n)
  32.   | Pccall(name, arity) =>
  33.       (msgString "ccall"; msgInt arity;
  34.        msgString " "; msgString name)
  35.   | Praise => msgString "raise"
  36.   | Pnot => msgString "not"
  37.   | Pnegint => msgString "negint"
  38.   | Psuccint => msgString "succint"
  39.   | Ppredint => msgString "predint"
  40.   | Paddint => msgString "addint"
  41.   | Psubint => msgString "subint"
  42.   | Pmulint => msgString "mulint"
  43.   | Pdivint => msgString "divint"
  44.   | Pmodint => msgString "modint"
  45.   | Pandint => msgString "andint"
  46.   | Porint => msgString "orint"
  47.   | Pxorint => msgString "xorint"
  48.   | Pshiftleftint => msgString "shiftleftint"
  49.   | Pshiftrightintsigned => msgString "shiftrightintsigned"
  50.   | Pshiftrightintunsigned => msgString "shiftrightintunsigned"
  51.   | Pincr => msgString "incr"
  52.   | Pdecr => msgString "decr"
  53.   | Pintoffloat => msgString "intoffloat"
  54.   | Pfloatprim fprim => (msgString "floatprim "; printFloatPrim fprim)
  55.   | Pstringlength => msgString "stringlength"
  56.   | Pgetstringchar => msgString "getstringchar"
  57.   | Psetstringchar => msgString "setstringchar"
  58.   | Pmakevector => msgString "makevector"
  59.   | Pvectlength => msgString "vectlength"
  60.   | Pgetvectitem => msgString "getvectitem"
  61.   | Psetvectitem => msgString "setvectitem"
  62.   | Psmlnegint => msgString "smlnegint"
  63.   | Psmlsuccint => msgString "smlsuccint"
  64.   | Psmlpredint => msgString "smlpredint"
  65.   | Psmladdint => msgString "smladdint"
  66.   | Psmlsubint => msgString "smlsubint"
  67.   | Psmlmulint => msgString "smlmulint"
  68.   | Psmldivint => msgString "smldivint"
  69.   | Psmlmodint => msgString "smlmodint"
  70.   | Pmakerefvector => msgString "makerefvector"
  71.   | Pbreak     => msgString "break"
  72.   | Patom t     => (msgString "atom "; msgInt t)
  73.   | Psmlquotint => (msgString "smlquotint")
  74.   | Psmlremint  => (msgString "smlremint")
  75.  
  76. and printFloatPrim = fn
  77.     Pfloatofint => msgString "floatofint"
  78.   | Pnegfloat => msgString "negfloat"
  79.   | Paddfloat => msgString "addfloat"
  80.   | Psubfloat => msgString "subfloat"
  81.   | Pmulfloat => msgString "mulfloat"
  82.   | Pdivfloat => msgString "divfloat"
  83.   | Psmlnegfloat => msgString "smlnegfloat"
  84.   | Psmladdfloat => msgString "smladdfloat"
  85.   | Psmlsubfloat => msgString "smlsubfloat"
  86.   | Psmlmulfloat => msgString "smlmulfloat"
  87.   | Psmldivfloat => msgString "smldivfloat"
  88.  
  89. and printBoolTest = fn
  90.     Peq_test => msgString "eq_test"
  91.   | Pnoteq_test => msgString "noteq_test"
  92.   | Pint_test test => printPrimTest msgInt test
  93.   | Pfloat_test test => printPrimTest msgReal test
  94.   | Pstring_test test => printPrimTest msgString test
  95.   | Pnoteqtag_test ct =>
  96.       (msgString "noteqtag_test "; printCTag ct)
  97. ;
  98.  
  99. fun printLam lam =
  100.   case lam of
  101.     Lvar i => (msgString "var:"; msgInt i)
  102.   | Lconst cst => printStrConst cst
  103.   | Lapply(func, args) =>
  104.       (msgString "(app "; printLam func; msgString " ";
  105.        printSeq printLam " " args; msgString ")")
  106.   | Lfn lam => (msgString "(fn "; printLam lam; msgString ")")
  107.   | Llet(args, scope) =>
  108.       (msgString "let "; printSeq printLam " " args;
  109.        msgString " in "; printLam scope; msgString " end")
  110.   | Lletrec(args, scope) =>
  111.       (msgString "letrec "; printSeq printLam " " args;
  112.        msgString " in "; printLam scope; msgString " end")
  113.   | Lprim(prim, args) =>
  114.       (msgString "(prim ("; printPrim prim; msgString ") ";
  115.        printSeq printLam " " args; msgString ")")
  116.   | Lcase(arg, clauses) =>
  117.       (msgString "(case "; printLam arg; msgString " of ";
  118.        printSeq printClause " " clauses; msgString ")")
  119.   | Lswitch(n, arg, clauses) =>
  120.       (msgString "(switch:"; msgInt n; msgString " ";
  121.        printLam arg; msgString " of ";
  122.        printSeq printSwClause " " clauses; msgString ")")
  123.   | Lstaticfail => msgString "staticfail"
  124.   | Lstatichandle(lam1, lam2) =>
  125.       (msgString "("; printLam lam1; msgString " statichandle ";
  126.        printLam lam2; msgString ")")
  127.   | Lhandle(lam1, lam2) =>
  128.       (msgString "("; printLam lam1; msgString " handle ";
  129.        printLam lam2; msgString ")")
  130.   | Lif(lam0, lam1, lam2) =>
  131.       (msgString "if"; printLam lam0; msgString " then (";
  132.        printLam lam1; msgString ") else "; printLam lam2)
  133.   | Lseq(lam1, lam2) =>
  134.       (msgString "("; printLam lam1; msgString "; "; printLam lam2;
  135.        msgString ")")
  136.   | Lwhile(lam1, lam2) =>
  137.       (msgString "while "; printLam lam1; msgString " do ";
  138.        printLam lam2)
  139.   | Landalso(lam1, lam2) =>
  140.       (msgString "("; printLam lam1; msgString " andalso ";
  141.        printLam lam2; msgString ")")
  142.   | Lorelse(lam1, lam2) =>
  143.       (msgString "("; printLam lam1; msgString " orelse ";
  144.        printLam lam2; msgString ")")
  145.   | Lunspec =>
  146.       msgString "unspec"
  147.   | Lshared(lam, lbl) =>
  148.       (msgString "(shared:"; msgInt (!lbl); msgString " ";
  149.        printLam lam; msgString ")")
  150.  
  151. and printClause (scon, lam) =
  152.   (printSCon scon; msgString " : "; printLam lam)
  153.  
  154. and printExClause (lam1, lam2) =
  155.   (printLam lam1; msgString " : "; printLam lam2)
  156.  
  157. and printSwClause (ct, lam) =
  158.   (printCTag ct; msgString " : "; printLam lam)
  159. ;
  160.  
  161. end;
  162.