Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Let over using #947

Merged
merged 4 commits into from
Sep 30, 2023
Merged

Let over using #947

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
e42b06e
let over using syntax
vyzo Sep 30, 2023
dac2acc
remove duplicate declation
vyzo Sep 30, 2023
409d981
let over using in stdlib
vyzo Sep 30, 2023
bec68bf
update docs
vyzo Sep 30, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
57 changes: 27 additions & 30 deletions doc/reference/std/contract.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -15,9 +15,9 @@ The `:std/contract` package provides facilities for contract checking and type a
(using (declaration ...) body ...)

declaration:
(var :~ predicate) ; contract check with predicate
(var : Type) ; contract check or cast with type
(var :- Type) ; type assertion
(var [expr] :~ predicate) ; contract check with predicate
(var [expr] : Type) ; contract check or cast with type
(var [expr] :- Type) ; type assertion

Type:
struct identifier
Expand All @@ -44,6 +44,8 @@ The macro expands the declarations and creates a block that evaluates the body w
facade procedure will be used.
- If the declaration is a type assertion with `:-`, then the unchecked facade procedure
will be used.
- The form with the optional expression in the declaration expands to a let over using.
So `(using (var expr :~ contract) body ...)` expands to `(let (var expr) (using (var :~ contract) body ...))` and so on.

### Example

Expand All @@ -66,33 +68,28 @@ Here is an example from the standard library:

(def (lru-cache-touch! lru n)
(using ((lru :- lru-cache)
(n :- node))
(let ((hd lru.hd)
(tl lru.tl))
(using ((hd :- node)
(tl :- node))
(cond
((eq? n hd))
((eq? n tl)
(let (prev n.prev)
(using (prev :- node)
(set! prev.next #f)
(set! lru.tl prev)
(set! n.next hd)
(set! hd.prev n)
(set! n.prev #f)
(set! lru.hd n))))
(else
(let ((prev n.prev)
(next n.next))
(using ((prev :- node)
(next :- node))
(set! prev.next next)
(set! next.prev prev)
(set! n.next hd)
(set! hd.prev n)
(set! n.prev #f)
(set! lru.hd n)))))))))
(n :- node)
(hd lru.hd :- node)
(tl lru.tl :- node))
(cond
((eq? n hd))
((eq? n tl)
(using (prev n.prev :- node)
(set! prev.next #f)
(set! lru.tl prev)
(set! n.next hd)
(set! hd.prev n)
(set! n.prev #f)
(set! lru.hd n)))
(else
(using ((prev n.prev :- node)
(next n.next :- node))
(set! prev.next next)
(set! next.prev prev)
(set! n.next hd)
(set! hd.prev n)
(set! n.prev #f)
(set! lru.hd n))))))
```

### maybe
Expand Down
2 changes: 1 addition & 1 deletion etc/gerbil-mode.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -472,7 +472,7 @@
(1 font-lock-keyword-face)
(2 font-lock-function-name-face)))
(gerbil-fontlock-add
'("(\\(using\\)\\s-+((?\\(\\sw+\\)\\s-+\\(:[-~]?\\)\\s-+\\(\\sw+\\)"
'("(\\(using\\)\\s-+((?\\(\\sw+\\)\\s-+[^:]*\\(:[-~]?\\)\\s-+\\(\\sw+\\)"
(1 font-lock-keyword-face)
(2 font-lock-variable-name-face)
(3 font-lock-keyword-face)
Expand Down
34 changes: 16 additions & 18 deletions src/std/actor-v18/server.ss
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -541,24 +541,22 @@
(actor-id (add-actor! source)))
(cond
((routed-message? msg)
(let (dest msg.dest)
(using (dest :- handle)
(let (dest-ref dest.ref)
(using (dest-ref :- reference)
(let* ((dest-srv-id dest-ref.server)
(dest-actor-id dest-ref.id))
(if (or (not dest-srv-id) (eq? dest-srv-id id))
;; local send
(cond
((hash-get actors dest-actor-id)
=> (lambda (actor)
(thread-send/check actor msg)))
(else
(warnf "message for unknown actor ~a" dest-actor-id)
(when msg.reply-expected?
(send-control-reply! msg (!error "unknown actor")))))
;; remote send
(send-remote-message! msg dest-srv-id dest-actor-id actor-id))))))))
(using ((dest msg.dest :- handle)
(dest-ref dest.ref :- reference))
(let* ((dest-srv-id dest-ref.server)
(dest-actor-id dest-ref.id))
(if (or (not dest-srv-id) (eq? dest-srv-id id))
;; local send
(cond
((hash-get actors dest-actor-id)
=> (lambda (actor)
(thread-send/check actor msg)))
(else
(warnf "message for unknown actor ~a" dest-actor-id)
(when msg.reply-expected?
(send-control-reply! msg (!error "unknown actor")))))
;; remote send
(send-remote-message! msg dest-srv-id dest-actor-id actor-id)))))

((control-message? msg)
(debugf "control message from ~a: ~a" source msg)
Expand Down
20 changes: 18 additions & 2 deletions src/std/contract.ss
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,15 @@

(defsyntax (using stx)
(syntax-case stx (:~)
((_ (id expr ~ contract) body ...)
(and (identifier? #'id)
(identifier? #'~)
(or (free-identifier=? #'~ #':)
(free-identifier=? #'~ #':-)
(free-identifier=? #'~ #':~)))
#'(let (id expr)
(using (id ~ contract)
body ...)))
((_ (id ~ Type) body ...)
(and (identifier? #'id)
(identifier? #'Type)
Expand All @@ -32,13 +41,20 @@
((_ (id :~ pred) body ...)
(identifier? #'id)
#'(with-contract (id :~ pred) body ...))
((macro ((id ~ contract) . rest) body ...)
((_ ((id ~ contract) . rest) body ...)
(and (identifier? #'id)
(identifier? #'~)
(or (free-identifier=? #'~ #':)
(free-identifier=? #'~ #':-)
(free-identifier=? #'~ #':~)))
#'(using (id ~ contract) (using rest body ...)))
((_ ((id expr ~ contract) . rest) body ...)
(and (identifier? #'id)
(identifier? #'~)
(or (free-identifier=? #'~ #':)
(free-identifier=? #'~ #':-)
(free-identifier=? #'~ #':~)))
#'(macro (id ~ contract) (macro rest body ...)))
#'(using (id expr ~ contract) (using rest body ...)))
((_ () body ...)
#'(let () body ...))))

Expand Down
2 changes: 1 addition & 1 deletion src/std/db/conpool.ss
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -60,7 +60,7 @@
(mutex-lock! cp.mx)
(set! cp.out (remq conn cp.out))
(mutex-unlock! cp.mx)
{destroy conn}))
{conn.destroy}))
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

How does that work over {} ?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I added support for dots in the @method macro in the ptelude in the original using pr.


(def (conpool-close cp)
(using (cp : conpool)
Expand Down
Loading