Changeset 15297 for src/Pugs/Prim.hs

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

* Revert the previous patch; everything back to normal.

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/Prim.hs

    r15296 r15297  
    1 {-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans -fno-full-laziness -fno-cse -fallow-overlapping-instances -foverloaded-strings #-} 
     1{-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans -fno-full-laziness -fno-cse -fallow-overlapping-instances #-} 
    22 
    33{-| 
    … …  
    5555import GHC.Unicode 
    5656import qualified Data.HashTable as H 
    57 import qualified UTF8 as Str 
    5857 
    5958constMacro :: Exp -> [Val] -> Eval Val 
    … …  
    6665op0 "^"  = fmap opJuncOne . mapM fromVal 
    6766op0 "|"  = fmap opJuncAny . mapM fromVal 
    68 op0 "want"  = const $ fmap _VStr (asks (maybe "Void" envWant . envCaller)) 
     67op0 "want"  = const $ fmap VStr (asks (maybe "Void" envWant . envCaller)) 
    6968op0 "Bool::True"  = const . return $ VBool True 
    7069op0 "Bool::False" = const . return $ VBool False 
    … …  
    8382op0 "File::Spec::cwd" = const $ do 
    8483    cwd <- guardIO getCurrentDirectory 
    85     return $ _VStr cwd 
     84    return $ VStr cwd 
    8685op0 "File::Spec::tmpdir" = const $ do 
    8786    tmp <- guardIO getTemporaryDirectory 
    88     return $ _VStr tmp 
     87    return $ VStr tmp 
    8988op0 "Pugs::Internals::pi" = const $ return $ VNum pi 
    9089op0 "self"    = const $ expToEvalVal (_Var "&self") 
    … …  
    117116    str <- fromVal x 
    118117    return $ if null str 
    119         then _VStr str 
    120         else _VStr $ init str 
     118        then VStr str 
     119        else VStr $ init str 
    121120op1 "Scalar::chomp" = \x -> do 
    122121    str <- fromVal x 
    123122    return $ op1Chomp str 
    124123op1 "Str::split" = op1Cast (castV . words) 
    125 op1 "lc"         = op1Cast (_VStr . map toLower) 
     124op1 "lc"         = op1Cast (VStr . map toLower) 
    126125op1 "lcfirst"    = op1StrFirst toLower 
    127 op1 "uc"         = op1Cast (_VStr . map toUpper) 
     126op1 "uc"         = op1Cast (VStr . map toUpper) 
    128127op1 "ucfirst"    = op1StrFirst toUpper 
    129 op1 "capitalize" = op1Cast $ _VStr . (mapEachWord capitalizeWord) 
     128op1 "capitalize" = op1Cast $ VStr . (mapEachWord capitalizeWord) 
    130129  where 
    131130    mapEachWord _ [] = [] 
    … …  
    136135    capitalizeWord []     = [] 
    137136    capitalizeWord (c:cs) = toUpper c:(map toLower cs) 
    138 op1 "quotemeta" = op1Cast (_VStr . concat . map toQuoteMeta) 
     137op1 "quotemeta" = op1Cast (VStr . concat . map toQuoteMeta) 
    139138op1 "undef" = const $ return undef 
    140139op1 "undefine" = \x -> do 
    … …  
    161160    val <- fromVal x 
    162161    val' <- case val of 
    163         (VStr str)  -> return (_VStr $ strInc (cast str)) 
     162        (VStr str)  -> return (VStr $ strInc str) 
    164163        _           -> op1Numeric (+1) val 
    165164    writeRef ref val' 
    166165    case val of 
    167         VStr{}      -> return val 
     166        (VStr _)    -> return val 
    168167        _           -> op1 "+" val 
    169168op1 "++"   = \mv -> do 
    … …  
    193192        _  -> return (args, Nothing) 
    194193    sortBy <- case sortByGiven of 
    195         Nothing -> readVar (_cast "&infix:cmp") 
     194        Nothing -> readVar (cast "&infix:cmp") 
    196195        Just subVal -> return subVal 
    197196    sub <- fromVal sortBy 
    … …  
    203202op1 "Scalar::reverse" = \v -> do 
    204203    str     <- fromVal v 
    205     return (_VStr $ reverse str) 
     204    return (VStr $ reverse str) 
    206205op1 "List::reverse" = \v -> do 
    207206    vlist <- fromVal v 
    … …  
    209208op1 "list" = op1Cast VList 
    210209op1 "pair" = op1Cast $ VList . (map $ \(k, v) -> castV ((VStr k, v) :: VPair)) 
    211 op1 "~"    = op1Cast _VStr 
     210op1 "~"    = op1Cast VStr 
    212211op1 "?"    = op1Cast VBool 
    213212op1 "int"  = op1Cast VInt 
    214213op1 "+^"   = op1Cast (VInt . pred . negate) -- Arbitrary precision complement- 0 ==> -1 / 1 ==> -2 
    215 op1 "~^"   = op1Cast (_VStr . mapStr complement) 
     214op1 "~^"   = op1Cast (VStr . mapStr complement) 
    216215op1 "?^"   = op1 "!" 
    217216op1 "\\"   = \v -> do 
    … …  
    339338op1 "take" = \v -> assertFrame FrameGather $ do 
    340339    glob    <- askGlobal 
    341     arr     <- findSymRef (_cast "$*TAKE") glob 
     340    arr     <- findSymRef (cast "$*TAKE") glob 
    342341    push    <- doArray (VRef arr) array_push 
    343342    push (listVal v) 
    … …  
    365364op1 "IO::next" = \v -> do 
    366365    fh  <- fromVal v 
    367     guardIO (fmap _VStr (hGetLine fh)) 
     366    guardIO $ fmap (VStr . (++ "\n") . decodeUTF8) (hGetLine fh) 
    368367op1 "Pugs::Safe::safe_print" = \v -> do 
    369368    str  <- fromVal v 
    370     guardIO $ Str.putStr str 
     369    guardIO . putStr $ encodeUTF8 str 
    371370    return $ VBool True 
    372371op1 "die" = \v -> do 
    … …  
    375374    retShift $! VError (errmsg $! v') [pos] 
    376375    where 
    377     errmsg VUndef      = _VStr "Died" 
    378     errmsg VType{}     = _VStr "Died" 
    379     errmsg (VStr "")   = _VStr "Died" 
    380     errmsg (VList [])  = _VStr "Died" 
     376    errmsg VUndef      = VStr "Died" 
     377    errmsg VType{}     = VStr "Died" 
     378    errmsg (VStr "")   = VStr "Died" 
     379    errmsg (VList [])  = VStr "Died" 
    381380    errmsg (VList [x]) = x 
    382381    errmsg x           = x 
    383382op1 "warn" = \v -> do 
    384383    strs <- fromVal v 
    385     errh <- readVar $ _cast "$*ERR" 
     384    errh <- readVar $ cast "$*ERR" 
    386385    pos  <- asks envPos 
    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 
     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 
    391390op1 "fail" = op1 "fail_" -- XXX - to be replaced by Prelude later 
    392391op1 "fail_" = \v -> do 
    393     throw <- fromVal =<< readVar (_cast "$*FAIL_SHOULD_DIE") 
     392    throw <- fromVal =<< readVar (cast "$*FAIL_SHOULD_DIE") 
    394393    if throw then op1 "die" (errmsg v) else do 
    395394    pos   <- asks envPos 
    … …  
    398397    op1Return (retControl (ControlLeave (<= SubRoutine) 0 dieThunk)) 
    399398    where 
    400     errmsg VUndef      = _VStr "Failed" 
    401     errmsg VType{}     = _VStr "Failed" 
    402     errmsg (VStr "")   = _VStr "Failed" 
    403     errmsg (VList [])  = _VStr "Failed" 
     399    errmsg VUndef      = VStr "Failed" 
     400    errmsg VType{}     = VStr "Failed" 
     401    errmsg (VStr "")   = VStr "Failed" 
     402    errmsg (VList [])  = VStr "Failed" 
    404403    errmsg (VList [x]) = x 
    405404    errmsg x           = x 
    … …  
    407406op1 "readlink" = \v -> do 
    408407    str  <- fromVal v 
    409     guardIO $ fmap _VStr (readSymbolicLink str) 
     408    guardIO $ fmap VStr (readSymbolicLink str) 
    410409op1 "sleep" = \v -> do 
    411410    x <- fromVal v :: Eval VNum 
    … …  
    432431    path  <- fromVal v 
    433432    files <- guardIO $ getDirectoryContents path 
    434     retSeq (map _VStr files) 
     433    retSeq (map VStr files) 
    435434op1 "slurp" = \v -> do 
    436435    ifValTypeIsa v "IO" 
    437436        (do h <- fromVal v 
    438437            ifListContext (strictify $! op1 "=" v) $ do 
    439                 content <- guardIO $ Str.hGetContents h 
    440                 return (VStr content)) 
     438                content <- guardIO $ hGetContents h 
     439                return . VStr $ decodeUTF8 content) 
    441440        (do 
    442441            fileName    <- fromVal v 
    … …  
    448447        VList lines <- action 
    449448        return $ VList (length lines `seq` lines) 
    450     slurpList file = strictify $! op1 "=" (VList [_VStr file]) 
     449    slurpList file = strictify $! op1 "=" (VList [VStr file]) 
    451450    slurpScalar file = do 
    452         content <- guardIO $ Str.readFile file 
    453         return (VStr content) 
     451        content <- guardIO $ readFile file 
     452        return . VStr $ decodeUTF8 content 
    454453op1 "opendir" = \v -> do 
    455454    str <- fromVal v 
    … …  
    472471        if null this then return [] else do 
    473472        rest <- readDirStreamList dir 
    474         return (_VStr this:rest) 
     473        return (VStr this:rest) 
    475474op1 "Pugs::Internals::runShellCommand" = \v -> do 
    476475    str <- fromVal v 
    … …  
    484483    handleExitCode exitCode  
    485484    return $ case cxt of 
    486         CxtSlurpy{} -> VList (map _VStr $ lines res) 
    487         _           -> _VStr res 
     485        CxtSlurpy{} -> VList (map VStr $ lines res) 
     486        _           -> VStr res 
    488487    where 
    489488    -- XXX - crude CRLF treatment 
    … …  
    590589op1 "max"   = op1Max 
    591590op1 "uniq"  = op1Uniq 
    592 op1 "chr"   = op1Cast (_VStr . (:[]) . chr) 
     591op1 "chr"   = op1Cast (VStr . (:[]) . chr) 
    593592op1 "ord"   = op1Cast $ \str -> if null str then undef else (castV . ord . head) str 
    594593op1 "hex"   = fail "hex() is not part of Perl 6 - use :16() instead." 
    … …  
    642641op1 "Pugs::Internals::rule_pattern" = \v -> do 
    643642    case v of 
    644         VRule MkRulePGE{rxRule=re} -> return $ _VStr re 
    645         VRule MkRulePCRE{rxRuleStr=re} -> return $ _VStr re 
     643        VRule MkRulePGE{rxRule=re} -> return $ VStr re 
     644        VRule MkRulePCRE{rxRuleStr=re} -> return $ VStr re 
    646645        _ -> fail $ "Not a rule: " ++ show v 
    647646op1 "Pugs::Internals::rule_adverbs" = \v -> do 
    … …  
    671670    glob <- filterPrim =<< asks envGlobal 
    672671    yml  <- liftIO $ showYaml (filterUserDefinedPad glob, v) 
    673     return $ _VStr yml 
     672    return $ VStr yml 
    674673op1 "Object::HOW" = \v -> do 
    675674    typ     <- evalValType v 
    … …  
    698697op1SigilHyper sig val = do 
    699698    vs <- fromVal val 
    700     evalExp $ Syn "," (map (\x -> _Syn (shows sig "{}") [Val x]) vs) 
     699    evalExp $ Syn "," (map (\x -> Syn (shows sig "{}") [Val x]) vs) 
    701700 
    702701retSeq :: VList -> Eval Val 
    … …  
    706705handleExitCode exitCode = do 
    707706    glob    <- askGlobal 
    708     errSV   <- findSymRef (_cast "$!") glob 
     707    errSV   <- findSymRef (cast "$!") glob 
    709708    writeRef errSV $ case exitCode of 
    710709        ExitFailure x   -> VInt $ toInteger x 
    … …  
    712711    return (VBool $ exitCode == ExitSuccess) 
    713712 
    714 cascadeMethod :: ([String] -> [String]) -> String -> Val -> Val -> Eval Val 
     713cascadeMethod :: ([VStr] -> [VStr]) -> VStr -> Val -> Val -> Eval Val 
    715714cascadeMethod f meth v args = do 
    716715    typ     <- evalValType v 
    … …  
    738737op1Return :: Eval Val -> Eval Val 
    739738op1Return action = assertFrame FrameRoutine $ do 
    740     sub   <- fromVal =<< readVar (_cast "&?ROUTINE") 
     739    sub   <- fromVal =<< readVar (cast "&?ROUTINE") 
    741740    -- If this is a coroutine, reset the entry point 
    742741    case subCont sub of 
    … …  
    752751op1Yield :: Eval Val -> Eval Val 
    753752op1Yield action = assertFrame FrameRoutine $ do 
    754     sub   <- fromVal =<< readVar (_cast "&?ROUTINE") 
     753    sub   <- fromVal =<< readVar (cast "&?ROUTINE") 
    755754    case subCont sub of 
    756755        Nothing -> fail $ "cannot yield() from a " ++ pretty (subType sub) 
    … …  
    773772 
    774773op1StrFirst :: (Char -> Char) -> Val -> Eval Val 
    775 op1StrFirst f = op1Cast $ _VStr . 
     774op1StrFirst f = op1Cast $ VStr . 
    776775    \str -> case str of 
    777776        []      -> [] 
    … …  
    790789            Just str -> do 
    791790                ~(VList rest) <- getLines fh 
    792                 return $ VList (_VStr str:rest) 
     791                return $ VList (VStr str:rest) 
    793792            _ -> return (VList []) 
    794793    getLine :: VHandle -> Eval Val 
    … …  
    796795        line <- liftIO $! doGetLine fh 
    797796        case line of 
    798             Just str    -> return $! _VStr $! (length str `seq` str) 
     797            Just str    -> return $! VStr $! (length str `seq` str) 
    799798            _           -> return undef 
    800     doGetLine :: VHandle -> IO (Maybe String) 
     799    doGetLine :: VHandle -> IO (Maybe VStr) 
    801800    doGetLine fh = guardIOexcept [(isIOError isEOFError, Nothing)] $ do 
    802801        line <- hGetLine fh 
    … …  
    815814        char <- hGetChar fh 
    816815        str  <- getChar' fh char 
    817         return $ _VStr $ decodeUTF8 str 
     816        return $ VStr $ decodeUTF8 str 
    818817    -- We may have to read more than one byte, as one utf-8 char can span 
    819818    -- multiple bytes. 
    … …  
    849848    handleOf VUndef = handleOf (VList []) 
    850849    handleOf (VList []) = do 
    851         argsGV  <- readVar (_cast "$*ARGS") 
     850        argsGV  <- readVar (cast "$*ARGS") 
    852851        gv      <- fromVal argsGV 
    853852        if defined gv 
    854853            then handleOf gv 
    855854            else do 
    856                 args    <- readVar (_cast "@*ARGS") 
     855                args    <- readVar (cast "@*ARGS") 
    857856                files   <- fromVal args 
    858857                if null files 
    859858                    then return stdin 
    860859                    else do 
    861                         hdl <- handleOf (_VStr (head files)) -- XXX wrong 
    862                         writeVar (_cast "$*ARGS") (VHandle hdl) 
     860                        hdl <- handleOf (VStr (head files)) -- XXX wrong 
     861                        writeVar (cast "$*ARGS") (VHandle hdl) 
    863862                        return hdl 
    864863    handleOf (VStr x) = do 
    865         return =<< guardIO $ openFile (cast x) ReadMode 
     864        return =<< guardIO $ openFile x ReadMode 
    866865    handleOf (VList [x]) = handleOf x 
    867866    handleOf v = fromVal v 
    … …  
    896895mapStr f = map (chr . fromEnum . f) 
    897896 
    898 mapStr2 :: (Word8 -> Word8 -> Word8) -> [Word8] -> [Word8] -> VStr 
    899 mapStr2 f x y = __ . map (chr . fromEnum . uncurry f) $ x `zip` y 
    900  
    901 mapStr2Fill :: (Word8 -> Word8 -> Word8) -> [Word8] -> [Word8] -> VStr 
    902 mapStr2Fill f x y = __ . map (chr . fromEnum . uncurry f) $ x `zipFill` y 
     897mapStr2 :: (Word8 -> Word8 -> Word8) -> [Word8] -> [Word8] -> String 
     898mapStr2 f x y = map (chr . fromEnum . uncurry f) $ x `zip` y 
     899 
     900mapStr2Fill :: (Word8 -> Word8 -> Word8) -> [Word8] -> [Word8] -> String 
     901mapStr2Fill f x y = map (chr . fromEnum . uncurry f) $ x `zipFill` y 
    903902    where 
    904903    zipFill [] [] = [] 
    … …  
    907906    zipFill (a:as) (b:bs) = (a,b) : zipFill as bs 
    908907 
    909 op1Chomp :: String -> Val 
    910 op1Chomp "" = _VStr "" 
     908op1Chomp :: VStr -> Val 
     909op1Chomp "" = VStr "" 
    911910op1Chomp str 
    912     | last str == '\n'  = _VStr (init str) 
    913     | otherwise         = _VStr str 
     911    | last str == '\n'  = VStr (init str) 
     912    | otherwise         = VStr str 
    914913 
    915914-- |Implementation of 2-arity primitive operators and functions 
    … …  
    921920op2 "/"  = op2Divide 
    922921op2 "%"  = op2Modulus 
    923 op2 "x"  = op2Cast (\x y -> _VStr . concat $ (y :: VInt) `genericReplicate` x) 
     922op2 "x"  = op2Cast (\x y -> VStr . concat $ (y :: VInt) `genericReplicate` x) 
    924923op2 "xx" = op2Cast (\x y -> VList . concat $ (y :: VInt) `genericReplicate` x) 
    925924op2 "+&" = op2Int (.&.) 
    … …  
    927926op2 "+>" = op2Int shiftR 
    928927op2 "~&" = op2Str $ mapStr2 (.&.) 
    929 op2 "~<" = op2Cast (\x y -> _VStr $ mapStr (`shiftL` y) x) 
    930 op2 "~>" = op2Cast (\x y -> _VStr $ mapStr (`shiftR` y) x) 
     928op2 "~<" = op2Cast (\x y -> VStr $ mapStr (`shiftL` y) x) 
     929op2 "~>" = op2Cast (\x y -> VStr $ mapStr (`shiftR` y) x) 
    931930op2 "**" = op2Exp 
    932931op2 "+"  = op2Numeric (+) 
    933932op2 "-"  = op2Numeric (-) 
    934933op2 "atan" = op2Num atan2 
    935 op2 "~"  = op2Str (+++) 
     934op2 "~"  = op2Str (++) 
    936935op2 "+|" = op2Int (.|.) 
    937936op2 "+^" = op2Int xor 
    … …  
    998997op2 "reduce" = op2ReduceL False 
    999998op2 "produce" = op2ReduceL True 
    1000 op2 "reverse" = op2MaybeListop (VList . reverse) (_VStr . reverse) 
     999op2 "reverse" = op2MaybeListop (VList . reverse) (VStr . reverse) 
    10011000op2 "chomp" = op2MaybeListop (VList . map op1Chomp) op1Chomp 
    10021001op2 "kill" = \s v -> do 
    … …  
    10121011op2 "isa"    = \x y -> do 
    10131012    typY <- case y of 
    1014         VStr str -> return $ cast str 
     1013        VStr str -> return $ mkType str 
    10151014        _        -> fromVal y 
    10161015    typX <- fromVal x -- XXX consider line 224 of Pugs.Prim.Match case too 
    … …  
    10191018op2 "does"   = \x y -> do 
    10201019    typY <- case y of 
    1021         VStr str -> return $ cast str 
     1020        VStr str -> return $ mkType str 
    10221021        _        -> fromVal y 
    10231022    op2Match x (VType typY) 
    … …  
    10701069    str <- fromVal x 
    10711070    arg <- fromVal y 
    1072     return $ _VStr $ case arg of 
     1071    return $ VStr $ case arg of 
    10731072       VNum n -> printf str n 
    10741073       VRat r -> printf str ((fromRational r)::Double) 
    10751074       VInt i -> printf str i 
    1076        VStr s -> printf str (cast s :: String) 
     1075       VStr s -> printf str s 
    10771076       _      -> fail "should never be reached given the type declared below" 
    10781077op2 "system" = \x y -> do 
    … …  
    11321131 
    11331132baseDigit :: Char -> Maybe Val 
    1134 baseDigit '.'       = return (_VStr ".") 
     1133baseDigit '.'       = return (VStr ".") 
    11351134baseDigit ch | ch >= '0' && ch <= '9' = return (castV (ord ch - ord '0')) 
    11361135baseDigit ch | ch >= 'a' && ch <= 'z' = return (castV (ord ch - ord 'a' + 10)) 
    … …  
    11481147        return $ VRat (asFractional (0:post') + (asIntegral pre' % 1)) 
    11491148    where 
    1150     (pre, post) = break (== _VStr ".") $ filter (/= _VStr "_") vs 
     1149    (pre, post) = break (== VStr ".") $ filter (/= VStr "_") vs 
    11511150    asIntegral = foldl (\x d -> base * x + d) 0 
    11521151    asFractional :: [VInt] -> VRat 
    … …  
    11601159        _         -> return [v] 
    11611160    guardIO $ do 
    1162         forM_ strs (Str.hPut handle) 
    1163         when wantNewline (Str.hPut handle (__"\n")) 
     1161        forM_ strs (hPutStr handle . encodeUTF8) 
     1162        when wantNewline (hPutStr handle "\n") 
    11641163        return $ VBool True 
    11651164 
    … …  
    11761175            return $ split' delim str 
    11771176    where 
    1178     split' :: String -> String -> Val 
    1179     split' [] xs = VList $ map (_VStr . (:[])) xs 
    1180     split' glue xs = VList $ map _VStr $ split glue xs 
     1177    split' :: VStr -> VStr -> Val 
     1178    split' [] xs = VList $ map (VStr . (:[])) xs 
     1179    split' glue xs = VList $ map VStr $ split glue xs 
    11811180 
    11821181op2MaybeListop :: forall tlist titem. (Value tlist, Value [tlist], Value titem) => 
    … …  
    12141213    --kind <- fromVal =<< op1 "WHAT" x 
    12151214    kind <- case x of 
    1216         VStr str -> return $ cast str 
     1215        VStr str -> return $ mkType str 
    12171216        _        -> fromVal x 
    12181217    skip <- fromVal y 
    … …  
    12271226    return . VInt $ doIndex 0 str sub pos 
    12281227    where 
    1229     doIndex :: VInt -> String -> String -> VInt -> VInt 
     1228    doIndex :: VInt -> VStr -> VStr -> VInt -> VInt 
    12301229    doIndex n a b p 
    12311230        | p > 0, null a     = doIndex n a b 0 
    … …  
    12421241    return . VInt $ doRindex str sub skip 
    12431242    where 
    1244     doRindex :: String -> String -> Int -> VInt 
     1243    doRindex :: VStr -> VStr -> Int -> VInt 
    12451244    doRindex a b skip 
    12461245        | skip > 0         = doRindex (init a) b (skip-1) 
    … …  
    12851284 
    12861285    defs    <- fetchMetaInfo "attrs" (showType typ) 
    1287     attrs   <- liftIO $ hashNew 
     1286    attrs   <- liftIO $ H.new (==) H.hashString 
    12881287    writeIVar (IHash attrs) (named `Map.union` defs) 
    12891288    uniq    <- newObjectId 
    … …  
    13041303    (VObject o) <- fromVal t 
    13051304    attrs   <- readIVar (IHash $ objAttrs o) 
    1306     attrs'  <- liftIO $ hashNew 
     1305    attrs'  <- liftIO $ H.new (==) H.hashString 
    13071306    uniq    <- newObjectId 
    13081307    writeIVar (IHash attrs') (named `Map.union` attrs) 
    … …  
    13141313    pico <- fromVal z 
    13151314    c <- guardIO $ toCalendarTime $ TOD (offset + sec) pico 
    1316     if wantString then return $ _VStr $ calendarTimeToString c else 
     1315    if wantString then return $ VStr $ calendarTimeToString c else 
    13171316        retSeq $ [ vI $ ctYear c 
    13181317                 , vI $ (1+) $ fromEnum $ ctMonth c 
    … …  
    13241323                 , vI $ (1+) $ fromEnum $ ctWDay c 
    13251324                 , vI $ ctYDay c 
    1326                  , _VStr $ ctTZName c 
     1325                 , VStr $ ctTZName c 
    13271326                 , vI $ ctTZ c 
    13281327                 , VBool $ ctIsDST c 
    … …  
    13741373            return $ split' delim str limit 
    13751374    where 
    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 
     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 
    13791378 
    13801379-- XXX - The "String" below wants to be Type. 
    1381 fetchMetaInfo :: Value a => String -> String -> Eval a 
     1380fetchMetaInfo :: Value a => String -> [Char] -> Eval a 
    13821381fetchMetaInfo key typ = do 
    13831382    meta    <- readRef =<< fromVal =<< evalExp (_Var (':':'*':typ)) 
    13841383    fetch   <- doHash meta hash_fetchVal 
    1385     fromVal =<< fetch (cast key) 
     1384    fromVal =<< fetch key 
    13861385 
    13871386-- |Implementation of 4-arity primitive operators and functions. 
    … …  
    13981397        var <- fromVal x 
    13991398        rep <- fromVal new 
    1400         writeRef var (_VStr $ concat [pre, rep, post]) 
     1399        writeRef var (VStr $ concat [pre, rep, post]) 
    14011400    -- If the replacement is given in w, change the str. 
    14021401    when (defined w && not (defined result)) $ change w 
    … …  
    14041403    return $ VRef . MkRef $ proxyScalar (return result) change 
    14051404    where 
    1406     doSubstr :: String -> Int -> Int -> (String, Val, String) 
     1405    doSubstr :: VStr -> Int -> Int -> (VStr, Val, VStr) 
    14071406    doSubstr str pos len 
    14081407        | abs pos > length str = ("", VUndef, "") 
    14091408        | pos < 0   = doSubstr str (length str + pos) len 
    14101409        | len < 0   = doSubstr str pos (length str - pos + len) 
    1411         | otherwise = ((take pos str), _VStr (take len $ drop pos str), (drop (pos + len) str)) 
     1410        | otherwise = ((take pos str), VStr (take len $ drop pos str), (drop (pos + len) str)) 
    14121411 
    14131412-- op4 "splice" = \x y z w-> do 
    … …  
    14231422 
    14241423op1Range :: Val -> Eval Val 
    1425 op1Range (VStr s)    = return . VList $ map _VStr $ strRangeInf (cast s) 
     1424op1Range (VStr s)    = return . VList $ map VStr $ strRangeInf s 
    14261425op1Range (VRat n)    = return . VList $ map VRat [n ..] 
    14271426op1Range (VNum n)    = return . VList $ map VNum [n ..] 
    … …  
    14341433op2Range (VStr s) y  = do 
    14351434    y'  <- fromVal y 
    1436     return . VList $ map _VStr $ strRange (cast s) y' 
     1435    return . VList $ map VStr $ strRange s y' 
    14371436op2Range (VNum n) y  = do 
    14381437    y'  <- fromVal y 
    … …  
    15161515op2OrdNumStr x y 
    15171516    | isNumeric x && isNumeric y = op2Ord vCastRat x y 
    1518     | otherwise                  = op2Ord vCastStr x y 
     1517    | otherwise                  = op2OrdNumeric compare x y 
    15191518 
    15201519op3Caller :: Type -> Int -> Val -> Eval Val 
    … …  
    15271526    formatFrame [] = retEmpty 
    15281527    formatFrame ((env, Just sub):_) = retSeq 
    1529         [ _VStr $ cast (envPackage env)                 -- .package 
    1530         , _VStr $ posName $ envPos env                  -- .file 
     1528        [ VStr $ cast (envPackage env)                 -- .package 
     1529        , VStr $ posName $ envPos env                  -- .file 
    15311530        , VInt $ toInteger $ posBeginLine $ envPos env -- .line 
    1532         , _VStr $ cast (subName sub)                    -- .subname 
    1533         , _VStr $ show $ subType sub                    -- .subtype 
     1531        , VStr $ cast (subName sub)                    -- .subname 
     1532