home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / compiler / Const.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  2.2 KB  |  100 lines  |  [TEXT/R*ch]
  1. local
  2.   open Obj Fnlib Config Mixture
  3. in
  4.  
  5. (* Qualified identifiers *)
  6.  
  7. type QualifiedIdent =
  8. {
  9.   id: string,
  10.   qual: string
  11. };
  12.  
  13. (* Constants *)
  14.  
  15. datatype SCon =
  16.     INTscon of int
  17.   | WORDscon of word
  18.   | CHARscon of char
  19.   | REALscon of real
  20.   | STRINGscon of string
  21. ;
  22.  
  23. datatype BlockTag =
  24.     CONtag of int * int             (* tag number & span *)
  25.   | EXNtag of QualifiedIdent * int  (* constructor name & stamp *)
  26. ;
  27.  
  28. datatype StructConstant =
  29.     ATOMsc of SCon
  30.   | BLOCKsc of BlockTag * StructConstant list
  31.   | QUOTEsc of obj ref
  32. ;
  33.  
  34. val constUnit =
  35.     BLOCKsc(CONtag(0,1), [])
  36. ;
  37.  
  38. fun intOfAtom (INTscon i) = i
  39.   | intOfAtom (WORDscon w) = (magic w) : int
  40.   | intOfAtom (CHARscon c) = Char.ord c
  41.   | intOfAtom _ = fatalError "intOfAtom"
  42. ;
  43.  
  44. fun intOfAbsoluteTag (CONtag(i,_)) = i
  45.   | intOfAbsoluteTag (EXNtag _) = fatalError "intOfAbsoluteTag"
  46. ;
  47.  
  48. (* Printing structured constants for debugging purposes *)
  49.  
  50. fun printSeq printEl sep =
  51.   let fun loop [] = ()
  52.         | loop [x] = printEl x
  53.         | loop (x :: xs) = (printEl x; msgString sep; loop xs)
  54.   in loop end
  55. ;
  56.  
  57. fun showQualId {qual="", id=id} = id
  58.   | showQualId {qual=u,  id=id} = u ^ "." ^ id
  59. ;
  60.  
  61. fun printQualId {qual="", id=name} =
  62.       msgString name
  63.   | printQualId {qual=u, id=name} =
  64.       (msgString u; msgString "."; msgString name)
  65. ;
  66.  
  67. prim_val sml_makestring_of_char : char -> string
  68.                               = 1 "sml_makestring_of_char";
  69. prim_val sml_makestring_of_string : string -> string
  70.                               = 1 "sml_makestring_of_string";
  71.  
  72. fun printSCon (INTscon i) =
  73.       msgInt i
  74.   | printSCon (WORDscon w) =
  75.       msgWord w
  76.   | printSCon (CHARscon c) =
  77.       msgString (sml_makestring_of_char c)
  78.   | printSCon (REALscon r) =
  79.       msgReal r
  80.   | printSCon (STRINGscon s) =
  81.       msgString (sml_makestring_of_string s)
  82. ;
  83.  
  84. fun printCTag (CONtag(tag, span)) =
  85.       (msgInt tag; msgString ":"; msgInt span)
  86.   | printCTag (EXNtag(q, stamp)) =
  87.       (printQualId q; msgString "/"; msgInt stamp)
  88. ;
  89.  
  90. fun printStrConst (ATOMsc scon) =
  91.       printSCon scon
  92.   | printStrConst (BLOCKsc(ct, consts)) =
  93.       (msgString "(BLOCK "; printCTag ct; msgString " ";
  94.        printSeq printStrConst " " consts; msgString ")")
  95.   | printStrConst (QUOTEsc rv) =
  96.       msgString "<const>"
  97. ;
  98.  
  99. end;
  100.