Changeset 15296 for src/Pugs/Prim.hs

Show
Ignore:
Timestamp:
02/18/07 15:56:10 (21 months ago)
Author:
audreyt
Message:

* Convert VStr from String to ByteString?, and Syn from

String to ID, in Pugs. Benchmark shows the perf gain is 5%,
so it's not worth the trouble of writing a GHC 6.7-compatible
processor. The next commit will revert this commit.

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/Prim.hs

    r15201 r15296  
    1 {-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans -fno-full-laziness -fno-cse -fallow-overlapping-instances #-} 
     1{-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans -fno-full-laziness -fno-cse -fallow-overlapping-instances -foverloaded-strings #-} 
    22 
    33{-| 
    … …  
    5555import GHC.Unicode 
    5656import qualified Data.HashTable as H 
     57import qualified UTF8 as Str 
    5758 
    5859constMacro :: Exp -> [Val] -> Eval Val 
    … …  
    6566op0 "^"  = fmap opJuncOne . mapM fromVal 
    6667op0 "|"  = fmap opJuncAny . mapM fromVal 
    67 op0 "want"  = const $ fmap VStr (asks (maybe "Void" envWant . envCaller)) 
     68op0 "want"  = const $ fmap _VStr (asks (maybe "Void" envWant . envCaller)) 
    6869op0 "Bool::True"  = const . return $ VBool True 
    6970op0 "Bool::False" = const . return $ VBool False 
    … …  
    8283op0 "File::Spec::cwd" = const $ do 
    8384    cwd <- guardIO getCurrentDirectory 
    84     return $ VStr cwd 
     85    return $ _VStr cwd 
    8586op0 "File::Spec::tmpdir" = const $ do 
    8687    tmp <- guardIO getTemporaryDirectory 
    87     return $ VStr tmp 
     88    return $ _VStr tmp 
    8889op0 "Pugs::Internals::pi" = const $ return $ VNum pi 
    8990op0 "self"    = const $ expToEvalVal (_Var "&self") 
    … …  
    116117    str <- fromVal x 
    117118    return $ if null str 
    118         then VStr str 
    119         else VStr $ init str 
     119        then _VStr str 
     120        else _VStr $ init str 
    120121op1 "Scalar::chomp" = \x -> do 
    121122    str <- fromVal x 
    122123    return $ op1Chomp str 
    123124op1 "Str::split" = op1Cast (castV . words) 
    124 op1 "lc"         = op1Cast (VStr . map toLower) 
     125op1 "lc"         = op1Cast (_VStr . map toLower) 
    125126op1 "lcfirst"    = op1StrFirst toLower 
    126 op1 "uc"         = op1Cast (VStr . map toUpper) 
     127op1 "uc"         = op1Cast (_VStr . map toUpper) 
    127128op1 "ucfirst"    = op1StrFirst toUpper 
    128 op1 "capitalize" = op1Cast $ VStr . (mapEachWord capitalizeWord) 
     129op1 "capitalize" = op1Cast $ _VStr . (mapEachWord capitalizeWord) 
    129130  where 
    130131    mapEachWord _ [] = [] 
    … …  
    135136    capitalizeWord []     = [] 
    136137    capitalizeWord (c:cs) = toUpper c:(map toLower cs) 
    137 op1 "quotemeta" = op1Cast (VStr . concat . map toQuoteMeta) 
     138op1 "quotemeta" = op1Cast (_VStr . concat . map toQuoteMeta) 
    138139op1 "undef" = const $ return undef 
    139140op1 "undefine" = \x -> do 
    … …  
    160161    val <- fromVal x 
    161162    val' <- case val of 
    162         (VStr str)  -> return (VStr $ strInc str) 
     163        (VStr str)  -> return (_VStr $ strInc (cast str)) 
    163164        _           -> op1Numeric (+1) val 
    164165    writeRef ref val' 
    165166    case val of 
    166         (VStr _)    -> return val 
     167        VStr{}      -> return val 
    167168        _           -> op1 "+" val 
    168169op1 "++"   = \mv -> do 
    … …  
    192193        _  -> return (args, Nothing) 
    193194    sortBy <- case sortByGiven of 
    194         Nothing -> readVar (cast "&infix:cmp") 
     195        Nothing -> readVar (_cast "&infix:cmp") 
    195196        Just subVal -> return subVal 
    196197    sub <- fromVal sortBy 
    … …  
    202203op1 "Scalar::reverse" = \v -> do 
    203204    str     <- fromVal v 
    204     return (VStr $ reverse str) 
     205    return (_VStr $ reverse str) 
    205206op1 "List::reverse" = \v -> do 
    206207    vlist <- fromVal v 
    … …  
    208209op1 "list" = op1Cast VList 
    209210op1 "pair" = op1Cast $ VList . (map $ \(k, v) -> castV ((VStr k, v) :: VPair)) 
    210 op1 "~"    = op1Cast VStr 
     211op1 "~"    = op1Cast _VStr 
    211212op1 "?"    = op1Cast VBool 
    212213op1 "int"  = op1Cast VInt 
    213214op1 "+^"   = op1Cast (VInt . pred . negate) -- Arbitrary precision complement- 0 ==> -1 / 1 ==> -2 
    214 op1 "~^"   = op1Cast (VStr . mapStr complement) 
     215op1 "~^"   = op1Cast (_VStr . mapStr complement) 
    215216op1 "?^"   = op1 "!" 
    216217op1 "\\"   = \v -> do 
    … …  
    338339op1 "take" = \v -> assertFrame FrameGather $ do 
    339340    glob    <- askGlobal 
    340     arr     <- findSymRef (cast "$*TAKE") glob 
     341    arr     <- findSymRef (_cast "$*TAKE") glob 
    341342    push    <- doArray (VRef arr) array_push 
    342343    push (listVal v) 
    … …  
    364365op1 "IO::next" = \v -> do 
    365366    fh  <- fromVal v 
    366     guardIO $ fmap (VStr . (++ "\n") . decodeUTF8) (hGetLine fh) 
     367    guardIO (fmap _VStr (hGetLine fh)) 
    367368op1 "Pugs::Safe::safe_print" = \v -> do 
    368369    str  <- fromVal v 
    369     guardIO . putStr $ encodeUTF8 str 
     370    guardIO $ Str.putStr str 
    370371    return $ VBool True 
    371372op1 "die" = \v -> do 
    … …  
    374375    retShift $! VError (errmsg $! v') [pos] 
    375376    where 
    376     errmsg VUndef      = VStr "Died" 
    377     errmsg VType{}     = VStr "Died" 
    378     errmsg (VStr "")   = VStr "Died" 
    379     errmsg (VList [])  = VStr "Died" 
     377    errmsg VUndef      = _VStr "Died" 
     378    errmsg VType{}     = _VStr "Died" 
     379    errmsg (VStr "")   = _VStr "Died" 
     380    errmsg (VList [])  = _VStr "Died" 
    380381    errmsg (VList [x]) = x 
    381382    errmsg x           = x 
    382383op1 "warn" = \v -> do 
    383384    strs <- fromVal v 
    384     errh <- readVar $ cast "$*ERR" 
     385    errh <- readVar $ _cast "$*ERR" 
    385386    pos  <- asks envPos 
    386     op2 "IO::say" errh $ VList [ VStr $ pretty (VError (errmsg strs) [pos]) ] 
    387     where 
    388     errmsg "" = VStr "Warning: something's wrong" 
    389     errmsg x  = VStr x 
     387    op2 "IO::say" errh $ VList [ _VStr $ pretty (VError (errmsg strs) [pos]) ] 
     388    where 
     389    errmsg "" = _VStr "Warning: something's wrong" 
     390    errmsg x  = _VStr x 
    390391op1 "fail" = op1 "fail_" -- XXX - to be replaced by Prelude later 
    391392op1 "fail_" = \v -> do 
    392     throw <- fromVal =<< readVar (cast "$*FAIL_SHOULD_DIE") 
     393    throw <- fromVal =<< readVar (_cast "$*FAIL_SHOULD_DIE") 
    393394    if throw then op1 "die" (errmsg v) else do 
    394395    pos   <- asks envPos 
    … …  
    397398    op1Return (retControl (ControlLeave (<= SubRoutine) 0 dieThunk)) 
    398399    where 
    399     errmsg VUndef      = VStr "Failed" 
    400     errmsg VType{}     = VStr "Failed" 
    401     errmsg (VStr "")   = VStr "Failed" 
    402     errmsg (VList [])  = VStr "Failed" 
     400    errmsg VUndef      = _VStr "Failed" 
     401    errmsg VType{}     = _VStr "Failed" 
     402    errmsg (VStr "")   = _VStr "Failed" 
     403    errmsg (VList [])  = _VStr "Failed" 
    403404    errmsg (VList [x]) = x 
    404405    errmsg x           = x 
    … …  
    406407op1 "readlink" = \v -> do 
    407408    str  <- fromVal v 
    408     guardIO $ fmap VStr (readSymbolicLink str) 
     409    guardIO $ fmap _VStr (readSymbolicLink str) 
    409410op1 "sleep" = \v -> do 
    410411    x <- fromVal v :: Eval VNum 
    … …  
    431432    path  <- fromVal v 
    432433    files <- guardIO $ getDirectoryContents path 
    433     retSeq (map VStr files) 
     434    retSeq (map _VStr files) 
    434435op1 "slurp" = \v -> do 
    435436    ifValTypeIsa v "IO" 
    436437        (do h <- fromVal v 
    437438            ifListContext (strictify $! op1 "=" v) $ do 
    438                 content <- guardIO $ hGetContents h 
    439                 return . VStr $ decodeUTF8 content) 
     439                content <- guardIO $ Str.hGetContents h 
     440                return (VStr content)) 
    440441        (do 
    441442            fileName    <- fromVal v 
    … …  
    447448        VList lines <- action 
    448449        return $ VList (length lines `seq` lines) 
    449     slurpList file = strictify $! op1 "=" (VList [VStr file]) 
     450    slurpList file = strictify $! op1 "=" (VList [_VStr file]) 
    450451    slurpScalar file = do 
    451         content <- guardIO $ readFile file 
    452         return . VStr $ decodeUTF8 content 
     452        content <- guardIO $ Str.readFile file 
     453        return (VStr content) 
    453454op1 "opendir" = \v -> do 
    454455    str <- fromVal v 
    … …  
    471472        if null this then return [] else do 
    472473        rest <- readDirStreamList dir 
    473         return (VStr this:rest) 
     474        return (_VStr this:rest) 
    474475op1 "Pugs::Internals::runShellCommand" = \v -> do 
    475476    str <- fromVal v 
    … …  
    483484    handleExitCode exitCode  
    484485    return $ case cxt of 
    485         CxtSlurpy{} -> VList (map VStr $ lines res) 
    486         _           -> VStr res 
     486        CxtSlurpy{} -> VList (map _VStr $ lines res) 
     487        _           -> _VStr res 
    487488    where 
    488489    -- XXX - crude CRLF treatment 
    … …  
    589590op1 "max"   = op1Max 
    590591op1 "uniq"  = op1Uniq 
    591 op1 "chr"   = op1Cast (VStr . (:[]) . chr) 
     592op1 "chr"   = op1Cast (_VStr . (:[]) . chr) 
    592593op1 "ord"   = op1Cast $ \str -> if null str then undef else (castV . ord . head) str 
    593594op1 "hex"   = fail "hex() is not part of Perl 6 - use :16() instead." 
    … …  
    641642op1 "Pugs::Internals::rule_pattern" = \v -> do 
    642643    case v of 
    643         VRule MkRulePGE{rxRule=re} -> return $ VStr re 
    644         VRule MkRulePCRE{rxRuleStr=re} -> return $ VStr re 
     644        VRule MkRulePGE{rxRule=re} -> return $ _VStr re 
     645        VRule MkRulePCRE{rxRuleStr=re} -> return $ _VStr re 
    645646        _ -> fail $ "Not a rule: " ++ show v 
    646647op1 "Pugs::Internals::rule_adverbs" = \v -> do 
    … …  
    670671    glob <- filterPrim =<< asks envGlobal 
    671672    yml  <- liftIO $ showYaml (filterUserDefinedPad glob, v) 
    672     return $ VStr yml 
     673    return $ _VStr yml 
    673674op1 "Object::HOW" = \v -> do 
    674675    typ     <- evalValType v 
    … …  
    697698op1SigilHyper sig val = do 
    698699    vs <- fromVal val 
    699     evalExp $ Syn "," (map (\x -> Syn (shows sig "{}") [Val x]) vs) 
     700    evalExp $ Syn "," (map (\x -> _Syn (shows sig "{}") [Val x]) vs) 
    700701 
    701702retSeq :: VList -> Eval Val 
    … …  
    705706handleExitCode exitCode = do 
    706707    glob    <- askGlobal 
    707     errSV   <- findSymRef (cast "$!") glob 
     708    errSV   <- findSymRef (_cast "$!") glob 
    708709    writeRef errSV $ case exitCode of 
    709710        ExitFailure x   -> VInt $ toInteger x 
    … …  
    711712    return (VBool $ exitCode == ExitSuccess) 
    712713 
    713 cascadeMethod :: ([VStr] -> [VStr]) -> VStr -> Val -> Val -> Eval Val 
     714cascadeMethod :: ([String] -> [String]) -> String -> Val -> Val -> Eval Val 
    714715cascadeMethod f meth v args = do 
    715716    typ     <- evalValType v 
    … …  
    737738op1Return :: Eval Val -> Eval Val 
    738739op1Return action = assertFrame FrameRoutine $ do 
    739     sub   <- fromVal =<< readVar (cast "&?ROUTINE") 
     740    sub   <- fromVal =<< readVar (_cast "&?ROUTINE") 
    740741    -- If this is a coroutine, reset the entry point 
    741742    case subCont sub of 
    … …  
    751752op1Yield :: Eval Val -> Eval Val 
    752753op1Yield action = assertFrame FrameRoutine $ do 
    753     sub   <- fromVal =<< readVar (cast "&?ROUTINE") 
     754    sub   <- fromVal =<< readVar (_cast "&?ROUTINE") 
    754755    case subCont sub of 
    755756        Nothing -> fail $ "cannot yield() from a " ++ pretty (subType sub) 
    … …  
    772773 
    773774op1StrFirst :: (Char -> Char) -> Val -> Eval Val 
    774 op1StrFirst f = op1Cast $ VStr . 
     775op1StrFirst f = op1Cast $ _VStr . 
    775776    \str -> case str of 
    776777        []      -> [] 
    … …  
    789790            Just str -> do 
    790791                ~(VList rest) <- getLines fh 
    791                 return $ VList (VStr str:rest) 
     792                return $ VList (_VStr str:rest) 
    792793            _ -> return (VList []) 
    793794    getLine :: VHandle -> Eval Val 
    … …  
    795796        line <- liftIO $! doGetLine fh 
    796797        case line of 
    797             Just str    -> return $! VStr $! (length str `seq` str) 
     798            Just str    -> return $! _VStr $! (length str `seq` str) 
    798799            _           -> return undef 
    799     doGetLine :: VHandle -> IO (Maybe VStr) 
     800    doGetLine :: VHandle -> IO (Maybe String) 
    800801    doGetLine fh = guardIOexcept [(isIOError isEOFError, Nothing)] $ do 
    801802        line <- hGetLine fh 
    … …  
    814815        char <- hGetChar fh 
    815816        str  <- getChar' fh char 
    816         return $ VStr $ decodeUTF8 str 
     817        return $ _VStr $ decodeUTF8 str 
    817818    -- We may have to read more than one byte, as one utf-8 char can span 
    818819    -- multiple bytes. 
    … …  
    848849    handleOf VUndef = handleOf (VList []) 
    849850    handleOf (VList []) = do 
    850         argsGV  <- readVar (cast "$*ARGS") 
     851        argsGV  <- readVar (_cast "$*ARGS") 
    851852        gv      <- fromVal argsGV 
    852853        if defined gv 
    853854            then handleOf gv 
    854855            else do 
    855                 args    <- readVar (cast "@*ARGS") 
     856                args    <- readVar (_cast "@*ARGS") 
    856857                files   <- fromVal args 
    857858                if null files 
    858859                    then return stdin 
    859860                    else do 
    860                         hdl <- handleOf (VStr (head files)) -- XXX wrong 
    861                         writeVar (cast "$*ARGS") (VHandle hdl) 
     861                        hdl <- handleOf (_VStr (head files)) -- XXX wrong 
     862                        writeVar (_cast "$*ARGS") (VHandle hdl) 
    862863                        return hdl 
    863864    handleOf (VStr x) = do 
    864         return =<< guardIO $ openFile x ReadMode 
     865        return =<< guardIO $ openFile (cast x) ReadMode 
    865866    handleOf (VList [x]) = handleOf x 
    866867    handleOf v = fromVal v 
    … …  
    895896mapStr f = map (chr . fromEnum . f) 
    896897 
    897 mapStr2 :: (Word8 -> Word8 -> Word8) -> [Word8] -> [Word8] -> String 
    898 mapStr2 f x y = map (chr . fromEnum . uncurry f) $ x `zip` y 
    899  
    900 mapStr2Fill :: (Word8 -> Word8 -> Word8) -> [Word8] -> [Word8] -> String 
    901 mapStr2Fill f x y = map (chr . fromEnum . uncurry f) $ x `zipFill` y 
     898mapStr2 :: (Word8 -> Word8 -> Word8) -> [Word8] -> [Word8] -> VStr 
     899mapStr2 f x y = __ . map (chr . fromEnum . uncurry f) $ x `zip` y 
     900 
     901mapStr2Fill :: (Word8 -> Word8 -> Word8) -> [Word8] -> [Word8] -> VStr 
     902mapStr2Fill f x y = __ . map (chr . fromEnum . uncurry f) $ x `zipFill` y 
    902903    where 
    903904    zipFill [] [] = [] 
    … …  
    906907    zipFill (a:as) (b:bs) = (a,b) : zipFill as bs 
    907908 
    908 op1Chomp :: VStr -> Val 
    909 op1Chomp "" = VStr "" 
     909op1Chomp :: String -> Val 
     910op1Chomp "" = _VStr "" 
    910911op1Chomp str 
    911     | last str == '\n'  = VStr (init str) 
    912     | otherwise         = VStr str 
     912    | last str == '\n'  = _VStr (init str) 
     913    | otherwise         = _VStr str 
    913914 
    914915-- |Implementation of 2-arity primitive operators and functions 
    … …  
    920921op2 "/"  = op2Divide 
    921922op2 "%"  = op2Modulus 
    922 op2 "x"  = op2Cast (\x y -> VStr . concat $ (y :: VInt) `genericReplicate` x) 
     923op2 "x"  = op2Cast (\x y -> _VStr . concat $ (y :: VInt) `genericReplicate` x) 
    923924op2 "xx" = op2Cast (\x y -> VList . concat $ (y :: VInt) `genericReplicate` x) 
    924925op2 "+&" = op2Int (.&.) 
    … …  
    926927op2 "+>" = op2Int shiftR 
    927928op2 "~&" = op2Str $ mapStr2 (.&.) 
    928 op2 "~<" = op2Cast (\x y -> VStr $ mapStr (`shiftL` y) x) 
    929 op2 "~>" = op2Cast (\x y -> VStr $ mapStr (`shiftR` y) x) 
     929op2 "~<" = op2Cast (\x y -> _VStr $ mapStr (`shiftL` y) x) 
     930op2 "~>" = op2Cast (\x y -> _VStr $ mapStr (`shiftR` y) x) 
    930931op2 "**" = op2Exp 
    931932op2 "+"  = op2Numeric (+) 
    932933op2 "-"  = op2Numeric (-) 
    933934op2 "atan" = op2Num atan2 
    934 op2 "~"  = op2Str (++) 
     935op2 "~"  = op2Str (+++) 
    935936op2 "+|" = op2Int (.|.) 
    936937op2 "+^" = op2Int xor 
    … …  
    997998op2 "reduce" = op2ReduceL False 
    998999op2 "produce" = op2ReduceL True 
    999 op2 "reverse" = op2MaybeListop (VList . reverse) (VStr . reverse) 
     1000op2 "reverse" = op2MaybeListop (VList . reverse) (_VStr . reverse) 
    10001001op2 "chomp" = op2MaybeListop (VList . map op1Chomp) op1Chomp 
    10011002op2 "kill" = \s v -> do 
    … …  
    10111012op2 "isa"    = \x y -> do 
    10121013    typY <- case y of 
    1013         VStr str -> return $ mkType str 
     1014        VStr str -> return $ cast str 
    10141015        _        -> fromVal y 
    10151016    typX <- fromVal x -- XXX consider line 224 of Pugs.Prim.Match case too 
    … …  
    10181019op2 "does"   = \x y -> do 
    10191020    typY <- case y of 
    1020         VStr str -> return $ mkType str 
     1021        VStr str -> return $ cast str 
    10211022        _        -> fromVal y 
    10221023    op2Match x (VType typY) 
    … …  
    10691070    str <- fromVal x 
    10701071    arg <- fromVal y 
    1071     return $ VStr $ case arg of 
     1072    return $ _VStr $ case arg of 
    10721073       VNum n -> printf str n 
    10731074       VRat r -> printf str ((fromRational r)::Double) 
    10741075       VInt i -> printf str i 
    1075        VStr s -> printf str s 
     1076       VStr s -> printf str (cast s :: String) 
    10761077       _      -> fail "should never be reached given the type declared below" 
    10771078op2 "system" = \x y -> do 
    … …  
    11311132 
    11321133baseDigit :: Char -> Maybe Val 
    1133 baseDigit '.'       = return (VStr ".") 
     1134baseDigit '.'       = return (_VStr ".") 
    11341135baseDigit ch | ch >= '0' && ch <= '9' = return (castV (ord ch - ord '0')) 
    11351136baseDigit ch | ch >= 'a' && ch <= 'z' = return (castV (ord ch - ord 'a' + 10)) 
    … …  
    11471148        return $ VRat (asFractional (0:post') + (asIntegral pre' % 1)) 
    11481149    where 
    1149     (pre, post) = break (== VStr ".") $ filter (/= VStr "_") vs 
     1150    (pre, post) = break (== _VStr ".") $ filter (/= _VStr "_") vs 
    11501151    asIntegral = foldl (\x d -> base * x + d) 0 
    11511152    asFractional :: [VInt] -> VRat 
    … …  
    11591160        _         -> return [v] 
    11601161    guardIO $ do 
    1161         forM_ strs (hPutStr handle . encodeUTF8) 
    1162         when wantNewline (hPutStr handle "\n") 
     1162        forM_ strs (Str.hPut handle) 
     1163        when wantNewline (Str.hPut handle (__"\n")) 
    11631164        return $ VBool True 
    11641165 
    … …  
    11751176            return $ split' delim str 
    11761177    where 
    1177     split' :: VStr -> VStr -> Val 
    1178     split' [] xs = VList $ map (VStr . (:[])) xs 
    1179     split' glue xs = VList $ map VStr $ split glue xs 
     1178    split' :: String -> String -> Val 
     1179    split' [] xs = VList $ map (_VStr . (:[])) xs 
     1180    split' glue xs = VList $ map _VStr $ split glue xs 
    11801181 
    11811182op2MaybeListop :: forall tlist titem. (Value tlist, Value [tlist], Value titem) => 
    … …  
    12131214    --kind <- fromVal =<< op1 "WHAT" x 
    12141215    kind <- case x of 
    1215         VStr str -> return $ mkType str 
     1216        VStr str -> return $ cast str 
    12161217        _        -> fromVal x 
    12171218    skip <- fromVal y 
    … …  
    12261227    return . VInt $ doIndex 0 str sub pos 
    12271228    where 
    1228     doIndex :: VInt -> VStr -> VStr -> VInt -> VInt 
     1229    doIndex :: VInt -> String -> String -> VInt -> VInt 
    12291230    doIndex n a b p 
    12301231        | p > 0, null a     = doIndex n a b 0 
    … …  
    12411242    return . VInt $ doRindex str sub skip 
    12421243    where 
    1243     doRindex :: VStr -> VStr -> Int -> VInt 
     1244    doRindex :: String -> String -> Int -> VInt 
    12441245    doRindex a b skip 
    12451246        | skip > 0         = doRindex (init a) b (skip-1) 
    … …  
    12841285 
    12851286    defs    <- fetchMetaInfo "attrs" (showType typ) 
    1286     attrs   <- liftIO $ H.new (==) H.hashString 
     1287    attrs   <- liftIO $ hashNew 
    12871288    writeIVar (IHash attrs) (named `Map.union` defs) 
    12881289    uniq    <- newObjectId 
    … …  
    13031304    (VObject o) <- fromVal t 
    13041305    attrs   <- readIVar (IHash $ objAttrs o) 
    1305     attrs'  <- liftIO $ H.new (==) H.hashString 
     1306    attrs'  <- liftIO $ hashNew 
    13061307    uniq    <- newObjectId 
    13071308    writeIVar (IHash attrs') (named `Map.union` attrs) 
    … …  
    13131314    pico <- fromVal z 
    13141315    c <- guardIO $ toCalendarTime $ TOD (offset + sec) pico 
    1315     if wantString then return $ VStr $ calendarTimeToString c else 
     1316    if wantString then return $ _VStr $ calendarTimeToString c else 
    13161317        retSeq $ [ vI $ ctYear c 
    13171318                 , vI $ (1+) $ fromEnum $ ctMonth c 
    … …  
    13231324                 , vI $ (1+) $ fromEnum $ ctWDay c 
    13241325                 , vI $ ctYDay c 
    1325                  , VStr $ ctTZName c 
     1326                 , _VStr $ ctTZName c 
    13261327                 , vI $ ctTZ c 
    13271328                 , VBool $ ctIsDST c 
    … …  
    13731374            return $ split' delim str limit 
    13741375    where 
    1375     split' :: VStr -> VStr -> Int -> Val 
    1376     split' [] xs n = VList $ (map (VStr . (:[])) (take (n-1) xs)) ++ [ VStr $ drop (n-1) xs ] 
    1377     split' glue xs n = VList $ map VStr $ split_n glue xs n 
     1376    split' :: String -> String -> Int -> Val 
     1377    split' [] xs n = VList $ (map (_VStr . (:[])) (take (n-1) xs)) ++ [ _VStr $ drop (n-1) xs ] 
     1378    split' glue xs n = VList $ map _VStr $ split_n glue xs n 
    13781379 
    13791380-- XXX - The "String" below wants to be Type. 
    1380 fetchMetaInfo :: Value a => String -> [Char] -> Eval a 
     1381fetchMetaInfo :: Value a => String -> String -> Eval a 
    13811382fetchMetaInfo key typ = do 
    13821383    meta    <- readRef =<< fromVal =<< evalExp (_Var (':':'*':typ)) 
    13831384    fetch   <- doHash meta hash_fetchVal 
    1384     fromVal =<< fetch key 
     1385    fromVal =<< fetch (cast key) 
    13851386 
    13861387-- |Implementation of 4-arity primitive operators and functions. 
    … …  
    13971398        var <- fromVal x 
    13981399        rep <- fromVal new 
    1399         writeRef var (VStr $ concat [pre, rep, post]) 
     1400        writeRef var (_VStr $ concat [pre, rep, post]) 
    14001401    -- If the replacement is given in w, change the str. 
    14011402    when (defined w && not (defined result)) $ change w 
    … …  
    14031404    return $ VRef . MkRef $ proxyScalar (return result) change 
    14041405    where 
    1405     doSubstr :: VStr -> Int -> Int -> (VStr, Val, VStr) 
     1406    doSubstr :: String -> Int -> Int -> (String, Val, String) 
    14061407    doSubstr str pos len 
    14071408        | abs pos > length str = ("", VUndef, "") 
    14081409        | pos < 0   = doSubstr str (length str + pos) len 
    14091410        | len < 0   = doSubstr str pos (length str - pos + len) 
    1410         | otherwise = ((take pos str), VStr (take len $ drop pos str), (drop (pos + len) str)) 
     1411        | otherwise = ((take pos str), _VStr (take len $ drop pos str), (drop (pos + len) str)) 
    14111412 
    14121413-- op4 "splice" = \x y z w-> do 
    … …  
    14221423 
    14231424op1Range :: Val -> Eval Val 
    1424 op1Range (VStr s)    = return . VList $ map VStr $ strRangeInf s 
     1425op1Range (VStr s)    = return . VList $ map _VStr $ strRangeInf (cast s) 
    14251426op1Range (VRat n)    = return . VList $ map VRat [n ..] 
    14261427op1Range (VNum n)    = return . VList $ map VNum [n ..] 
    … …  
    14331434op2Range (VStr s) y  = do 
    14341435    y'  <- fromVal y 
    1435     return . VList $ map VStr $ strRange s y' 
     1436    return . VList $ map _VStr $ strRange (cast s) y' 
    14361437op2Range (VNum n) y  = do 
    14371438    y'  <- fromVal y 
    … …  
    15151516op2OrdNumStr x y 
    15161517    | isNumeric x && isNumeric y = op2Ord vCastRat x y 
    1517     | otherwise                  = op2OrdNumeric compare x y 
     1518    | otherwise                  = op2Ord vCastStr x y 
    15181519 
    15191520op3Caller :: Type -> Int -> Val -> Eval Val 
    … …  
    15261527    formatFrame [] = retEmpty 
    15271528    formatFrame ((env, Just sub):_) = retSeq 
    1528         [ VStr $ cast (envPackage env)                 -- .package 
    1529         , VStr $ posName $ envPos env                  -- .file 
     1529        [ _VStr $ cast (envPackage env)                 -- .package 
     1530        , _VStr $ posName $ envPos env                  -- .file 
    15301531        , VInt $ toInteger $ posBeginLine $ envPos env -- .line 
    1531         , VStr $ cast (subName sub)                    -- .subname 
    1532         , VStr $ show $ subType sub                    -- .subtype 
     1532