Revised patch for using MLton's smlnj-lib with Poly/ML

poly_smlnj-lib.patch

--- smlnj-lib/HTML/html-elements-fn.sml.orig	Mon Nov  5 18:02:27 2007
+++ smlnj-lib/HTML/html-elements-fn.sml	Mon Nov  5 18:02:44 2007
@@ -144,7 +144,8 @@
    *   3) a string literal enclosed in ''
    *)
     fun scanAttrVal (ctx, attrName, ss) = let
-	  fun isNameChar (#"." | #"-") = true
+	  fun isNameChar #"." = true
+            | isNameChar #"-" = true
 	    | isNameChar c = (Char.isAlphaNum c)
 	  in
 	    case SS.getc ss
--- smlnj-lib/HTML/html-attrs-fn.sml.orig	Mon Nov  5 18:03:13 2007
+++ smlnj-lib/HTML/html-attrs-fn.sml	Mon Nov  5 18:04:51 2007
@@ -89,19 +89,24 @@
 		fun error () = (
 		      Err.badAttrVal ctx (attrName, attrValToString attrVal);
 		      NONE)
-		fun cvt (AT_IMPLICIT, IMPLICIT) = SOME IMPLICIT
-		  | cvt (AT_INSTANCE, IMPLICIT) = SOME(NAME attrName)
-		  | cvt (AT_TEXT, v) = SOME v
-		  | cvt (AT_NUMBER, v) = SOME v
-		  | cvt (AT_NAMES names, (NAME s | STRING s)) = (
+		fun atNames (names, s) = (
 		      case (List.find (eqName s) names)
 		       of NONE => error()
 			| (SOME name) => SOME(NAME name)
 		      (* end case *))
-		  | cvt (AT_IMPLICIT, (NAME s | STRING s)) =
+		fun atImplicit (s) = 
 		      if (s = attrName)
 			then SOME IMPLICIT
 			else error()
+
+		fun cvt (AT_IMPLICIT, IMPLICIT) = SOME IMPLICIT
+		  | cvt (AT_INSTANCE, IMPLICIT) = SOME(NAME attrName)
+		  | cvt (AT_TEXT, v) = SOME v
+		  | cvt (AT_NUMBER, v) = SOME v
+		  | cvt (AT_NAMES names, NAME s) = atNames (names, s)
+		  | cvt (AT_NAMES names, STRING s) = atNames (names, s)
+		  | cvt (AT_IMPLICIT, NAME s) = atImplicit (s)
+		  | cvt (AT_IMPLICIT, STRING s) = atImplicit (s)
 		  | cvt _ = error()
 		in
 		  case (HTbl.find attrTbl attrName)
@@ -138,7 +143,8 @@
 	  val getFn = bindFindAttr (attrMap, attr)
 	  fun get attrVec = (case (getFn attrVec)
 		 of NONE => NONE
-		  | (SOME((STRING s) | (NAME s))) => SOME s
+		  | SOME (STRING s) => SOME s
+		  | SOME (NAME s) => SOME s
 		  | _ => (
 		      Err.missingAttrVal (getContext attrVec) attr;
 		      NONE)
@@ -162,31 +168,41 @@
 	  end
     fun getNUMBER (attrMap, attr) = let
 	  val getFn = bindFindAttr (attrMap, attr)
-	  fun get attrVec = (case (getFn attrVec)
+	  fun get attrVec = let
+	  fun doitStringName s = (case (Int.fromString s)
+		 of NONE =>  (
+		      Err.badAttrVal (getContext attrVec) (attr, s);
+		      NONE)
+		  | someN => someN
+		(* end case *))
+          in 
+             (case (getFn attrVec)
 		 of NONE => NONE
-		  | (SOME((STRING s) | (NAME s))) => (case (Int.fromString s)
-		       of NONE =>  (
-			    Err.badAttrVal (getContext attrVec) (attr, s);
-			    NONE)
-			| someN => someN
-		      (* end case *))
+		  | SOME (STRING s) => doitStringName s
+		  | SOME (NAME s) => doitStringName s
 		  | SOME IMPLICIT => raise Fail "getNUMBER: IMPLICIT unexpected"
 		(* end case *))
+          end
 	  in
 	    get
 	  end
     fun getChar (attrMap, attr) = let
 	  val getFn = bindFindAttr (attrMap, attr)
-	  fun get attrVec = (case (getFn attrVec)
-		 of NONE => NONE
-		  | (SOME((STRING s) | (NAME s))) =>
-		      if (size s = 1) then SOME(String.sub(s, 0))
+	  fun get attrVec = let 
+	  fun doitStringName s =
+		if (size s = 1) then SOME(String.sub(s, 0))
 (** NOTE: we should probably accept &#xx; as a character value **)
-			else  (
-			Err.badAttrVal (getContext attrVec) (attr, s);
-			NONE)
+		  else  (
+		  Err.badAttrVal (getContext attrVec) (attr, s);
+		  NONE)
+          in 
+             (case (getFn attrVec)
+		 of NONE => NONE
+		  | SOME (STRING s) => doitStringName s
+		  | SOME (NAME s) => doitStringName s
 		  | SOME IMPLICIT => raise Fail "getChar: IMPLICIT unexpected"
 		(* end case *))
+	  end
 	  in
 	    get
 	  end