Changeset 14321 for src/Pugs/Prim.hs

Timestamp:

10/17/06 08:25:00 (2 years ago)

Author:

gaal

svk:copy_cache_prev:

21206

Message:

* Primitive golf and cleanups

Files:

• src/Pugs/Prim.hs (modified) (11 diffs)

src/Pugs/Prim.hs

@@ -65 +65 @@
 -- (including list ops).
 op0 :: String -> [Val] -> Eval Val
-op0 "&"  = fmap opJuncAll  . mapM fromVal
-op0 "^"  = fmap opJuncOne  . mapM fromVal
-op0 "|"  = fmap opJuncAny  . mapM fromVal
+op0 "&"  = fmap opJuncAll . mapM fromVal
+op0 "^"  = fmap opJuncOne . mapM fromVal
+op0 "|"  = fmap opJuncAny . mapM fromVal
 op0 "want"  = const $ fmap VStr (asks (maybe "Void" envWant . envCaller))
-op0 "Bool::True" = const . return $ VBool True
+op0 "Bool::True"  = const . return $ VBool True
 op0 "Bool::False" = const . return $ VBool False
-op0 "True" = constMacro . Val $ VBool True
+op0 "True"  = constMacro . Val $ VBool True
 op0 "False" = constMacro . Val $ VBool False
 op0 "time"  = const $ do
@@ -96 +96 @@
     return $ VStr tmp
 op0 "Pugs::Internals::pi" = const $ return $ VNum pi
-op0 "self" = const $ expToEvalVal (_Var "&self")
-op0 "say" = const $ op1 "IO::say" (VHandle stdout)
-op0 "print" = const $ op1 "IO::print" (VHandle stdout)
-op0 "return" = const $ op1Return (retControl (ControlLeave (<= SubRoutine) 0 undef))
-op0 "yield" = const $ op1Yield (retControl (ControlLeave (<= SubRoutine) 0 undef))
-op0 "leave" = const $ retControl (ControlLeave (>= SubBlock) 0 undef)
-op0 "take" = const $ assertFrame FrameGather retEmpty
+op0 "self"    = const $ expToEvalVal (_Var "&self")
+op0 "say"     = const $ op1 "IO::say" (VHandle stdout)
+op0 "print"   = const $ op1 "IO::print" (VHandle stdout)
+op0 "return"  = const $ op1Return (retControl (ControlLeave (<= SubRoutine) 0 undef))
+op0 "yield"   = const $ op1Yield (retControl (ControlLeave (<= SubRoutine) 0 undef))
+op0 "leave"   = const $ retControl (ControlLeave (>= SubBlock) 0 undef)
+op0 "take"    = const $ assertFrame FrameGather retEmpty
 op0 "nothing" = const . return $ VBool True
-op0 "Pugs::Safe::safe_getc" = const . op1Getc $ VHandle stdin
+op0 "Pugs::Safe::safe_getc"     = const . op1Getc $ VHandle stdin
 op0 "Pugs::Safe::safe_readline" = const . op1Readline $ VHandle stdin
 op0 "reverse" = const $ return (VList [])
-op0 "chomp" = const $ return (VList [])
-op0 "fork"  = const $ opPerl5 "fork" []
+op0 "chomp"   = const $ return (VList [])
+op0 "fork"    = const $ opPerl5 "fork" []
 op0 other = const $ fail ("Unimplemented listOp: " ++ other)
 
@@ -116 +116 @@
 op1 "WHICH" = \x -> do
     val <- fromVal x
-    case val of
-        VObject o   -> return . castV . unObjectId $ objId o
-        _           -> return val
+    return $ case val of
+        VObject o   -> castV . unObjectId $ objId o
+        _           -> val
 op1 "chop" = \x -> do
     str <- fromVal x
-    if null str
-        then return $ VStr str
-        else return $ VStr $ init str
+    return $ if null str
+        then VStr str
+        else VStr $ init str
 op1 "Scalar::chomp" = \x -> do
     str <- fromVal x
     return $ op1Chomp str
 op1 "Str::split" = op1Cast (castV . words)
