Some limited dylan snippet code.

limited.dylan

module: limited

define class <some-thing> (<object>)
  slot foo :: <integer>, init-keyword: foo:;
end class;

define method limited-instance? (obj :: <some-thing>, limited-type :: subclass(limited(<some-thing>)))
  => (result :: <boolean>)
  format-out("limited-instance?(%=, %=)\n", obj, limited-type);
  force-output(*standard-output*);
  let limitations /* <simple-vector> of: <pair> */ = type-limitations(limited-type);
  
  local method check-limit (limitation :: <symbol>, value :: <integer>)
          select (limitation)
            #"max" => obj.foo <= value;
            #"min" => obj.foo >= value;
            otherwise => #f;
          end select;
        end method;
  
  let result = block (return)
                 for (limitation in limitations)
                   let limit-key :: <symbol> = head(limitation);
                   let limit-value :: <integer> = tail(limitation);
                   if (~ check-limit(limit-key, limit-value)) return(#f); end;
                 end for;
                 
                 return(#t);
               end;
  
  result;
end method;

define method limited-subtype? (limited-super-type :: subclass(limited(<some-thing>)),
                                limited-sub-type   :: subclass(limited(<some-thing>)))
  => (result :: <boolean>)
  format-out("limited-subtype?(%=, %=)\n", limited-super-type, limited-sub-type);
  force-output(*standard-output*);
  let super-limitations = type-limitations(limited-super-type);
  let sub-limitations   = type-limitations(limited-sub-type);
  
  local method check-limit (limitation :: <symbol>,
                            super-value :: <integer>,
                            sub-value :: <integer>)
          select (limitation)
            #"max" => sub-value <= super-value;
            #"min" => sub-value >= super-value;
            otherwise => #f;
          end select;
        end method;
  
  block (return)
    for (super-limitation in super-limitations)
      let super-limit-key :: <symbol> = head(super-limitation);
      for (sub-limitation in sub-limitations)
        let sub-limit-key :: <symbol> = head(sub-limitation);
        if (sub-limit-key == super-limit-key)
          let super-limit-value :: <integer> = tail(super-limitation);
          let sub-limit-value :: <integer> = tail(sub-limitation);
          if (~ check-limit(super-limit-key, super-limit-value, sub-limit-value) )
            return(#f);
          end if;
        end;
      end for;
    end for;
    
    return(#t);
  end;
end method;

/* TODO how to do custom setters?

define method foo-setter(new-foo :: <integer>, some-thing :: <some-thing>, #next next-method)
  => (foo :: <integer>)
  format-out("normal foo-setter(%=, %=)\n", new-foo, some-thing);
  force-output(*standard-output*);

  next-method();
end method;

define method foo-setter(new-foo :: <integer>, some-thing :: limited(<some-thing>), #next next-method)
  => (foo :: <integer>)
  format-out("limited foo-setter(%=, %=)\n", new-foo, some-thing);
  force-output(*standard-output*);
  let limitations = type-limitations(some-thing);
  
  local method check-limit (limitation :: <symbol>, value :: <integer>)
          select (limitation)
            #"max" => if (new-foo > value) error("Value %d for foo exceeds limit for %=.", new-foo, some-thing) end;
            #"min" => if (new-foo < value) error("Value %d for foo exceeds limit for %=.", new-foo, some-thing) end;
          end select;
        end method;
  
  for (limitation in limitations)
    let limit-key :: <symbol> = head(limitation);
    let limit-value :: <integer> = tail(limitation);
    check-limit(limit-key, limit-value)
  end for;

  next-method();
end method;
*/

define method print-object(some-thing :: <some-thing>, stream :: <stream>) => ()
  print("{<some-thing> foo: ", stream);
  print(some-thing.foo, stream);
  print("}", stream);
end;

// TODO: fix segfault
// define method make(some-thing :: subclass(limited(<some-thing>)),
//                    #next next-method, #key foo = 0)
//   => (result :: limited(<some-thing>))
//   format-out("make(%=, foo: %=)\n", some-thing, foo);
//   force-output(*standard-output*);
//   next-method();
// end;

define method main (argv0 :: <byte-string>, #rest noise)
  let unlimited-foo :: <some-thing> = make(<some-thing>, foo: 0);
  let foo-under-5 :: limited(<some-thing>, max: 4) = make(<some-thing>, foo: 3);
  // foo-under-5 := make(limited(<some-thing>, max: 4), foo: 3); // custom make doesn't work yet
  let foo-between-0-and-10 :: limited(<some-thing>, min: 0, max: 10) = make(<some-thing>, foo: 3);
  let foo-over-10  :: limited(<some-thing>, min: 11) = make(<some-thing>, foo: 15);
  let foo-under-11 :: limited(<some-thing>, max: 10) = make(<some-thing>, foo: 7);
  // let bar-between-0-and-10 :: limited(<some-thing>, min: 0, max: 10) = make(<some-thing>, foo: 30); // -> fails :)
  unlimited-foo.foo := 500;
  foo-over-10.foo := 500;
  format-out("%=\n", foo-over-10);
  foo-under-11.foo := 500; // should fail, but doesn't yet.
  let foo-under-11-bis :: limited(<some-thing>, max: 10) = foo-under-5; // Should not incur full type check & pass, untested because make() segfaults
  foo-under-11-bis := foo-under-11;  // incurs full type check & passes
  foo-under-11-bis := unlimited-foo; // incurs full type check & fails
  foo-under-11-bis := foo-over-10;   // incurs full type check & fails
end;