[MLton-commit] r6029

[Vesa Karvonen]

Constant folding for Vector.sub and Vector.length primitives.

The motivation for this is to make it possible to perform (non-recursive)
compile-time operations on strings.  For example, compile-time hashing of
constant strings up to a source-time specified length is possible.

Try compiling the following example with

  mlton -inline 1000 -keep g example.sml

and then run it.

<--- example.sml --->
local
   fun hashStep (c, h) = h * 0w33 + Word.fromInt (ord c)
   fun hash8 s = let
      fun $ (i, h) =
          if i < size s
          then (i+1, hashStep (CharVector.sub (s, i), h))
          else (i, h)
   in
      #2 (($o$o$o$o$o$o$o$) (0, 0w5381))
   end
   val hashN = CharVector.foldl hashStep 0w5381
in
   fun hashString s = if size s <= 8 then hash8 s else hashN s
end

val key = "password"

val () =
    print (if hashString key =
              (valOf (Word.fromString (hd (CommandLine.arguments ())))
               handle _ => 0w0)
           then "You got it!\n"
           else "Try looking at the generated for "^
                Word.toString (hashString key)^"...\n")
<--- example.sml --->

----------------------------------------------------------------------

U   mlton/trunk/mlton/atoms/const.sig
U   mlton/trunk/mlton/atoms/prim.fun

----------------------------------------------------------------------

Modified: mlton/trunk/mlton/atoms/const.sig
===================================================================
--- mlton/trunk/mlton/atoms/const.sig	2007-09-17 14:46:58 UTC (rev 6028)
+++ mlton/trunk/mlton/atoms/const.sig	2007-09-17 19:04:33 UTC (rev 6029)
@@ -13,6 +13,7 @@
       structure RealX: REAL_X
       structure WordX: WORD_X
       structure WordXVector: WORD_X_VECTOR
+      sharing WordX = WordXVector.WordX
    end
 
 signature CONST = 

Modified: mlton/trunk/mlton/atoms/prim.fun
===================================================================
--- mlton/trunk/mlton/atoms/prim.fun	2007-09-17 14:46:58 UTC (rev 6028)
+++ mlton/trunk/mlton/atoms/prim.fun	2007-09-17 19:04:33 UTC (rev 6029)
@@ -1242,6 +1242,9 @@
       datatype z = datatype t
       datatype z = datatype Const.t
       val bool = ApplyResult.Bool
+      fun seqIndexConst i =
+         ApplyResult.Const
+         (Const.word (WordX.fromIntInf (i, WordSize.seqIndex ())))
       val intInf = ApplyResult.Const o Const.intInf
       val intInfConst = intInf o IntInf.fromInt
       val null = ApplyResult.Const Const.null
@@ -1303,6 +1306,10 @@
                     then null
                  else ApplyResult.Unknown
            | (CPointer_toWord, [Null]) => word (WordX.zero (WordSize.cpointer ()))
+           | (Vector_length, [WordVector v]) =>
+                 seqIndexConst (IntInf.fromInt (WordXVector.length v))
+           | (Vector_sub, [WordVector v, Word i]) =>
+                 word (WordXVector.sub (v, WordX.toInt i))
            | (Word_add _, [Word w1, Word w2]) => word (WordX.add (w1, w2))
            | (Word_addCheck s, [Word w1, Word w2]) => wcheck (op +, s, w1, w2)
            | (Word_andb _, [Word w1, Word w2]) => word (WordX.andb (w1, w2))