From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Thien-Thi Nguyen Newsgroups: gmane.lisp.guile.user Subject: make-vtable-vtable Date: Mon, 18 Nov 2002 04:40:15 -0800 Sender: guile-user-admin@gnu.org Message-ID: Reply-To: ttn@glug.org NNTP-Posting-Host: main.gmane.org X-Trace: main.gmane.org 1037624732 30926 80.91.224.249 (18 Nov 2002 13:05:32 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 18 Nov 2002 13:05:32 +0000 (UTC) Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 18Dlak-00082N-00 for ; Mon, 18 Nov 2002 14:05:30 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.10) id 18DlZY-0002Yk-00; Mon, 18 Nov 2002 08:04:16 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.10) id 18DlIS-000450-00 for guile-user@gnu.org; Mon, 18 Nov 2002 07:46:36 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.10) id 18DlIN-000415-00 for guile-user@gnu.org; Mon, 18 Nov 2002 07:46:35 -0500 Original-Received: from ca-crlsca-cuda3-c6a-b-211.crlsca.adelphia.net ([68.71.15.211] helo=giblet) by monty-python.gnu.org with esmtp (Exim 4.10) id 18DlIM-0003yt-00 for guile-user@gnu.org; Mon, 18 Nov 2002 07:46:30 -0500 Original-Received: from ttn by giblet with local (Exim 3.35 #1 (Debian)) id 18DlCJ-0002T7-00 for ; Mon, 18 Nov 2002 04:40:15 -0800 Original-To: guile-user@gnu.org Errors-To: guile-user-admin@gnu.org X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.0.11 Precedence: bulk List-Help: List-Post: List-Subscribe: , List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: Xref: main.gmane.org gmane.lisp.guile.user:1368 someone asked about alternatives for smobs and i suggested looking into structs w/o understanding them very well at the time. this prompted me to delve into them a little, including looking at the docs. turns out, docs for make-vtable-vtable are incorrect (as well as unreviewed :-). vtable fields (w/ non-negative index numbers -- see struct.h) are: 0 -- memory layout string 1 -- opaque (for gc) 2 -- printer callback 3 -- "user offset" (conventionally a symbol naming the type) make-vtable-vtable args are new-fields, tail-size, and inits. new-fields and tail-size args update field 0. field 1 is under internal control. inits start with field 2. thus, to get the desired behavior of (struct-ref x vtable-offset-user) => foo that is, vtable's "vtable-offset-user" field naming the type, the example should be changed from (define x (make-vtable-vtable (make-struct-layout (quote pw)) 0 'foo)) to (define x (make-vtable-vtable (make-struct-layout (quote pw)) 0 #f ;; new 'foo)) likewise, the definition for `y' should be updated to: (define y (make-struct x 0 (make-struct-layout (quote pwpwpw)) #f ;; new 'bar)) below is a nascent structures.test; feedback welcome. i think it would be nice to find/write a tutorial comparing/contrasting structures and smobs: usage, tips, performance, philosophy, etc. an interesting test case would be libbfd + bit-field-diagram + structures and/or smobs. thi ___________________________________________________________________________ ;;; structures.test -*- scheme -*- ;; Copyright (C) 2002 Free Software Foundation, Inc. ;; ;; This file is part of GUILE [... deletia ...] ;;; Author: Thien-Thi Nguyen (pass-if "structures procs" (and make-struct-layout (procedure? make-struct-layout) make-struct (procedure? make-struct) struct? (procedure? struct?) struct-ref (procedure? struct-ref) struct-set! (procedure? struct-set!) struct-vtable (procedure? struct-vtable) struct-vtable? (procedure? struct-vtable?) make-vtable-vtable (procedure? make-vtable-vtable) struct-vtable-name (procedure? struct-vtable-name) set-struct-vtable-name! (procedure? set-struct-vtable-name!) struct-vtable-tag (procedure? struct-vtable-tag))) (define structures-test:exception:ref-denied (cons 'misc-error "ref denied")) ;; TODO: test this, too. ;;+ (define structures-test:exception:set!-denied ;;+ (cons 'misc-error "set_x denied")) ;; chaining state (define structures-test:x #f) (define structures-test:y #f) ;; tests (with-test-prefix "make-vtable-vtable" (let ((x (make-vtable-vtable (make-struct-layout (quote pw)) 0 #f ; printer callback 'foo))) ; name (pass-if "x" (->bool x)) (pass-if "struct?" (struct? x)) (pass-if "struct-vtable?" (struct-vtable? x)) (pass-if "points to self" (eq? x (struct-vtable x))) (pass-if "user offset holds name" (eq? 'foo (struct-ref x vtable-offset-user))) ;; ref checks (pass-if-exception "ref -1 is out-of-range" exception:out-of-range (struct-ref x -1)) (pass-if "ref 0 is layout" (let ((ref-0 (struct-ref x 0))) (and (symbol? ref-0) ;; symbol specially interned so compare as string (string=? "pruosrpwpw" (symbol->string ref-0))))) (pass-if-exception "ref 1 opaque" structures-test:exception:ref-denied (struct-ref x 1)) (pass-if "ref 2 is pointer to handle (self)" (let ((ref-2 (struct-ref x 2))) (and ref-2 (eq? x ref-2 (struct-vtable x))))) (pass-if "ref 3 is printer for this type" (not (struct-ref x 3))) (pass-if "ref 4 is name" (eq? 'foo (struct-ref x 4))) (pass-if-exception "ref 5 is out-of-range" exception:out-of-range (struct-ref x 5)) ;; chain (set! structures-test:x x))) (with-test-prefix "make vtable (using make-struct)" (let* ((x structures-test:x) (y (make-struct x 0 (make-struct-layout (quote pwpwpw)) #f 'bar))) (pass-if "y" (->bool y)) (pass-if "struct?" (struct? y)) (pass-if "struct-vtable?" (struct-vtable? y)) (pass-if "x and y not eq" (not (eq? x y))) (pass-if "x is y's vtable" (eq? x (struct-vtable y))) (pass-if "user offset holds name" (eq? 'bar (struct-ref y vtable-offset-user))) ;; ref checks (pass-if-exception "ref -1 is out-of-range" exception:out-of-range (struct-ref y -1)) (pass-if "ref 0 is layout" (let ((ref-0 (struct-ref y 0))) (and (symbol? ref-0) ;; symbol specially interned so compare as strings (string=? "pwpwpw" (symbol->string ref-0))))) (pass-if-exception "ref 1 is opaque" structures-test:exception:ref-denied (struct-ref y 1)) (pass-if "ref 2 is pointer to handle (self)" (let ((ref-2 (struct-ref y 2))) (and ref-2 (eq? y ref-2)))) (pass-if "ref 3 is printer for this type" (not (struct-ref y 3))) (pass-if "ref 4 is name" (eq? 'bar (struct-ref y 4))) (pass-if-exception "ref 5 is out-of-range" exception:out-of-range (struct-ref y 5)) ;; chain (set! structures-test:y y))) (with-test-prefix "make structure (using make-struct)" (let* ((x structures-test:x) (y structures-test:y) (z (make-struct y 0 'a 'b 'c))) (pass-if "z" (->bool z)) (pass-if "struct?" (struct? z)) (pass-if "not struct-vtable?" (not (struct-vtable? z))) (pass-if "y is z's vtable" (eq? y (struct-vtable z))) (pass-if-exception "ref -1 out-of-range" exception:out-of-range (struct-ref z -1)) (pass-if "ref 0-2" (equal? '(a b c) (map (lambda (n) (struct-ref z n)) '(0 1 2)))) (pass-if-exception "ref 3 out-of-range" exception:out-of-range (struct-ref z 3)))) ;;; structures.test ends here _______________________________________________ Guile-user mailing list Guile-user@gnu.org http://mail.gnu.org/mailman/listinfo/guile-user