From ab8a02fd30451207578927c7e69aa397ad596459 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Sat, 30 Mar 2024 22:20:36 -0500
Subject: Read from ports now

---
 base.lua | 257 ---------------------------------------------------------------
 1 file changed, 257 deletions(-)
 delete mode 100644 base.lua

(limited to 'base.lua')

diff --git a/base.lua b/base.lua
deleted file mode 100644
index b6e3a30..0000000
--- a/base.lua
+++ /dev/null
@@ -1,257 +0,0 @@
---- lam.base --- base environment
-
-local base = {}
-local type = require "type"
-local isNull, isa, totable = type.isNull, type.isa, type.totable
-local math = math
-
-base.env = {
-	-- Equivalence
-	["eqv?"] =
-		function (r)
-			local a, b = r.car, r.cdr.car
-			if a == b then
-				return true
-			else
-				return false
-			end
- 		end,
-	-- ["eq?"] = function (r) end, -- how would this be different to eqv?
-	-- Numbers
-	["number?"] = function (r) return isa(r.car, "Number") end,
-	-- ["complex?"] = function (r) end,
-	-- ["real?"] = function (r) end,
-	-- ["rational?"] = function (r) end,
-	-- ["integer?"] = function (r) end,
-	-- ["exact?"] = function (r) end,
-	-- ["inexact?"] = function (r) end,
-	-- ["exact-integer?"] = function (r) end,
-	-- ["finite?"] = function (r) end,
-	-- ["infinite?"] = function (r) end,
-	["="] =
-		function (r)
-			local n, r = r.car, r.cdr
-			while r.cdr do
-				if n ~= r.car then return false end
-				r = r.cdr
-			end
-			return true
-		end,
-	["<"] =
-		function (r)
-			local n, r = r.car, r.cdr
-			while r.cdr do
-				if n >= r.car then return false end
-				r = r.cdr
-			end
-			return true
-		end,
-	[">"] =
-		function (r)
-			local n, r = r.car, r.cdr
-			while r.cdr do
-				if n <= r.car then return false end
-				r = r.cdr
-			end
-			return true
-		end,
-	["<="] =
-		function (r)
-			local n, r = r.car, r.cdr
-			while r.cdr do
-				if n > r.car then return false end
-				r = r.cdr
-			end
-			return true
-		end,
-	[">="] =
-		function (r)
-			local n, r = r.car, r.cdr
-			while r.cdr do
-				if n < r.car then return false end
-				r = r.cdr
-			end
-			return true
-		end,
-	-- Math
-	["+"] =
-		function (r)
-			local r, a = r, 0
-			while r.cdr do
-				r, a = r.cdr, a + r.car
-			end
-			return a
-		end,
-	["-"] =
-		function (r)
-			if isNull(r) then return -1 end
-			if isNull(r.cdr) then return (- r.car) end
-			local r, a = r.cdr, r.car
-			while r.cdr do
-				r, a = r.cdr, a - r.car
-			end
-			return a
-		end,
-	["*"] =
-		function (r)
-			local r, a = r, 1
-			while r.cdr do
-				if r.cdr == 0 then return 0 end
-				r, a = r.cdr, a * r.car
-			end
-			return a
-		end,
-	["/"] =
-		function (r)
-			if isNull(r) then error("Wrong arity") end
-			if isNull(r.cdr) then return (1 / r.car) end
-			local r, a = r.cdr, r.car
-			while r.cdr do
-				r, a = r.cdr, a / r.car
-			end
-			return a
-		end,
-	quotient =
-		function (r)
-		end,
-	remainder =
-		function (r)
-		end,
-	modulo =
-		function (r)
-		end,
-	-- numerator = function (r) end,
-	-- denominator = function (r) end,
-	abs = function (r) return math.abs(r.car) end,
-	floor = -- largest integer <= x
-		function (r) return math.floor(r.car) end,
-	ceiling = -- smallest integer >= x
-		function (r) return math.ceil(r.car) end,
-	truncate = -- smallest |integer| <= |x|
-		function (r)
-			local i, _ = math.modf(r.car)
-			return i
-		end,
-	round = -- closest integer to x (ties go even)
-		function (r)
-			local i, f = math.modf(r.car)
-			if f == 0.5 then
-				if i % 2 == 0 then
-					return i
-				else
-					return i+1
-				end
-			else
-				return i -- is this right?
-			end
-		end,
-	-- Trig
-	exp = function (r) return math.exp(r.car) end,
-	log = function (r) return math.log(r.car) end,
-	pi = math.pi, -- extension
-	sin = function (r) return math.sin(r.car) end,
-	cos = function (r) return math.cos(r.car) end,
-	tan = function (r) return math.tan(r.car) end,
-	asin = function (r) return math.asin(r.car) end,
-	acos = function (r) return math.acos(r.car) end,
-	atan = -- the two-argument variant of atan computes
-		-- (angle (make-rectangular x y)), even in implementations that
-		-- don't support general complex numbers [ed. note: whatever
-		-- that means] --- atan2 ???
-		function (r) return math.atan(r.car) end,
-	sqrt = function (r) return math.sqrt(r.car) end,
-	expt = function (r) return r.car ^ r.cdr.car end,
-	-- ["make-rectangular"] = function (r) end,
-	-- ["make-polar"] = function (r) end,
-	-- ["real-part"] = function (r) end,
-	-- ["imag-part"] = function (r) end,
-	-- ["magnitude"] = function (r) end,
-	-- ["angle"] = function (r) end,
-	-- ["exact->inexact"] = function (r) end,
-	-- ["inexact->exact"] = function (r) end,
-	["number->string"] =
-		function (r)
-			-- this will be somewhat complicated
-		end,
-	["string->number"] =
-		function (r)
-			local n = r.car
-			if not isNull(r.cdr) then
-				local radix = r.cdr.car
-			end
-			-- This is technically an extension to r5rs
-			return tonumber(n, radix)
-		end,
-	-- Pairs
-	["pair?"] = function (r) end,
-	cons = function (r) return type.Cons(r.car, r.cdr.car) end,
-	car = function (r) return r.car.car end,
-	cdr = function (r) return r.car.cdr end,
-	["set-car!"] = function (r) r.car.car = r.cdr.car end,
-	["set-cdr!"] = function (r) r.car.cdr = r.cdr.car end,
-	-- cxr
-	["null?"] = function (r) return isNull(r.car) end,
-	["list?"] = function (r) return type.isList(r.car) end,
-	list = function (r) return r end, -- r is already a list
-	-- Symbols
-	["symbol?"] = function (r) return isa(r.car, "Symbol") end,
-	["symbol->string"] = function (r) return type.String(r.car) end,
-	["string->symbol"] = function (r) return type.Symbol(r.car.value) end,
-	-- Characters
-	["char?"] = function (r) end,
-	["char=?"] = function (r) end,
-	["char<?"] = function (r) end,
-	["char>?"] = function (r) end,
-	["char<=?"] = function (r) end,
-	["char>=?"] = function (r) end,
-	["char->integer"] = function (r) end,
-	["integer->char"] = function (r) end,
-	-- Strings
-	["string?"] = function (r) end,
-	["make-string"] = function (r) end,
-	["string-length"] = function (r) end,
-	["string-ref"] = function (r) end,
-	-- ["string-set!"] = function (r) end, -- not sure if i'll implement
-	-- Vectors
-	["vector?"] = function (r) end,
-	["make-vector"] = function (r) end,
-	["vector-length"] = function (r) end,
-	["vector-ref"] = function (r) end,
-	["vector-set!"] = function (r) end,
-	-- Control
-	["procedure?"] = function (r) end,
-	apply = function (r) end,
-	["call-with-current-continuation"] = function (r) end,
-	values = function (r) end,
-	["call-with-values"] = function (r) end,
-	["dynamic-wind"] = function (r) end,
-	-- Eval
-	eval = function (r) end,
-	["scheme-report-environment"] = function (r) end,
-	["null-environment"] = function (r) end,
-	-- Ports
-	["input-port?"] = function (r) end,
-	["output-port?"] = function (r) end,
-	["current-input-port"] = function (r) end,
-	["current-output-port"] = function (r) end,
-	["open-input-file"] = function (r) end,
-	["open-output-file"] = function (r) end,
-	["close-input-port"] = function (r) end,
-	["close-output-port"] = function (r) end,
-	-- Input
-	read = function (r) end,
-	["read-char"] = function (r) end,
-	["peek-char"] = function (r) end,
-	["eof-object?"] = function (r) end,
-	["char-ready?"] = function (r) end,
-	-- Output
-	write = function (r) end,
-	display = function (r) end,
-	newline = function (r) end,
-	["write-char"] = function (r) end,
-	-- System
-	load = function (r) end,
-}
-
----
-return base
-- 
cgit 1.4.1-21-gabe81