Page 1 of 1

Lisp type system, lang-lisp

Posted: Fri Mar 13, 2009 3:20 pm
by Jasper
As i have already stated i am working on a language i call lang-lisp(thusfar). I am starting this thread fishing for some comments. At the heart of the language is types, and the idea that they can be done better. Secondly is the idea that the language should be flexible enough to be able to express peoples idea in a library, firstly because that is the way it should be, and secondly because it relieves a lot of pressure of not having to bother with every idea out there, just whether you can make a library that creates the language feature. (For instance, i read a little about design patterns, and they seem to be ideas which the language doesn't make you able express.)
Of the language Common Lisp, i find the worst flaw it's type system. For instance, +,-,/,* are functions, not methods. You can't extend them with:

Code: Select all

(defmethod + ((a vector) (b vector))
  (let ((len (min (length a) (length b)))
         (out (make-array (list len))))
     (do ((i 0 (+ i 1))) ((>= i len) out) (setf (aref out i) (+ (aref a i) (aref b i))))
These operators seem to arbitrarily be different to then the regular functions.

Note also that the type could not handle the length of the vectors. You either need to let lisp store length explicitly, or make a new object for each length. Then, lisp also has to look up the length. In this case lisp might optimize this, but the user does not have confidence that it will. Furthermore, there are cases where some elements of a struct/class is 'eql' to something, and The object should be treated like that; not checking around what that object is, not dragging the data around.

So how to fix this? Since common lisp does not have these types itself, macros can't do it.(Besides ones that practically create a whole new language.) I suggest functional types; types depending on arguments, which are defined with (basically) one macro which takes arguments as following:

Code: Select all

(struct name (&rest arguments) &rest elements)
Where elements are: (element-name element-type &rest other-stuff-here) Where for the other stuff i think stuff like :initform, :derive(pass on functions to take this argument instead of the whole struct, class derivation-like) :reader, :writer,: accessor. Maybe :set :get functions that replace ordenary getting and setting.

Types are written with s-expressions, any symbol that is not the first element of a list is a variable in it. Some types have to be defined as atoms, like (int64), (int32), (ptr of-type), (eql 3)
For instance, with this you make a list with the following:

Code: Select all

(struct listnode (item-tp)
   (item item-tp)
  (next (ptr(list-node item-tp))))
Functions are all overload(able), chosen by using the function that matches with the most specific type. As you might know, that this is ambiguous by itself, you also need a preference. The preference is used when two functions are applicable with equal specificness, you choose the one with the more specific part leftmost, the earlier argument of a type.

Of course, if you have function overloading, you can choose macros the same way, caveit is that the macro might change the result.

I should say more about specificness and how it is defined. Unmodified, A is more general then B if the variables in A can be set in such a way that the results equals B. However, for some things there are modifications, like (any) which is more general then anything else. (number) and other numbers.
Another override i would like is conversion functions, which would make A more general then B if it can be converted as well. However, i have not succeeded at this yet, currently the generality of numbers is 'manual', like (any).

A simple example of a function in lang-lisp:

Code: Select all

(defun sqr :define-as-needed ((x (number))) (* x x))
Here :define-as-needed means that it will create a new function in binary for each type of number it means. if it is (int32) it will produce (int32), (safe-int32) or maybe (safe (int32)) could be used if you want to prevent overflows.(So types can take over the role of optimisation of code upto an extent as well) I am still unsure about numbers in general, maybe i need to use intervals in types of numbers. (That way the user can also give more info on the functions; to which intervals they map; for instance [a,b] maps to [0, max(abs(a),abs(b))^2])

All in all, i have to admit that i still need to figure this out more. I think typed lambda calculus might help, i think i will try learn about it. Also making some proofs of stuff in the hopes of clarifying things for myself and just for being a fancypants.

So i would like to hear some responses on the idea of types, and what it would take for a language to be efficient and able to change to many forms by adding libraries.

PS been a little slow on my lang-lisp project lately because i was messing with a loop/iterate -like macro. I should kill the ideas i had on how to do the macro with fire, i might try make a post about that on my conclusion. (And macros with ideas regarding a loop-like macro.)

Re: Lisp type system, lang-lisp

Posted: Sat Mar 14, 2009 6:28 pm
by nuntius
Learning lisp can be a wonderful experience; it tends to blow your mind with possibilities. Unfortunately, a common response is to head off exploring those ideas before fully learning what CL offers. Beginners often get lost reinventing the wheel, rather than simply leveraging CL to write interesting software.

Related projects:
http://www.lambdassociates.org/
http://ecls.sourceforge.net/

and related ideas:
http://www2.parc.com/csl/groups/sda/pro ... guide.html
http://www.haskell.org/

As far as Lisp's type system, its richer than you indicate. For example, the ARRAY type specifier is given in the CLHS as

Code: Select all

array [{element-type | *} [dimension-spec]]
dimension-spec::= rank | * | ({dimension | *}*) 
So (array 'single-float (3 4)) indicates a 3x4 array of single-floats.


As for CL:+ its not hard to

Code: Select all

(defpackage :generic-cl (:use :cl) (:shadow :+ :- :* :/))
(in-package :generic-cl)
(defgeneric + *magic-lambda-list*)
...

The problem is now to define *magic-lambda-list* such that the standard lisp overloads still dispatch properly. (- 1), (- 1 2), (- 1 2 3), ...
It should be something like

Code: Select all

(defgeneric - (x &optional y &rest rest))
but you can't specialize on &optional or &rest parameters...

Another downer is that CLOS specializers don't directly allow

Code: Select all

(defmethod + ((x (array 'single-float (2 2))) (y (array 'single-float (2 2))) ...)
You could try

Code: Select all

(defstruct (single-float-2-2 (:conc-name sf22-))
  (mat (make-array '(2 2) :element-type 'single-float) :type (array 'single-float (2 2))))
(defmethod + ((x single-float-2-2) (y single-float-2-2)) ...)
but that's certifiably ugly (though hideable in a macro). Unfortunately, CLOS was designed to exclude ambiguities rather than introduce complex rules to resolve them...
http://groups.google.com/group/comp.lan ... ceba4bf4c6

But OOPing the algebraic ops has other problems outside of CLOS.

One revelation is that overloading scalar algebraic ops for vector and matrix types is "the wrong thing" anyway.
Given x=[1 2 3], should x-transpose(x) succeed or fail? Is x*x an elementwise multiply, a dot product, or a cross product?
The right thing is to define more specific operators such as (elementwise* x y), (inner* x y), and (outer* x y) since type dispatch is insufficient to distinguish the intended behavior.

Another revelation is that matrix algebra should not be performed op-by-op. Efficient calculation requires loop unrolling across operations. For example, many libraries add three arrays X=A+B+C as X=(A+B)+C; but this wastes a temporary array and an extra traversal. The correct solution is to allocate X and iteratively assign Xij=Aij+Bij+Cij. Yet another reason the "straightforward" extension of +-*/ to matrices is wrong.


If your favorite lisp implementation does not properly optimize things, choices include fixing it yourself (through compiler macros, by editing the implementation itself, or by writing an optimized library), asking the developers to fix it, and switching implementations. All of these are easier than writing a new lisp implementation...

Re: Lisp type system, lang-lisp

Posted: Sat Mar 14, 2009 7:42 pm
by gugamilare
I will agree with nuntius. I had the intention of writing something like he said, but I didn't know how to do it without being too agressive, and I think nuntius have done that well. Just complementing what nuntius said, instead of using

Code: Select all

(defun sqr :define-as-needed ((x (number))) (* x x))
You might just want to say

Code: Select all

(declaim (inline sqr))
and define sqr the usual way. This will make you lisp optimize your code for the type you are using, and will have about the same trade of space (of defining the same function many times) for speed. Or you can declare it inline locally, as the need for real optimization arrives.

And it looks like you also would like to be able to "sum" more kinds of things, but defining the operators, e.g. +, have their drawbacks as well.

The first drawback is portability. You create an extension to manipulate matrices, and define the + to matrices. Then I create another library which implements symbolic computations, and include, maybe because it needs, some more simple computations with matrices as well, including another version of + to matrices. Then some user will load your lib and then load mine, and the definitions I made might break you code, since they are incompatible definitions of the same methods with same specializers.

The second one, less of an issue in most cases, is efficiency. It may be possible to optimize generic functions, but it will surely not be so easy, since an user might want to define some :around methods for sum of fixnums, which will slow things down. And, if I understood you idea, efficiency is one of the purposes of your lib.

If you want to operate on matrices and such, try looking for some libraries. I can't give you advices here since I don't use matrices, but I'm sure you can find a library that you like.

Anyway, Jasper, my advice is that you keep learning and try to learn the usual way of doing what you want to do, make some tests, try different angles and see if what you think is a problem is really a problem or just not knowing how to do it the right way.

Re: Lisp type system, lang-lisp

Posted: Sun Mar 15, 2009 6:51 am
by Jasper
Thanks for the response. I knew of Haskell and ECL, links. Haven't learned Haskel yet (got scared away by notation). Still, i need to read stuff.
nuntius wrote:One revelation is that overloading scalar algebraic ops for vector and matrix types is "the wrong thing" anyway.
It certainly is if people conflate inproduct with multiplication. Matrix 'multiplication' is more inproduct then multiplication. I have regularly used a macro v* (like)

Code: Select all

(defmacro v* (a &rest b)  '(method* ,a (v* ,@b)))
As long as all the input in b are scalars, this is alright. Also for addition, that also really has to be addition, not something else. (Like appending)
nuntius wrote:Another revelation is that matrix algebra should not be performed op-by-op. Efficient calculation requires loop unrolling across operations. For example, many libraries add three arrays X=A+B+C as X=(A+B)+C; but this wastes a temporary array and an extra traversal.
On the other hand, optimization should probably catch that. Also, you can't do this optimization easily while still using CLOS? Unless you make '*-3el '*-4el methods. (Btw, i guess i made this mistake)
nuntius wrote:but that's certifiably ugly (though hideable in a macro). Unfortunately, CLOS was designed to exclude ambiguities rather than introduce complex rules to resolve them...
The selection of function based on the preference (rather then specificness) would certainly be something that should be avoided.(Unless the functions are really just different versions of the same.)
The issue of ambiguousness disappears if types took only one argument, unless it is a primitive, then take two arguments. This seems limited but can be expanded by putting the next argument 'at the ends'.
Lets be more specific, let (atom [type-name] [next-element]) be a primitive element, and (any [type] [next-element]) be an arbitrary element with some arbitrary type. next element gives the next element(none if nil), of course. Now we can make a pair the following way: (If i had made a macro in the types.)

Code: Select all

(defmacro-in-types pair (a b) '(any ,a (any ,b nil))
If you define A more specific then B when the first encounter of 'any' in B is earlier then that of A, then you have defined it the same way as lang-lisp would on pair. Maybe stack-language-like (all untested so i fear incorrectness)

Code: Select all

:make-type pair nil any any
The stack at start is {a,b}, add nil -> {a,b,nil} take off two for 'any -> {a, (any b nil)} again -> {(any a (any b nil))}.
My point of this, of course, is that the preference added to the specificness might seem complicated, but it is also very natural.

@gugamilare: In my language, :define-as-needed and :inline are two different things; the first one inlines. The second one is only for functions of which more specific versions could be made, :define-as-needed creates a function taking exactly the types that are provided when if finds a function. This more specific function is based on the more general one which has a :define-as-needed flag. (I shouldve called it :specify-as-needed)
gugamilare wrote:The first drawback is portability. You create an extension to manipulate matrices, and define the + to matrices. Then I create another library which implements symbolic computations, and include, maybe because it needs, some more simple computations with matrices as well, including another version of + to matrices. Then some user will load your lib and then load mine, and the definitions I made might break you code, since they are incompatible definitions of the same methods with same specializers.
Just explicitly choose which one is desired, or make a good complete standard library, so people don't try define those basic things.

Perhaps i should show how useful having 'functional' types (like C++ templates, but better) is. For instance you could make a vector -as-in math. (I assume it is fully-fledged not in lang-lisps current state)

Code: Select all

(struct vect (number (dimension (integer)))
  (el (array number (list dimension)))) ;components

(defun + ((a (vect number-a dim)) (b (vect number-b dim)))
  (let ((out (make-vect dim)))
    (do-times (i dim) (set (aref out i) (+ (aref a i) (aref b i)))))))
So basically that would make a vector for any future numerical type that will ever exist. Also do-times doesn't need to loop (raw macros can see types; can see if the dimension is a constant, variable.(Like (int) ) You can now take information right out of the type specification as if they are arguments as well.

For optimisation it helps too, no more (the .. ..) to keep it from converting to more general number types, just start with a number type that does it. No more declare; you don't even need to specify types, just add :specify-as-used.

I still think lisp needs functional types, but i have to digest things a lot more. Thanks for the reading material, and without posting this i wouldn't have gotten the idea of looking at functional types from a stack-language perspective.

Re: Lisp type system, lang-lisp

Posted: Sun Mar 15, 2009 11:11 am
by gugamilare
Jasper wrote:@gugamilare: In my language, :define-as-needed and :inline are two different things; the first one inlines. The second one is only for functions of which more specific versions could be made, :define-as-needed creates a function taking exactly the types that are provided when if finds a function. This more specific function is based on the more general one which has a :define-as-needed flag. (I shouldve called it :specify-as-needed)
Yes, I get this difference. The thing is, in practice, in my opition at least, the functions which would actually benefit with this feature are simple enough to actually need this key :define-as-needed will be small enough so that they would do much better inlined - it avoids a function call. And, by inlining code, you let any implementation to manipulate your code to produce code optimized for the types you are using. For more complex things, the code for each type of thing will be different anyway so that you will have to use generic functions, and if speed is really critical, you can create a compiler-macro which uses a generic function to produce faster code, just like cffi does.
Jasper wrote:
gugamilare wrote:The first drawback is portability. You create an extension to manipulate matrices, and define the + to matrices. Then I create another library which implements symbolic computations, and include, maybe because it needs, some more simple computations with matrices as well, including another version of + to matrices. Then some user will load your lib and then load mine, and the definitions I made might break you code, since they are incompatible definitions of the same methods with same specializers.
Just explicitly choose which one is desired, or make a good complete standard library, so people don't try define those basic things.
No, you didn't really get it, this is not enough. In the example, the definition I made (in my lib) would be the only one to exist. When some function inside your lib try to sum two matrices, it would end up calling the methods I defined in my lib, because the method itself is overwritten.
Maybe an explicit example would explain what I mean.

Code: Select all

;;; Suppose this is the code for your lib.
(defmethod my+ ((a vector) (b vector))
  (let* ((len (length a))
         (vec (make-array len)))
    (dotimes (i (array-dimension a 0))
      (setf (aref vec i) (+ (aref a i) (aref b i))))))

;;; Then, some internal function of your lib needs your definition of my+
;;; This example is too simple, but just to explain how things would work
(defun print-sum (a b)
  (print (my+ a b)))

;;; For now you lib works
(print-sum #(1 2 3) #(1 2 3))

;;; Now this is my (strange) lib definiton of my+
(defmethod my+ ((a vector) (b vector))
  (let* ((len (length a))
         (vec (make-array len)))
    (dotimes (i (array-dimension a 0))
      (setf (aref vec i) (- (aref a i) (aref b i))))
    vec))

;;; Try evaluating this at the REPL then:
(print-sum #(1 2 3) #(1 2 3))
The only way to fix this is to explictly make two different functions, one for my lib and other for your lib, both bound to the same symbol "+" but each one in a different package. But that Common Lisp can already do, and that works much better than your version.
Jasper wrote:Perhaps i should show how useful having 'functional' types (like C++ templates, but better) is. For instance you could make a vector -as-in math. (I assume it is fully-fledged not in lang-lisps current state)

Code: Select all

(struct vect (number (dimension (integer)))
  (el (array number (list dimension)))) ;components

(defun + ((a (vect number-a dim)) (b (vect number-b dim)))
  (let ((out (make-vect dim)))
    (do-times (i dim) (set (aref out i) (+ (aref a i) (aref b i)))))))
So basically that would make a vector for any future numerical type that will ever exist.
And how exactly wouldn't this be the truth for CL? I mean, except that you name the sum of two vects with the same symbol cl:+, but, again, like nuntis you can define it with mat-lib:+ and extend it to be exactly the way it would otherwise be used.
Jasper wrote:Also do-times doesn't need to loop (raw macros can see types; can see if the dimension is a constant, variable.(Like (int) )
If I understand it correctly, that is called loop-unrolling and is very well-known among compiler designers (including gcc and probably SBCL, though I never checked this. But that only works for small constants, otherwise the code generated can be too large to be unrolled.
Jasper wrote:You can now take information right out of the type specification as if they are arguments as well.
For optimization it helps too, no more (the .. ..) to keep it from converting to more general number types, just start with a number type that does it. No more declare; you don't even need to specify types, just add :specify-as-used.
I think that here you are implying that your lisp would be able to correctly derivate types of results. What I mean is that the sum of two fixnums is not necessarily a fixnum. It is always an integer, true, but there is no way to fully optimize away sum of wo integer. The least it would need is a test and a jump to go to the correct code. But most current CL implementations will not do this when you declare the sum of two fixnums to produce a fixnum - they will just do the sum.

Remember that sum of two numbers should always be inlined (the same is not true to sum of two vectors or matrices), because it is will appear in critical parts of any code, always.

Just to give a few examples, MATLAB implements sum for matrices the same way that sum for numbers. But matlab is interpreted, since the critical part of it - which is doing the internal routines - is written in hand-optimized C.

And python, as much as I know, let you redefine the sum, which will make the sum of two numbers always need to produce a function call. But, again, python is interpreted, it won't be used to critical speed applications.
Jasper wrote:I still think lisp needs functional types, but i have to digest things a lot more. Thanks for the reading material, and without posting this i wouldn't have gotten the idea of looking at functional types from a stack-language perspective.
In CL there are functional types, but you know that, right?

Code: Select all

(declare (type (function (fixnum fixnum) integer) my-sum))
Anyway, I still think you should learn more CL (or scheme or clojure if you rather) before doing trying to do this. Not trying to "methodify" every single function is what makes CL very good for almost any kind of application. And CL was created from a group of experienced lispers, many already very experient about creating optimized compilers. You really think that you alone can come up with a better language? Well, you don't harm anyone about thinking whatever you want, but that won't make it true. This kind of idealization comes to the mind of anyone who is still learning, including me, and many people I know.

Your ideas are very good to generalize mathematic operations, for instance, but would most likely fail otherwise. I am sure that, if instead of trying to make a whole new lisp, you just create a set of macros and generic functions in a specific package for a math lib, you will do much better. If you test other libs and even this way still think yours has some extra features the others don't, you can release it.

Re: Lisp type system, lang-lisp

Posted: Mon Mar 16, 2009 2:43 pm
by Jasper
gugamilare wrote:The only way to fix this is to explictly make two different functions, one for my lib and other for your lib, both bound to the same symbol "+" but each one in a different package. But that Common Lisp can already do, and that works much better than your version.
I can do exactly the same thing as common lisp does. Currently i have a sort of namespace system, but i do think what i have currently is not good enough. In any case the problem of namespaces/packages is independent to the main goal of lang-lisp. Currently figuring out how to do stuff and getting a "hello world" program is more important.
gugamilare wrote:I think that here you are implying that your lisp would be able to correctly derivate types of results. What I mean is that the sum of two fixnums is not necessarily a fixnum. It is always an integer, true, but there is no way to fully optimize away sum of wo integer. The least it would need is a test and a jump to go to the correct code. But most current CL implementations will not do this when you declare the sum of two fixnums to produce a fixnum - they will just do the sum.
If you ask for some safe type, the resolver will try to find the intervals the value is in and use C-like integers if it is faster. If you ask for just an unsafe number type, the resolver will have some simple rules for them, and not check for bounds at all. Then it is C-like programming. That is the plan, at least.
gugamilare wrote:In CL there are functional types, but you know that, right?
AFAIK and AFAICS, only for stuff that is in common-lisp itself. If not, show me how to make a real functional type of your own.
gugamilare wrote:Not trying to "methodify" every single function is what makes CL very good for almost any kind of application.
A function name with only one defmethod might aswel be a defun with type checking.
gugamilare wrote:Your ideas are very good to generalize mathematic operations, for instance, but would most likely fail otherwise.
I have been thinking about using it for checking mathematical theorems, if it is given steps by user. (And maybe very limitedly, finding some steps.) This job has a lot in common with optimization, here too you find equivalences. The difference is that in compilers, you want to find something equivalent to the written code, that also maximizes some utility function based on memory usuage and cpu usuage. (Although it is probably more tricky then just those two.)
gugamilare wrote:Anyway, I still think you should learn more CL (or scheme or clojure if you rather) before doing trying to do this.
I should. At the very least i should see how common-lisp itself works with types. Currently it seems like it keeps the workings of the types to itself too much.
gugamilare wrote:For more complex things, the code for each type of thing will be different anyway so that you will have to use generic functions, and if speed is really critical, you can create a compiler-macro which uses a generic function to produce faster code, just like cffi does.
Don't really get what you mean here, as i said i should learn some more. But that this works, does not mean that the way lang-lisp would do it is worse.

Re: Lisp type system, lang-lisp

Posted: Mon Mar 16, 2009 4:39 pm
by gugamilare
Jasper wrote:Don't really get what you mean here, as i said i should learn some more. But that this works, does not mean that the way lang-lisp would do it is worse.
You can see this in CFFI's documentation (compile-to-foreign and compile-from-foreign generic functions).

Anyway, I won't insist in this subject anymore. Do everything as you like, and I wish the best of luck for you.

Re: Lisp type system, lang-lisp

Posted: Tue Mar 17, 2009 7:05 am
by Jasper
Good, i mean, i whine on and on forever ;)

Seriously though, i need to learn and either improve the case for the suggested type system or learn why it isn't a good idea; otherwise the discussion won't go anywhere anyway.

An other type system.

Posted: Thu Apr 16, 2009 1:17 pm
by Jasper
In the spirit of actually trying to make a better lisp, and promoting discussion about it, i post my new approach here. I like it for its simplicity. (also relative to the previous one.) Note that the code are just examples, you don't need to read/check all of it, as long as you get the gist. (which you should be able to get from the text.)

I have been implementing and looking into another way of doing types. This way ditches of choosing based on generality, but i think some form of CLOS-like capabilities should be possible.(And maybe even better then the old idea.) The idea is to allow the user(and the language itself) to make functions that determine the resulting type of functions, overriding what would else be the type determination.
  • Has type determining function -> use, have type.
  • Doesnt have type function -> evaluate code of function, using type determining functions of functions used.(And using results already calculated in the same way)
For instance say we have the multiplication function #'*, with little math you can determine to what interval two intervals multiply to.

Code: Select all

(defclass interval ()
  ((fr :initform 0 :initarg :fr :type number :accessor fr)
   (to :initform 0 :initarg :to :type number :accessor to)))

(defun mk-interval (fr to)
  (make-instance 'interval :fr fr :to to))

(defmethod multiply ((a number) (b interval))
  (with-slots (fr to) b
    (if (> a 0)
      (mk-interval (* a fr) (* a to))
      (mk-interval (* a to) (* a fr)))))

(defmethod multiply ((a interval) (b number))
  (multiply b a))

(defmethod multiply ((a interval) (b interval))
  (let ((ff (* (fr a) (fr b))) ;TODO this is the easy crude way.
	(ft (* (fr a) (to b)))
	(tf (* (to a) (fr b)))
	(tt (* (to a) (to b))))
    (mk-interval (min ff ft tf tt) (max ff ft tf tt))))

(defun type-to-set (type)
  (case (car type)
    (|eql|    (cadr type))
    (|number| (mk-interval (cadr type) (caddr type)))))
And then attach this to the function:

Code: Select all

(defun set-to-type (set)
  (cond
    ((numberp set)
     `(|eql| ,set))
    ((eql (type-of set) 'interval)
     `(|number| ,(fr set) ,(to set)))))

(defun op-number (types op)
  (if (null (cdr types))
    (car types)
    (cons (set-to-type (funcall op (to-set (first types))
				   (to-set (second types))))
	  (cddr types))))

(lang:fun-add *local* '* :names '(:usual *) ;thing from the lang project
  :out-type-fn (lambda (fun types)
		 (declare (ignored fun))
		 (op-number types #'multiply)))
Now, one might say that in reality, this is naive, the numbers would stay in only a subset of the 'predicted' set, and you'd be right. For instance it does not account for (= x x) in (* x x). However, one could make a compiler macro that automatically converts this to the square function, #'sqr, and give that function the correct estimate:

Code: Select all

(defgeneric sqr (x))

(defmethod sqr ((x number))
  (* x x))

(defmethod sqr ((x interval))
  (with-slots (fr to) x
    (let ((fr2 (sqr fr))
	  (to2 (sqr to)))
      (if (> fr 0)
	(mk-interval fr2 to2)
	(if (< to 0)
	  (mk-interval to2 fr2)
	  (mk-interval 0 (max to2 fr2)))))))

(lang:fun-add *local* 'sqr ;Again lang project function.
  :args-code '(x) :body-code '(* x x)
  :out-type-fn (lambda (fun types)
		 (declare (ignored fun))
		 (set-to-type (sqr (type-to-set (car types))))))
With this scheme, regular and compiler macros can also have access to types, and hopefully, it is complete. Since it deals with both types and macros. (I don't see any way how to explore with math whether i can disprove that it is [in]complete in some way.)

With getting the types (Type inference is the wrong word, it is basically always told what the type is by the type-functions.) it can cut short many functions, for instance (defun abs (x) (if (< x 0) (- x) x)) should be 'cut short' if the intervals x is on are either entirely smaller or larger then zero.
If this ability is good, you can get CLOS-like abilty by allowing definition as (defun abs (x) (if (> x 0) x (undefined))) (extend-after #'abs (x) (- x)) basically, instead of saying which types it is for, you place the logic what the type is in the code, and the language then has some guarantees of using types it gets to cut to the chase and get the objects. #'extent-after would fill in the (undefined) bits, and #'extend-before would put the existing stuff in the (undefined) bits of it. (Of course, the arguments bit must always be the same.)

Of course there are some doubts/challenges in my mind here:
  • If things spoil obtaining the types, the whole logic bit of CLOS would be run-time. (I think this is probably easily avoided, though.)
  • The out-type-getting function is opaque once it is set. (Of course, you can reason about those you yourself have created.)
  • Nothing really dictates how the type specification actually works, although in my mind it is really strictly defined as 'functional types'. Have not worked out how structures should work, although it might be a good idea to treat structures in a way that might strike people as weird though, as dynamic variables can do it's job, at least in part. (#'defvar, #'defparameter) Especially when the language has references. It also depends on how hard it is to optimize these though.
  • The way the response to types works right now uses clos, maybe the type resolving system should have a bunch of different functions triggered by a bunch of different types. On the other hand, the way of extending functions is a solution to that. Also, no OR type yet.
  • I feel 'intervals' are not enough, for some types of numbers it should be an interval with desired precision. Also plenty of number types are uncovered, fractions with the divisor (eql some-integer) should be interesting for fixed-point simulations.
I should add that how the binary is chopped up into functions doesn't really have to relate to how the functions were defined, as long as the behavior is as it is defined. Although i think that if one explicitly states a function inline or such, it should follow that. (Maybe implementations should have gradations of following the standard, if it does not always follow stuff like inline <language-name> standard compliant minus inline.)