Thanks to Justin R. Hall (HenZo) <henzo@tunes.org> for help pair programming, and for trying to catch up. I hope this document will allow you to catch up for good.
Thanks to François-René Rideau (Faré) <fare@tunes.org> for starting the TUNES project. I hope Max will be useful, nevertheless expedient enough to focus and provide direction to the project.
Max is a framework for a reflective computing system. For a system to be reflective, it needs two complementary capabilities: Introspection, the ability to examine any part of the system; and dynamism, the ability to modify any part of the system by replacing it with a functionally equivalent one.
Max provides a clean model of the system, with fully generic, non-redundant abstractions, and a model of computation that unifies all known programming paradigms. The exact meaning of this description will be made clear in the sections that follow, as we examine the purpose and implementation of each component.
This implementation is in Common LISP using an iterative development cycle. This is iteration #1, intended to implement the basic functionality in every required component of Max, and to demonstrate the overall design. Iteration 1 is not yet complete. Our TODO list describes the remaining tasks for this iteration.
This document is produced by ``noweb'', a Literate Programming tool. Literate Programming allows the documentation and code to coexist in the same source file, and to present the entire body of source code to a human being in an understandable order, with explanations. Code is defined in named ``chunks''. Chunks can refer to other chunks (using <chunk name> notation), which are replaced with their contents recursively when noweb creates the source files. Each module has 1 top-level chunk that is the same name as the filename stem of the module.
This is the main module, called ``max'', and all it does is load other modules. The term ``module'' is currently equivalent to a file with the .lsp extension. Most files implement one or more related abstract data types and operations on those types, for use within Max.
<max>= <Define the load-files function> <Setup initialization framework> <Call the load-files function on the list of files to load> <Initialization>
Load-files is a LISP function taking a list of files and loading them in sequence:
<Define the load-files function>= (<-U)
; function load-files to load all files.
; For this reason it can't be loaded from a file itself :)
(defun load-files (files)
(map nil #'load files)
)
The modules are loaded here; some of these have dependencies on earlier ones, and others don't. The dependencies should be declared somewhere so this order doesn't get screwed up. I think the Common LISP package system might be able to handle this, but I haven't learned about it yet, so for now we just have this fixed load order. Each module will be documented in its own section to follow.
<Call the load-files function on the list of files to load>= (<-U)
; (load 'test) finds the dir test/ so we have to (load 'test.lsp)
(load-files '(test.lsp util addr object ptr function set
string boolean catalog eval menu name repl))
Currently most initialization is done in the individual modules as they are loaded. Each module's initialization consists of creating some global variables, declared with DEFPARAMETER and initialized in the same place they are declared. The global variables store Max objects so they can be accessed from within LISP.
Here's a framework for the later modules to define functions to be called after all the modules are loaded.
<Setup initialization framework>= (<-U)
(defparameter *init-hooks* nil)
(defun add-init-hook (thunk)
(setf *init-hooks* (append *init-hooks* (list thunk)))
)
<Initialization>= (<-U)
(defun init ()
(map nil #'funcall *init-hooks*)
)
(format t "~%Initializing...~%")
(init)
We use automated testing for the Max implementation. This module sets up the LISP environment so we can define and run the tests.
<test>= <Load the automated testing package> <Create the main Max test suite instance> <Create a function to run all Max tests> <Create a test fixture used by many Max modules>
We chose the XP Test Suite by onShore Development because it was the only test suite for Common LISP we could find and get to work. It works adequately, but needs improvement. Fortunately, it is public domain so we can simply make the changes as we need them. We'll need to make some improvements soon, because I think I'm avoiding writing more test cases to avoid having to deal with the existing situation.
<Load the automated testing package>= (<-U) ; Load and use the XP Test Suite by onShore Development ; http://alpha.onshored.com/lisp-software/#xptest (load-files '(test/package test/xptestsuite)) (use-package 'xptest)
A test suite is a collection of other test suites and individual tests. We make one test suite the ``main'' test suite, which will contain all the tests for Max. In each module, we'll add Max tests or test suites to this one.
<Create the main Max test suite instance>= (<-U)
; Create a master test suite
(defparameter max-test-suite
(make-test-suite "main Max test suite"
"All other max test suites should be added to this one"
)
)
The standard interface provided by onShore's package requires running tests to produce a ``test results'' object, and then calling a reporting function on the results. We create a function, TEST, to combine both tasks: It runs all tests and displays their results.
The result reporting function needs improvements soon, since it displays at minimum 3 lines per test, with no summary at the end, so you have to scroll back quite a ways in order to determine which tests succeeded or failed.
In order to see the reasons for any test failures, you have to call
(TEST :verbose t). This adds even more lines of text to
successful tests, though, so we'll remain terse by default.
<Create a function to run all Max tests>= (<-U)
; runs all max tests
(defun test (&key (verbose nil))
(let ((results (run-test max-test-suite)))
(report-result results)
(test-summary results)
)
)
A test fixture is an object containing some variables that store intermediate results for tests. In many Max modules, no test fixture is needed, but the testing package requires one to be declared for every test. Here we define the empty test fixture and call it ``nullfix'' so we don't have to redefine it every time it is needed.
<Create a test fixture used by many Max modules>= (<-U) ; The empty fixture, used by a lot of tests since we test a lot of globals (def-test-fixture nullfix () NIL)
Prior to the use of literate programming for documenting Max, the tests were at the end of the file for the module they were testing. Most other programs I have seen that use testing put the tests in a separate file and directory, using a name related to the name of the file they are testing. Regardless of where the tests are stored, we'll now present tests right along with the code they are testing. Just as literate programming allows documentation to be kept in sync with code, it will allow the tests to be kept in sync as well.
Types, values and addresses are an important part of Max's design.
Since Max is meant to have no redundant abstractions, addresses must be used anywhere uniqueness is needed. Some examples of situations where you would use an address: [*]
You can probably think of many more applications of an address. Addresses need to be quite versatile to support all these uses, and their versatility depends on the expressiveness of the type system. Since addresses and types are so closely tied together, we currently define them in the same module, ``addr.''
<addr>= <Addresses> <Types>
<Addresses>= (<-U) <Define the representation of an address> <Get the type of an address> <Get the value of an address> <Compare two addresses for equality>
An address consists of a type and a value. We just use the obvious approach and represent an address as a list of its type and its value.
<Define the representation of an address>= (<-U)
(defun make-address-form (typekey addrkey)
(list typekey addrkey)
)
Now that we have a representation of an address we need some functions to access its parts.
The only inherent operation on an address is to obtain its type. The type can be used to look up all the other operations dealing with the address.
<Get the type of an address>= (<-U)
; The first item in the list representating an address is the type.
(defun addr-type (addr)
(car addr)
)
; Max function ADDR-TYPE
(add-init-hook #'(lambda ()
(let ((addr-type
(make-function 'builtin-function *objects* *types*
#'current-type
)
))
(add-public-function addr-type)
(add-name addr-type "type")
)
))
There is no operation to obtain the value of an address. That is, inside Max, values are opaque. We just said that we can look up all the operations dealing with an address if we know its type. So, why would we ever need the value of the address? We already have the address itself, and we can get all the operations available, including possibly converting to a string, retrieving an integer representing the value, or getting some kind of hex number. There is no reason to expose the value of an address to the outside world. In fact, it would be bad style to allow access to the value except by going through the published interface for the type.
Ok, so, inside Max you can't get directly at the value of an address. Inside LISP, we have to get at it in the LISP functions for dealing with addresses.
<Get the value of an address>= (<-U)
; The second list item in an address is the "value":
; What this actually is depends on the type.
(defun addr-value (addr)
(cadr addr)
)
Now, we already know addresses are globally unique IDs. If we have two, can we compare them? Well, within Max, the answer is currently ``possibly not.'' That is, I can't think of a good reason to require that every type implement an equality operation, so I won't.
Inside LISP, we often need to compare addresses, mostly in the unit tests. The function ADDR-EQUAL takes two addresses and returns the LISP truth value (NIL or non-NIL) of their equality. It will compare the types first, then if they are equal, use a type-specific comparison on the values. However, the type-specific comparison might trigger a runtime error (if the ADDR-VALUE-EQUAL method is not defined on the target type). Since ADDR-EQUAL is not a published interface inside Max, that's OK.
<Compare two addresses for equality>= (<-U)
; Two addresses are equal iff:
; their type field is the same symbol and
; their value is equal as defined by the class of the type of the addresses
; Uses addr-value-equal, a generic function which needs to be implemented
; by the class of every type (unless they want addr-equal to fail)
(defun addr-equal (a b)
(and
(type-equal (addr-type a) (addr-type b))
(addr-value-equal
(addr-type a)
(addr-value a)
(addr-value b)
)
)
)
(add-init-hook #'(lambda ()
(let ((addr-equal
(make-function 'builtin-function
(type-product *objects* *objects*)
*boolean-type*
#'(lambda (twoobjs)
(let ((vals (product-values twoobjs)))
(boolean-cond #'(lambda ()
(addr-equal (first vals) (second vals))
))
)
))
))
(add-public-function addr-equal)
(add-name addr-equal "equal")
)
))
A type is an entity containing some number of unique values. Max's type system is designed to allow easy creation of types of all kinds so that you can use the appropriate model for the problem you are trying to solve. There are enumerated types, union (sum) types, and tuple (product) types. We intend to add inductive types in a future iteration. Types themselves have the type ``types'', making them first-class objects. Most of the modules that follow are focused on defining a new type and some behavior for it.
<Types>= (<-U) [D->] <Definitions common to all types> <Enumerated types> <Sum types> <Product types> <The null type>
We'll define tests as we go through each part of the types module.
<Types>+= (<-U) [<-D->] <Tests for types>
Tests get added to a test suite for types which is added to the main max test suite.
<Types>+= (<-U) [<-D] <Create a test suite for types>
<Create a test suite for types>= (<-U)
(add-test
(make-test-suite
"Type Test Suite"
"Test suite for types"
<Types test suite items>
)
max-test-suite
)
The implementation of types contains the following elements, which will be covered in the order shown.
<Definitions common to all types>= (<-U) <Define the class of types> <Base identity for type products> <Base identity for type sums> <Define the default comparison method for values in the same type> <Create a class for the type of types> <Create the one instance representing the type of types> <Create the address of the type of types> <Create a new type and return its address> <Compare two types> <Get the instance implementing a type given its address>
We use CLOS to represent types, since we have several different kinds of types with different implementations. Here's the base class. All classes that implement types are derived from this class. An instance of any type class implements an individual type.
<Define the class of types>= (<-U)
(defclass type ()
nil
)
Base case for type products. Every type is a 1-tuple. See [->].
<Base identity for type products>= (<-U)
(defmethod factors ((atype type))
(list (make-address-form (addr-value *types*) atype))
)
<Base identity for type sums>= (<-U)
(defmethod members ((atype type))
(list (make-address-form (addr-value *types*) atype))
)
Most classes of types will have a method called ADDR-VALUE-EQUAL. This method compares two values that are already known to in the same type. We'll define this method using EQ on the base class of types because many of the subclasses currently use EQ to compare values. They won't have to define their own method since they can just use this default one.
<Define the default comparison method for values in the same type>= (<-U)
; Default comparison for two address values is EQ
; since most are now CLOS instances
(defmethod addr-value-equal ((s type) a b)
(eq a b)
)
We will want to refer to types explicitly as first-class objects in Max. This means assigning an address to each type. An address consists of a type and a value, and if the value represents one type, we need to create the type of types to complete the address.
Let's create a class for the type of types, since it's different from other types.
<Create a class for the type of types>= (<-U)
; the class for a type of types
(defclass types-type (type)
nil
)
Let's create an instance of the class we just defined. Since there's only one type of types, this seems silly, but it's because CLOS is class-based instead of prototype-based. CLOS dispatches on instances only.
<Create the one instance representing the type of types>= (<-U) ; *types-instance* will be the CLOS instance of a type of types. ; There's normally just one such instance. (defparameter *types-instance* (make-instance 'types-type))
Now we want to refer to the type of types in Max, so it should also be a first-class object (address). Since it's a type, it's only appropriate that it be its own type.
We'll test that the type of types is its own type by checking its type field is EQ to its value field.
<Tests for types>= (<-U) [D->]
; Type of types must be the type for itself
(defmethod sos-test ((sf nullfix))
(unless (eq (addr-type *types*) (addr-value *types*))
(failure "Type of types is not the type for itself")
)
)
<Types test suite items>= (<-U) [D->]
("Type of types" 'nullfix
:test-thunk 'sos-test)
We'll implement the address such that the test succeeds.
<Create the address of the type of types>= (<-U) ; *types* will be the Max address of the type of types. (defparameter *types* (make-address-form *types-instance* *types-instance*)) (add-init-hook #'(lambda () (add-name *types* "types")))
MAKE-TYPE creates a new type and returns its address. It defaults to creating an enumerated type (defined in section [->]), but you can specify any class of type using the :class keyword argument. The :key keyword argument allows you to assign a symbolic name to this type, but this option is currently ignored.
We'll store the instance implementing a type directly in the value part of the address. Recall that the value part can be anything; it is totally up to the type being implemented.
<Get the instance implementing a type given its address>= (<-U)
(defun typeaddr-instance (typeaddr)
(addr-value typeaddr)
)
The type part of the address will contain the value of the type of types, which we take from the value field of *types*.
<Create a new type and return its address>= (<-U)
; Ignore the key for now, maybe store in a slot for debugging later
(defun make-type (&key (class 'enumerated-type) key)
(make-address-form (addr-value *types*) (make-instance class))
)
A and B are both instances. Two types are equal if they have the same instance (EQ), or, if they are different instances of the same class and their class considers them equal.
<Compare two types>= (<-U) [D->]
(defun type-equal (a b)
(or
(eq a b)
(and
(eq (class-of a) (class-of b))
(type-specific-equal (class-of a) a b)
)
)
)
(defun addr-type-equals (type addr)
(type-equal (addr-value type) (addr-type addr))
)
By default, two types are equal if they have the same instance. Types for which this is not true (such as product types) can override this method.
<Compare two types>+= (<-U) [<-D]
(defmethod type-specific-equal ((t type) a b)
(eq a b)
)
<Enumerated types>= (<-U) <Define the class of enumerated types> <Get the hash table implementing an enumerated type> <Create an identifier for a value> <Add a value to an enumerated type>
Currently we use a model where you create a new empty enumerated type using MAKE-TYPE and then proceed to add values into it using MAKE-ADDRESS. This violates one of the principles of Max's design: to only use one abstraction for dynamism (Pointers, section [->]) . So this API should change someday to a better one where you start with the empty enumerated type and repeatedly use a function to return a new enumerated type based on the last one. I have not thought about whether it is possible to make this change yet, but it's not a high priority.
An enumerated type is implemented by a hash table stored in the instance.
<Define the class of enumerated types>= (<-U)
; An enumerated type is created by adding elements one by one,
; explicitly. It is necessarily finite, and is implemented by a
; hash table: each key corresponds to the address of one item in the
; type.
; Current examples of enumerated types: *boolean-type*, *types*,
; *functions*
(defclass enumerated-type (type)
((hash :initform (make-hash-table)
:accessor hash
:documentation
"Keys are addresses; values are implementation data for each address"
))
)
TYPE-HASH is a function to retrieve the hash table that implements an enumerated type. It isn't meant to work with other classes of types, but we can't make it a method because it takes an address, and addresses are not CLOS instances.
<Get the hash table implementing an enumerated type>= (<-U)
(defun type-hash (typeaddr)
(hash (typeaddr-instance typeaddr))
)
The values in an enumerated type are represented by symbols used as the keys in the hash table. We allow the user (whoever is building an enumerated type) to choose the symbols if they wish, otherwise we create one with a name like ADDR1, ADDR2, etc.
GET-ADDR-KEY takes a symbol or NULL; if NULL it creates a key named ADDRn using its global variable that it increments when used (one counter for all enumerated types). If non-NULL it just returns the argument.
<Create an identifier for a value>= (<-U)
(defparameter *n_keys* 0)
(defun get-addr-key (sym)
; Return key for address using "ADDRnn" if key not specified.
; Key names are only for implementation debugging and are not
; part of the system design.
(if (null sym)
(progn
(incf *n_keys*)
(nth-value 0
(read-from-string
(format nil "~a~a" 'addr *n_keys*)
)
)
)
; else str argument was provided
sym
)
)
MAKE-ADDRESS takes the address of an enumerated type and modifies it to contain a new value.
The :key keyword argument specifies an optional symbolic name for the new value. If it is unspecified, GET-ADDR-KEY is called to generate one.
The :value keyword argument allows enumerated types to store some type-specific private information along with the value.
<Add a value to an enumerated type>= (<-U)
#|
Add a new value to an enumerated type and return the new address.
Required: typeaddr = the max address of the type that the address is
to live in
Optional: key = the symbol to put in the enumerated type's hash table
as this address' key rather than the default ADDRx
Optional: value = value to store in the type's hash table with the
new address as key (Use value only for things that are not Max
addresses and thus can't be returned in functions)
|#
(defun make-address (typeaddr &key key (value nil))
(let ((type (typeaddr-instance typeaddr))
(addr-key (get-addr-key key)))
; Hash value
(setf (gethash addr-key (hash type)) value)
; Return the new address, including the type it is in
(make-address-form (addr-value typeaddr) addr-key) ) )
Contrast this kind of union to the union of mathematical sets. See SET-UNION in section [->]) .
Let's write some tests for the sum types to get some idea of the interface they'll need.
<Tests for types>+= (<-U) [<-D->] <Sum type tests>
<Sum type tests>= (<-U) [D->]
(def-test-fixture type-sum-fix ()
(<Sum types test fixture slots>)
(:documentation "Fixture for testing type-sum")
)
(defmethod setup ((sf type-sum-fix))
<Sum types test fixture initialization>
)
Create an enumerated type containing some values. This type will be used to test sum types.
<Sum types test fixture slots>= (<-U) [D->]
(sc-races :accessor sc-races)
(zerg :accessor zerg)
(protoss :accessor protoss)
(terran :accessor terran)
<Sum types test fixture initialization>= (<-U) [D->]
(setf (sc-races sf) (make-type :key 'SC-RACES))
(setf (zerg sf) (make-address (sc-races sf) :key 'ZERG))
(setf (protoss sf) (make-address (sc-races sf) :key 'PROTOSS))
(setf (terran sf) (make-address (sc-races sf) :key 'TERRAN))
Create the sum of the new enumerated type and boolean. Since the enumerated type was called SC-RACES we call the new sum a BOOLRACE (Values in this type can be either Booleans or SC Races).
<Sum types test fixture slots>+= (<-U) [<-D->]
(mysum :accessor mysum)
<Sum types test fixture initialization>+= (<-U) [<-D->]
(setf (mysum sf) (type-sum *boolean-type* (sc-races sf)))
Now, get all the functions that convert the member types to the new sum type.
<Sum types test fixture slots>+= (<-U) [<-D->]
(myfuncset :accessor myfuncset)
<Sum types test fixture initialization>+= (<-U) [<-D->]
; Get a max set of functions that return one of our new
; BOOLRACE objects
(setf (myfuncset sf) (get-constructors (mysum sf)))
; Get the list of domains that these functions take
(setf (mydomlist sf) nil)
Do a fancy mapping to obtain a set of types that can be converted to our new sum. These are the domains of the functions in the previous step.
<Sum types test fixture slots>+= (<-U) [<-D]
(mydomlist :accessor mydomlist)
<Sum types test fixture initialization>+= (<-U) [<-D]
(mapset #'(lambda (func)
(setf (mydomlist sf)
(cons (function-apply *domain* func)
(mydomlist sf))
))
(myfuncset sf)
)
After all that work, we can verify that the conversion functions are from the correct types.
<Sum type tests>+= (<-U) [<-D]
(defmethod type-sum-bool-boolrace ((sf type-sum-fix))
(unless (member *boolean-type* (mydomlist sf) :test #'addr-equal)
(failure "Can't find a function taking a boolean returning a BOOLRACE")
)
)
(defmethod type-sum-scrace-boolrace ((sf type-sum-fix))
(unless (member (sc-races sf) (mydomlist sf) :test #'addr-equal)
(failure "Can't find a function taking an sc-race returning a BOOLRACE")
)
)
Add the tests for sum types to the types test suite.
<Types test suite items>+= (<-U) [<-D->]
("function Boolean -> BOOLRACE exists" 'type-sum-fix
:test-thunk 'type-sum-bool-boolrace)
("function SC-RACE -> BOOLRACE exists" 'type-sum-fix
:test-thunk 'type-sum-scrace-boolrace)
<Sum types public interface>= (U->) <Create the sum of N types> <Get a sum constructor> <Get all the sum constructors for a sum type> <Get the current member type of a sum address> <Sum destructor>
And here's the layout of the implementation.
<Sum types>= (<-U) <A class for sum types> <Compare two values in the same sum type> <Sum types public interface>
Sum types definitely need their own class. In the instance implementing an individual sum type, we need to remember what member types were summed to create it. That's the only slot in this class.
<A class for sum types>= (<-U)
; The class of types which are created by taking the sum of other types.
; Note that addresses in sum types are actually in a different type
; depending on which types are in the sum.
; Each sum type has its own instance of class sum-type.
; Two sum types made from the same members will have an identical-looking
; instance- but won't be the same instance.
; When comparing the addresses of two such sum types, they will be unequal
; in the addr-value-equal sense. Need a CLASS SUM-TYPE-ADDRESS or something
; if we want to be able to compare them and treated as addr-value-equal.
(defclass sum-type (type)
((members :reader members :type list
:initarg :members
:documentation "The list of types that were summed to make this one"))
)
TYPE-SUM creates a sum type. It takes a LISP list of addresses of types, to be the member types, and returns the address of the new type.
The new address is of the type ``types'', and has an instance of the class of sum types as its value.
TODO: All types should be the sum of just 1 type
<Create the sum of N types>= (<-U)
; Create a type containing the combined
; values from N other types
; (discriminated union?)
; The other types become known as the member types
(defun type-sum (&rest typeaddrs)
(make-address-form
(addr-value *types*)
(make-instance 'sum-type :members typeaddrs)
)
)
A sum constructor is a function taking an argument in one of the member types of a sum, and returning a value in the sum type. There are N sum constructors for the sum created from N types. Max functions are defined in section [->] .
MAKE-SUM-CONSTRUCTOR takes the address of a sum type and the address of one of its member types and returns the appropriate sum constructor.
The sum constructor is responsible for building an address into the sum type (a sum address). The type of a sum address indicates which sum type it's in, and is an instance of the class of sum types. The value in a sum address is simply the complete address from the member type, including its type and value.
In Max we don't have type coercion, or subtyping. All type conversion has to be explicit in the first-order system, so that introspection reveals a precise description of the system and proofs can be done step by step. Any automatic conversion can be done by searching for conversion functions, building an expression containing them, and evaluating the expression.
Since we don't have subtypes, we had to make the type of a sum address simply be ``types.'' So functions operating on sum types must also operate on any other type. We'll treat non-sum types as if they were the sum of a single type.
The ``if'' statement here creates a special case when both arguments
are the same type. This allows any type to be a sum type of just
itself. Also, if (make-sum-constructor *objects* *objects*) didn't
return identity, converting from objects to objects would make a value
that grows redundantly.
<Get a sum constructor>= (<-U)
; Declare *objects* global that we refer to before it's initialized
(defparameter *objects* nil)
(defun make-sum-constructor (sumtype membertype)
(if (eq (addr-value sumtype) (addr-value membertype))
;then
(identity-function sumtype)
;else
(make-function 'builtin-function membertype sumtype
#'(lambda (membervalue)
(make-address-form (addr-value membertype) (addr-value membervalue))
)
)
)
)
(add-init-hook #'(lambda ()
(let ((make-sum-constructor
(make-function 'builtin-function
(type-product *types* *types*)
*functions*
#'(lambda (sum-and-member)
(apply #'make-sum-constructor (product-values sum-and-member)))
)))
(add-public-function make-sum-constructor)
(add-name make-sum-constructor "constructor")
)
))
Here's a helper function to get a set of max functions that create values from each of the member types of a sum type. Functions and sets are defined in later sections.
<Get all the sum constructors for a sum type>= (<-U)
; Given the address of a sum type, return a Max set of
; function addresses, each one of which takes an argument
; in one of the member types and returns an address in the sum type.
(defun get-constructors (sumtype)
(let ((funcset (get-empty-set)))
(map nil #'(lambda (membertype)
(setf funcset (set-add funcset
(make-sum-constructor sumtype membertype)
)))
(members (addr-value sumtype))
)
funcset
)
)
(add-init-hook #'(lambda ()
(let ((get-constructors (make-function 'builtin-function *types* *set-type*
#'get-constructors)))
(add-public-function get-constructors)
(add-name get-constructors "constructors")
)
))
Here we define equality of two values in the same sum type, specializing our generic function for comparing two values in the same type.
Note that addr-value-equal's ``a'' and ``b'' arguments are values in the sum type, but addresses in the member types (as defined in the structure of a sum address above). Therefore we can compare ``a'' and ``b'' using the comparison for addresses, ADDR-EQUAL.
<Compare two values in the same sum type>= (<-U)
; Two addresses in the same sum type are equal iff their
; stored addresses are addr-equal. ADDR-EQUAL compares
; their types and values. It is assumed that their
; types are one of the member types of this sum type.
(defmethod addr-value-equal ((ss sum-type) a b)
(addr-equal a b)
)
An address in a sum type must correspond to exactly one of the member types. CURRENT-TYPE does this lookup, taking an address in a sum type and returning the address of the member type.
<Get the current member type of a sum address>= (<-U)
; Given an address in a sum type,
; return the address of the type of the current value
; (will be one of the sum type's members at all times)
(defun current-type (sumaddr)
(make-address-form (addr-value *types*) (addr-type (addr-value sumaddr)))
)
Given a sum address return the sum value, which is an address in the current sum type.
<Sum destructor>= (<-U)
(defun sum-value (sumaddr)
(addr-value sumaddr)
)
Product types, like sum types, are created from N other types. However, while a sum type contains a value corresponding to exactly one of the N types, a product type contains a value for each of the N types.
Product types create a multidimensional type. An address is constant, but given one in a product type you should be able to get a new address by changing one of the component dimensions to refer to a different address in its original type.
Let's define some tests on product types to see how they should behave.
<Tests for types>+= (<-U) [<-D] <Product type tests>
Before we can define tests, we need a test fixture and an initialization method for the test fixture. We'll take advantage of literate programming to add slots to the fixture and initialize them right by the tests that use those slots, instead of jumping around.
<Product type tests>= (<-U) [D->]
(def-test-fixture product-fix ()
(<Product type test fixture slots>
)
(:documentation "Fixture for type product testing")
)
(defmethod setup ((pf product-fix))
<Product type test fixture initialization>
)
Ok, now we're ready to define some tests.
We'll take the product of Boolean X Boolean, and store its address in
twobooltype.
<Product type test fixture slots>= (<-U) [D->]
(twobooltype :accessor twobooltype)
<Product type test fixture initialization>= (<-U) [D->]
(setf (twobooltype pf) (type-product *boolean-type* *boolean-type*))
Now we'll try and retrieve a list of factor types from the product type address.
<Product type test fixture slots>+= (<-U) [<-D->]
(factlist :accessor factlist)
<Product type test fixture initialization>+= (<-U) [<-D->]
(setf (factlist pf) (product-types (twobooltype pf)))
Now we'll compare what we got out with what we put in. Did we reap what we sowed?
<Product type tests>+= (<-U) [<-D->]
(defmethod test-prod-1 ((pf product-fix))
(unless (addr-equal (car (factlist pf)) *boolean-type*)
(failure "First dim in bool X bool is not bool")
)
)
(defmethod test-prod-2 ((pf product-fix))
(unless (addr-equal (cadr (factlist pf)) *boolean-type*)
(failure "Second dim in bool X bool is not bool")
)
)
<Types test suite items>+= (<-U) [<-D->]
("Type Product 1st type type" 'product-fix
:test-thunk 'test-prod-1)
("Type Product 2nd type type" 'product-fix
:test-thunk 'test-prod-2)
Now we'll create an address in our new product type. Here's the slot to store it in:
<Product type test fixture slots>+= (<-U) [<-D->]
(twobooladdr :accessor twobooladdr) ; an address in twobooltype
<Product type test fixture initialization>+= (<-U) [<-D->]
(setf (twobooladdr pf) (make-product-addr (twobooltype pf) (list true false)))
This would be a good time to test that the type of the address is our product type.
<Product type tests>+= (<-U) [<-D->]
(defmethod test-prod-addr ((pf product-fix))
(unless (eq (addr-type (twobooladdr pf)) (addr-value (twobooltype pf)))
(failure "Product address is not of the product type")
)
)
<Types test suite items>+= (<-U) [<-D->]
("Address type of a product address" 'product-fix
:test-thunk 'test-prod-addr)
The remaining thing that we will test is extracting the values of the factor types from the product address. The interface currently returns these back as a list, just as we specified them.
<Product type test fixture slots>+= (<-U) [<-D]
(twoboolvals :accessor twoboolvals) ; list of two boolean addresses
<Product type test fixture initialization>+= (<-U) [<-D]
(setf (twoboolvals pf) (product-values (twobooladdr pf)))
<Product type tests>+= (<-U) [<-D]
; These also test the type of the values (addr-equal compares types and values)
(defmethod test-prod-val-1 ((pf product-fix))
(unless (addr-equal true (car (twoboolvals pf)))
(failure "Didn't get out what we put in 1st value")
)
)
(defmethod test-prod-val-2 ((pf product-fix))
(unless (addr-equal false (cadr (twoboolvals pf)))
(failure "Didn't get out what we put in 2nd value")
)
)
<Types test suite items>+= (<-U) [<-D]
("Type Product 1st value" 'product-fix
:test-thunk 'test-prod-val-1)
("Type Product 2nd value" 'product-fix
:test-thunk 'test-prod-val-2)
Now we can define the interface for product types based on the behavior we decided on above.
<Product types interface>= (U->) <Create a product type> <Get the list of types used to create a product type> <Product address constructor> <Product address destructor>
In order to completely implement product types, we'll need a class and an internal method for comparing values, as well as the functions implementing the interface.
<Product types>= (<-U) <Create the class of product types> <Compare two values in the same product type> <Compare two product types> <Product types interface>
The only internal information an instance of a product type needs to store is the factors: the list of types used to create it.
<Create the class of product types>= (<-U)
; The class of types created by taking the product of other types.
(defclass product-type (type)
((factors :reader factors :type list
:initarg :factors
:documentation "The list of types that were multiplied to make this one"
))
)
TYPE-PRODUCT creates a product type. The argument is a LISP list of addresses of types... the result is the address of the product type.
Like TYPE-SUM, these implementations are imperfect. They should return the same type when given the same arguments, but they don't. I guess we need an ADDR-TYPE-EQUAL generic function in order to allow different classes of types to compare their instances for equality, instead of just using EQ which causes different instances to always be different.
If only 1 type is specified, it is returned: The product of one type is itself.
<Create a product type>= (<-U)
; Create a type containing multiple dimensions:
; one for each of N other types
; Product types
; * Given a list of types, return a new type called a product type.
; The original types then become known as the factor types of the product type.
(defun type-product (&rest typeaddrs)
(if (= 1 (length typeaddrs))
(car typeaddrs)
(make-address-form
(addr-value *types*)
(make-instance 'product-type :factors typeaddrs)
)
)
)
Here's a public interface to access the types used to create a product type.
<Get the list of types used to create a product type>= (<-U)
; Given the address of a product type, return a list of addresses of its factor types
(defun product-types (prodtype)
(factors (addr-value prodtype))
)
Return an address in a product type given the address of the type and a LISP list of addresses in all of the component types. The order of addresses needs to be the same as the order of the addresses of their types that was passed into TYPE-PRODUCT to create the product type.
Form of an address in a product type: Value field contains list of addresses in the respective factor types. This is kind of lazy; the type field in these addresses is redundant, since it's stored in the product type's instance. We'd have to use map to remove/add it back in.
<Product address constructor>= (<-U)
(defun make-product-addr (prodtype addrlist)
(if (= 1 (length addrlist))
(car addrlist)
(make-address-form (addr-value prodtype) addrlist)
)
)
Given an address in a product type, return a list of addresses in the corresponding factor types
Inverse of MAKE-PRODUCT-ADDR. A destructor is a function that retrieves part of the structure of something.
<Product address destructor>= (<-U)
(defun product-values (prodaddr)
(addr-value prodaddr)
)
Compare two values in the same product type by comparing the respective values corresponding to each component type.
<Compare two values in the same product type>= (<-U)
; Compare values in the same type product
; Does not check if the factors match the types of the addresses in a or b,
; just if the addresses are equal
;
; Note: This method will only be called if the exact same
; type instance object is used for the type field of the address.
; If you make two set product types from the same factors,
; they will be DIFFERENT TYPES (this will change sometime)
(defmethod addr-value-equal ((ps product-type) a b)
; Create list of truth values for comparing each successive address in a and b
; then AND them all together (AND returns the list of truth values either way
(eval (cons 'and (map 'list
#'(lambda (x y) (addr-equal x y))
(product-values a) (product-values b))
))
)
Compare two product types. Two product types are equal iff the corresponding component types are type-equal.
<Compare two product types>= (<-U)
(defmethod type-specific-equal ((c product-type) a b)
(eval (cons 'and (map 'list
#'(lambda (x y) (type-equal x y))
(factors a) (factors b))
))
)
<The null type>= (<-U) <Define the null type>
<Define the null type>= (<-U) ; Create the Null type, which never has any addresses. ; To be used for the domain of functions with no arguments, ; for example (defclass null-type (type) nil) (defparameter *null-type* (make-type :class 'null-type)) (add-init-hook #'(lambda () (add-name *null-type* "null")))
Let's enable *print-circle*, in case we have some circular data structures. MOVE THIS to somewhere that actually creates circular structures. (Hash table implemeneting *domains* inside function.lsp?)
<Enable detection of circular data structures>= (setf *print-circle* t)
This module unifies all types into one type, the Objects type. The Objects type is the sum of all other types (See sum types, section [<-]). Recall that sum types are created from some set of member types, and functions are available to convert from values in the member types to values in the sum type. The objects type is the sum of every possible type that could exist: the entire set described by the ``types'' type, which is infinite. However, the objects type does not contain itself as a member of the sum, since duplicating its values inside itself would be redundant.
The values in the Objects type are exactly the set of all possible addresses!
Note that there is no dynamic typing and no subtyping. Values in other types are not values in the objects type; even though there is a one-to-one correspondence.
The class objects-class, derived from class sum-type, implements the Objects type and has one instance. The address of the Objects type is available in the global variable *objects*. Like any sum address, the format for an object address includes the reference to the instance of its class in the type field (object-class in this case), and an address in the value field (composed of any type and a value in that type). The Objects type implements the functions for sum types CURRENT-TYPE and MAKE-SUM-CONSTRUCTOR but not GET-CONSTRUCTORS since that would return an infinite set.
Calling MAKE-SUM-CONSTRUCTOR with the objects type for both arguments will return a conversion function from the objects type to itself, which is the identity function for Objects (a function taking an Object and returning the same object). This prevents multiple representations for addresses that are equal (since it is redundant to specify the type Objects twice, both in the type field of the outer address and in the type field of the inner address). This change was made in the addr module in DEFUN MAKE-SUM-CONSTRUCTOR.
CURRENT-TYPE and ADDR-VALUE-EQUAL for sum types will work with no change for the object type. The ``members'' slot in the class object-class is unused instead of being a LISP list of member types since that list would be infinite.
<object>=
(defclass object-class (sum-type)
(members :type nil)
)
; declared *objects* global in addr module, by MAKE-SUM-CONSTRUCTOR
; since it references it
(setf *objects* (make-type :class 'object-class :key 'OBJECT))
(add-init-hook #'(lambda () (add-name *objects* "objects")))
The concept of information is encapsulated in functions. Information is the meaning of values in a type; or ways to get from a value in one type to a value in another. Functions enable these transitions. Max functions are pure functions as defined in mathematics. A pure function is one which has no side-effects. A side-effect is a change to the system. Pure functions contain no variable assignments and no I/O. We will discuss how to perform variable assignments and I/O in later sections.
A function is a mapping from one type, called the domain, to another, called the codomain. This means for every value in the domain (argument), the function associates it with one value in the codomain (return value). Values in the codomain can be used more than once, and some values might be unused (however, all values in the domain must be used). The actual subset of values in the codomain that the function may return is called the range.
There are currently two implementations of functions in Max: enumerated functions and builtin functions. Other kinds of functions will be added in the future.
<function>= [D->] <Define a class for the type of functions> <Create the address of the type of functions> <Create the class of functions> <Get the instance implementing a function given its address> <Enumerated functions> <Apply a function> <Quotient a function by an address> <Create a Max function> <Builtin functions> <Domains and codomains> <Identity functions>
Following our standard order, we'll setup for tests at the beginning and define tests throughout the implementation of functions.
<function>+= [<-D] <Tests for functions> <Create a test suite for functions>
<Create a test suite for functions>= (<-U)
(add-test
(make-test-suite
"Functions Test Suite"
NIL
<Functions test suite items>
)
max-test-suite
)
The type of functions has some special characteristics so we implement it using its own class derived from the class of types.
<Define a class for the type of functions>= (<-U)
(defclass function-type (type)
nil
)
This test verifies that the type of functions is a type.
<Tests for functions>= (<-U) [D->]
(defmethod type-of-functions ((nf nullfix))
(unless (addr-value-equal
(typeaddr-instance *types*)
(addr-type *functions*)
(addr-value *types*))
(failure "Type of *functions* is not *types*")
))
<Functions test suite items>= (<-U) [D->]
("Type of *functions*" 'nullfix :test-thunk 'type-of-functions)
We create the address of the type of functions here.
(addr-value *functions*) will go in the "type" field of
function addresses.
<Create the address of the type of functions>= (<-U) (defparameter *functions* (make-type :class 'function-type :key 'FUNCTION)) (add-init-hook #'(lambda () (add-name *functions* "functions")))
Create the CLOS base class of all max function implementations. An instance of a subclass of this class is stored in the value slot of the function address. Every function has a mapping, so this class defines a slot called ``mapping.'' This slot will contain something totally different depending on which subclass is instantiated, since the different classes of functions have different ways of implementing the mapping.
<Create the class of functions>= (<-U)
(defclass function-class ()
((mapping :accessor mapping
:initarg :mapping
))
)
A function address has a type field referring to the *functions* type, and a value field containing an instance of a class derived from function-class.
Given the Max function address of a function, return the CLOS object implementing the function. The instance is currently stored in the value field of the function address.
<Get the instance implementing a function given its address>= (<-U)
(defun function-implementation (funcval)
(third (addr-value funcval))
)
Functions are strongly typed, meaning the types for a function's domain and codomain are required to be specified when the function is defined.
There are two standard Max functions, DOMAIN and CODOMAIN, that return the domain or codomain of any Max function. They are implemented as enumerated functions. When any function is created, the mappings of DOMAIN and CODOMAIN are automatically updated with definitions for the new function. This leads to some difficulties both creating the DOMAIN and CODOMAIN functions, and accessing them from LISP.
<Domains and codomains>= (<-U) <Bootstrap the domain and codomain functions> <Publish the domain and codomain functions>
Bootstrap the domain and codomain functions--we can't call MAKE-FUNCTION since it adds to the domain and codomain functions.
<Bootstrap the domain and codomain functions>= (<-U)
(defun function-domain (func)
(make-address-form (addr-value *types*) (first (addr-value func)))
)
(defun function-codomain (func)
(make-address-form (addr-value *types*) (second (addr-value func)))
)
(defparameter *domain* (make-function 'builtin-function
*functions*
*types*
#'(lambda (func)
(function-domain func)
)
))
(defparameter *codomain* (make-function 'builtin-function
*functions*
*types*
#'(lambda (func) (function-codomain func))
))
We have 4 tests to ensure the domain is ``types'' and the codomain is ``functions'' for both the domain and codomain functions.
<Tests for functions>+= (<-U) [<-D]
(defmethod domain-domain ((nf nullfix))
(unless (addr-equal (function-apply *domain* *domain*) *functions*)
(failure "Domain of the domain function is not *functions*")
))
(defmethod domain-codomain ((nf nullfix))
(unless (addr-equal (function-apply *domain* *codomain*) *functions*)
(failure "Domain of the codomain function is not *functions*")
))
(defmethod codomain-domain ((nf nullfix))
(unless (addr-equal (function-apply *codomain* *domain*) *types*)
(failure "Codomain of the domain function is not *types*")
))
(defmethod codomain-codomain ((nf nullfix))
(unless (addr-equal (function-apply *codomain* *codomain*) *types*)
(failure "Codomain of the codomain function is not *types*")
))
<Functions test suite items>+= (<-U) [<-D]
("Domain of domain function" 'nullfix :test-thunk 'domain-domain)
("Domain of codomain function" 'nullfix :test-thunk 'domain-codomain)
("Codomain of domain function" 'nullfix :test-thunk 'codomain-domain)
("Codomain of codomain function" 'nullfix :test-thunk 'codomain-codomain)
<Publish the domain and codomain functions>= (<-U)
(add-init-hook #'(lambda ()
(add-public-function *domain*)
(add-public-function *codomain*)
(add-name *domain* "domain")
(add-name *codomain* "codomain")
))
FUNCTION-APPLY takes the address of a function, and the address of a value in its domain, and returns the value from the codomain as specified by the function's definition (mapping).
This function is to be called APPLY in Max, but is renamed in LISP to prevent a clash with LISP's APPLY.
For applying thunks (functions with no argument), pass NIL for param.
<Apply a function>= (<-U)
; Apply a function to param and return the address of the result.
; Wrap apply-address, a generic function
(defun function-apply (funcaddr param)
(apply-address
(function-implementation funcaddr)
param ; assume domain is prechecked
)
)
APPLY-ADDRESS is an internal method used by FUNCTION-APPLY to dispatch based on the class of function being applied.
The ``func'' argument is the instance implementing the function.
The ``param'' argument is the address being applied.
It finds the return value of the function and returns it.
We could put a DEFGENERIC for APPLY-ADDRESS here but it's optional so we'll leave it implicit.
QUOTIENT will be a Max function that takes the address of a Max function and the address of a value in its codomain, and returns the Max set of values in the domain that return that value. The set will be empty if the value specified is in the codomain but not in the range of the function. Sets are defined in section [->].
The LISP implementation is called FUNCTION-QUOTIENT for consistency with the other FUNCTION-* functions in this module, although QUOTIENT is not a function in LISP so it could be used.
Like all the other functions in this module, we do no type checking whatsoever, assuming it is done by the caller. In LISP this will be the tester calling the LISP implementations, but in Max type checking is done early. See Evaluation, section [->].
<Quotient a function by an address>= (<-U) [D->]
(defun function-quotient (func_addr result_addr)
(let ((quotient (get-empty-set))
(divisor (addr-value result_addr))
(dom (function-domain func_addr)))
(maphash
#'(lambda (key val)
(if (addr-value-equal dom divisor val)
(setf quotient (set-add quotient
(make-address-form dom key)
))
)
)
(mapping (function-implementation func_addr))
)
quotient
)
)
The type of the second argument is equal to the domain of the first argument. Since we have no way to express this constraint directly in the types of the arguments, we'll do a hack that works for now: The Max version of function-quotient will take the original function and return a ``quotienter'' function that takes a value in the codomain and returns the quotient set. An alternate approach would be to make the second argument type *objects* and do run-type type checking, but that's an inelegant solution. The first hack is elegant enough, and if necessary, later we should be able to write a constraint system that can describe restrictive relationships between argument values (especially ones that are functions).
<Quotient a function by an address>+= (<-U) [<-D]
(add-init-hook #'(lambda ()
(let ((function-quotient
(make-function 'builtin-function *functions* *functions*
#'(lambda (func)
(make-function 'builtin-function
(function-codomain func) *set-type*
#'(lambda (divisor)
(function-quotient func divisor))
))
)))
(add-public-function function-quotient)
(add-name function-quotient "quotient")
)
))
MAKE-FUNCTION creates an enumerated or builtin function.
class: The symbolic name of the class of function to make: either 'ENUMERATED-FUNCTION or 'BUILTIN-FUNCTION.
mapping: initializer for the :mapping slot of CLASS FUNCTION-CLASS. For enumerated, use a hash table, while for builtin, it is a lambda.
domain and codomain: Max addresses of the types which are this function's domain and codomain.
key: symbolic name of this function to use as key in the *functions* hash Now optional so unnamed functions can be made.
<Create a Max function>= (<-U)
(defun make-function (class domain codomain mapping &optional key)
(let* ((obj (make-instance class :mapping mapping))
(addr (make-address-form (addr-value *functions*) (list (addr-value domain) (addr-value codomain) obj))))
addr
)
)
Enumerated functions have finite domains and codomains, defined by an explicit set of tuples. You cannot use a set [set.lsp] of tuples (values in a product type) to create a function, yet, but you will be able to eventually.
You can modify an enumerated function using FUNCTION-CHANGE to specify a new pair of values. This should change at some point to be more like sets (section ? ) to create a new function based on an old one and leave the old one untouched.
<Enumerated functions>= (<-U) <Define the class of enumerated functions> <Define comparison of two enumerated functions> <Apply an enumerated function> <Helper for changing enumerated functions> <Create mappings using LISP symbols> <Change one value pair using literal arguments> <Change one value pair using symbolic arguments>
The implementation of enumerated functions uses a hash table to store an explicit map of values. The hash table is stored in the ``mapping'' slot defined by the base class, FUNCTION-CLASS.
<Define the class of enumerated functions>= (<-U)
(defclass enumerated-function (function-class)
; Use accessor and initarg from parent for this slot
((mapping :type hash-table))
)
If ``a'' and ``b'' are enumerated functions, they are equal if and only if their CLOS instance is the same object (EQ).
<Define comparison of two enumerated functions>= (<-U)
(defmethod addr-value-equal ((f enumerated-function) a b)
(eq a b)
)
Specify how to apply an enumerated function (get the result given the argument): Look it up in the hash table.
This method is the specialization of APPLY-ADDRESS for enumerated functions.
<Apply an enumerated function>= (<-U)
(defmethod apply-address ((func enumerated-function) param)
(make-address-form
(addr-type param)
(gethash (addr-value param) (mapping func))
)
)
FUNCTION-CHANGE-HELPER modifies one key/value pair in the hash table of an enumerated function.
x is a dotted pair of symbols bound to Max addresses. (See FUNCTION-VALUES)
The function definition is updated with the new tuple, either creating or changing the mapping for the first address, so that the function will return the second address.
<Helper for changing enumerated functions>= (<-U)
(defun function-change-helper (h x)
(setf (gethash (addr-value (symbol-value (car x))) h)
(addr-value (symbol-value (cdr x))))
)
FUNCTION-VALUES creates the "mapping" part of a function definition for an enumerated function. Arguments are any number of dotted pairs of symbols bound to Max addresses. Returns a hash table suitable for the implementation field of a function. Then to create the enumerated function, pass this hash table to MAKE-FUNCTION as the ``mapping'' argument. See the boolean module for examples of use.
<Create mappings using LISP symbols>= (<-U)
(defun function-values (&rest args)
(let ((h (make-hash-table)))
(map
nil
#'(lambda (x)
(function-change-helper h x))
args
)
h
)
)
FUNCTION-CHANGE changes an enumerated function in-place.
Tup is '(arg . value), so use FUNCTION-CHANGE when you have literal arguments.
The supplied function's definition is updated with the new pair. If the argument key was already in the function, its associated value is changed; otherwise the key,value pair is added to the definition.
The return value is undefined.
<Change one value pair using literal arguments>= (<-U)
(defmethod function-change ((func enumerated-function) tup)
(let ((h (mapping func)))
(function-change-helper h tup)
)
)
FUNCTION-CHANGE-2 is like function-change, but for symbolic arguments.
<Change one value pair using symbolic arguments>= (<-U)
(defmethod function-change-2 ((func enumerated-function) arg result)
(let ((h (mapping func)))
(setf (gethash (addr-value arg) h)
(addr-value result))
)
)
Builtins are implemented in LISP but take Max addresses as arguments and return Max addresses, so they can be called from Max.
<Builtin functions>= (<-U) <Define the class of builtin functions> <Define function application on builtin functions>
For builtins, the :mapping slot inherited from function-class is a LISP function.
<Define the class of builtin functions>= (<-U)
(defclass builtin-function (function-class)
((mapping :type function)) ;store a lambda expression
)
Call LISP's apply on the LISP function stored in the mapping slot to determine the return value of a builtin function.
<Define function application on builtin functions>= (<-U)
(defmethod apply-address ((bf builtin-function) arg)
(apply (mapping bf) (list arg))
)
An identity function for a type takes any value in that type and returns the same value.
IDENTITY-FUNCTION below can return an identity function for any type.
LISP defines the function IDENTITY so we use the longer name:
<Identity functions>= (<-U)
(defun identity-function (type)
(make-function 'builtin-function type type
#'(lambda (addr) addr))
)
A pointer encapsulates the concept of state and changing state. Pointers are the only thing that can change. A pointer always contains an address, and we say the pointer refers to, stores, or points at that address. An address can be updated to contain a different address. While an address is a constant, a pointer is a variable.
Recall the situations where an address would be used (section [<-] and compare them to some situations appropriate for pointers:
Currently pointers can point at any address, but there's a fragment of code for ``restricted pointers'' that can only point at a specific type throughout their lifetime. In the near future, pointers will be updated to always be restricted, because we're going to have a type called Object that contains addresses corresponding to every other address. Then to create an unrestricted pointer you can just use Object as the type restriction. That's the theory anyway.
The interface for pointers is intended to contain two elements: read and write. Read is a function, taking a value of the type ``pointers'' and returning a value in whatever type the pointer was restricted to when it was created. Writing a pointer is not a function, since it modifies the pointer. The appropriate abstraction is called a sink. See section [->], Evaluation.
Currently, the interface for pointers is not as described above. That's because sinks are not implemented yet. For now, we have a CHANGE-PTR that takes the place of WRITE. Also, DEREF is used instead of READ. These names more closely match the current semantics of pointers. However, note that in Max names are not the authoritative way to refer to things. As you can guess, the abstraction used for referring to things is an address. One entity can have many names, and to access it you need to find some way to lookup its address given a name. You would probably use a function--or a pointer--for that. Indeed, functions and pointers have a close relationship. We'll soon change the implementation of pointers to use an enumerated function, and CHANGE-PTR to be a wrapper for CHANGE-FUNCTION. However, currently pointers are implemented as an enumerated type.
Here's the overall layout of the pointers module.
<ptr>= <Define the global address to the pointers type> <Follow a pointer> <Create a self-referencing pointer> <Create a pointer to a given address> <Change a pointer to point at a new address> <Define a test fixture for pointers> <Tests for pointers> <Pointers test suite>
<Define a test fixture for pointers>= (<-U)
; Now we'll create a fixture with some values in it..
(def-test-fixture ptrfix ()
(
<Pointers test fixture slots>
)
(:documentation "Fixture for testing pointers")
)
(defmethod setup ((pf ptrfix))
<Pointers test fixture initialization>
)
;(defmethod teardown ((pf ptrfix)) t)
Set up a test suite, test fixture, and fixture initialization method for testing pointers. Tests will be defined as we go through the pointers module.
<Pointers test suite>= (<-U)
(add-test
(make-test-suite
"Pointers Test Suite"
NIL
<Pointers test suite items>
)
max-test-suite
)
There's a global variable, *ptrs*, containing the address of the type of pointers. Test that *ptrs* is a type address.
<Tests for pointers>= (<-U) [D->]
(defmethod ptrs-type ((nf nullfix))
(unless (eq (addr-type *ptrs*) (addr-value *types*))
(failure "The type of *ptrs* is not *types*")
))
<Pointers test suite items>= (<-U) [D->]
("*ptrs* type" 'nullfix :test-thunk 'ptrs-type)
MAKE-TYPE will return the address to a new enumerated type, that will implement all our pointers.
<Define the global address to the pointers type>= (<-U) ; The Pointers (defparameter *ptrs* (make-type))
The following tests demonstrate the interface to pointers. The first two fixture slots contain an enumerated type and a value in it.
<Pointers test fixture slots>= (<-U) [D->]
(atype :accessor atype)
(anaddr :accessor anaddr)
<Pointers test fixture initialization>= (<-U) [D->]
(setf (atype pf) (make-type :key 'TestType))
(setf (anaddr pf) (make-address (atype pf) :key 'TestAddress))
Let's create a new pointer, specifying an initial value, and store its address in a fixture slot.
<Pointers test fixture slots>+= (<-U) [<-D->]
(aptr :accessor aptr)
<Pointers test fixture initialization>+= (<-U) [<-D->]
; Leaving off :key on the next two since they don't support it yet
(setf (aptr pf) (make-ptr (anaddr pf)))
Test that the new pointer is of the correct type (pointers).
<Tests for pointers>+= (<-U) [<-D->]
(defmethod test-make-ptr-1 ((pf ptrfix))
(unless (addr-value-equal
(addr-value *types*)
(addr-type (aptr pf))
(addr-value *ptrs*)
)
(failure "The type of aptr is not *ptrs*")
)
)
<Pointers test suite items>+= (<-U) [<-D->]
("MAKE-PTR 1" 'ptrfix :test-thunk 'test-make-ptr-1)
We'll define MAKE-PTR to follow the behavior used in the test.
MAKE-PTR makes a new pointer that points at the specified address ``addr'', and returns the address of the new pointer, which will be a value in the *ptrs* type.
The values in the pointer type are individual pointers; the implementation-specific datum stored with each value is the address stored in that pointer.
The :restricted keyword argument is currently ignored.
<Create a pointer to a given address>= (<-U)
(defun make-ptr (addr &key restricted)
(make-address *ptrs* :value addr)
)
Test that the new pointer, APTR, created in the previous section correctly stores the value we initialized it with, ANADDR.
<Tests for pointers>+= (<-U) [<-D->]
; Use EQUAL: allow DEREF-PTR to recreate the address
(defmethod test-make-ptr-2 ((pf ptrfix))
(unless (addr-equal (deref-ptr (aptr pf)) (anaddr pf))
(failure "APTR does not point at ANADDR")
))
<Pointers test suite items>+= (<-U) [<-D->]
("MAKE-PTR 2" 'ptrfix :test-thunk 'test-make-ptr-2)
DEREF-PTR takes the address of a pointer, and returns the address that the pointer is storing.
<Follow a pointer>= (<-U)
; Follow a pointer
(defun deref-ptr (ptr)
; return the address pointed at
(nth-value 0 (gethash (addr-value ptr) (type-hash *ptrs*)))
)
Now we know how to create a pointer with an initial address that we provide. What if we don't have an address? Since a pointer must always contain a value, it would be useful to have a function that creates a pointer initialized with its own address, so we can create pointers without needing to specify a parameter.
Someone might want a self-referencing pointer for some other reason, and since it has to be a primitive we'll put it here for completeness and as a demonstration that it can be done.
<Pointers test fixture slots>+= (<-U) [<-D->]
(aselfptr :accessor aselfptr)
<Pointers test fixture initialization>+= (<-U) [<-D->]
(setf (aselfptr pf) (make-self-ptr))
<Tests for pointers>+= (<-U) [<-D->]
(defmethod test-self-ptr ((pf ptrfix))
(unless (addr-equal (deref-ptr (aselfptr pf)) (aselfptr pf))
(failure "MAKE-SELF-PTR failed")
))
<Pointers test suite items>+= (<-U) [<-D->]
("MAKE-SELF-PTR" 'ptrfix :test-thunk 'test-self-ptr)
<Create a self-referencing pointer>= (<-U)
; Make a pointer that refers to its own address,
; i.e. self-referencing.
(defun make-self-ptr ()
; Get address for the pointer
(let* ((addr (make-address *ptrs*)) (key (addr-value addr)))
; Point the pointer at itself
(setf (gethash key (type-hash *ptrs*)) addr)
; Return the address of the new self-referencing pointer
(make-address-form (addr-value *ptrs*) key)
)
)
We mentioned at the beginning of this section that pointers will be able to be changed using a continuation-like structure called WRITE. However, currently we just have CHANGE-PTR. It takes a pointer and an address and modifies the pointer to point at the address. WRITE, when it exists, will actually just be CHANGE-PTR specialized for an individual pointer.
In order to test changing a pointer, we'll need a second address to point APTR to.
<Pointers test fixture slots>+= (<-U) [<-D]
(anotheraddr :accessor anotheraddr)
We'll make ANOTHERADDR as a second value in the enumerated type ATYPE.
<Pointers test fixture initialization>+= (<-U) [<-D]
(setf (anotheraddr pf) (make-address (atype pf) :key 'TestAddr2))
Now change APTR and check if it got changed. Since we want to test the side-effect of CHANGE-PTR, we can't call CHANGE-PTR inside the test fixture initialization. We'll call it inside the test itself, and hope that the test is called after any previous tests that use the initial value of APTR.
<Tests for pointers>+= (<-U) [<-D]
(defmethod test-change-ptr ((pf ptrfix))
(change-ptr (aptr pf) (anotheraddr pf))
(unless (addr-equal (deref-ptr (aptr pf)) (anotheraddr pf))
(failure "APTR does not point at ANOTHERADDR after CHANGE-PTR")
))
<Pointers test suite items>+= (<-U) [<-D]
("CHANGE-PTR" 'ptrfix :test-thunk 'test-change-ptr)
CHANGE-PTR changes the value of ptr (a pointer) to point at addr (an address).
<Change a pointer to point at a new address>= (<-U)
(defun change-ptr (ptr addr)
; Get the address ptr currently points at
(let ((oldaddr (deref-ptr ptr)))
; Type-check if this pointer is restricted
(cond
((and
(eq (addr-type ptr) 'restptr)
(not
(eq (addr-type oldaddr) (addr-type addr))
)
)
(format t "Type mismatch~%")
(return-from change-ptr nil)
)
)
; If ptr already points at addr, we're done
; (typecheck above should be done first, or else
; it would appear that it works to set a restricted pointer
; that was already pointing at what we want, even if the
; types didn't match)
(if (eq addr oldaddr) nil)
; update the ptr
(setf (gethash (addr-value ptr) (type-hash *ptrs*)) addr)
; return nothing
nil
)
)
Booleans are about the simplest possible type you could think of.
<boolean>= <Boolean type definition> <Boolean function definitions> <Tests for booleans> <Boolean test suite>
As usual, we first define some tests and then use the tests to define the implementation.
<Boolean test suite>= (<-U)
(add-test
(make-test-suite
"Boolean Type Test Suite"
NIL
<Boolean test suite items>
)
max-test-suite
)
<Tests for booleans>= (<-U) [D->]
(defmethod boolean1 ((nf nullfix))
(unless (eq (addr-type *boolean-type*) (addr-type *types*))
(failure "The type of *boolean-type* is not the type of *types*")
))
<Boolean test suite items>= (<-U) [D->]
("Type of *boolean-type*" 'nullfix
:test-thunk 'boolean1)
Create an enumerated type to implement booleans.
<Boolean type definition>= (<-U) [D->] (defparameter *boolean-type* (make-type :key 'BOOLEAN)) (add-init-hook #'(lambda () (add-name *boolean-type* "boolean")))
There are only two values: TRUE and FALSE. Their addresses need to be of the boolean type, so test that.
<Tests for booleans>+= (<-U) [<-D->]
(defmethod boolean2 ((nf nullfix))
(unless (eq (addr-type true) (addr-value *boolean-type*))
(failure "The type of TRUE is not *boolean-type*")
))
(defmethod boolean3 ((nf nullfix))
(unless (eq (addr-type false) (addr-value *boolean-type*))
(failure "The type of FALSE is not *boolean-type*")
))
Add all the tests on TRUE and FALSE to the test suite.
<Boolean test suite items>+= (<-U) [<-D->]
("Type of TRUE" 'nullfix
:test-thunk 'boolean2)
("Type of FALSE" 'nullfix
:test-thunk 'boolean3)
Create values in the boolean type for true and false using the interface to enumerated types, MAKE-ADDRESS. Return the addresses, and store those addresses in global variables named TRUE and FALSE. LISP uses T and NIL and doesn't define the more natural names in this case. Booleans are common enough that they don't need *'s around them, hopefully.
<Boolean type definition>+= (<-U) [<-D]
(defparameter TRUE (make-address *boolean-type* :key 'TRUE))
(defparameter GET-TRUE
(make-function 'builtin-function *null-type* *boolean-type*
#'(lambda (ignore-nil) TRUE)
))
(defparameter FALSE (make-address *boolean-type* :key 'FALSE))
(defparameter GET-FALSE
(make-function 'builtin-function *null-type* *boolean-type*
#'(lambda (ignore-nil) FALSE)
))
(add-init-hook #'(lambda ()
(add-public-function get-true)
(add-name get-true "true")
(add-public-function get-false)
(add-name get-false "false")
(add-name true "true")
(add-name false "false")
))
Booleans make a good example for creating new functions. Since we only recently created product types, we haven't yet added any multi-argument functions. There's only two non-trivial single-argument functions on booleans (the trivial ones just return TRUE or FALSE and ignore their argument, so we don't implement those):
<Boolean function definitions>= (<-U) [D->] <Boolean NOT> <Boolean identity>
<Tests for booleans>+= (<-U) [<-D->]
(defmethod domain-boolean-not ((nf nullfix))
(unless (equal (function-apply *domain* boolean-not) *boolean-type*)
(failure "The domain of boolean NOT is not *boolean-type*")
))
(defmethod codomain-boolean-not ((nf nullfix))
(unless (equal (function-apply *codomain* boolean-not) *boolean-type*)
(failure "The codomain of boolean NOT is not *boolean-type*")
))
Since booleans are so simple, we can just test all the cases.
<Tests for booleans>+= (<-U) [<-D->]
; Use EQUAL here instead of EQ because the addresses may get reconstructed
; by the function call, and need not be the same exact list.
; If they contain hash tables, those need to be EQ, which is exactly
; what EQUAL tests. (EQUALP would be wrong)
(defmethod boolean-func1 ((nf nullfix))
(unless (equal (function-apply boolean-not true) false)
(failure "The boolean NOT of TRUE is not FALSE")
))
(defmethod boolean-func2 ((nf nullfix))
(unless (equal (function-apply boolean-not false) true)
(failure "The boolean NOT of FALSE is not TRUE")
))
Add all the tests on Boolean NOT to the test suite.
<Boolean test suite items>+= (<-U) [<-D->]
("Domain of boolean NOT" 'nullfix :test-thunk 'domain-boolean-not)
("Codomain of boolean NOT" 'nullfix :test-thunk 'codomain-boolean-not)
("NOT TRUE" 'nullfix :test-thunk 'boolean-func1)
("NOT FALSE" 'nullfix :test-thunk 'boolean-func2)
Now the actual definition that you've all been waiting for. MAKE-FUNCTION doesn't use any keyword arguments, so take care with the order of the 5 arguments (or just copy this definition when you create a new enumerated function).
<Boolean NOT>= (<-U)
(defparameter boolean-not
(make-function 'enumerated-function *boolean-type* *boolean-type*
(function-values
'(true . false)
'(false . true)
)
'BOOLEAN-NOT
)
)
(add-init-hook #'(lambda ()
(add-public-function boolean-not)
(add-name boolean-not "not")
))
Boolean identity needs two types, a domain and a codomain:
<Tests for booleans>+= (<-U) [<-D->]
(defmethod domain-boolean-id ((nf nullfix))
(unless (equal (function-apply *domain* boolean-identity) *boolean-type*)
(failure "The domain of boolean identity is not *boolean-type*")
))
(defmethod codomain-boolean-id ((nf nullfix))
(unless (equal (function-apply *codomain* boolean-identity) *boolean-type*)
(failure "The codomain of boolean identity is not *boolean-type*")
))
It also needs two key/value pairs:
<Tests for booleans>+= (<-U) [<-D]
(defmethod boolean-func3 ((nf nullfix))
(unless (equal (function-apply boolean-identity true) true)
(failure "The boolean identity of TRUE is not TRUE")
))
(defmethod boolean-func4 ((nf nullfix))
(unless (equal (function-apply boolean-identity false) false)
(failure "The boolean identity of FALSE is not FALSE")
))
Add all the tests on Boolean IDENTITY to the test suite:
<Boolean test suite items>+= (<-U) [<-D]
("TRUE identity" 'nullfix :test-thunk 'boolean-func3)
("FALSE identity" 'nullfix :test-thunk 'boolean-func4)
("Domain of boolean identity" 'nullfix :test-thunk 'domain-boolean-id)
("Codomain of boolean identity" 'nullfix :test-thunk 'codomain-boolean-id)
Since we can't automatically build this type definition from the above tests yet, we have to manually specify it!
<Boolean identity>= (<-U)
(defparameter boolean-identity
(make-function 'enumerated-function *boolean-type* *boolean-type*
(function-values
'(true . true)
'(false . false)
)
'BOOLEAN-IDENTITY
)
)
(add-init-hook #'(lambda ()
(add-public-function boolean-identity)
))
Return the appropriate Max boolean value depending on whether the given LISP function evaluates to NIL or non-NIL.
TODO: rewrite as a macro
<Boolean function definitions>+= (<-U) [<-D->]
(defun boolean-cond (lisp-func)
(if (funcall lisp-func) TRUE FALSE)
)
<Boolean function definitions>+= (<-U) [<-D]
(add-init-hook #'(lambda ()
(let ((boolean-and (make-function 'builtin-function
(type-product *boolean-type* *boolean-type*)
*boolean-type*
#'(lambda (twobools)
(let ((vals (product-values twobools)))
(boolean-cond #'(lambda ()
(and
(addr-equal TRUE (first vals))
(addr-equal TRUE (second vals))
)
))
)
)))
(boolean-or (make-function 'builtin-function
(type-product *boolean-type* *boolean-type*)
*boolean-type*
#'(lambda (twobools)
(let ((vals (product-values twobools)))
(boolean-cond #'(lambda ()
(or
(addr-equal TRUE (first vals))
(addr-equal TRUE (second vals))
)
))
)
)))
)
(add-public-function boolean-and)
(add-public-function boolean-or)
(add-name boolean-and "and")
(add-name boolean-or "or")
)
))
They contain values, which are of the type specified when the set was created. Types are not checked here (all typechecking is in the evaluation module).
Every set has an address in the type of sets *set-type*. Since a
pointer is the only thing that can change, sets are static. To "edit"
a set, you create a new set based on the old one and change a pointer
somewhere to point at the new set.
This module currently only implements finite sets. Later iterations will certainly implement sets that contain a possibly-infinite number of addresses.
<set>= <Implement the set type> <Operations on sets> <Relations>
Tests: We need to write some tests for sets. However, it's not a high priority because I believe this implementation is rather straightforward and likely to be correct.
Since there are an infinite number of possible sets, and there is no limit on the number of items in a set, a set's address may consume a variable amount of type. The contents of the set are stored in the address's value field as a hash table. The hash table is used because it is setlike: an unordered collection with keys occurring at most once. The hash values will be NIL since we don't need them. Another thing we don't need is the mutability of LISP's hash tables. The hash tables are never modified, instead they are copied when constructing a new set based on an old one.
<Implement the set type>= (<-U) <Define the class implementing the type of sets> <Create the global address for the type of sets> <Define comparison for two set addresses> <Define the format of a set address> <Define accessor for the hash table implementing a set> <Define accessor for the type of items in a set>
Define a new class to implement the type of sets, because they're different from other types.
<Define the class implementing the type of sets>= (<-U)
(defclass set-type (type)
nil
)
Create the type of sets and assign its address to the global *set-type*.
This is probably going to be the only instance of class set-type.
<Create the global address for the type of sets>= (<-U) (defparameter *set-type* (make-type :class 'set-type :key 'SET)) (add-init-hook #'(lambda () (add-name *set-type* "sets")))
Define how set address values are compared for equality. Two set addresses should be equal iff the sets they describe are set-equal:
<Define comparison for two set addresses>= (<-U)
(defmethod addr-value-equal ((s set-type) a b)
(set-equal a b)
)
The format of a set address: The type is sets, and the value is a dotted pair of the type to be stored in the set and a hash table with hash-keys being the Max values in the set, and hash-values being NIL.
<Define the format of a set address>= (<-U)
; Create a set address with hash table h
(defun make-set-helper (type h)
(make-address-form (addr-value *set-type*) (cons (addr-value type) h))
)
Given a set address, get its hash table
<Define accessor for the hash table implementing a set>= (<-U)
(defun set-implementation (setaddr)
(cdr (addr-value setaddr))
)
<Define accessor for the type of items in a set>= (<-U)
(defun set-type (setaddr)
(make-address-form (addr-value *types*) (car (addr-value setaddr)))
)
Return the empty set. We'll depart from the practice seen in other modules of creating a global variable for common values in a type. This was originally because we did modify the hash tables in a set, but providing a function to return a common value is not a worse approach. The philosophy in Max is that every value is the result of calling some function. It makes little difference if we provide the value or the function because we'll be able to obtain one from the other. When we have the function, we can call it to get the value. When we have the value, we can use introspection to find out where it came from. It makes some sense to consider functions primitive, though. Bucky Fuller believed that verbs are primitive and nouns are just an illusion, since everything is continuously changing anyway. This is not a bad belief to have when dealing with a reflective system.
Here's the LISP function:
<Function returning the empty set>= (U->) [D->]
(defun get-empty-set (&optional (type *objects*))
; return the empty-set address
(make-set-helper type (make-hash-table :test 'equalp))
)
Now we create a Max function as a builtin that returns the empty set.
<