--------------------------------------------------------------------------------
-- Initialize the types table. It has an __index metatable entry,
-- so that if a symbol is not found in it, it is looked for in the current
-- environment. It allows to write things like [ n=3; x :: vector(n) ].
--------------------------------------------------------------------------------
types = { }
setmetatable (types, { __index = getfenv(0)})

--------------------------------------------------------------------------------
-- Built-in types
--------------------------------------------------------------------------------
for typename in values{ "number", "string", "boolean", "table" } do
   types[typename] = 
      function (val)           
         if type(val) ~= typename then error (typename .. " expected") end
      end
end

--------------------------------------------------------------------------------
-- [list (subtype)] checks that the term is a table, and all of its 
-- integer-indexed elements are of type [subtype].
--------------------------------------------------------------------------------
function types.list (...)
   local args={...}
   return function (val)
      for x in values(args) do
         if type(x) == "number" and #val ~= x then
            error "Wrong number of arguments in list"
         elseif type(x) == "function" then
            for v in values (val) do
               x(v)
            end 
         else 
            error "Invalid type specifier"
         end
      end
   end
end

--------------------------------------------------------------------------------
-- Check that [x] is an integral number
--------------------------------------------------------------------------------
function types.int (x)
   if type(x)~="number" or x%1~=0 then error "Integer number expected" end
end

--------------------------------------------------------------------------------
-- [range(a,b)] checks that number [val] is between [a] and [b]. [a] and [b]
-- can be omitted.
--------------------------------------------------------------------------------
function types.range (a,b)
   return function (val)
      if type(val)~="number" or a and val<a or b and val>b then 
         error (string.format("Number between %s and %s expected",
                              a and tostring(a) or "-infty",
                              b and tostring(b) or "+infty"))
      end
   end
end

--------------------------------------------------------------------------------
-- [inter (x, y)] checks that the term has both types [x] and [y].
--------------------------------------------------------------------------------
function types.inter (...)
   local args={...}
   return function(val)
      for t in values(args) do t(args) end
   end
end      

--------------------------------------------------------------------------------
-- [union (x, y)] checks that the term has type either [x] or [y].
--------------------------------------------------------------------------------
function types.union (...)
   local args={...}
   return function(val)
      for t in values(args) do if pcall(t, val) then return end end
      error "None of the types in the union fits"
   end
end      

--------------------------------------------------------------------------------
-- [optional(t)] accepts values of types [t] or [nil].
--------------------------------------------------------------------------------
function types.optional(t)
   return function(val) if val~=nil then t(val) end end
end  

--------------------------------------------------------------------------------
-- A call to this is done on litteral tables passed as types, i.e.
-- type {1,2,3} is transformed into types.__table{1,2,3}.
--------------------------------------------------------------------------------
function types.__table(s_type)
   return function (s_val)
      if type(s_val) ~= "table" then error "Struct table expected" end
      for k, field_type in pairs (s_type) do
         local r, msg = pcall (field_type, s_val[k])
         if not r then 
            error(string.format("In structure field `%s': %s", k, msg)) 
         end
      end
   end
end

--------------------------------------------------------------------------------
-- Same as __table, except that it's called on literal strings.
--------------------------------------------------------------------------------
function types.__string(s_type)
   return function (s_val)
      if s_val ~= s_type then
         error(string.format("String %q expected", s_type))
      end
   end
end

--------------------------------------------------------------------------------
-- Top and Bottom:
--------------------------------------------------------------------------------
function types.any() end
function types.none() error "Empty type" end
/body>