-op1 "lc" = op1Cast (VStr . map toLower)
-op1 "lcfirst" = op1StrFirst toLower
-op1 "uc" = op1Cast (VStr . map toUpper)
-op1 "ucfirst" = op1StrFirst toUpper
+op1 "lc"         = op1Cast (VStr . map toLower)
+op1 "lcfirst"    = op1StrFirst toLower
+op1 "uc"         = op1Cast (VStr . map toUpper)
+op1 "ucfirst"    = op1StrFirst toUpper
 op1 "capitalize" = op1Cast $ VStr . (mapEachWord capitalizeWord)
   where
@@ -277 +277 @@
     str <- fromVal v
     opEval quiet "<eval>" (encodeUTF8 str)
-    where quiet = MkEvalStyle{evalResult=EvalResultLastValue
-                             ,evalError=EvalErrorUndef}
+    where quiet = MkEvalStyle { evalResult = EvalResultLastValue
+                              , evalError  = EvalErrorUndef }
 op1 "evalfile" = \v -> do
     filename <- fromVal v
@@ -345 +345 @@
     x <- fromVal v
     guardSTM . unsafeIOToSTM $ do
-       seed <- if ( defined v )
+       seed <- if defined v
           then return x
           else randomRIO (0, 2^(31::Int))
@@ -581 +581 @@
     _           -> op1 "readline" v
 op1 "readline" = op1Readline
-
 op1 "getc"     = op1Getc
-
-op1 "WHAT"   = fmap VType . evalValType
+op1 "WHAT"     = fmap VType . evalValType
 op1 "List::end"   = \x -> fmap (castV . pred) (join $ doArray x array_fetchSize) -- monadic join
 op1 "List::elems" = \x -> fmap castV (join $ doArray x array_fetchSize) -- monadic join
@@ -778 +776 @@
 op1Exit v = do
     rv <- fromVal v
-    if rv /= 0
-        then retControl . ControlExit . ExitFailure $ rv
-        else retControl . ControlExit $ ExitSuccess
+    retControl . ControlExit $ if rv /= 0
+        then ExitFailure rv else ExitSuccess
 
 op1StrFirst :: (Char -> Char) -> Val -> Eval Val
@@ -973 +970 @@
 op2 "~~" = op2Match
 op2 "=:=" = \x y -> do
-    case x of
-        VRef xr | VRef yr <- y -> do
+    return $ castV $ case x of
+        VRef xr | VRef yr <- y ->
             -- Take advantage of the pointer address built-in with (Show VRef)
-            return $ castV (show xr == show yr)
-        _   -> do
-            return $ castV (W# (unsafeCoerce# x :: Word#) == W# (unsafeCoerce# y :: Word#))
+            show xr == show yr
+        _   ->
+            W# (unsafeCoerce# x :: Word#) == W# (unsafeCoerce# y :: Word#)
 op2 "===" = \x y -> do
     return $ castV (x == y)
@@ -1035 +1032 @@
     rv  <- deleteFromRef ref y
     -- S29: delete always returns the full list regardless of context.
-    case rv of
-        VList [x]   -> return x
-        _           -> return rv
+    return $ case rv of
+        VList [x]   -> x
+        _           -> rv
 op2 "exists" = \x y -> do
     ref <- fromVal x
@@ -1062 +1059 @@
         hSetBuffering h NoBuffering
         return h
-    return $ VHandle $ hdl
+    return $ VHandle hdl
     where
     modeOf "r"  = ReadMode
@@ -1697 +1694 @@
     rv      <- prettyVal v
     isRecur <- liftSTM (readTVar recur)
-    if isRecur
-        then return (VStr $ decodeUTF8 ("$_ := " ++ rv))
-        else return (VStr $ decodeUTF8 rv)
+    return $ VStr $ decodeUTF8 $ if isRecur then "$_ := " ++ rv else rv
 
 prettyVal :: (?seen :: IntSet.IntSet, ?recur :: TVar Bool, ?printer :: PrettyPrinter) => Val -> Eval VStr