Changeset 4922

Show
Ignore:
Timestamp:
06/23/05 21:00:37 (4 years ago)
Author:
autrijus
svk:copy_cache_prev:
6771
Message:

* clean up theorbtwo's vCast patch. I expect most tests

to still break... :)

Location:
src/Pugs
Files:
9 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/AST/Internals.hs

    r4920 r4922  
    5757    fromVals, refType, 
    5858    lookupPad, padToList, 
    59     mkPrim, mkSub, 
     59    mkPrim, mkSub, showRat, 
    6060    cxtOfSigil, typeOfSigil, 
    6161    buildParam, defaultArrayParam, defaultHashParam, defaultScalarParam, 
    … …  
    196196        PerlSV sv'  -> fromSV sv'   -- it was a SV 
    197197        val         -> fromVal val  -- it was a Val 
    198 fromVal' v = return $ vCast v 
     198fromVal' v = doCast v 
    199199 
    200200{-| 
    … …  
    206206    fromVal :: Val -> Eval n 
    207207    fromVal = fromVal' 
     208    doCast :: Val -> Eval n 
     209    doCast = castFailM 
    208210    fromSV :: PerlSV -> Eval n 
    209211    fromSV sv = do 
    210212        str <- liftIO $ svToVStr sv 
    211213        fail $ "cannot cast from SV (" ++ str ++ ") to " ++ errType (undefined :: n) 
    212     vCast :: Val -> n 
    213     vCast v@(VRef _)    = castFail v 
    214     {- vCast v             = doCast v -} 
    215214    castV :: n -> Val 
    216215    castV x = VOpaque (MkOpaque x) -- error $ "cannot cast into Val" 
    217 {-    doCast :: Val -> n 
    218     doCast v = error $ "cannot cast from Val: " ++ show v -} 
    219     fmapVal :: (n -> n) -> Val -> Val 
    220     fmapVal f = castV . f . vCast 
    221216 
    222217errType :: (Typeable a) => a -> String 
    … …  
    344339                _       -> VList (map PerlSV rv) 
    345340        } 
    346     fromVal (VCode b) = return $ b 
    347     fromVal (VList [VCode b]) = return $ b -- XXX Wrong 
     341    doCast (VCode b) = return b 
     342    doCast (VList [VCode b]) = return b -- XXX Wrong 
     343    doCast v = castFailM v 
    348344 
    349345instance Value VBool where 
    350346    castV = VBool 
    351347    fromSV sv = liftIO $ svToVBool sv 
    352     fromVal (VJunc j)   = return $ juncToBool j 
    353     fromVal (VMatch m)  = return $ matchOk m 
    354     fromVal (VBool b)   = return $ b 
    355     fromVal VUndef      = return $ False 
    356     fromVal (VStr "")   = return $ False 
    357     fromVal (VStr "0")  = return $ False 
    358     fromVal (VInt 0)    = return $ False 
    359     fromVal (VRat 0)    = return $ False 
    360     fromVal (VNum 0)    = return $ False 
    361     fromVal (VList [])  = return $ False 
    362     fromVal _           = return $ True 
     348    doCast (VJunc j)   = juncToBool j 
     349    doCast (VMatch m)  = return $ matchOk m 
     350    doCast (VBool b)   = return $ b 
     351    doCast VUndef      = return $ False 
     352    doCast (VStr "")   = return $ False 
     353    doCast (VStr "0")  = return $ False 
     354    doCast (VInt 0)    = return $ False 
     355    doCast (VRat 0)    = return $ False 
     356    doCast (VNum 0)    = return $ False 
     357    doCast (VList [])  = return $ False 
     358    doCast _           = return $ True 
    363359 
    364360{-| 
    … …  
    368364the actual junction test. 
    369365-} 
    370 juncToBool :: VJunc -> Bool 
    371 juncToBool (MkJunc JAny  _  vs) = True `Set.member` Set.map vCast vs 
    372 juncToBool (MkJunc JAll  _  vs) = not (False `Set.member` Set.map vCast vs) 
    373 juncToBool (MkJunc JNone _  vs) = not (True `Set.member` Set.map vCast vs) 
    374 juncToBool (MkJunc JOne  ds vs) 
    375     | True `Set.member` Set.map vCast ds 
    376     = False 
    377     | otherwise 
    378     = (1 ==) . length . filter vCast $ Set.elems vs 
     366juncToBool :: VJunc -> Eval Bool 
     367juncToBool (MkJunc JAny  _  vs) = do 
     368    bools <- mapM fromVal (Set.elems vs) 
     369    return . isJust $ find id bools 
     370juncToBool (MkJunc JAll  _  vs) = do 
     371    bools <- mapM fromVal (Set.elems vs) 
     372    return . isNothing $ find not bools 
     373juncToBool (MkJunc JNone _  vs) = do 
     374    bools <- mapM fromVal (Set.elems vs) 
     375    return . isNothing $ find id bools 
     376juncToBool (MkJunc JOne ds vs) = do 
     377    bools <- mapM fromVal (Set.elems ds) 
     378    if isJust (find id bools) then return False else do 
     379    bools <- mapM fromVal (Set.elems vs) 
     380    return $ 1 == (length $ filter id bools) 
    379381 
    380382instance Value VInt where 
    381383    castV = VInt 
    382384    fromSV sv = liftIO $ svToVInt sv 
    383     fromVal (VInt i)     = return $ i 
    384     fromVal x            = return $ truncate (vCast x :: VRat) 
     385    doCast (VInt i)     = return $ i 
     386    doCast x            = fmap truncate (fromVal x :: Eval VRat) 
    385387 
    386388instance Value VRat where 
    387389    castV = VRat 
    388390    fromSV sv = liftIO $ svToVNum sv 
    389     fromVal (VInt i)     = return $ i % 1 
    390     fromVal (VRat r)     = return $ r 
    391     fromVal (VBool b)    = return $ if b then 1 % 1 else 0 % 1 
    392     fromVal (VList l)    = return $ genericLength l 
    393     fromVal (VStr s) | not (null s) , isSpace $ last s = do 
     391    doCast (VInt i)     = return $ i % 1 
     392    doCast (VRat r)     = return $ r 
     393    doCast (VBool b)    = return $ if b then 1 % 1 else 0 % 1 
     394    doCast (VList l)    = return $ genericLength l 
     395    doCast (VStr s) | not (null s) , isSpace $ last s = do 
    394396        str <- fromVal (VStr $ init s) 
    395397        return str 
    396     fromVal (VStr s) | not (null s) , isSpace $ head s = do  
     398    doCast (VStr s) | not (null s) , isSpace $ head s = do  
    397399        str <- fromVal (VStr $ tail s) 
    398400        return str 
    399     fromVal (VStr s)     = return $ 
     401    doCast (VStr s)     = return $ 
    400402        case ( runParser naturalOrRat () "" s ) of 
    401403            Left _   -> 0 % 1 
    … …  
    403405                Left  i -> i % 1 
    404406                Right d -> d 
    405     fromVal x            = return $ toRational (vCast x :: VNum) 
     407    doCast x            = fmap toRational (fromVal x :: Eval VNum) 
    406408 
    407409instance Value VNum where 
    408410    castV = VNum 
    409411    fromSV sv = liftIO $ svToVNum sv 
    410     fromVal VUndef       = return $ 0 
    411     fromVal (VBool b)    = return $ if b then 1 else 0 
    412     fromVal (VInt i)     = return $ fromIntegral i 
    413     fromVal (VRat r)     = return $ realToFrac r 
    414     fromVal (VNum n)     = return $ n 
    415     fromVal (VStr s) | not (null s) , isSpace $ last s = do 
     412    doCast VUndef       = return $ 0 
     413    doCast (VBool b)    = return $ if b then 1 else 0 
     414    doCast (VInt i)     = return $ fromIntegral i 
     415    doCast (VRat r)     = return $ realToFrac r 
     416    doCast (VNum n)     = return $ n 
     417    doCast (VStr s) | not (null s) , isSpace $ last s = do 
    416418        str <- fromVal (VStr $ init s) 
    417419        return str 
    418     fromVal (VStr s) | not (null s) , isSpace $ head s = do 
     420    doCast (VStr s) | not (null s) , isSpace $ head s = do 
    419421        str <- fromVal (VStr $ tail s) 
    420422        return str 
    421     fromVal (VStr "Inf") = return $ 1/0 
    422     fromVal (VStr "NaN") = return $ 0/0 
    423     fromVal (VStr s)     = return $ 
     423    doCast (VStr "Inf") = return $ 1/0 
     424    doCast (VStr "NaN") = return $ 0/0 
     425    doCast (VStr s)     = return $ 
    424426        case ( runParser naturalOrRat () "" s ) of 
    425427            Left _   -> 0 
    … …  
    427429                Left  i -> fromIntegral i 
    428430                Right d -> realToFrac d 
    429     fromVal (VList l)     = return $ genericLength l 
    430     fromVal t@(VThread _) = return $ read $ vCast t 
    431     fromVal (VMatch m)    = return $ vCast (VStr $ matchStr m) 
    432     fromVal _             = return $ 0/0 -- error $ "cannot cast as Num: " ++ show x 
     431    doCast (VList l)     = return $ genericLength l 
     432    doCast t@(VThread _) = fmap read (fromVal t) 
     433    doCast (VMatch m)    = fromVal (VStr $ matchStr m) 
     434    doCast v             = castFailM v 
    433435 
    434436instance Value VComplex where 
    435437    castV = VComplex 
    436     fromVal x            = return $ (vCast x :: VNum) :+ 0 
     438    doCast x            = fmap (:+ 0) (fromVal x :: Eval VNum) 
    437439 
    438440instance Value VStr where 
    … …  
    450452            return $ k ++ "\t" ++ str 
    451453        return $ unlines lns 
    452     vCast VUndef        = "" 
    453     vCast (VStr s)      = s 
    454     vCast (VBool b)     = if b then "1" else "" 
    455     vCast (VInt i)      = show i 
    456     vCast (VRat r) 
    457         | frac == 0 = s ++ show quot 
    458         | otherwise = s ++ show quot ++ "." ++ showFrac frac 
    459         where 
    460         n = numerator r 
    461         d = denominator r 
    462         s = if signum n < 0 then "-" else "" 
    463         (quot, rem) = quotRem (abs n) d 
    464         frac :: VInt 
    465         frac = round ((rem * (10 ^ (40 :: VInt))) % d) 
    466         showFrac = reverse . dropWhile (== '0') . reverse . pad . show 
    467         pad x = (replicate (40 - length x) '0') ++ x 
    468     vCast (VNum n)      = showNum n 
    469     vCast (VList l)     = unwords $ map vCast l 
    470     vCast (VCode s)     = "<" ++ show (subType s) ++ "(" ++ subName s ++ ")>" 
    471     vCast (VJunc j)     = show j 
    472     vCast (VThread t)   = takeWhile isDigit $ dropWhile (not . isDigit) $ show t 
    473     vCast (VHandle h)   = "<" ++ "VHandle (" ++ (show h) ++ ">" 
    474     vCast (VMatch m)    = matchStr m 
    475     vCast (VType typ)   = showType typ -- "::" ++ showType typ 
    476     vCast (VObject o)   = "<obj:" ++ showType (objType o) ++ ">" 
    477     vCast x             = "<" ++ showType (valType x) ++ ">" 
     454    doCast VUndef        = return "" 
     455    doCast (VStr s)      = return s 
     456    doCast (VBool b)     = return $ if b then "1" else "" 
     457    doCast (VInt i)      = return $ show i 
     458    doCast (VRat r)      = return $ showRat r 
     459    doCast (VNum n)      = return $ showNum n 
     460    doCast (VList l)     = fmap unwords (mapM fromVal l) 
     461    doCast (VCode s)     = return $ "<" ++ show (subType s) ++ "(" ++ subName s ++ ")>" 
     462    doCast (VJunc j)     = return $ show j 
     463    doCast (VThread t)   = return $ takeWhile isDigit $ dropWhile (not . isDigit) $ show t 
     464    doCast (VHandle h)   = return $ "<" ++ "VHandle (" ++ (show h) ++ ">" 
     465    doCast (VMatch m)    = return $ matchStr m 
     466    doCast (VType typ)   = return $ showType typ -- "::" ++ showType typ 
     467    doCast (VObject o)   = return $ "<obj:" ++ showType (objType o) ++ ">" 
     468    doCast x             = return $ "<" ++ showType (valType x) ++ ">" 
     469 
     470showRat :: VRat -> VStr 
     471showRat r 
     472    | frac == 0 = s ++ show quot 
     473    | otherwise = s ++ show quot ++ "." ++ showFrac frac 
     474    where 
     475    n = numerator r 
     476    d = denominator r 
     477    s = if signum n < 0 then "-" else "" 
     478    (quot, rem) = quotRem (abs n) d 
     479    frac :: VInt 
     480    frac = round ((rem * (10 ^ (40 :: VInt))) % d) 
     481    showFrac = reverse . dropWhile (== '0') . reverse . pad . show 
     482    pad x = (replicate (40 - length x) '0') ++ x 
    478483 
    479484instance Value [PerlSV] where 
    … …  
    509514            (VList vs) -> return vs 
    510515            _          -> return [v] 
    511     fromVal (VList l)     = return $ l 
    512     fromVal (VUndef)      = return $ [VUndef] 
    513     fromVal v             = return $ [v] 
     516    fromVal v = fromVal' v 
     517    doCast (VList l)     = return $ l 
     518    doCast (VUndef)      = return $ [VUndef] 
     519    doCast v             = return $ [v] 
    514520 
    515521instance Value VHandle where 
    516522    castV = VHandle 
    517     fromVal (VHandle x)  = return $ x 
     523    doCast (VHandle x)  = return $ x 
     524    doCast v = castFailM v 
    518525 
    519526instance Value VSocket where 
    520527    castV = VSocket 
    521     fromVal (VSocket x)  = return $ x 
     528    doCast (VSocket x)  = return $ x 
     529    doCast v = castFailM v 
    522530 
    523531instance Value (VThread Val) where 
    524532    castV = VThread 
    525     fromVal (VThread x)  = return $ x 
     533    doCast (VThread x)  = return $ x 
     534    doCast v = castFailM v 
    526535 
    527536instance Value VProcess where 
    528537    castV = VProcess 
    529     fromVal (VProcess x)  = return $ x 
     538    doCast (VProcess x)  = return $ x 
     539    doCast v = castFailM v 
    530540 
    531541instance Value Int where 
    532542    fromSV sv = liftIO $ svToVInt sv 
    533     fromVal x = return $ intCast x 
     543    doCast x = intCast x 
    534544    castV = VInt . fromIntegral 
    535 instance Value Word  where fromVal x = return $ intCast x 
    536 instance Value Word8 where fromVal x = return $ intCast x 
     545instance Value Word  where fromVal x = intCast x 
     546instance Value Word8 where fromVal x = intCast x 
    537547instance Value [Word8] where 
    538     fromVal (byte : tailbytes) = do 
    539         let char   = toEnum . fromEnum byte 
    540         tailchars <- fromVal tailbytes 
    541         return (char : tailchars) 
     548    fromVal val = fmap (map (toEnum . ord)) (fromVal val) 
    542549 
    543550type VScalar = Val 
    … …  
    547554    fromVal (VRef r) = fromVal =<< readRef r 
    548555    fromVal v = return v 
    549     vCast = id 
    550556    castV = id -- XXX not really correct; need to referencify things 
    551557 
    552 intCast :: Num b => Val -> b 
    553 intCast x   = fromIntegral (vCast x :: VInt) 
     558intCast :: Num b => Val -> Eval b 
     559intCast x = fmap fromIntegral (fromVal x :: Eval VInt) 
    554560 
    555561type VList = [Val] 
    … …  
    675681        (show jtype) ++ "(" ++ 
    676682            (foldl (\x y -> 
    677                 if x == "" then (vCast :: Val -> VStr) y 
    678                 else x ++ "," ++ (vCast :: Val -> VStr) y) 
     683                if x == "" then show y 
     684                else x ++ "," ++ show y) 
    679685            "" $ Set.elems set) ++ ")" 
    680686 
    … …  
    14661472 
    14671473instance Value VOpaque where 
    1468     vCast (VOpaque o) = o 
    1469     vCast v = MkOpaque v 
     1474    fromVal (VOpaque o) = return o 
     1475    fromVal v = return $ MkOpaque v 
    14701476    castV (MkOpaque x) = castV x 
    14711477#endif 

  • src/Pugs/Bind.hs

    r4832 r4922  
    4242        = ( ((prm, exp) : bound), exps ) 
    4343        | otherwise 
    44         = ( bound, (Syn "=>" [Val (VStr name), exp]:exps) ) 
     44        = ( bound, (App (Var "&infix:=>") Nothing [Val (VStr name), exp]:exps) ) 
     45 
    4546 
    4647matchNamedAttribute :: String -> String -> Bool 
    … …  
    156157isPair (Pos _ exp) = isPair exp 
    157158isPair (Cxt _ exp) = isPair exp 
    158 isPair (Syn "=>" [(Val _), _])   = True 
    159159isPair (App (Var "&infix:=>") Nothing [(Cxt _ (Val _)), _])   = True 
    160160isPair (App (Var "&infix:=>") Nothing [(Val _), _])   = True 
    … …  
    168168unPair (Pos _ exp) = unPair exp 
    169169unPair (Cxt _ exp) = unPair exp 
    170 unPair (Syn "=>" [(Val k), exp]) = (vCast k, exp) 
    171 unPair (App (Var "&infix:=>") Nothing [(Cxt _ (Val k)), exp]) = (vCast k, exp) 
    172 unPair (App (Var "&infix:=>") Nothing [(Val k), exp]) = (vCast k, exp) 
    173 unPair x                                = error ("Not a pair: " ++ show x) 
     170unPair (App (Var "&infix:=>") Nothing [key, exp]) 
     171    | Val (VStr k) <- unwrap key = (k, exp) 
     172unPair x = error ("Not a pair: " ++ show x) 
    174173 
    175174{-| 

  • src/Pugs/Eval.hs

    r4921 r4922  
    495495    reduce (Syn ":=" [expand var, expand vexp]) 
    496496 
    497 reduceSyn "=>" [keyExp, valExp] = do 
    498     key <- enterEvalContext cxtItemAny keyExp 
    499     val <- enterEvalContext cxtItemAny valExp 
    500     retItem $ castV (key, val) 
    501  
    502497reduceSyn "*" exps 
    503498    | [Syn syn [exp]] <- unwrap exps --  * cancels out [] and {} 
    … …  
    511506 
    512507reduceSyn "," exps = do 
    513     vals <- mapM (enterEvalContext cxtSlurpyAny) exps 
    514     retVal . VList . concat $ map vCast vals 
     508    vals    <- mapM (enterEvalContext cxtSlurpyAny) exps 
     509    vals'   <- mapM fromVal vals 
     510    retVal . VList $ concat vals' 
    515511 
    516512reduceSyn "val" [exp] = do 
    … …  
    721717        Right curriedSub -> retVal $ castV $ curriedSub 
    722718 
    723 reduceApp (Var "&infix:=>") invs args = reduce (Syn "=>" (maybeToList invs ++ args)) 
     719reduceApp (Var "&infix:=>") invs args = do 
     720    let [keyExp, valExp] = maybeToList invs ++ args 
     721    key <- enterEvalContext cxtItemAny keyExp 
     722    val <- enterEvalContext cxtItemAny valExp 
     723    retItem $ castV (key, val) 
    724724 
    725725reduceApp (Var name@('&':_)) invs args = do 
    … …  
    843843applyThunk styp bound@(arg:_) thunk = do 
    844844    -- introduce $?SELF and $_ as the first invocant. 
    845     inv <- if styp <= SubMethod then invocant else return [] 
     845    inv     <- if styp <= SubMethod then invocant else return [] 
    846846    pad <- formal 
    847847    enterLex (inv ++ pad) $ thunk_force thunk 
    848848    where 
    849849    formal = mapM argNameValue $ filter (not . null . argName) bound 
    850     invocant = mapM (`genSym` (vCast $ argValue arg)) $ words "$?SELF $_" 
    851     argNameValue (ApplyArg name val _) = genSym name (vCast val) 
     850    invocant = do 
     851        argRef  <- fromVal (argValue arg) 
     852        mapM (`genSym` argRef) $ words "$?SELF $_" 
     853    argNameValue (ApplyArg name val _) = genSym name =<< fromVal val 
    852854 
    853855{-| 

  • src/Pugs/Eval/Var.hs

    r4625 r4922  
    251251    argSlurpLen (Val listMVal) = do 
    252252        listVal  <- fromVal listMVal 
    253         return $ length (vCast listVal :: [Val]) 
     253        fmap length (fromVal listVal :: Eval [Val]) 
    254254    argSlurpLen (Var name) = do 
    255255        listMVal <- evalVar name 
    256256        listVal  <- fromVal listMVal 
    257         return $ length (vCast listVal :: [Val]) 
     257        fmap length (fromVal listVal :: Eval [Val]) 
    258258    argSlurpLen (Syn "," list) =  return $ length list 
    259259    argSlurpLen _ = return 1 -- XXX 

  • src/Pugs/Parser.hs

    r4910 r4922  
    537537    args <- ruleExpression 
    538538    case args of 
    539         App (Var "&infix:=>") Nothing [Val key, Val val] -> do 
    540             return $ Syn "inline" $ map (Val . VStr . vCast) [key, val] 
     539        App (Var "&infix:=>") Nothing exp -> do 
     540            return $ Syn "inline" exp 
    541541        _ -> fail "not yet parsed" 
    542542 

  • src/Pugs/Pretty.hs

    r4137 r4922  
    9595    format (VInt x) = integer x 
    9696    format (VStr x) = text $ "'" ++ encodeUTF8 (concatMap quoted x) ++ "'" 
    97     format v@(VRat _) = text $ vCast v 
     97    format (VRat x) = text $ showRat x 
    9898    format (VComplex x) = text $ show x 
    9999    format (VControl (ControlEnv _)) = text "<env>" 
    … …  
    125125--      [ format (VStr k, v) | (k, v) <- Map.toList h ] 
    126126    format (VHandle x) = text $ show x 
    127     format t@(VThread _) = text $ vCast t 
     127    format (VThread t) = text $ takeWhile isDigit $ dropWhile (not . isDigit) $ show t 
    128128    format (VSocket x) = text $ show x 
    129129    -- format (MVal v) = text $ unsafePerformIO $ do 

  • src/Pugs/Prim.hs

    r4914 r4922  
    218218        (VList vs)  -> VRef . arrayRef $ vs 
    219219        _           -> VRef . scalarRef $ v 
    220 op1 "post:..."  = op1Cast op1Range 
     220op1 "post:..."  = op1Range 
    221221op1 "true" = op1 "?" 
    222222op1 "any"  = op1Cast opJuncAny 
    … …  
    751751op2 "cmp"= op2Ord vCastStr 
    752752op2 "<=>"= op2Ord vCastRat 
    753 op2 ".." = op2Cast op2Range 
    754 op2 "..^" = op2Cast op2RangeExclRight 
    755 op2 "^.." = op2Cast op2RangeExclLeft 
    756 op2 "^..^" = op2Cast op2RangeExclBoth 
     753op2 ".." = op2Range 
     754op2 "..^" = op2RangeExclRight 
     755op2 "^.." = op2RangeExclLeft 
     756op2 "^..^" = op2RangeExclBoth 
    757757op2 "!=" = op2Cmp vCastRat (/=) 
    758758op2 "==" = op2Cmp vCastRat (==) 
    … …  
    804804    sig  <- fromVal s 
    805805    pids <- fromVals v 
     806    sig' <- fromVal sig 
     807    pids'<- mapM fromVal pids 
    806808    let doKill pid = do 
    807         signalProcess (toEnum $ vCast sig) (toEnum $ vCast pid) 
     809        signalProcess (toEnum sig') (toEnum pid) 
    808810        return 1 
    809     rets <- mapM (tryIO 0 . doKill) pids 
     811    rets <- mapM (tryIO 0 . doKill) pids' 
    810812    return . VInt $ sum rets 
    811813op2 "does"  = op2 "isa" -- XXX not correct 
    … …  
    10501052op4 other = \_ _ _ _ -> fail ("Unimplemented 4-ary op: " ++ other) 
    10511053 
    1052 op1Range :: Val -> Val 
    1053 op1Range (VStr s)    = VList $ map VStr $ strRangeInf s 
    1054 op1Range (VRat n)    = VList $ map VRat [n ..] 
    1055 op1Range (VNum n)    = VList $ map VNum [n ..] 
    1056 op1Range x           = VList $ map VInt [vCast x ..] 
    1057  
    1058 op2Range :: Val -> Val -> Val 
    1059 op2Range (VStr s) y  = VList $ map VStr $ strRange s (vCast y) 
    1060 op2Range (VNum n) y  = VList $ map VNum [n .. vCast y] 
    1061 op2Range x (VNum n)  = VList $ map VNum [vCast x .. n] 
    1062 op2Range (VRat n) y  = VList $ map VRat [n .. vCast y] 
    1063 op2Range x (VRat n)  = VList $ map VRat [vCast x .. n] 
    1064 op2Range x y         = VList $ map VInt [vCast x .. vCast y] 
    1065  
    1066 op2RangeExclRight :: Val -> Val -> Val 
    1067 op2RangeExclRight x y = VList $ init $ vCast $ op2Range x y 
    1068  
    1069 op2RangeExclLeft :: Val -> Val -> Val 
    1070 op2RangeExclLeft x y = VList $ tail $ vCast $ op2Range x y  
    1071  
    1072 op2RangeExclBoth :: Val -> Val -> Val 
    1073 op2RangeExclBoth x y = VList $ tail $ init $ vCast $ op2Range x y 
     1054op1Range :: Val -> Eval Val 
     1055op1Range (VStr s)    = return . VList $ map VStr $ strRangeInf s 
     1056op1Range (VRat n)    = return . VList $ map VRat [n ..] 
     1057op1Range (VNum n)    = return . VList $ map VNum [n ..] 
     1058op1Range (VInt n)    = return . VList $ map VInt [n ..] 
     1059op1Range x           = do 
     1060    int <- fromVal x 
     1061    op1Range (VInt int) 
     1062 
     1063op2Range :: Val -> Val -> Eval Val 
     1064op2Range (VStr s) y  = do 
     1065    y'  <- fromVal y 
     1066    return . VList $ map VStr $ strRange s y' 
     1067op2Range (VNum n) y  = do 
     1068    y'  <- fromVal y 
     1069    return . VList $ map VNum [n .. y'] 
     1070op2Range x (VNum n)  = do 
     1071    x'  <- fromVal x 
     1072    return . VList $ map VNum [x' .. n] 
     1073op2Range (VRat n) y  = do 
     1074    y'  <- fromVal y 
     1075    return . VList $ map VRat [n .. y'] 
     1076op2Range x (VRat n)  = do 
     1077    x'  <- fromVal x 
     1078    return . VList $ map VRat [x' .. n] 
     1079op2Range x y         = do 
     1080    x'  <- fromVal x 
     1081    y'  <- fromVal y 
     1082    return . VList $ map VInt [x' .. y'] 
     1083 
     1084op2RangeExclRight :: Val -> Val -> Eval Val 
     1085op2RangeExclRight x y = do 
     1086    VList vals <- op2Range x y 
     1087    return . VList $ init vals 
     1088 
     1089op2RangeExclLeft :: Val -> Val -> Eval Val 
     1090op2RangeExclLeft x y = do 
     1091    VList vals <- op2Range x y 
     1092    return . VList $ tail vals 
     1093 
     1094op2RangeExclBoth :: Val -> Val -> Eval Val 
     1095op2RangeExclBoth x y = do 
     1096    VList vals <- op2Range x y 
     1097    return . VList $ init (tail vals) 
    10741098 
    10751099op2ChainedList :: Val -> Val -> Val 

  • src/Pugs/Prim/Match.hs

    r4870 r4922  
    119119    if (not $ isSlurpyCxt cxt) 
    120120        then return (VInt $ genericLength rv) 
    121         else return . VList $ if rxStringify rx 
    122             then map (VStr . vCast) rv 
    123             else rv 
     121        else if rxStringify rx 
     122            then do 
     123                strs <- mapM fromVal rv 
     124                return (VList $ map VStr strs) 
     125            else return (VList rv) 
    124126    where 
    125127    matchOnce :: String -> Eval [Val] 

  • src/Pugs/Trans.hs

    r4916 r4922  
    4040    gen <- catch (doLookup s) $ \_ -> do 
    4141        fail $ "Cannot compile to " ++ s 
    42     val <- runEvalIO env gen 
    43     return $ vCast val 
     42    VStr str <- runEvalIO env gen 
     43    return str