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 / Const.sml < prev    next >
Encoding:
Text File  |  1996-07-03  |  2.1 KB  |  96 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.   | CHARscon of char
  18.   | REALscon of real
  19.   | STRINGscon of string
  20. ;
  21.  
  22. datatype BlockTag =
  23.     CONtag of int * int             (* tag number & span *)
  24.   | EXNtag of QualifiedIdent * int  (* constructor name & stamp *)
  25. ;
  26.  
  27. datatype StructConstant =
  28.     ATOMsc of SCon
  29.   | BLOCKsc of BlockTag * StructConstant list
  30.   | QUOTEsc of obj ref
  31. ;
  32.  
  33. val constUnit =
  34.     BLOCKsc(CONtag(0,1), [])
  35. ;
  36.  
  37. fun intOfAtom (INTscon i) = i
  38.   | intOfAtom (CHARscon c) = Char.ord c
  39.   | intOfAtom _ = fatalError "intOfAtom"
  40. ;
  41.  
  42. fun intOfAbsoluteTag (CONtag(i,_)) = i
  43.   | intOfAbsoluteTag (EXNtag _) = fatalError "intOfAbsoluteTag"
  44. ;
  45.  
  46. (* Printing structured constants for debugging purposes *)
  47.  
  48. fun printSeq printEl sep =
  49.   let fun loop [] = ()
  50.         | loop [x] = printEl x
  51.         | loop (x :: xs) = (printEl x; msgString sep; loop xs)
  52.   in loop end
  53. ;
  54.  
  55. fun showQualId {qual="", id=id} = id
  56.   | showQualId {qual=u,  id=id} = u ^ "." ^ id
  57. ;
  58.  
  59. fun printQualId {qual="", id=name} =
  60.       msgString name
  61.   | printQualId {qual=u, id=name} =
  62.       (msgString u; msgString "."; msgString name)
  63. ;
  64.  
  65. prim_val sml_makestring_of_char : char -> string
  66.                               = 1 "sml_makestring_of_char";
  67. prim_val sml_makestring_of_string : string -> string
  68.                               = 1 "sml_makestring_of_string";
  69.  
  70. fun printSCon (INTscon i) =
  71.       msgInt i
  72.   | printSCon (CHARscon c) =
  73.       msgString (sml_makestring_of_char c)
  74.   | printSCon (REALscon r) =
  75.       msgReal r
  76.   | printSCon (STRINGscon s) =
  77.       msgString (sml_makestring_of_string s)
  78. ;
  79.  
  80. fun printCTag (CONtag(tag, span)) =
  81.       (msgInt tag; msgString ":"; msgInt span)
  82.   | printCTag (EXNtag(q, stamp)) =
  83.       (printQualId q; msgString "/"; msgInt stamp)
  84. ;
  85.  
  86. fun printStrConst (ATOMsc scon) =
  87.       printSCon scon
  88.   | printStrConst (BLOCKsc(ct, consts)) =
  89.       (msgString "(BLOCK "; printCTag ct; msgString " ";
  90.        printSeq printStrConst " " consts; msgString ")")
  91.   | printStrConst (QUOTEsc rv) =
  92.       msgString "<const>"
  93. ;
  94.  
  95. end;
  96.