Contract added with contract-out is not enforced - racket

I need an explanation of why this 'contract-out' does not work.
It should only return positive value but it still accepts a negative value. Can anyone explain? thank you.
#lang racket
(struct account (balance))
(provide (contract-out
[balance (-> account? number?)]
[deposit (-> account? positive-num? account?)]))
(define new-account (account 0))
(define (positive-num? n)
(cond [(not (number? n)) #f]
[(> n 0) #t]))
(define (balance acc)
(account-balance acc))
(define (deposit acc amt)
(account (+ (account-balance acc) amt)))
(displayln (balance (deposit new-account -10)))

There are two problems with your program as written.
First of all, your positive-num? predicate is wrong. Try it on a negative number—you won’t get back #f. Your implementation will make (positive-num? -10) produce #<void> (since no cond clauses match), which is not #f and is therefore truthy. You can rewrite the body of positive-num? to simply (and (number? n) (> n 0)), which is both clearer and actually correct, but you could also scrap the custom positive-num? predicate entirely and just use the contract (and/c real? positive?).
The second issue with your code is more subtle. When a value is given a contract, the contract is attached on a contract boundary. The contract is enforced whenever the value is used outside the contract boundary, but it isn’t enforced inside the contract boundary. This is because, inside the contract boundary, you’re using the value directly, not the value with a contract attached.
When you use contract-out, the contract boundary is the module providing the identifier. Outside of the module, the contract is enforced, but inside the module, it isn’t. Therefore, since your whole program is within a single module, the contracts are never relevant.
To see this in action, try a program consisting of multiple modules:
#lang racket
(module bank racket
(provide (contract-out
[balance (-> account? number?)]
[deposit (-> account? (and/c real? positive?) account?)]
[new-account account?]))
(struct account (balance))
(define new-account (account 0))
(define (balance acc)
(account-balance acc))
(define (deposit acc amt)
(account (+ (account-balance acc) amt))))
(require 'bank)
(displayln (balance (deposit new-account -10)))
Since the contracted definitions have been moved into a separate submodule, and since the call to deposit is outside that submodule, the above code raises a contract violation:
deposit: contract violation
expected: a number strictly greater than 0
given: -10
in: the 2nd argument of
(->
account?
(and/c real? positive?)
account?)
contract from: (anonymous-module bank)
blaming: anonymous-module
(assuming the contract is correct)
at: unsaved-editor:6.13
If you want the contract to be enforced within the same module, you need to use a form that creates a more fine-grained contract boundary than contract-out. One such form is define/contract, which creates a boundary between the definition itself and everything outside the definition’s body:
#lang racket
(struct account (balance))
(define new-account (account 0))
(define/contract (balance acc)
(-> account? number?)
(account-balance acc))
(define/contract (deposit acc amt)
(-> account? (and/c real? positive?) account?)
(account (+ (account-balance acc) amt)))
(displayln (balance (deposit new-account -10)))
Now the contract violation will be signaled even though the use and definition are in the same module.
For more details on contract boundaries and why you might wish to choose one form over the other, see Contracts and Boundaries in The Racket Guide.

Related

How do I provide a list of functions in Racket?

If I have a function that I want to be available outside of the current module, I can do the following...
(provide my-function)
Can I do this for a list of functions?
I tried the following...
(define f1 ...) ; body omitted for clarity
(define f2 ...) ; ditto
(define my-funs '(f1 f2))
(provide my-funs)
...but this gave "Unbound identifier in: f1" when I tried it.
Can I do this? Thanks
Update: Just to clarify what I'm trying to do here, I am working my way through Beautiful Racket, and am doing the first tutorial. At the stage where he defines the expander, he adds a handle function to handle the operators...
(define (handle [arg #f])
(cond
[(number? arg) (push-stack! arg)]
[(or (equal? * arg) (equal? + arg))
(define op-result (arg (pop-stack!) (pop-stack!)))
(push-stack! op-result)]))
But then, in order to make this work, he provides both + and *...
(provide + *)
This means that these two operators are hard-coded twice. When adding support for other operators, you'd need to modify the handle function and the provide call. I am trying to work out if we can define a list of operators, and use that in both, so you'd only need to make one modification to support new operators.
No, you can't do this.
You can export a list of functions by using filtered-out and begin-for-syntax (as seen below), but this prevents you from using the list within your code.
Exporting a list
#lang racket
(module fns racket
(require racket/provide)
(define (f1 a) (+ a 1))
(define (f2 a) (+ a 2))
(begin-for-syntax
(define my-funs '(f1 f2)))
(provide
(filtered-out
(λ (name) (and (member (string->symbol name) my-funs) name))
(all-defined-out))))
(require 'fns)
(display (f1 2))
How this works
provide can take any number of provide-spec forms and specifying multiple provide-specs is equivalent to writing multiple provide forms. One of the available provide-spec forms is all-defined-out, which will export all defined symbols in the module (or file if a module isn't explicitly specified).
By requiring racket/provide, we get access to helper functions that can transform and operate on provide-spec forms; filtered-out in particular allows us to run arbitrary code over a provide-spec and returns a valid provide-spec. (The required proc-expr is a function that takes a string (the string value of the exported identifiers) and returns a string or a falsy value. That's why when using member, we wrap it in an and and return the raw name itself. This could also be accomplished with findf: (λ (name) (findf (λ (n) (equal? (string->symbol name) n)) my-funs)))
However, this isn't quite enough, as provide is executed at "compile time", meaning that our list my-funs isn't available yet. To handle that, we need to wrap that definition in begin-for-syntax, which makes the binding available at "compile time" as well. But, by moving my-funs to "compile time", you lose the ability to use my-funs in non-"compile time" code. This means, for instance, you couldn't say (cond ... [(member arg my-funs) ...]):
(define (handle [arg #f])
(cond
[(number? arg) (push-stack! arg)]
[(member arg my-funs)
;; ^--- Error here with "my-funs: unbound identifier"
(define op-result (arg (pop-stack!) (pop-stack!)))
(push-stack! op-result)]))

How to define a contract that allows either a quoted list or a function?

I have a function whose single argument can be one of:
quoted list (which I will eval within a context)
function
How to express this as a contract for this argument?
My first guess was:
(or/c expr? list?)
Any better ideas or this is right?
Since expr? does not exist, you should either use procedure? or something using the arrow constructor (for example (-> number? any/c)) for the function part of the contract.
Moreover, since this is a contract for a function, you should include both domain and range using ->.
Example:
#lang racket
(require racket/contract)
(require rackunit)
(define/contract (f x)
(-> (or/c (-> number? number?) list?) (or/c number? list?))
(if (list? x)
x
(x 3)))
(check-equal? (f '()) '())
(check-equal? (f add1) 4)

racket contract dependency evaluation twice?

#lang racket
(module inside racket
(provide
(contract-out
[dummy (->i ([x (lambda (x) (begin (displayln 0) #t))]
[y (x) (lambda (y) (begin (displayln 1) #t))]
[z (x y) (lambda (z) (begin (displayln 2) #t))]
)
any
)]
)
)
(define (dummy x y z) #t)
)
(require 'inside)
(dummy 1 2 3)
The output is
0
0
1
1
2
#t
It's unclear to me why having x and y as dependencies would require the corresponding guard to fire again.
The doc of ->i http://docs.racket-lang.org/reference/function-contracts.html#%28form._%28%28lib.racket%2Fcontract%2Fbase..rkt%29.-~3ei%29%29 doesn't seem to mention this behavior.
Anyone can shed some light on this?
This was as confusing to me as it was to you, so I took the opportunity to ask this question on the Racket mailing list. What follows is an attempt to summarize what I found.
The ->i combinator produces a dependent contract that uses the indy blame semantics presented in the paper Correct Blame for Contracts. The key idea presented in the paper is that, with dependent contracts, there can actually be three parties that might need to be blamed for contract violations.
With normal function contracts, there are two potentially guilty parties. The first is the most obvious one, which is the caller. For example:
> (define/contract (foo x)
(integer? . -> . string?)
(number->string x))
> (foo "hello")
foo: contract violation
expected: integer?
given: "hello"
in: the 1st argument of
(-> integer? string?)
contract from: (function foo)
blaming: anonymous-module
(assuming the contract is correct)
The second potential guilty party is the function itself; that is, the implementation might not match the contract:
> (define/contract (bar x)
(integer? . -> . string?)
x)
> (bar 1)
bar: broke its own contract
promised: string?
produced: 1
in: the range of
(-> integer? string?)
contract from: (function bar)
blaming: (function bar)
(assuming the contract is correct)
Both of these cases are pretty obvious. However, the ->i contract introduces a third potential guilty party: the contract itself.
Since ->i contracts can execute arbitrary expressions at contract attachment time, it’s possible for them to violate themselves. Consider the following contract:
(->i ([mk-ctc (integer? . -> . contract?)])
[val (mk-ctc) (mk-ctc "hello")])
[result any/c])
This is a somewhat silly contract, but it’s easy to see that it’s a naughty one. It promises to only call mk-ctc with integers, but the dependent expression (mk-ctc "hello") calls it with a string! It would obviously be wrong to blame the calling function, since it has no control over the invalid contract, but it might also be wrong to blame the contracted function, since the contract could be defined in complete isolation from the function it is attached to.
For an illustration of this, consider a multi-module example:
#lang racket
(module m1 racket
(provide ctc)
(define ctc
(->i ([f (integer? . -> . integer?)]
[v (f) (λ (v) (> (f v) 0))])
[result any/c])))
(module m2 racket
(require (submod ".." m1))
(provide (contract-out [foo ctc]))
(define (foo f v)
(f #f)))
(require 'm2)
In this example, the ctc contract is defined in the m1 submodule, but the function that uses the contract is defined in a separate submodule, m2. There are two possible blame scenarios here:
The foo function is obviously invalid, since it applies f to #f, despite the contract specifying (integer? . -> . integer?) for that argument. You can see this in practice by calling foo:
> (foo add1 0)
foo: broke its own contract
promised: integer?
produced: #f
in: the 1st argument of
the f argument of
(->i
((f (-> integer? integer?))
(v (f) (λ (v) (> (f v) 0))))
(result any/c))
contract from: (anonymous-module m2)
blaming: (anonymous-module m2)
(assuming the contract is correct)
I’ve emphasized the spot in the contract error that includes blame information, and you can see that it blames m2, which makes sense. This isn’t the interesting case, since it’s the second potential blame party mentioned in the non-dependent case.
However, the ctc contract is actually a little bit wrong! Note that the contract on v applies f to v, but it never checks that v is an integer. For this reason, if v is something else, f will be called in an invalid way.1 You can see this behavior by giving a non-integral value for v:
> (foo add1 "hello")
foo: broke its own contract
promised: integer?
produced: "hello"
in: the 1st argument of
the f argument of
(->i
((f (-> integer? integer?))
(v (f) (λ (v) (> (f v) 0))))
(result any/c))
contract from: (anonymous-module m1)
blaming: (anonymous-module m1)
(assuming the contract is correct)
The top of the contract error is the same (Racket provides the same “broke its own contract” message for these kinds of contract violations), but the blame information is different! It now blames m1, which is the actual source of the contract. This is the indy blame party.
This distinction is what means the contracts have to be applied twice. It applies them with each distinct blame party’s information: first it applies them with the contract-blame, then it applies them with the function-blame.
Technically, this could be avoided for flat contracts, since flat contracts will never signal a contract violation after the initial contract attachment process. However, the ->i combinator currently does not implement any such optimization, since it probably wouldn’t have a significant impact on performance, and the contract implementation is already fairly complex (though if someone wanted to implement it, it would likely be accepted).
In general, though, contracts are expected to be stateless and idempotent (flat contracts are expected to be simple predicates), so there’s not really any guarantee that this won’t happen, and ->i just uses that to implement its fine-grained blame information.
1. As it turns out, the ->d contract combinator doesn’t catch this issue at all, so add1 ends up raising a contract violation here. This is why ->i was created, and it’s why ->i is favored over ->d.

Why is (type-of list) equal to CONS?

I am playing around with Common Lisp and just realized that
(type-of (cons 1 2)) is CONS
and
(type-of (list 1 2)) is also CONS
However the two are clearly not the same because all "proper" lists, must be conses with second element being a list.
That said, when there are only two elements, the second element is 2, and first element is 1, neither is a list, but the construct is also still called a cons.
This gets even more confusing since
(print (list (cons 1 2) 3)) ; this is a ((1 . 2) 3), an improper list, but still cons
(print (cons 1 (list 2 3))) ; this is a (1 2 3), a proper list, but still cons
(cons 1 (cons 2 3)) ; is not a proper list, but is a (1 2 . 3), but still cons...
All are cons, but why isn't (list 1 2) a list? It can't be a cons because cons and list must be different types in order to be told apart in the algorithm for determining whether or not it is a proper list (and in turn, (equal (list 1 2) (cons 1 2)) should be true; without this discrimination, there should be no difference between a cons and a list, there would just be a cons.
Can somebody please help me understand why it says that (type-of (list 1 2)) is cons, even though it is clearly a list (otherwise it would be an improper list to my understanding).
Proper and improper lists are not defined at the type level. This would require recursive type definitions which is only possible to do with Lisp with a satisfies type, and in that case type-of would still not return a type-specifier as complex:
b. the type returned does not involve and, eql,
member, not, or, satisfies or values.
The list type could be defined as (or cons null):
The types cons and null form an exhaustive partition of the type list.
That means that nil is a list, and any cons cell is a list. See also the definition of listp.
In other words:
(typep '(a b c) 'cons)
=> T
But also:
(typep '(a b c) 'list)
=> T
And of course this is true for any supertype:
(typep '(a b c) 'sequence)
=> T
(typep '(a b c) 't)
=> T
The type-of function returns the most basic type, i.e. cons, which can be thought of as the type for which no other subtype satisfy typep (but read the specification which gives the actual definition).
Remarks
Just to clarify:
(cons 1 2)
... is a list, but it cannot be passed to functions that expect proper lists like map, etc. This is checked at runtime and generally, there is no confusion because the cases where one use improper lists are actually quite rare (when you treat cons cells as trees, for example). Likewise, circular lists require special treatment.
In order to check if a list is proper or not, you only need to check whether the last cons has a nil or not as its cdr.
Also, I saw that you wrote:
((1 . 2) 3) ; [...] an improper list
What you have here is a proper-list of two elements where the first one is an improper list, a.k.a. a dotted-list.
#coredump's answer is the correct one, but it's perhaps useful to see pragmatic reasons why it's correct.
Firstly, it's quite desirable that typechecks are quick. So if I say (typep x 'list), I'd like it not to have to go away for a long time to do the check.
Well, consider what a proper list checker has to look like. Something like this, perhaps:
(defun proper-list-p (x)
(typecase x
(null t)
(cons (proper-list-p (rest x)))
(t nil)))
For any good CL compiler this is a loop (and it can obviously be rewritten as an explicit loop if you might need to deal with rudimentary compilers). But it's a loop which is as long as the list you are checking, and this fails the 'typechecks should be quick' test.
In fact it fails a more serious test: typechecks should terminate. Consider a call like (proper-list-p #1=(1 . #1#)). Oops. So we need something like this, perhaps:
(defun proper-list-p (x)
(labels ((plp (thing seen)
(typecase thing
(null (values t nil))
(cons
(if (member thing seen)
(values nil t) ;or t t?
(plp (rest thing)
(cons thing seen))))
(t (values nil nil)))))
(plp x '())))
Well, this will terminate (and tell you whether the list is circular):
> (proper-list-p '#1=(1 . #1#))
nil
t
(This version considers circular lists not to be proper: I think the other decision is less useful but perhaps equally justified in some theoretical sense.)
But this is now quadratic in the length of the list. This can be made better by using a hashtable in the obvious way, but then the implementation is ludicrously consy for small lists (hashtables are big).
Another reason is to consider the difference between representational type and intentional type: the representational type of something tells you how it is implemented, while the intentional type tells you what it logically is. And it's easy to see that, in a lisp with mutable data structures, it is absurdly difficult for the representational type of a (non-null) list to be different than that of a cons. Here's an example of why:
(defun make-list/last (length init)
;; return a list of length LENGTH, with each element being INIT,
;; and its last cons.
(labels ((mlt (n list last)
(cond ((zerop n)
(values list last))
((null last)
(let ((c (cons init nil)))
(mlt (- n 1) c c)))
(t (mlt (- n 1) (cons init list) last)))))
(mlt length '() '())))
(multiple-value-bind (list last) (make-list/last 10 3)
(values
(proper-list-p list)
(progn
(setf (cdr last) t)
(proper-list-p list))
(progn
(setf (cdr (cdr list)) '(2 3))
(proper-list-p list))))
So the result of the last form is t nil t: list is initially a proper list, then it isn't because I fiddled with its final cons, then it is again because I fiddled with some intermediate cons (and now, whatever I do to the cons bound to last will make no difference to that bound to list).
It would be insanely difficult to keep track, in terms of representational type, of whether something is a proper list or not, if you want to use anything that is remotely like linked lists. And type-of, for instance, tells you the representational type of something, which can only be cons (or null for empty lists).

How do I write Push and Pop in Scheme?

Right now I have
(define (push x a-list)
(set! a-list (cons a-list x)))
(define (pop a-list)
(let ((result (first a-list)))
(set! a-list (rest a-list))
result))
But I get this result:
Welcome to DrScheme, version 4.2 [3m].
Language: Module; memory limit: 256 megabytes.
> (define my-list (list 1 2 3))
> (push 4 my-list)
> my-list
(1 2 3)
> (pop my-list)
1
> my-list
(1 2 3)
What am I doing wrong? Is there a better way to write push so that the element is added at the end and pop so that the element gets deleted from the first?
This is a point about using mutation in your code: there is no need to jump to macros for that. I'll assume the stack operations for now: to get a simple value that you can pass around and mutate, all you need is a wrapper around the list and the rest of your code stays the same (well, with the minor change that makes it do stack operations properly). In PLT Scheme this is exactly what boxes are for:
(define (push x a-list)
(set-box! a-list (cons x (unbox a-list))))
(define (pop a-list)
(let ((result (first (unbox a-list))))
(set-box! a-list (rest (unbox a-list)))
result))
Note also that you can use begin0 instead of the let:
(define (pop a-list)
(begin0 (first (unbox a-list))
(set-box! a-list (rest (unbox a-list)))))
As for turning it into a queue, you can use one of the above methods, but except for the last version that Jonas wrote, the solutions are very inefficient. For example, if you do what Sev suggests:
(set-box! queue (append (unbox queue) (list x)))
then this copies the whole queue -- which means that a loop that adds items to your queue will copy it all on each addition, generating a lot of garbage for the GC (think about appending a character to the end of a string in a loop). The "unknown (google)" solution modifies the list and adds a pointer at its end, so it avoids generating garbage to collect, but it's still inefficient.
The solution that Jonas wrote is the common way to do this -- keeping a pointer to the end of the list. However, if you want to do it in PLT Scheme, you will need to use mutable pairs: mcons, mcar, mcdr, set-mcar!, set-mcdr!. The usual pairs in PLT are immutable since version 4.0 came out.
You are just setting what is bound to the lexical variable a-list. This variable doesn't exist anymore after the function exits.
cons makes a new cons cell. A cons cell consists of two parts, which are called car and cdr. A list is a series of cons cells where each car holds some value, and each cdr points to the respective next cell, the last cdr pointing to nil. When you write (cons a-list x), this creates a new cons cell with a reference to a-list in the car, and x in the cdr, which is most likely not what you want.
push and pop are normally understood as symmetric operations. When you push something onto a list (functioning as a stack), then you expect to get it back when you pop this list directly afterwards. Since a list is always referenced to at its beginning, you want to push there, by doing (cons x a-list).
IANAS (I am not a Schemer), but I think that the easiest way to get what you want is to make push a macro (using define-syntax) that expands to (set! <lst> (cons <obj> <lst>)). Otherwise, you need to pass a reference to your list to the push function. Similar holds for pop. Passing a reference can be done by wrapping into another list.
Svante is correct, using macros is the idiomatic method.
Here is a method with no macros, but on the down side you can not use normal lists as queues.
Works with R5RS at least, should work in R6RS after importing correct libraries.
(define (push x queue)
(let loop ((l (car queue)))
(if (null? (cdr l))
(set-cdr! l (list x))
(loop (cdr l)))))
(define (pop queue)
(let ((tmp (car (car queue))))
(set-car! queue (cdr (car queue)))
tmp))
(define make-queue (lambda args (list args)))
(define q (make-queue 1 2 3))
(push 4 q)
q
; ((1 2 3 4))
(pop a)
; ((2 3 4))
q
I suppose you are trying to implement a queue. This can be done in several ways, but if you want both the insert and the remove operation to be performed in constant time, O(1), you must keep a reference to the front and the back of the queue.
You can keep these references in a cons cell or as in my example, wrapped in a closure.
The terminology push and pop are usually used when dealing with stacks, so I have changed these to enqueue and dequeue in the code below.
(define (make-queue)
(let ((front '())
(back '()))
(lambda (msg . obj)
(cond ((eq? msg 'empty?) (null? front))
((eq? msg 'enqueue!)
(if (null? front)
(begin
(set! front obj)
(set! back obj))
(begin
(set-cdr! back obj)
(set! back obj))))
((eq? msg 'dequeue!)
(begin
(let ((val (car front)))
(set! front (cdr front))
val)))
((eq? msg 'queue->list) front)))))
make-queue returns a procedure which wraps the state of the queue in the variables front and back. This procedure accepts different messages which will perform the procedures of the queue data structure.
This procedure can be used like this:
> (define q (make-queue))
> (q 'empty?)
#t
> (q 'enqueue! 4)
> (q 'empty?)
#f
> (q 'enqueue! 9)
> (q 'queue->list)
(4 9)
> (q 'dequeue!)
4
> (q 'queue->list)
(9)
This is almost object oriented programming in Scheme! You can think of front and back as private members of a queue class and the messages as methods.
The calling conventions is a bit backward but it is easy to wrap the queue in a nicer API:
(define (enqueue! queue x)
(queue 'enqueue! x))
(define (dequeue! queue)
(queue 'dequeue!))
(define (empty-queue? queue)
(queue 'empty?))
(define (queue->list queue)
(queue 'queue->list))
Edit:
As Eli points out, pairs are immutable by default in PLT Scheme, which means that there is no set-car! and set-cdr!. For the code to work in PLT Scheme you must use mutable pairs instead. In standard scheme (R4RS, R5RS or R6RS) the code should work unmodified.
What you're doing there is modifying the "queue" locally only, and so the result is not available outside of the definition's scope. This is resulted because, in scheme, everything is passed by value, not by reference. And Scheme structures are immutable.
(define queue '()) ;; globally set
(define (push item)
(set! queue (append queue (list item))))
(define (pop)
(if (null? queue)
'()
(let ((pop (car queue)))
(set! queue (cdr queue))
pop)))
;; some testing
(push 1)
queue
(push 2)
queue
(push 3)
queue
(pop)
queue
(pop)
queue
(pop)
The problem relies on the matter that, in Scheme, data and manipulation of it follows the no side-effect rule
So for a true queue, we would want the mutability, which we don't have. So we must try and circumvent it.
Since everything is passed by value in scheme, as opposed to by reference, things remain local and remain unchanged, no side-effects. Therefore, I chose to create a global queue, which is a way to circumvent this, by applying our changes to the structure globally, rather than pass anything in.
In any case, if you just need 1 queue, this method will work fine, although it's memory intensive, as you're creating a new object each time you modify the structure.
For better results, we can use a macro to automate the creation of the queue's.
The push and pop macros, which operate on lists, are found in many Lispy languages: Emacs Lisp, Gauche Scheme, Common Lisp, Chicken Scheme (in the miscmacros egg), Arc, etc.
Welcome to Racket v6.1.1.
> (define-syntax pop!
(syntax-rules ()
[(pop! xs)
(begin0 (car xs) (set! xs (cdr xs)))]))
> (define-syntax push!
(syntax-rules ()
[(push! item xs)
(set! xs (cons item xs))]))
> (define xs '(3 4 5 6))
> (define ys xs)
> (pop! xs)
3
> (pop! xs)
4
> (push! 9000 xs)
> xs
'(9000 5 6)
> ys ;; Note that this is unchanged.
'(3 4 5 6)
Note that this works even though lists are immutable in Racket. An item is "popped" from the list simply by adjusting a pointer.