--[[ Scheme Values Module
     KILT -- Kamin Interpreters in Lua Toolset
     H. Conrad Cunningham, Professor
     Computer and Information Science
     University of Mississippi

Developed for CSci 658, Software Language Engineering, Fall 2013

2013-08-19: Built Scheme module from Scheme interpreter code
2013-08-22: Moved treeConcat and printTree to new Utilities module
            Added require of Utilities module
            Corrected forward references to sxpToString, flattenList
2013-08-24: Added functions cons, decons, car, and cdr
            Modified conslist to use cons
2013-08-29: Changed to require Opcode Factory module

1234567890123456789012345678901234567890123456789012345678901234567890

--]]

-- KILT Interpreter Opcode Global Constants
local opcodes = require "opcodes"

-- KILT tree utilities library
local util = require "utilities"
local treeConcat = util.treeConcat


-- Function "hasOpCode" determines whether the first item in
-- array-style table "t" equals "op".  In particular, "op" is
-- expected to be one of the semantic opcodes.

local function hasOpCode(t,op)
  return (type(t) == "table" and t[1] == op)
end

-- BEGIN add for Lisp

-- ACCESS ATTRIBUTES OF S-EXPRESSIONS

-- Function "getNum" takes a semantic form "t". If "t" is a number,
-- it returns the enclosed number.

local function getNum(t)
  if hasOpCode(t,NUMSXP) and #t > 1 then
    return t[2]
  else
    return nil
  end
end

-- Function "getSym" takes a semantic form "t". If "t" is a symbol, it
-- returns the enclosed symbol (string).

local function getSym(t)
  if hasOpCode(t,SYMSXP) and #t > 1 then
    return t[2]
  else
    return nil
  end
end

-- BEGIN add for Scheme

-- Function "getPrim" takes a semantic form "t". If "t" is a builtin
-- primitive operator, it returns the enclosed operator.

local function getPrim(t)
  if hasOpCode(t,PRIMSXP) and #t > 1 then
    return t[2]
  else
    return nil
  end
end

-- END add for Scheme


-- CONS LIST FUNCTIONS AND CONSTANTS

-- Nil list "singleton" constant
local NILLIST = {NILSXP}

-- Function "cons" takes a head element "h" and a tail list "t" 
-- and returns a cons cell for the list with car "h" and cdr "t".

local function cons(h,t)
  if hasOpCode(t,LISTSXP) or t == NILLIST then
    return {LISTSXP; car = h, cdr = t}
  else
    error("Second operand of cons must be a list.")
  end
end
 
-- Function "decons" takes a cons list "l" and decomposes the cons
-- cell into its "op" component, where "op" is either "car" or 
-- "cdr".

local function decons(op,l)
  if hasOpCode(l,LISTSXP) then
    return l[op]
  else
    error(op .. " can only be applied to nonempty lists.")
  end
end

-- Functions "car" and "cdr" return the respective attributes of the
-- argument "l".

local function car(l) return decons("car",l) end
local function cdr(l) return decons("cdr",l) end

-- Function "consList" constructs a "cons" linked list from
-- array-style table "t" and returns it.

local function consList(t)
  if type(t) == "table" then
    local list = NILLIST
    for i = #t, 1, -1 do
      list = cons(t[i],list)
    end
    return list
  else
    error("Argument to consList is not a table: " .. tostring(t))
  end
end

-- END add for Lisp


-- HANDLE FALSE AND TRUE VALUES IN INTERPRETED LANGUAGE

-- The representation of the concepts false and true differs from one
-- of the Kamin interpreted languages to another and from the values
-- used by Lua.  The following constants and functions enable the Lua
-- program to manipulate the interpreted language "booleans".

-- BEGIN change for Lisp
-- local FALSEVAL = 0
-- local TRUEVAL  = 1
local FALSEVAL = NILLIST  -- make point to Nil list singleton object
local TRUEVAL  = {SYMSXP, "T"}
-- END change for Lisp

local function isFalse(v)
  return v == FALSEVAL
end

local function isTrue(v)
  return v ~= FALSEVAL
end

-- Function "boolAsVal" takes a Lua boolean (false or true) and
-- returns the corresponding value used in the interpreted language
-- (FALSEVAL or TRUEVAL).

local function boolAsVal(b) 
  if b then return TRUEVAL else return FALSEVAL end 
end


-- CONVERT LANGUAGE VALUES TO STRINGS

-- BEGIN add for Lisp
-- Local variables for function forward references
local sxpToString
local flattenList
-- END add for Lisp

-- Function "valToString converts value "v" to a string and 
-- returns it.

local function valToString(v)
  local tv = type(v)
  if tv == "string" then
    return v
  elseif tv == "number" then
    return tostring(v)
-- BEGIN add for Lisp
  elseif tv == "table" then
    return sxpToString(v)
-- END add for Lisp
  else
    return "Bad value:  " .. treeConcat(v)
  end
end

-- BEGIN add for Lisp

-- Function "sxpToString" converts an S-expression "v" to a string and
-- returns it.

sxpToString = function(v)
  if hasOpCode(v,NUMSXP) then
    return tostring(getNum(v))
  elseif hasOpCode(v,SYMSXP) then
    return getSym(v)
  elseif hasOpCode(v,NILSXP) then
    return "nil"
  elseif hasOpCode(v,LISTSXP) then
    local list = flattenList(v)
    return treeConcat(list)
-- BEGIN add for Scheme
  elseif hasOpCode(v,PRIMSXP) then
    return getPrim(v)
  elseif hasOpCode(v,CLOSXP) then
    return "<< closure >>"
-- END add for Scheme  else
  else
    return "Bad S-expression value:  " .. treeConcat(v)
  end
end

-- Function "flattenList" converts a "cons" linked list "list" into an
-- array-style table and returns it.

flattenList = function(list)
  if hasOpCode(list,LISTSXP) or list == NILLIST then
    local res = {}
    while list and list ~= NILLIST do
      res[#res+1] = valToString(list.car)
      list = list.cdr
    end
    return res
  else
    error("Argument to flattenList is not a list.")
  end
end

-- END add for Lisp


-- MODULE EXPORT LIST

return {
  FALSEVAL    = FALSEVAL,
  TRUEVAL     = TRUEVAL,
  isFalse     = isFalse,
  isTrue      = isTrue,
  boolAsVal   = boolAsVal,
  hasOpCode   = hasOpCode,
  valToString = valToString,
-- BEGIN add for Lisp
  sxpToString = sxpTotring,
  flattenList = flattenList,
  NILLIST     = NILLIST,
  cons        = cons,
  car         = car,
  cdr         = cdr,
  consList    = consList,
  getNum      = getNum,
  getSym      = getSym,
-- END add for Lisp
-- BEGIN add for Scheme
  getPrim     = getPrim
-- END add for Scheme
}