changes

• src/The.hs :: line 11

  import The.Debug
  

• src/The/Environment.hs :: line 327

  protoFor x = error $ "no protoFor for " ++ show x
  

• src/The/Environment.hs :: line 535

      dump ("dispatching", m, Prototype iid ds ms)
  

      {-dump ("dispatching", m, Prototype iid ds ms)-}
  

• src/The/Kernel.hs :: line 17

      "this" =: exec "dispatch sender"
  

      "this" =: eval (Dispatch (ESingle "sender" ECall))
  

• src/The/Kernel.hs :: line 69

      "(x: Object) as: String" =: exec "x show"
  

      "(x: Object) as: String" =:
          here "x" >>= dispatch . Single "show"
  

• src/The/Kernel.hs :: line 90

      "v do: (b: Block)" =: exec "v do: b with: []"
      "v do: (b: Block) with: (l: List)" =: exec "{ v join: b with: l; v } call"
  

      "v do: (b: Block)" =: do
          v <- here "v"
          vv <- val "v"
          b <- here "b"
          joinWith v vv b []
          return v
      "v do: (b: Block) with: (l: List)" =: do
          v <- here "v"
          vv <- val "v"
          b <- here "b"
          as <- fmap V.toList $ getList "l"
          joinWith v vv b []
          return v
  

• src/The/Kernel.hs :: line 104

      "v join: (b: Block)" =: exec "v join: b with: []"
  

      "v join: (b: Block)" =: do
          v <- here "v"
          vv <- val "v"
          b <- here "b"
          joinWith v vv b []
  

• src/The/Kernel.hs :: line 111

          Prototype iid ds ms <- val "v"
          Block s ps es <- here "b" >>= findValue isBlock
          vs <- fmap V.toList $ getList "l"
  

          vv <- val "v"
          b <- here "b" >>= findValue isBlock
          as <- fmap V.toList $ getList "l"
          joinWith v vv b as
  

• src/The/Kernel.hs :: line 116

          if length ps > length vs
              then throwError . ErrorMsg . unwords $
                  [ "block expects"
                  , show (length ps)
                  , "arguments, given"
                  , show (length vs)
                  ]
              else do
                  let bs = insertSMethod (Method (PSingle "this" PSelf) s (Primitive v)) $
                              M.unions $ zipWith (bindings s) ps vs
                      merge (os, ok) (ns, nk) =
                          ( foldl (flip insertSMethod) os (concat $ M.elems ns)
                          , foldl (flip insertKWMethod) ok (concat $ M.elems nk)
                          )
  
                  -- the original prototype, but without its delegations
                  -- this is to prevent dispatch loops
                  doppelganger <- newProto $ \p -> p
                      { vpMethods = ms
                      }
  
                  -- a toplevel scope with transient definitions
                  pseudoScope <- newProto $ \p -> p
                      { vpMethods = (bs, M.empty)
                      }
  
                  -- the main scope, methods are taken from here and merged with
                  -- the originals. delegates to the pseudoscope and doppelganger
                  -- so it has their methods in scope, but definitions go here
                  blockScope <- newProto $ \p -> p
                      { vpDelegates = (pseudoScope:doppelganger:s:ds)
                      , vpMethods = (M.empty, M.empty)
                      }
  
                  res <- withTop blockScope (evalAll es)
                  new <- liftIO (readIORef blockScope)
                  liftIO (writeIORef iid new
                      { vpID = iid
                      , vpDelegates = drop 3 (vpDelegates new)
                      , vpMethods = merge ms (vpMethods new)
                      })
  
                  return res
  

• src/The/Kernel.hs :: line 126

    where
      joinWith v (Prototype iid ds ms) (Block s ps es) as
          | length ps > length as = throwError . ErrorMsg . unwords $
              [ "block expects"
              , show (length ps)
              , "arguments, given"
              , show (length as)
              ]
          | null as = do
              blockScope <- newProto $ \p -> p
                  { vpDelegates = s:ds
                  , vpMethods = ms
                  }
  
              res <- withTop blockScope (evalAll es)
              new <- liftIO (readIORef blockScope)
              liftIO $ writeIORef iid new
                  { vpID = iid
                  , vpDelegates = tail (vpDelegates new)
                  , vpMethods = vpMethods new
                  }
  
              return res
          | otherwise = do
              -- the original prototype, but without its delegations
              -- this is to prevent dispatch loops
              doppelganger <- newProto $ \p -> p
                  { vpMethods = ms
                  }
  
              -- a toplevel scope with transient definitions
              pseudoScope <- newProto $ \p -> p
                  { vpMethods = (bs, M.empty)
                  }
  
              -- the main scope, methods are taken from here and merged with
              -- the originals. delegates to the pseudoscope and doppelganger
              -- so it has their methods in scope, but definitions go here
              blockScope <- newProto $ \p -> p
                  { vpDelegates = (pseudoScope:doppelganger:s:ds)
                  , vpMethods = (M.empty, M.empty)
                  }
  
              res <- withTop blockScope (evalAll es)
              new <- liftIO (readIORef blockScope)
              liftIO (writeIORef iid new
                  { vpID = iid
                  , vpDelegates = drop 3 (vpDelegates new)
                  , vpMethods = merge ms (vpMethods new)
                  })
  
              return res
        where
          bs = insertSMethod (Method (PSingle "this" PSelf) s (Primitive v)) $
                  M.unions $ zipWith (bindings s) ps as
  
          merge (os, ok) (ns, nk) =
              ( foldl (flip insertSMethod) os (concat $ M.elems ns)
              , foldl (flip insertKWMethod) ok (concat $ M.elems nk)
              )
  

• src/The/Kernel.hs :: line 819

              then exec "x up-to: y"
              else exec "x down-to: y"
  

              then dispatch (Keyword ["up-to"] [Integer x, Integer y])
              else dispatch (Keyword ["down-to"] [Integer x, Integer y])
  

• src/The/Kernel.hs :: line 827

              then exec "x up-to: (y - 1)"
              else exec "x down-to: (y + 1)"
  

              then dispatch (Keyword ["up-to"] [Integer x, Integer (y - 1)])
              else dispatch (Keyword ["down-to"] [Integer x, Integer (y + 1)])