Source code in the r programming language

empty <- function() length(l) == 0
push <- function(x) 
{
   l <<- c(l, list(x))
   print(l)
   invisible()
}
pop <- function() 
{
   if(empty()) stop("can't pop from an empty list")
   l[[1]] <<- NULL
   print(l)
   invisible()
}
l <- list() 
empty()
# [1] TRUE
push(3)
# [[1]]
# [1] 3
push("abc")
# [[1]]
# [1] 3
# [[2]]
# [1] "abc"
push(matrix(1:6, nrow=2))
# [[1]]
# [1] 3
# [[2]]
# [1] "abc"
# [[3]]
#      [,1] [,2] [,3]
# [1,]    1    3    5
# [2,]    2    4    6
empty()
# [1] FALSE
pop()
# [[1]]
# [1] 3
# [[2]]
# [1] "abc"
pop()
# [[1]]
# [1] 3
pop()
# list()
pop()
# Error in pop() : can't pop from an empty list


# The usual Scheme way : build a function that takes commands as parameters (it's like message passing oriented programming)
queue <- function() {
    v <- list()
    f <- function(cmd, val=NULL) {
        if(cmd == "push") {
            v <<- c(v, val)
            invisible()
        } else if(cmd == "pop") {
            if(length(v) == 0) {
                stop("empty queue")
            } else {
                x <- v[[1]]
                v[[1]] <<- NULL
                x
            }
        } else if(cmd == "length") {
            length(v)
        } else if(cmd == "empty") {
            length(v) == 0
        } else {
            stop("unknown command")
        }
    }
    f
}

# Create two queues
a <- queue()
b <- queue()
a("push", 1)
a("push", 2)
b("push", 3)
a("push", 4)
b("push", 5)

a("pop")
# [1] 1
b("pop")
# [1] 3


library(proto)

fifo <- proto(expr = {
   l <- list()
   empty <- function(.) length(.$l) == 0
   push <- function(., x) 
   {
      .$l <- c(.$l, list(x))
      print(.$l)
      invisible()
   }
   pop <- function(.) 
   {
      if(.$empty()) stop("can't pop from an empty list")
      .$l[[1]] <- NULL
      print(.$l)
      invisible()
   }
})

#The following code provides output that is the same as the previous example.
fifo$empty()
fifo$push(3)
fifo$push("abc")
fifo$push(matrix(1:6, nrow=2))
fifo$empty()
fifo$pop()
fifo$pop()
fifo$pop()
fifo$pop()