{"id":20931950,"url":"https://github.com/shixiongfei/oop-scheme","last_synced_at":"2026-02-27T00:32:55.593Z","repository":{"id":78504602,"uuid":"229532244","full_name":"shixiongfei/oop-scheme","owner":"shixiongfei","description":"Classes and objects in Scheme.","archived":false,"fork":false,"pushed_at":"2020-02-23T04:23:33.000Z","size":28,"stargazers_count":4,"open_issues_count":0,"forks_count":1,"subscribers_count":1,"default_branch":"master","last_synced_at":"2025-03-13T02:17:48.557Z","etag":null,"topics":["lisp","oop","scheme"],"latest_commit_sha":null,"homepage":"","language":"Scheme","has_issues":true,"has_wiki":null,"has_pages":null,"mirror_url":null,"source_name":null,"license":null,"status":null,"scm":"git","pull_requests_enabled":true,"icon_url":"https://github.com/shixiongfei.png","metadata":{"files":{"readme":"README.md","changelog":null,"contributing":null,"funding":null,"license":null,"code_of_conduct":null,"threat_model":null,"audit":null,"citation":null,"codeowners":null,"security":null,"support":null,"governance":null,"roadmap":null,"authors":null,"dei":null,"publiccode":null,"codemeta":null}},"created_at":"2019-12-22T07:17:05.000Z","updated_at":"2023-10-05T04:26:54.000Z","dependencies_parsed_at":"2023-05-21T00:30:16.939Z","dependency_job_id":null,"html_url":"https://github.com/shixiongfei/oop-scheme","commit_stats":null,"previous_names":[],"tags_count":0,"template":false,"template_full_name":null,"purl":"pkg:github/shixiongfei/oop-scheme","repository_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/shixiongfei%2Foop-scheme","tags_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/shixiongfei%2Foop-scheme/tags","releases_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/shixiongfei%2Foop-scheme/releases","manifests_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/shixiongfei%2Foop-scheme/manifests","owner_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/owners/shixiongfei","download_url":"https://codeload.github.com/shixiongfei/oop-scheme/tar.gz/refs/heads/master","sbom_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/shixiongfei%2Foop-scheme/sbom","scorecard":null,"host":{"name":"GitHub","url":"https://github.com","kind":"github","repositories_count":286080680,"owners_count":29879042,"icon_url":"https://github.com/github.png","version":null,"created_at":"2022-05-30T11:31:42.601Z","updated_at":"2026-02-26T23:51:21.483Z","status":"ssl_error","status_checked_at":"2026-02-26T23:50:46.793Z","response_time":89,"last_error":"SSL_connect returned=1 errno=0 peeraddr=140.82.121.5:443 state=error: unexpected eof while reading","robots_txt_status":"success","robots_txt_updated_at":"2025-07-24T06:49:26.215Z","robots_txt_url":"https://github.com/robots.txt","online":false,"can_crawl_api":true,"host_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub","repositories_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories","repository_names_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repository_names","owners_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/owners"}},"keywords":["lisp","oop","scheme"],"created_at":"2024-11-18T21:46:24.075Z","updated_at":"2026-02-27T00:32:55.572Z","avatar_url":"https://github.com/shixiongfei.png","language":"Scheme","funding_links":[],"categories":[],"sub_categories":[],"readme":"# Classes and objects in Scheme\n\n在Scheme中实现类和对象.\n\n## a. 类和对象\n\n函数定义可以解释为一个类，并且函数调用可以扮演对象的角色。换句话说，lambda表达式可以被视为类，而闭包可以被视为对象。\n\n下面定义一个`point`类，lambda表达式将作为`point`类的实例对象句柄返回。这个对象句柄实际上是一个调度程序，它在给定message参数作为输入的情况下返回匹配的方法。 \n\n```\n(define (point x y)\n  (letrec ((getx (lambda () x))\n           (gety (lambda () y))\n           (add  (lambda (p)\n                    (point\n                       (+ x (send 'getx p))\n                       (+ y (send 'gety p)))))\n           (type-of (lambda () 'point)))\n    (lambda (message)\n      (cond ((eq? message 'getx) getx)\n            ((eq? message 'gety) gety)\n            ((eq? message 'add)  add)\n            ((eq? message 'type-of) type-of)\n            (else (error #f \"Message not understood\"))))))\n```\n\n在`add`方法中，我们使用`send`函数向对象发送消息。`send`函数仅查找方法，并使用`apply`来调用方法。\n\n```\n(define (send message obj . par)\n  (let ((method (obj message)))\n    (apply method par)))\n```\n\n## b. 类的通用模式\n\n一个类通常包含：构造参数、实例变量、方法和self方法。方法除了通过上面的`letrec`定义外，还可以通过`define`来简化定义。\n\n```\n(define (class-name construction-parameters)\n (let ((instance-var init-value)\n        ...)\n\n   (define (method parameter-list)\n     method-body)\n\n   ...\n\n   (define (self message)\n     (cond ((eqv? message selector) method)\n\t   ...\n\n\t   (else (error #f \"Undefined message\" message))))\n\n   self))\n```\n\n我们再实现一个实例化对象的函数，顺便给`send`函数增加一点错误处理能力。\n\n```\n(define (new-instance class . parameters)\n  (apply class parameters))\n\n(define (send message object . args)\n  (let ((method (object message)))\n    (cond ((procedure? method) (apply method args))\n          (else (error #f \"Error in method lookup \" method)))))\n```\n\n## c. 类的示例\n\n现在我们重新写一下`point`类\n\n```\n(define (point x y)\n (let ((x x) \n       (y y))\n\n   (define (getx) x)\n\n   (define (gety) y)\n\n   (define (add p)\n    (point\n     (+ x (send 'getx p))\n     (+ y (send 'gety p))))\n\n   (define (type-of) 'point)\n\n   (define (self message)\n     (cond ((eqv? message 'getx) getx)\n           ((eqv? message 'gety) gety)\n           ((eqv? message 'add)  add)\n           ((eqv? message 'type-of) type-of)\n\t   (else (error #f \"Undefined message\" message))))\n\n   self))\n```\n\n下面我们模拟一个场景，其中我们创建了两个点，并将它们绑定到变量`p`和`q`，再将`p`与`q`的和绑定到变量`p+q`。最后我们通过`send`发送`getx`和`gety`消息来检查结果是否符合预期。\n\n```\n1\u003e (define p (new-instance point 2 3))\n\n2\u003e (send 'getx p)\n2\n\n3\u003e (define q (new-instance point 4 5))\n\n4\u003e (define p+q (send 'add p q))\n\n5\u003e (send 'getx p+q)\n6\n\n6\u003e (send 'gety p+q)\n8\n```\n\n## d. 继承\n\n上面我们已经在Scheme中简单的模拟了类和对象，继承是面向对象中更高级的概念。\n\n我们先将对象简单的分成两部分`super`(super part)和`self`(subclass part)。基类的对象是上半部分，\n我们将其绑定到`super`，分派器`dispatch`作为下半部分仍然绑定到`self`。\n\n```\n(define (class-name parameters)\n (let ((super (new-part super-class-name some-parameters))\n       (self 'nil))\n   (let ((instance-variable init-value)\n         ...)\n\n     (define (method parameter-list)\n       method-body)\n     ...\n\n     (define (dispatch message)\n       (cond ((eqv? message 'selector) method)\n             ...\n             (else (method-lookup super message))))\n\n     (set! self dispatch))\n\n   self))\n```\n\n下面将实现一个大多数面向对象语言中都有的基础类`object`。所有对象可以通过继承形成一个`super`链，`object`的`super`为空，作为整个`super`派发链的终结。\n\n```\n(define (object)\n  (let ((super '())\n        (self 'nil))\n\n   (define (dispatch message)\n       '())\n\n   (set! self dispatch)\n   self))\n```\n\n我们再添加`new-instance`、`new-part`、`send`和`method-lookup`这几个函数来对面向对象做更完善的支持。`new-part`用于构造对象的部件，而`new-instance`用于构造具体类型的对象，这里暂时看上去长得一样。\n\n```\n(define (new-instance class . parameters)\n  (apply class parameters))\n\n(define (new-part class . parameters)\n  (apply class parameters))\n\n(define (method-lookup object selector)\n (cond ((procedure? object) (object selector))\n       (else\n         (error #f \"Inappropriate object in method-lookup: \"\n                 object))))\n\n(define (send message object . args)\n (let ((method (method-lookup object message)))\n  (cond ((procedure? method) (apply method args))\n        ((null? method)\n         (error #f \"Message not understood: \" message))\n        (else\n         (error #f \"Inappropriate result of method lookup: \"\n                 method)))))\n```\n\n## e. 继承的示例\n\n我们借用c小节的示例`point`类型，在此基础上，我们通过继承来派生出一个带颜色的点`color-point`类型。\n\n```\n(define (color-point x y color)\n (let ((super (new-part point x y))\n       (self 'nil))\n   (let ((color color))\n\n     (define (get-color)\n       color)\n\n     (define (type-of) 'color-point)\n\n     (define (dispatch message)\n       (cond ((eqv? message 'get-color) get-color)\n             ((eqv? message 'type-of) type-of)\n             (else (method-lookup super message))))\n\n     (set! self dispatch))\n\n   self))\n```\n\n测试下我们的颜色点，并将两个颜色点相加(注意，两个颜色点相加后不是颜色点，只是普通的点)\n\n```\n1\u003e (define cp (new-instance color-point 5 6 'red))\n\n2\u003e (send 'get-color cp)\nred\n\n3\u003e (send 'getx cp)\n5\n\n4\u003e (send 'gety cp)\n6\n\n5\u003e (define cp-1 (send 'add cp (new-instance color-point 1 2 'green))) \n\n6\u003e (send 'getx cp-1)\n6\n\n7\u003e (send 'gety cp-1)\n8\n\n8\u003e (send 'type-of cp-1)\npoint\n\n9\u003e (send 'get-color cp-1)\nUndefined message get-color\n```\n\n## f. self解释\n\n继承的模拟涉及将对象部分聚合为整体对象。为了将整个对象绑定在一起，`self`所有部分的(对象句柄)必须指向最专门的对象部分。\n\n图中展示了我们想要实现的目标。左侧的绿色层次结构显示了现在的情况，其中`self`每个级别均指向当前对象部分。右侧的黄色层次结构显示了我们希望建立的情况。\n\n![self-super.gif](self-super.gif)\n\n`self`必须指向最顶层的对象部分，如果不是这样，就根本无法从“非顶层对象部分”访问“顶层对象部分”\n\n## g. 虚拟方法示例\n\n现在展示虚拟方法的效果。我们将定义一个基类`x`，一个子类`y`(`y`继承自`x`)。在这2个对象中，我们都将看到一个额外的方法`set-self!`，该方法负责将`self`更改为适当的对象。注意！使用`x`和`y`类的程序员对`set-self!`不感兴趣，所以`set-self!`方法是对象的内部事务。\n\n```\n(define (x)\n (let ((super (new-part object))\n       (self 'nil))\n\n   (let ((x-state 1))\n\n     (define (get-state) x-state)\n\n     (define (res)\n       (send 'get-state self))\n\n     (define (set-self! object-part)\n         (set! self object-part)\n         (send 'set-self! super object-part))\n\n     (define (self message)\n         (cond ((eqv? message 'get-state) get-state)\n               ((eqv? message 'res) res)\n               ((eqv? message 'set-self!) set-self!)\n               (else (method-lookup super message))))\n\n      self)))\n```\n\n```\n(define (y)\n (let ((super (new-part x))\n       (self 'nil))\n\n   (let ((y-state 2))\n\n     (define (get-state) y-state)\n\n     (define (set-self! object-part)\n         (set! self object-part)\n         (send 'set-self! super object-part))\n\n     (define (self message)\n         (cond ((eqv? message 'get-state) get-state)\n               ((eqv? message 'set-self!) set-self!)\n               (else (method-lookup super message))))\n\n      self)))\n```\n\n下面是一个小示例，它可以解释`self`的效果。将`res`消息发送到`y`对象`b`会得到值`2`，表明该`res`方法调用了`y`对象的`get-state`（不是`x`的`get-state`）。`y`的`res`方法是从`x`继承而来。\n\n```\n1\u003e (define a (new-instance x))\n\n2\u003e (define b (new-instance y))\n\n3\u003e (send 'res a)\n1\n\n4\u003e (send 'res b)\n2\n```\n\n为了得到上面示例的结果，我们对`new-instance`函数还需要做一些小小的修改。我们在`new-instance`中调用一个`virtual-operations`的函数，该函数将`set-self!`消息发送到对象，这将依次激活所有级别对象的`set-self!`方法。\n\n```\n(define (new-instance class . parameters)\n (let ((instance (apply class parameters)))\n   (virtual-operations instance)\n   instance))\n\n(define (virtual-operations object)\n  (send 'set-self! object object))\n```\n\n## h. 面向对象的一些思考\n\n这里只是在Scheme中对面向对象的一个简单模拟。在此基础上，我们还可以实现一个更完善的面向对象系统。例如：\n\n1. 通过槽(`Slot`)来管理属性和方法(槽是Key/Value对的列表)\n2. 所有的动作(`actions`)都是消息\n3. 对象与对象之间只能通过消息来交互\n4. 基于原型链(`Prototypes`)的方式实现继承(当对象收到一条消息时，它会寻找一个匹配的槽，如果找不到，则查找将首先在其原型中递归地继续进行)\n5. 多重继承只需要将原型添加到对象的原型链中即可(当响应消息时，查找机制对原型链进行深度优先搜索)\n6. 对象的继承和实例化可以都通过复制(`clone`)的方式进行\n\n## i. 参考资料\n\n* [示例代码(Github)](https://github.com/shixiongfei/oop-scheme)\n* [clos](http://community.schemewiki.org/?CLOS)\n* [clos for chez](https://github.com/theschemer/clos)\n* [Simulation of object-oriented mechanisms in Scheme - A technical report](http://people.cs.aau.dk/~normark/pp-*/oop-scheme.pdf)\n","project_url":"https://awesome.ecosyste.ms/api/v1/projects/github.com%2Fshixiongfei%2Foop-scheme","html_url":"https://awesome.ecosyste.ms/projects/github.com%2Fshixiongfei%2Foop-scheme","lists_url":"https://awesome.ecosyste.ms/api/v1/projects/github.com%2Fshixiongfei%2Foop-scheme/lists"}