Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
F
fare-utils
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Model registry
Operate
Environments
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
François-René Rideau
fare-utils
Commits
3dd9e8f0
Commit
3dd9e8f0
authored
13 years ago
by
Francois-Rene Rideau
Browse files
Options
Downloads
Patches
Plain Diff
Debug and add interface/box.
parent
39224dd0
No related branches found
No related tags found
No related merge requests found
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
build.xcvb
+1
-0
1 addition, 0 deletions
build.xcvb
fare-utils.asd
+1
-0
1 addition, 0 deletions
fare-utils.asd
interface/box.lisp
+4
-23
4 additions, 23 deletions
interface/box.lisp
interface/eq.lisp
+1
-1
1 addition, 1 deletion
interface/eq.lisp
interface/interface.lisp
+4
-4
4 additions, 4 deletions
interface/interface.lisp
with
11 additions
and
28 deletions
build.xcvb
+
1
−
0
View file @
3dd9e8f0
...
@@ -19,6 +19,7 @@
...
@@ -19,6 +19,7 @@
"filesystem/atomic"
"filesystem/atomic"
"unbaked/msv"
"unbaked/msv"
"interface/interface"
"interface/interface"
"interface/box"
"interface/eq"
"interface/eq"
"interface/order"
"interface/order"
"pure/package"
"pure/package"
...
...
This diff is collapsed.
Click to expand it.
fare-utils.asd
+
1
−
0
View file @
3dd9e8f0
...
@@ -44,6 +44,7 @@ and Lisp extensions for memoization and reader interception."
...
@@ -44,6 +44,7 @@ and Lisp extensions for memoization and reader interception."
:depends-on
(
"base"
)
:depends-on
(
"base"
)
:components
:components
((
:file
"interface"
)
((
:file
"interface"
)
(
:file
"box"
:depends-on
(
"interface"
))
(
:file
"eq"
:depends-on
(
"interface"
))
(
:file
"eq"
:depends-on
(
"interface"
))
(
:file
"order"
:depends-on
(
"eq"
))))
(
:file
"order"
:depends-on
(
"eq"
))))
...
...
This diff is collapsed.
Click to expand it.
interface/box.lisp
+
4
−
23
View file @
3dd9e8f0
;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
#+
xcvb
(
module
(
:depends-on
(
"interface/interface"
"pure/package"
)))
#+
xcvb
(
module
(
:depends-on
(
"interface/interface"
)))
(
in-package
:interface
)
(
in-package
:interface
)
;;;; Interface
;;;; Interface
;;; A class for box objects themselves
;;; A class for box objects themselves
...
@@ -18,7 +17,7 @@
...
@@ -18,7 +17,7 @@
;;; A box: you can make it, or get something out of it
;;; A box: you can make it, or get something out of it
(
define-interface
<box>
(
<interface>
)
())
(
define-interface
<box>
(
<interface>
)
())
(
defgeneric
make-box
(
<box>
generator
)
(
defgeneric
make-box
(
<box>
generator
&key
&allow-other-keys
)
(
:documentation
"Make a box from a generator for the value inside the box"
))
(
:documentation
"Make a box from a generator for the value inside the box"
))
(
defgeneric
unbox
(
<box>
box
)
(
defgeneric
unbox
(
<box>
box
)
...
@@ -31,9 +30,9 @@
...
@@ -31,9 +30,9 @@
(
defmethod
make-box
((
i
<classy-box>
)
generator
&rest
keys
&key
&allow-other-keys
)
(
defmethod
make-box
((
i
<classy-box>
)
generator
&rest
keys
&key
&allow-other-keys
)
(
apply
'instantiate
i
:generator
generator
keys
))
(
apply
'instantiate
i
:generator
generator
keys
))
(
defmethod
unbox
((
i
<classy-box>
)
box
&rest
keys
&key
&allow-other-keys
)
(
defmethod
unbox
((
i
<classy-box>
)
box
)
(
declare
(
ignorable
i
))
(
declare
(
ignorable
i
))
(
apply
'
box-ref
box
keys
))
(
box-ref
box
))
;;;; Boxes that hold a value
;;;; Boxes that hold a value
...
@@ -122,24 +121,6 @@
...
@@ -122,24 +121,6 @@
`
(
make-one-use-function
#'
(
lambda
,
formals
,@
body
)))
`
(
make-one-use-function
#'
(
lambda
,
formals
,@
body
)))
#|
;;;; Boxes that can only be opened with a key
(defclass lock-box ()
((lock :initarg :lock :reader %box-lock)))
(define-interface <lock-box> (<lock> <box>) ())
(defmethod unbox :before ((i <lock-box>) box &key key)
(unless (unlockedp (lock-interface i) (box-lock i box) key)
(error "Tried to access ~A with invalid key ~A" box key)))
(defmethod make-box :before ((i <lock-box>) generator &key key)
(declare (ignorable i generator))
(setf (slot-value box 'key) key))
|#
;;; Some boxes can be empty
;;; Some boxes can be empty
(
define-interface
<emptyable-box>
(
<box>
)
())
(
define-interface
<emptyable-box>
(
<box>
)
())
...
...
This diff is collapsed.
Click to expand it.
interface/eq.lisp
+
1
−
1
View file @
3dd9e8f0
;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;;;; Equality
;;;;; Equality
#+
xcvb
(
module
())
#+
xcvb
(
module
(
:depends-on
(
"interface/interface"
)
))
(
in-package
:cl
)
(
in-package
:cl
)
...
...
This diff is collapsed.
Click to expand it.
interface/interface.lisp
+
4
−
4
View file @
3dd9e8f0
...
@@ -47,13 +47,13 @@
...
@@ -47,13 +47,13 @@
(
in-package
:interface
)
(
in-package
:interface
)
(
defmacro
define-interface
(
name
super-interfaces
slots
&rest
options
)
(
defmacro
define-interface
(
name
super-interfaces
slots
&rest
options
)
(
multiple-value-bind
(
interface-options
class-options
)
(
let
((
class-options
(
split-list
options
#'
(
lambda
(
x
)
(
member
x
'
(
:singleton
:parametric
)))
:key
'car
)
(
remove-if
#'
(
lambda
(
x
)
(
member
x
'
(
:singleton
:parametric
)))
options
:key
'car
)
))
`
(
progn
`
(
progn
(
defclass
,
name
,
super-interfaces
,
slots
,@
class-options
)
(
defclass
,
name
,
super-interfaces
,
slots
,@
class-options
)
,@
(
let
((
singleton
(
find
:singleton
interface-
options
:key
'car
)))
,@
(
let
((
singleton
(
find
:singleton
options
:key
'car
)))
(
when
singleton
`
((
defvar
,
name
(
fmemo:memoized-funcall
'make-instance
',name
)))))
(
when
singleton
`
((
defvar
,
name
(
fmemo:memoized-funcall
'make-instance
',name
)))))
,@
(
let
((
parametric
(
find
:parametric
interface-
options
:key
'car
)))
,@
(
let
((
parametric
(
find
:parametric
options
:key
'car
)))
(
when
parametric
(
when
parametric
(
destructuring-bind
(
formals
&body
body
)
(
cdr
parametric
)
(
destructuring-bind
(
formals
&body
body
)
(
cdr
parametric
)
`
((
defun
,
name
,
formals
`
((
defun
,
name
,
formals
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment