Changeset 3906

Timestamp:

05/26/05 12:37:22 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

5482

Message:

* starting single-invocant feature branch.

(maybe laso do multi-level MMD param here?)

Location:

src

Files:

• Main.hs (modified) (1 diff)
• Pugs/AST.hs (modified) (2 diffs)
• Pugs/AST/Internals.hs (modified) (2 diffs)
• Pugs/Bind.hs (modified) (5 diffs)
• Pugs/Compile/Haskell.hs (modified) (1 diff)
• Pugs/Compile/Parrot.hs (modified) (7 diffs)
• Pugs/Eval.hs (modified) (26 diffs)
• Pugs/Lexer.hs (modified) (1 diff)
• Pugs/Parser.hs (modified) (20 diffs)
• Pugs/Parser/Program.hs (modified) (1 diff)
• Pugs/Pretty.hs (modified) (1 diff)
• Pugs/Prim.hs (modified) (6 diffs)
• Pugs/Prim/List.hs (modified) (5 diffs)

src/Main.hs

@@ -203 +203 @@
     return ()
     where
-    exp = App (Var "&require") [] [Val $ VStr fn]
+    exp = App (Var "&require") Nothing [Val $ VStr fn]
 
 doRunSingle :: TVar Env -> RunOptions -> String -> IO ()

src/Pugs/AST.hs

@@ -125 +125 @@
 mergeStmts (Pad scope lex x) y = Pad scope lex (mergeStmts x y)
 mergeStmts x@(Pos pos (Syn syn _)) y | (syn ==) `any` words "subst match //"  =
-    mergeStmts (Pos pos (App (Var "&infix:~~") [Var "$_", x] [])) y
+    mergeStmts (Pos pos (App (Var "&infix:~~") Nothing [Var "$_", x])) y
 mergeStmts x y@(Pos pos (Syn syn _)) | (syn ==) `any` words "subst match //"  =
-    mergeStmts x (Pos pos (App (Var "&infix:~~") [Var "$_", y] []))
+    mergeStmts x (Pos pos (App (Var "&infix:~~") Nothing [Var "$_", y]))
 mergeStmts (Pos pos (Syn "sub" [Val (VCode sub)])) y
     | subType sub >= SubBlock, isEmptyParams (subParams sub) =
     -- bare Block in statement level; annul all its parameters and run it!
-    mergeStmts (Pos pos $ App (Val $ VCode sub{ subParams = [] }) [] []) y
+    mergeStmts (Pos pos $ App (Val $ VCode sub{ subParams = [] }) Nothing []) y
 mergeStmts x (Pos pos (Syn "sub" [Val (VCode sub)]))
     | subType sub >= SubBlock, isEmptyParams (subParams sub) =
     -- bare Block in statement level; annul all its parameters and run it!
-    mergeStmts x (Pos pos $ App (Val $ VCode sub{ subParams = [] }) [] [])
+    mergeStmts x (Pos pos $ App (Val $ VCode sub{ subParams = [] }) Nothing [])
 mergeStmts x (Stmts y Noop) = mergeStmts x y
 mergeStmts x (Stmts Noop y) = mergeStmts x y
@@ -149 +149 @@
     [ Var (':':'*':name)
     , App (Var "&new")
-        [ Val (VType $ mkType "Class") ]
-        [ App (Var "&infix:=>")
+        (Just $ Val (VType $ mkType "Class"))
+        [ App (Var "&infix:=>") Nothing
             [ Val (VStr "traits")
             , Val (VList $ map VStr traits)
-            ] []
-        , App (Var "&infix:=>")
+            ]
+        , App (Var "&infix:=>") Nothing
             [ Val (VStr "name")
             , Val (VStr name)
-            ] []
+            ]
         ]
     ]

src/Pugs/AST/Internals.hs

@@ -775 +775 @@
 data Exp
     = Noop                              -- ^ No-op
-    | App !Exp ![Exp] ![Exp]            -- ^ Function application
+    | App !Exp !(Maybe Exp) ![Exp]      -- ^ Function application
                                         --     e.g. myfun($invocant: $arg)
     | Syn !String ![Exp]                -- ^ Syntactic construct that cannot
@@ -834 +834 @@
     where
     (n', vs')      = extract n vs
-    (invs', vs'')  = foldr extractExp ([], vs') invs
+    (invs', vs'')  = maybe (invs, vs') (\inv -> let (x, y) = extract inv vs' in (Just x, y)) invs
     (args', vs''') = foldr extractExp ([], vs'') args
 extract (Stmts exp1 exp2) vs = (Stmts exp1' exp2', vs'')

src/Pugs/Bind.hs

@@ -150 +150 @@
 isPair (Cxt _ exp) = isPair exp
 isPair (Syn "=>" [(Val _), _])   = True
-isPair (App (Var "&infix:=>") [(Cxt _ (Val _)), _] [])   = True
-isPair (App (Var "&infix:=>") [(Val _), _] [])   = True
+isPair (App (Var "&infix:=>") Nothing [(Cxt _ (Val _)), _])   = True
+isPair (App (Var "&infix:=>") Nothing [(Val _), _])   = True
 isPair _                         = False
 
@@ -162 +162 @@
 unPair (Cxt _ exp) = unPair exp
 unPair (Syn "=>" [(Val k), exp]) = (vCast k, exp)
-unPair (App (Var "&infix:=>") [(Cxt _ (Val k)), exp] []) = (vCast k, exp)
-unPair (App (Var "&infix:=>") [(Val k), exp] []) = (vCast k, exp)
+unPair (App (Var "&infix:=>") Nothing [(Cxt _ (Val k)), exp]) = (vCast k, exp)
+unPair (App (Var "&infix:=>") Nothing [(Val k), exp]) = (vCast k, exp)
 unPair x                                = error ("Not a pair: " ++ show x)
 
@@ -181 +181 @@
 -}
 bindParams :: VCode -- ^ A code object to perform bindings on
-           -> [Exp] -- ^ List of invocants to bind
+           -> (Maybe Exp) -- ^ List of invocants to bind
            -> [Exp] -- ^ List of arguments (actual params) to bind
            -> MaybeError VCode -- ^ Returns either a new 'VCode' with all the
@@ -232 +232 @@
 -}
 bindSomeParams :: VCode -- ^ Code object to perform bindings on
-               -> [Exp] -- ^ List of invocant expressions
+               -> (Maybe Exp) -- ^ List of invocant expressions
                -> [Exp] -- ^ List of argument expressions
                -> MaybeError VCode -- ^ A new 'VCode' structure, augmented
@@ -242 +242 @@
         (invPrms, argPrms) = span isInvocant params
         (givenInvs, givenArgs) = if null invPrms
-            then ([], (invsExp++argsExp))
-            else (invsExp, argsExp)
+            then ([], (maybeToList invsExp++argsExp))
+            else (maybeToList invsExp, argsExp)
 
     let boundInv                = invPrms `zip` givenInvs -- invocants are just bound, params to given

src/Pugs/Compile/Haskell.hs

@@ -50 +50 @@
     argC = compile stmt
     argRest = compile rest
-compile (App (Var op) [] []) = [| op0 op [] |]
-compile (App (Var op) [] args) = compile (App (Var op) args [])
-compile (App (Var ('&':op)) [arg] []) = [| do
+compile (App (Var op) Nothing []) = [| op0 op [] |]
+compile (App (Var ('&':op)) Nothing [arg]) = [| do
         val <- $(argC)
         op1 op val
     |] where
     argC = compile arg
-compile (App (Var ('&':op)) [arg1, arg2] []) = [| do
+compile (App (Var ('&':op)) Nothing [arg1, arg2]) = [| do
         val1 <- $(argC1)
         val2 <- $(argC2)

src/Pugs/Compile/Parrot.hs

@@ -202 +202 @@
     -- XXX "module" is handled in glob, need stub here to avoid compile error
     compile (Syn "module" [Val (VStr _)]) = return empty
-    compile (App (Var "&return") [val] []) = do
+    compile (App (Var "&return") Nothing [val]) = do
         (valC, p) <- compileArg val
         return $ valC $+$ text ".return" <+> parens p
     compile (App (Var "&last") _ _) = return $ text "invoke last"
-    compile (App (Var "&substr") [str, idx, len] [])
+    compile (App (Var "&substr") Nothing [str, idx, len])
         | Val v <- unwrap len, vCast v == (1 :: VNum) = do
         (strC, p1) <- enterLValue $ compileArg str
@@ -212 +212 @@
         rv         <- constPMC $ hcat [ p1, text "[" , p2, text "]"]
         return $ vcat [strC, idxC, rv]
-    compile (App (Var "&postfix:++") [inv] []) = do
+    compile (App (Var "&postfix:++") Nothing [inv]) = do
         (invC, p) <- enterLValue $ compileArg inv
         return $ invC $+$ text "inc" <+> p
-    compile (App (Var "&postfix:--") [inv] []) = do
+    compile (App (Var "&postfix:--") Nothing [inv]) = do
         (invC, p) <- enterLValue $ compileArg inv
         return $ invC $+$ text "dec" <+> p
     -- compile (App "&infix:~" [exp, Val (VStr "")] []) = compile exp
-    compile (App (Var "&infix:~") [exp1, exp2] []) = do
+    compile (App (Var "&infix:~") Nothing [exp1, exp2]) = do
         tmp <- currentStash
         (arg1, p1) <- compileArg exp1
@@ -229 +229 @@
             , text "concat" <+> tmp <> comma <+> p1 <> comma <+> p2
             ]
-    compile (App (Var ('&':'i':'n':'f':'i':'x':':':op)) [lhs, rhs] []) = do
+    compile (App (Var ('&':'i':'n':'f':'i':'x':':':op)) Nothing [lhs, rhs]) = do
         (lhsC, p1) <- compileArg lhs
         (rhsC, p2) <- compileArg rhs
@@ -244 +244 @@
         return $ vcat [ lhsC, rhsC, rv ]
     -- XXX store return code in $@, whereever that may be in Parrotland
-    compile (App (Var "&system") [cmd] []) = do
+    compile (App (Var "&system") Nothing [cmd]) = do
         (arg, p) <- compileArg cmd
         rc <- constPMC (text "$I10")
@@ -255 +255 @@
             , rc
             ]
-    compile (App (Var "&require_parrot") [arg] []) = do
+    compile (App (Var "&require_parrot") Nothing [arg]) = do
         (path, p) <- compileArg arg
         return $ vcat $
@@ -265 +265 @@
         compile $ App (Var "&print") invs (args ++ [Val $ VStr "\n"])
     compile (App (Var "&print") invs args) = do
-        actions <- fmap vcat $ mapM (compileWith (text "print" <+>)) (invs ++ args)
+        actions <- fmap vcat $ mapM (compileWith (text "print" <+>)) (maybeToList invs ++ args)
         rv      <- compile (Val (VBool True))
         return $ actions $+$ rv
-    compile (App (Var ('&':method)) [(Var ('$':obj))] [arg]) = do
+    compile (App (Var ('&':method)) (Just (Var ('$':obj))) [arg]) = do
         lhsC <- askPMC
         compileWith (\tmp -> text lhsC <+> text "=" <+> varText ("$" ++ obj) <> text "." <> text ("'" ++ method ++ "'") <> parens tmp) arg
-    compile (App (Var ('&':name)) [arg] _) = do
+    compile (App (Var ('&':name)) Nothing [arg]) = do
         lhsC <- askPMC
         compileWith (\tmp -> text lhsC <+> text "=" <+> text name <> parens tmp) arg
-    compile (App (Var "&not") [] []) = return $ text "new PerlUndef"
-    compile (App (Var ('&':name)) [] []) = do
+    compile (App (Var "&not") Nothing []) = return $ text "new PerlUndef"
+    compile (App (Var ('&':name)) Nothing []) = do
         lhsC <- askPMC
         return $ text lhsC <+> text "=" <+> text name <> text "()"
@@ -315 +315 @@
     compile (Syn "," things) = fmap vcat $ mapM compile things
     compile (Syn syn [lhs, exp]) | last syn == '=' =
-        compile $ Syn "=" [lhs, App (Var ("&infix:" ++ init syn)) [lhs, exp] []]
+        compile $ Syn "=" [lhs, App (Var ("&infix:" ++ init syn)) Nothing [lhs, exp]]
     compile (Cxt _ exp) = compile exp
     compile (Pos pos exp) = do

src/Pugs/Eval.hs

@@ -109 +109 @@
     initSubs <- fromVals initAV
     enterContext CxtVoid $ do
-        mapM_ evalExp [ App (Val sub) [] [] | sub <- initSubs ]
+        mapM_ evalExp [ App (Val sub) Nothing [] | sub <- initSubs ]
     -- The main runtime
     val      <- resetT $ evaluate exp
@@ -116 +116 @@
     endSubs  <- fromVals endAV
     enterContext CxtVoid $ do
-        mapM_ evalExp [ App (Val sub) [] [] | sub <- endSubs ]
+        mapM_ evalExp [ App (Val sub) Nothing [] | sub <- endSubs ]
     return val
 
@@ -190 +190 @@
     case rv of
         Nothing  -> case name of
-            ('&':_) -> maybeM (findSub name [] []) $ \sub -> do
+            ('&':_) -> maybeM (findSub name Nothing []) $ \sub -> do
                 return $ codeRef sub
             _ -> return Nothing
@@ -404 +404 @@
                 genSymCC "&next" $ \symNext -> do
                     genSymPrim "&redo" (const $ runBody vs sub') $ \symRedo -> do
-                        apply (updateSubPad sub' (symRedo . symNext)) [] $
+                        apply (updateSubPad sub' (symRedo . symNext)) Nothing $
                             map (Val . VRef . MkRef) these
                 runBody rest sub'
@@ -417 +417 @@
         av      <- newArray []
         symTake <- genSym "@?TAKE" (MkRef av)
-        apply (updateSubPad sub symTake) [] []
+        apply (updateSubPad sub symTake) Nothing []
         fmap VList $ readIVar av
     "loop" -> do
@@ -444 +444 @@
         break  <- evalVar "&?BLOCK_EXIT"
         vbreak <- fromVal break
-        result <- reduce (App (Var "&infix:~~") [(Var "$_"), match] [])
+        result <- reduce (App (Var "&infix:~~") Nothing [(Var "$_"), match])
         rb     <- fromVal result
         if rb
-            then enterWhen (subBody vbreak) $ apply vbreak [body] []
+            then enterWhen (subBody vbreak) $ apply vbreak Nothing [body]
             else retVal undef
     "default" -> do
@@ -453 +453 @@
         break  <- evalVar "&?BLOCK_EXIT"
         vbreak <- fromVal break
-        enterWhen (subBody vbreak) $ apply vbreak [body] []
+        enterWhen (subBody vbreak) $ apply vbreak Nothing [body]
     "while" -> doWhileUntil id
     "until" -> doWhileUntil not
@@ -534 +534 @@
     -- XXX evil hack for infinite slices
     "[]" | [lhs, App (Var "&postfix:...") invs args] <- unwrap exps
-         , [idx] <- invs ++ args
+         , [idx] <- maybeToList invs ++ args
 --       , not (envLValue env)
          -> reduce (Syn "[...]" [lhs, idx])
     "[]" | [lhs, App (Var "&infix:..") invs args] <- unwrap exps
-         , [idx, Val (VNum n)] <- invs ++ args
+         , [idx, Val (VNum n)] <- maybeToList invs ++ args
          , n == 1/0
 --       , not (envLValue env)
@@ -661 +661 @@
         let [lhs, exp] = exps
             op = "&infix:" ++ init syn
-        evalExp $ Syn "=" [lhs, App (Var op) [lhs, exp] []]
+        evalExp $ Syn "=" [lhs, App (Var op) Nothing [lhs, exp]]
     _ -> retError "Unknown syntactic construct" exp
     where
@@ -690 +690 @@
 -- XXX absolutely evil bloody hack for context hinters
 reduce (App (Var "&hash") invs args) =
-    enterEvalContext cxtItemAny $ Syn "\\{}" [Syn "," $ invs ++ args]
+    enterEvalContext cxtItemAny $ Syn "\\{}" [Syn "," $ maybeToList invs ++ args]
 
 reduce (App (Var "&list") invs args) =
-    enterEvalContext cxtSlurpyAny $ case invs ++ args of
+    enterEvalContext cxtSlurpyAny $ case maybeToList invs ++ args of
         []    -> Val (VList [])
         [exp] -> exp
@@ -699 +699 @@
 
 reduce (App (Var "&scalar") invs args)
-    | [exp] <- invs ++ args = enterEvalContext cxtItemAny exp
-    | otherwise = enterEvalContext cxtItemAny $ Syn "," (invs ++ args)
+    | [exp] <- maybeToList invs ++ args = enterEvalContext cxtItemAny exp
+    | otherwise = enterEvalContext cxtItemAny $ Syn "," (maybeToList invs ++ args)
 
 -- XXX absolutely evil bloody hack for "zip"
 reduce (App (Var "&zip") invs args) = do
-    vals <- mapM (enterRValue . enterEvalContext (cxtItem "Array")) (invs ++ args)
+    vals <- mapM (enterRValue . enterEvalContext (cxtItem "Array")) (maybeToList invs ++ args)
     val  <- op0Zip vals
     retVal val
 
 -- XXX absolutely evil bloody hack for "goto"
-reduce (App (Var "&not") [] []) = retEmpty
+reduce (App (Var "&not") Nothing []) = retEmpty
 
 reduce (App (Var "&not") invs args) = do
-    bool <- fromVal =<< evalExp (last $ invs ++ args)
+    bool <- fromVal =<< evalExp (last $ maybeToList invs ++ args)
     retVal $ VBool (not bool)
 
 -- XXX absolutely evil bloody hack for "goto"
-reduce (App (Var "&goto") (subExp:invs) args) = do
+reduce (App (Var "&goto") invs@(Just subExp) args) = do
     vsub <- enterEvalContext (cxtItem "Code") subExp
     sub <- fromVal vsub
@@ -732 +732 @@
 
 -- XXX absolutely evil bloody hack for "assuming"
-reduce (App (Var "&assuming") (subExp:invs) args) = do
+reduce (App (Var "&assuming") invs@(Just subExp) args) = do
     vsub <- enterEvalContext (cxtItem "Code") subExp
     sub <- fromVal vsub
@@ -739 +739 @@
         Right curriedSub -> retVal $ castV $ curriedSub
 
-reduce (App (Var "&infix:=>") invs args) = reduce (Syn "=>" (invs ++ args))
+reduce (App (Var "&infix:=>") invs args) = reduce (Syn "=>" (maybeToList invs ++ args))
 
 reduce (App (Var name@('&':_)) invs args) = do
@@ -745 +745 @@
     case sub of
         Just sub    -> applySub sub invs args
-        _ | [Syn "," invs'] <- unwrap invs, null args -> do
-            sub <- findSub name invs' []
+        _ | [Syn "," args'] <- unwrap args -> do
+            sub <- findSub name invs args'
             if isNothing sub then err else do
             fail $ "Extra space found after " ++ name ++ " (...) -- did you mean " ++ name ++ "(...) instead?"
@@ -752 +752 @@
     where
     err = retError "No compatible subroutine found" name
-    applySub :: VCode -> [Exp] -> [Exp] -> Eval Val
+    applySub :: VCode -> (Maybe Exp) -> [Exp] -> Eval Val
     applySub sub invs args
         -- list-associativity
         | MkCode{ subAssoc = "list" }      <- sub
-        , (App (Var name') invs' []):rest  <- invs
+        , (App (Var name') Nothing args'):rest  <- args
         , name == name'
-        = applySub sub (invs' ++ rest)  []
+        = applySub sub invs (args' ++ rest)
         -- fix subParams to agree with number of actual arguments
         | MkCode{ subAssoc = "list", subParams = (p:_) }   <- sub
-        , null args
-        = apply sub{ subParams = (length invs) `replicate` p } invs []
+        = apply sub{ subParams = (length args) `replicate` p } invs args
         -- chain-associativity
         | MkCode{ subAssoc = "chain" }  <- sub
-        , (App _ _ []):_                <- invs
-        , null args
-        = mungeChainSub sub invs
+        , (App _ _ []):_                <- args
+        = mungeChainSub sub args
         | MkCode{ subAssoc = "chain", subParams = (p:_) }   <- sub
-        = apply sub{ subParams = (length invs) `replicate` p } invs []
+        = apply sub{ subParams = (length args) `replicate` p } invs args
         -- normal application
         | otherwise
         = apply sub invs args
     mungeChainSub :: VCode -> [Exp] -> Eval Val
-    mungeChainSub sub invs = do
+    mungeChainSub sub args = do
         let MkCode{ subAssoc = "chain", subParams = (p:_) } = sub
-            (App (Var name') invs' args'):rest = invs
+            (App (Var name') invs' args'):rest = args
         theSub   <- findSub name' invs' args'
         case theSub of
-            Just sub'    -> applyChainSub sub invs sub' invs' args' rest
-            Nothing      -> apply sub{ subParams = (length invs) `replicate` p } invs [] -- XXX Wrong
-    applyChainSub :: VCode -> [Exp] -> VCode -> [Exp] -> [a] -> [Exp] -> Eval Val
-    applyChainSub sub invs sub' invs' args' rest
+            Just sub'    -> applyChainSub sub args sub' args' rest
+            Nothing      -> apply sub{ subParams = (length args) `replicate` p } Nothing args -- XXX Wrong
+    applyChainSub :: VCode -> [Exp] -> VCode -> [Exp] -> [Exp] -> Eval Val
+    applyChainSub sub args sub' args' rest
         | MkCode{ subAssoc = "chain", subBody = fun, subParams = prm }   <- sub
         , MkCode{ subAssoc = "chain", subBody = fun', subParams = prm' } <- sub'
-        , null args'
-        = applySub sub{ subParams = prm ++ tail prm', subBody = Prim $ chainFun prm' fun' prm fun } (invs' ++ rest) []
+        = applySub sub{ subParams = prm ++ tail prm', subBody = Prim $ chainFun prm' fun' prm fun } Nothing (args' ++ rest)
         | MkCode{ subAssoc = "chain", subParams = (p:_) }   <- sub
-        = apply sub{ subParams = (length invs) `replicate` p } invs [] -- XXX Wrong
+        = apply sub{ subParams = (length args) `replicate` p } Nothing args -- XXX Wrong
         | otherwise
         = internalError "applyChainsub did not match a chain subroutine"
@@ -834 +831 @@
 cxtOfExp _                      = return cxtSlurpyAny
 
-findSub :: String -> [Exp] -> [Exp] -> Eval (Maybe VCode)
+findSub :: String -> Maybe Exp -> [Exp] -> Eval (Maybe VCode)
 findSub name' invs args = do
     let name = possiblyFixOperatorName name'
     case invs of
-        [exp] | not (':' `elem` drop 2 name) -> do
+        Just exp | not (':' `elem` drop 2 name) -> do
             typ     <- evalExpType exp
             if typ == mkType "Scalar::Perl5" then runPerl5Sub name else do
@@ -860 +857 @@
                 svs     <- fromVals args
                 found   <- liftIO $ canPerl5 sv (tail name) `mplus` canPerl5 sv "AUTOLOAD"
-                if not found then evalExp (App (Var name) [] (map (Val . PerlSV) (sv:svs))) else do
+                if not found then evalExp (App (Var name) Nothing (map (Val . PerlSV) (sv:svs))) else do
                 cxt     <- asks envContext
                 rv      <- liftIO $ callPerl5 (tail name) (sv:svs) (enumCxt cxt)
@@ -871 +868 @@
         -- We use the first two elements of invs as invocants, as these are the
         -- types of the op.
-            rv = findSub ("&infix:" ++ op) (take 2 (invs ++ [Val undef, Val undef])) []
+            rv = findSub ("&infix:" ++ op) Nothing (take 2 (maybeToList invs ++ [Val undef, Val undef]))
         maybeM rv $ \code -> return $ mkPrim
             { subName     = "&prefix:[" ++ op ++ "]"
@@ -888 +885 @@
     possiblyBuildMetaopVCode op' | "&prefix:" `isPrefixOf` op', "<<" `isSuffixOf` op' = do 
         let op = drop 8 (init (init op'))
-            rv = findSub ("&prefix:" ++ op) [head $ invs ++ [Val undef]] []
+            rv = findSub ("&prefix:" ++ op) Nothing [head $ maybeToList invs ++ [Val undef]]
         maybeM rv $ \code -> return $ mkPrim
             { subName     = "&prefix:" ++ op ++ "<<"
@@ -903 +900 @@
     possiblyBuildMetaopVCode op' | "&postfix:>>" `isPrefixOf` op' = do
         let op = drop 11 op'
-            rv = findSub ("&postfix:" ++ op) [head $ invs ++ [Val undef]] []
+            rv = findSub ("&postfix:" ++ op) Nothing [head $ maybeToList invs ++ [Val undef]]
         maybeM rv $ \code -> return $ mkPrim
             { subName     = "&postfix:>>" ++ op
@@ -918 +915 @@
     possiblyBuildMetaopVCode op' | "&infix:>>" `isPrefixOf` op', "<<" `isSuffixOf` op' = do 
         let op = drop 9 (init (init op'))
-            rv = findSub ("&infix:" ++ op) (take 2 (invs ++ [Val undef, Val undef])) []
+            rv = findSub ("&infix:" ++ op) Nothing (take 2 (maybeToList invs ++ [Val undef, Val undef]))
         maybeM rv $ \code -> return $ mkPrim
             { subName     = "&infix:>>" ++ op ++ "<<"
@@ -951 +948 @@
     findSub' name = do
         subSyms     <- findSyms name
-        lens        <- mapM argSlurpLen (unwrap $ invs ++ args)
+        lens        <- mapM argSlurpLen (unwrap $ maybeToList invs ++ args)
         doFindSub (sum lens) subSyms
     argSlurpLen (Val listMVal) = do
@@ -972 +969 @@
         sub@(MkCode{ subType = subT, subReturns = ret, subParams = prms }) <- fromVal val
         let isGlobal = '*' `elem` n
-        let rv = return $ arityMatch sub (length (invs ++ args)) slurpLen
+        let rv = return $ arityMatch sub (length (maybeToList invs ++ args)) slurpLen
         maybeM rv $ \fun -> do
             -- if deltaFromCxt ret == 0 then return Nothing else do
             let pairs = map (typeOfCxt . paramContext) prms
-                            `zip` (map unwrap $ invs ++ args)
+                            `zip` (map unwrap $ maybeToList invs ++ args)
             deltaCxt    <- deltaFromCxt ret
             deltaArgs   <- mapM deltaFromPair pairs
@@ -1000 +997 @@
     sub <- fromVal val
     return $ subReturns sub
-evalExpType (App (Var "&new") [(Val (VType typ))] _) = return typ
-evalExpType (App (Var "&new") [(Var (':':name))] _) = return $ mkType name
+evalExpType (App (Var "&new") (Just (Val (VType typ))) _) = return typ
+evalExpType (App (Var "&new") (Just (Var (':':name))) _) = return $ mkType name
 evalExpType (App (Var name) invs args) = do
     sub <- findSub name invs args
@@ -1051 +1048 @@
 Mostly delegates to 'doApply' after explicitly retrieving the local 'Env'.
 -}
-apply :: VCode -- ^ The sub to apply
-      -> [Exp] -- ^ List of invocants
-      -> [Exp] -- ^ List of arguments (non-invocant)
+apply :: VCode       -- ^ The sub to apply
+      -> (Maybe Exp) -- ^ invocant
+      -> [Exp]       -- ^ List of arguments (non-invocant)
       -> Eval Val
 apply sub invs args = do
@@ -1067 +1064 @@
 doApply :: Env   -- ^ Environment to evaluate in
         -> VCode -- ^ Code to apply
-        -> [Exp] -- ^ Invocants (arguments before the colon)
+        -> (Maybe Exp) -- ^ Invocants (arguments before the colon)
         -> [Exp] -- ^ Arguments (not including invocants)
         -> Eval Val

src/Pugs/Lexer.hs

@@ -144 +144 @@
         = homogenConcat (Val (VStr (x ++ y)) : xs)
     homogenConcat (x:xs)
-        = App (Var "&infix:~") [x, homogenConcat xs] []
+        = App (Var "&infix:~") Nothing [x, homogenConcat xs]
     
     stringList = do

src/Pugs/Parser.hs

@@ -474 +474 @@
     val <- unsafeEvalExp $
         if (map toLower author) == "-perl5"
-            then Stmts (Sym SGlobal (':':'*':pkg) (Syn ":=" [ Var (':':'*':pkg), App (Var "&require_perl5") [Val . VStr $ concat (intersperse "::" names)] [] ])) (Syn "env" [])