I get this:
Exception- Fail "Invalid type (not a type construction)" raised
The context: I run a toplevel built by compiling Vesa Karvonen's "extended-basis" library and doing PolyML.export (_, PolyML.rootFunction). Into this toplevel I load the enclosed Word31 module. My guess is this happens because extended-basis rebinds some basis types which are normally special-cased by the poly pretty-printer, but aren't recognized as special anymore after the rebinding. Anyway, it works ok with the normal poly.
Who's to "blame"? And is there a workaround?
structure Word31 :> WORD = struct
infix 8 << >> ~>>
type word = Word32.word
val wordSize = 31
val toLarge = Word32.toLarge
val toLargeWord = toLarge
fun toLargeX w = let open Word32 in if andb (w, 0wx40000000) = 0wx0 then toLargeX w else toLargeX (orb (w, 0wx80000000)) end
val toLargeWordX = toLargeX
fun fromLarge wl = let open Word32 in andb (fromLarge wl, 0wx7fffffff) end
val fromLargeWord = fromLarge
val toLargeInt = Word32.toLargeInt
fun toLargeIntX w = let open Word32 in if andb (w, 0wx40000000) = 0wx0 then toLargeIntX w else toLargeIntX (orb (w, 0wx80000000)) end
fun fromLargeInt i = let open Word32 in andb (fromLargeInt i, 0wx7fffffff) end
val toInt = Word32.toInt
fun toIntX w = let open Word32 in if andb (w, 0wx40000000) = 0wx0 then toIntX w else toIntX (orb (w, 0wx80000000)) end
fun fromInt i = let open Word32 in andb (fromInt i, 0wx7fffffff) end
val andb = Word32.andb
val orb = Word32.orb
val xorb = Word32.xorb
fun notb w = let open Word32 in andb (notb w, 0wx7fffffff) end
fun w << i = let open Word32 in andb (w << i, 0wx7fffffff) end
val op >> = Word32.>>
fun w ~>> i = let open Word32 in if andb (w, 0wx40000000) = 0wx0 then w ~>> i else orb (w ~>> i, 0wx40000000) end
fun w1 + w2 = let open Word32 in andb (w1 + w2, 0wx7fffffff) end
fun w1 - w2 = let open Word32 in andb (w1 - w2, 0wx7fffffff) end
fun w1 * w2 = let open Word32 in andb (w1 * w2, 0wx7fffffff) end
val op div = Word32.div
val op mod = Word32.mod
val compare = Word32.compare
val op < = Word32.<
val op > = Word32.>
val op <= = Word32.<=
val op >= = Word32.>=
fun ~ w = let open Word32 in andb (~ w, 0wx7fffffff) end
val min = Word32.min
val max = Word32.max
val fmt = Word32.fmt
val toString = Word32.toString
fun scan radix getc strm = let open Word32 in case scan radix getc strm of NONE => NONE | res as SOME (w, strm') => if andb (w, 0wx80000000) = 0wx0 then res else raise Overflow end
val fromString = StringCvt.scanString (scan StringCvt.HEX)
(* the rest is for building on top of Vesa Karvonen's mltonlib extensions *) type largeable_large = LargeWord.word
type bitwise = word
val numBytes = 4
local fun mk idx w = Word8Vector.tabulate (numBytes, fn i => (Word8.fromLarge o LargeWord.>>) (toLarge w, Word.<< (Word.fromInt (idx i), 0w3))) in val toBigBytes = mk (fn i => Int.- (Int.- (numBytes, 1), i)) val toLittleBytes = mk (fn i => i) end
val toWord8 = Word8.fromLarge o toLarge
val toWord8X = toWord8
val fromWord8 = fromLarge o Word8.toLarge
val fromWord8X = fromLarge o Word8.toLargeX
local fun mk fold bs = if numBytes <> Word8Vector.length bs then raise Subscript else fold (fn (b, w) => Word32.orb (Word32.<< (w, 0w8), fromWord8 b)) (Word32.fromInt 0) bs in val fromBigBytes = mk Word8Vector.foldl val fromLittleBytes = mk Word8Vector.foldr end
val isoWord8 = (toWord8, fromWord8) val isoWord8X = (toWord8X, fromWord8X)
val toWord = Word.fromLarge o toLarge
val toWordX = Word.fromLarge o toLargeX
val fromWord = fromLarge o Word.toLarge
val fromWordX = fromLarge o Word.toLargeX
val isoWord = (toWord, fromWord) val isoWordX = (toWordX, fromWordX)
val toFixedInt = Int32.fromLarge o toLargeInt
val fromFixedInt = fromLargeInt o Int32.toLarge
val toFixedIntX = Int32.fromLarge o toLargeIntX
val isoFixedInt = (toFixedInt, fromFixedInt) val isoFixedIntX = (toFixedIntX, fromFixedInt)
val isoLarge = (toLarge, fromLarge) val isoLargeInt = (toLargeInt, fromLargeInt) val isoLargeX = (toLargeX, fromLarge) val isoLargeIntX = (toLargeIntX, fromLargeInt) val isoInt = (toInt, fromInt) val isoIntX = (toIntX, fromInt) val isoLargeWord = isoLarge val isoLargeWordX = isoLargeX
val isoBigBytes = (toBigBytes, fromBigBytes) val isoLittleBytes = (toLittleBytes, fromLittleBytes)
fun op == (w1, w2) = w1 = w2
fun op != (w1, w2) = w1 <> w2
fun inRange (w1, w2) w = if w1 > w2 then raise Domain else w1 <= w andalso w <= w2
fun isEven w = (w andb 0wx1) = 0wx0
fun isOdd w = (w andb 0wx1) = 0wx1
fun isZero w = w = 0wx0
type bounded = word
type bounded_ex = word
val minValue = 0wx0
val maxValue = 0wx7fffffff
val largestPrime = maxValue
val bounds = (minValue, maxValue)
type formattable = word
type scannable = word
type intable = word
type largeable = word
type equality = word
type equality_ex = word
type ordered = word
type ordered_ex = word
type shiftable = word
type stringable = word
type stringable_ex = word
type wordable = word
type formattable_format = StringCvt.radix
type scannable_format = StringCvt.radix
val embString = (toString, fromString)
type t = word
end
(* Because we are using opaque signature matching we have to install type-dependent functions OUTSIDE the structure. *) local open RuntimeCalls structure Conversion = RunCall.Run_exception1 ( type ex_type = string; val ex_iden = EXC_conversion ); exception Conversion = Conversion.ex; (* The string may be either 0wnnn or 0wxXXX *) fun convWord s : Word31.word = let val radix = (* The word value must consist of at least 0w and a digit. *) if String.sub(s, 2) = #"x" then StringCvt.HEX else StringCvt.DEC in case StringCvt.scanString (Word31.scan radix) s of NONE => raise Conversion "Invalid word8 constant" | SOME res => res end
(* Install the pretty printer for Word31.word *) fun pretty(p, _, _, _) _ _ x = p("0wx" ^ Word31.toString x) in val it: unit = RunCall.addOverload convWord "convWord" val it: unit = RunCall.Inner.install_pp pretty end;
(* Add the overloaded operators. *) RunCall.addOverload Word31.~ "~"; RunCall.addOverload Word31.+ "+"; RunCall.addOverload Word31.- "-"; RunCall.addOverload Word31.* "*"; RunCall.addOverload Word31.div "div"; RunCall.addOverload Word31.mod "mod"; RunCall.addOverload Word31.< "<"; RunCall.addOverload Word31.> ">"; RunCall.addOverload Word31.<= "<="; RunCall.addOverload Word31.>= ">=";