Changeset 13861 for src/Pugs/Eval

Timestamp:

10/04/06 15:43:36 (2 years ago)

Author:

audreyt

Message:

* Pugs.Eval.Var: Refactor the arityMatch algorithm to use a

custom data type to improve conciseness.

Files:

• src/Pugs/Eval/Var.hs (modified) (6 diffs)

src/Pugs/Eval/Var.hs

@@ -1 @@
-{-# OPTIONS_GHC -fglasgow-exts -cpp -fallow-overlapping-instances #-}
+{-# OPTIONS_GHC -fglasgow-exts -cpp -fallow-overlapping-instances -funbox-strict-fields #-}
 
 module Pugs.Eval.Var (
@@ -18 +18 @@
 import Pugs.Monads
 import qualified Pugs.Val as Val
-import qualified Data.ByteString.Char8 as Str
+import qualified Data.ByteString.Char8 as Buf
 
 findVar :: Var -> Eval (Maybe VRef)
@@ -191 +191 @@
         case subs' of
             -- Recursion prevention -- SUPER::foo should not go back to ThisClas::foo
-            Right sub | cast (Str.cons '&' $ subName sub) == var{ v_package = pkg } -> do
+            Right sub | cast (Buf.cons '&' $ subName sub) == var{ v_package = pkg } -> do
                 return (Left . NoSuchMethod $ cast pkg)
             _   -> do
@@ -654 +654 @@
                     return (var, val)
             Nothing -> mzero
-        
+
+
+data ArityMatchData = MkArityMatchData
+    { d_reqLen      :: !Int
+    , d_optLen      :: !Int
+    , d_slurpLen    :: !Int
+    , d_hasArray    :: !Bool
+    , d_hasHash     :: !Bool
+    }
+
 arityMatch :: VCode -> Int -> Int -> [Int] -> Maybe VCode
 arityMatch sub@MkCode{ subAssoc = assoc, subParams = prms } posLen namLen argSlurpLens
@@ -660 +669 @@
     | A_chain   <- assoc = Just sub
 
-{-
-    | isNothing $ find (not . isSlurpy) prms -- XXX - what about empty ones?
-    , slurpLen  <- length $ filter (\p -> isSlurpy p && v_sigil (paramName p) == SScalar) prms
-    , hasArray  <- isJust $ find (\p -> isSlurpy p && v_sigil (paramName p) == SArray) prms
+    | argLen >= reqLen
+    , hasArray || ((if hasHash then posLen else argLen) <= (reqLen + optLen + slurpLen))
     , if hasArray then slurpLen <= argSlurpLen else slurpLen == argSlurpLen
-    = Just sub
--}
-
-    | reqLen    <- length $ filter (\p -> not (isOptional p || isSlurpy p)) prms
-    , optLen    <- length $ filter (\p -> isOptional p) prms
-    , hasArray  <- isJust $ find (\p -> isSlurpy p && v_sigil (paramName p) == SArray) prms
-    , hasHash   <- isJust $ find (\p -> isSlurpy p && v_sigil (paramName p) == SHash) prms
-    , slurpLen  <- length $ filter (\p -> isSlurpy p && v_sigil (paramName p) == SScalar) prms
-    , argLen >= reqLen && (hasArray || (if hasHash then posLen else argLen) <= (reqLen + optLen))
-    , if hasArray then slurpLen <= sum (drop reqLen argSlurpLens) else slurpLen == sum (drop argLen argSlurpLens)
     = Just sub
 
@@ -680 +677 @@
     = Nothing
     where
-    argLen = posLen + namLen
+    argLen      = posLen + namLen
+    argSlurpLen = sum (drop (reqLen + optLen) argSlurpLens)
+    ~(MkArityMatchData reqLen optLen slurpLen hasArray hasHash) = foldl unwindPrm initArityMatchData prms
+
+initArityMatchData :: ArityMatchData
+initArityMatchData = MkArityMatchData 0 0 0 False False
+
+unwindPrm :: ArityMatchData -> Param -> ArityMatchData
+unwindPrm dat p
+    | isSlurpy p = case v_sigil (paramName p) of
+        SArray  -> dat{ d_hasArray = True }
+        SHash   -> dat{ d_hasHash  = True }
+        _       -> dat{ d_slurpLen = succ (d_slurpLen dat) }
+    | isOptional p  = dat{ d_optLen = succ (d_optLen dat) }
+    | otherwise     = dat{ d_reqLen = succ (d_reqLen dat) }
 
 toPackage :: Pkg -> Var -> Var