;;;; JSON-BUT - gensym-lookup prototype (defpackage #:json-but (:use #:cl) (:local-nicknames (#:a #:alexandria)) (:shadow #:get)) (in-package #:json-but) (defstruct object (keys #() :type simple-vector) (values #() :type simple-vector)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Pseudo-package (eval-when (:compile-toplevel :load-toplevel :execute) (defvar *pseudo-package* (make-hash-table :test #'equal :weakness :value))) (defun pseudo-intern (thing) (etypecase thing (symbol (pseudo-intern (string thing))) (character (pseudo-intern (string thing))) (string (multiple-value-bind (value foundp) (gethash thing *pseudo-package*) (cond (foundp value) (t (setf (gethash thing *pseudo-package*) (make-symbol thing)))))))) (define-compiler-macro pseudo-intern (&whole whole thing &environment env) (if (and (constantp thing env) (stringp thing)) (a:with-gensyms (value foundp) `(load-time-value (multiple-value-bind (,value ,foundp) (gethash ,thing *pseudo-package*) (cond (,foundp ,value) (t (setf (gethash ,thing *pseudo-package*) (make-symbol ,thing))))))) whole)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Getter (defun get (object name) (let ((symbol (pseudo-intern name))) (destructuring-bind (keys . values) object (svref values (position symbol keys :test #'eq))))) (define-compiler-macro get (&whole whole object name &environment env) (if (constantp name env) (a:with-gensyms (keys values) `(let ((,keys (object-keys ,object)) (,values (object-values ,object))) (declare (type simple-vector ,keys ,values)) (svref ,values (position (pseudo-intern ,name) ,keys :test #'eq)))) whole)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Test and disassembly (defun make-test-object () (let ((keys (map 'vector #'pseudo-intern '("foo" "bar" "fooBar"))) (values #(123 (1 2 3) "123"))) (make-object :keys keys :values values))) (defun test () (declare (optimize speed)) (let* ((object (make-test-object))) (list (get object "foo") (get object "bar") (get object "fooBar")))) JSON-BUT> (test) (123 (1 2 3) "123") JSON-BUT> (disassemble #'test) ; disassembly for TEST ; Size: 431 bytes. Origin: #x5309218F ; TEST ; 18F: 4883EC10 SUB RSP, 16 ; 193: 31C9 XOR ECX, ECX ; 195: 48892C24 MOV [RSP], RBP ; 199: 488BEC MOV RBP, RSP ; 19C: E881653BFD CALL #x50448722 ; # ; 1A1: 480F42E3 CMOVB RSP, RBX ; 1A5: 8D42FD LEA EAX, [RDX-3] ; 1A8: A80F TEST AL, 15 ; 1AA: 0F8570010000 JNE L13 ; 1B0: 8B4201 MOV EAX, [RDX+1] ; 1B3: 4881784D03823B50 CMP QWORD PTR [RAX+77], #x503B8203 ; # ; 1BB: 0F8553010000 JNE L12 ; 1C1: L0: 4C8BC2 MOV R8, RDX ; 1C4: 488B4A05 MOV RCX, [RDX+5] ; 1C8: 488B420D MOV RAX, [RDX+13] ; 1CC: 4C8BC8 MOV R9, RAX ; 1CF: 488B78F9 MOV RDI, [RAX-7] ; 1D3: 488B3576FFFFFF MOV RSI, [RIP-138] ; '#:|foo| ; 1DA: 488BD1 MOV RDX, RCX ; 1DD: 488B59F9 MOV RBX, [RCX-7] ; 1E1: 31C0 XOR EAX, EAX ; 1E3: EB19 JMP L2 ; 1E5: 660F1F840000000000 NOP ; 1EE: 6690 NOP ; 1F0: L1: 488B4C8201 MOV RCX, [RDX+RAX*4+1] ; 1F5: 4839CE CMP RSI, RCX ; 1F8: 740E JEQ L3 ; 1FA: 4883C002 ADD RAX, 2 ; 1FE: L2: 4839D8 CMP RAX, RBX ; 201: 7CED JL L1 ; 203: B817011050 MOV EAX, #x50100117 ; NIL ; 208: L3: A801 TEST AL, 1 ; 20A: 0F8516010000 JNE L14 ; 210: 4839C7 CMP RDI, RAX ; 213: 0F860D010000 JBE L14 ; 219: 4D8B548101 MOV R10, [R9+RAX*4+1] ; 21E: 498B4805 MOV RCX, [R8+5] ; 222: 498B400D MOV RAX, [R8+13] ; 226: 488BF8 MOV RDI, RAX ; 229: 4C8B48F9 MOV R9, [RAX-7] ; 22D: 488B3524FFFFFF MOV RSI, [RIP-220] ; '#:|bar| ; 234: 488BD1 MOV RDX, RCX ; 237: 488B59F9 MOV RBX, [RCX-7] ; 23B: 31C0 XOR EAX, EAX ; 23D: EB0F JMP L5 ; 23F: 90 NOP ; 240: L4: 488B4C8201 MOV RCX, [RDX+RAX*4+1] ; 245: 4839CE CMP RSI, RCX ; 248: 740E JEQ L6 ; 24A: 4883C002 ADD RAX, 2 ; 24E: L5: 4839D8 CMP RAX, RBX ; 251: 7CED JL L4 ; 253: B817011050 MOV EAX, #x50100117 ; NIL ; 258: L6: A801 TEST AL, 1 ; 25A: 0F85CB000000 JNE L15 ; 260: 4939C1 CMP R9, RAX ; 263: 0F86C2000000 JBE L15 ; 269: 4C8B4C8701 MOV R9, [RDI+RAX*4+1] ; 26E: 498B4805 MOV RCX, [R8+5] ; 272: 498B400D MOV RAX, [R8+13] ; 276: 488BF8 MOV RDI, RAX ; 279: 4C8B40F9 MOV R8, [RAX-7] ; 27D: 488B35DCFEFFFF MOV RSI, [RIP-292] ; '#:|fooBar| ; 284: 488BD1 MOV RDX, RCX ; 287: 488B59F9 MOV RBX, [RCX-7] ; 28B: 31C0 XOR EAX, EAX ; 28D: EB0F JMP L8 ; 28F: 90 NOP ; 290: L7: 488B4C8201 MOV RCX, [RDX+RAX*4+1] ; 295: 4839CE CMP RSI, RCX ; 298: 740E JEQ L9 ; 29A: 4883C002 ADD RAX, 2 ; 29E: L8: 4839D8 CMP RAX, RBX ; 2A1: 7CED JL L7 ; 2A3: B817011050 MOV EAX, #x50100117 ; NIL ; 2A8: L9: A801 TEST AL, 1 ; 2AA: 0F8580000000 JNE L16 ; 2B0: 4939C0 CMP R8, RAX ; 2B3: 767B JBE L16 ; 2B5: 488B7C8701 MOV RDI, [RDI+RAX*4+1] ; 2BA: 49896D28 MOV [R13+40], RBP ; thread.pseudo-atomic-bits ; 2BE: 4D8B5D68 MOV R11, [R13+104] ; thread.alloc-region ; 2C2: 498D5330 LEA RDX, [R11+48] ; 2C6: 493B5570 CMP RDX, [R13+112] ; 2CA: 7769 JNBE L17 ; 2CC: 49895568 MOV [R13+104], RDX ; thread.alloc-region ; 2D0: L10: 498D5307 LEA RDX, [R11+7] ; 2D4: 488BC2 MOV RAX, RDX ; 2D7: 4C8950F9 MOV [RAX-7], R10 ; 2DB: 4883C010 ADD RAX, 16 ; 2DF: 488940F1 MOV [RAX-15], RAX ; 2E3: 4C8948F9 MOV [RAX-7], R9 ; 2E7: 4883C010 ADD RAX, 16 ; 2EB: 488940F1 MOV [RAX-15], RAX ; 2EF: 488978F9 MOV [RAX-7], RDI ; 2F3: C7400117011050 MOV DWORD PTR [RAX+1], #x50100117 ; NIL ; 2FA: 49316D28 XOR [R13+40], RBP ; thread.pseudo-atomic-bits ; 2FE: 7402 JEQ L11 ; 300: CC09 INT3 9 ; pending interrupt trap ; 302: L11: 488BE5 MOV RSP, RBP ; 305: F8 CLC ; 306: 5D POP RBP ; 307: C3 RET ; 308: EB9E JMP L9 ; 30A: E949FFFFFF JMP L6 ; 30F: E9F4FEFFFF JMP L3 ; 314: L12: 483D03823B50 CMP RAX, #x503B8203 ; # ; 31A: 0F84A1FEFFFF JEQ L0 ; 320: L13: CC1E INT3 30 ; OBJECT-NOT-TYPE-ERROR ; 322: 08 BYTE #X08 ; RDX ; 323: 27 BYTE #X27 ; # ; 324: CC10 INT3 16 ; Invalid argument count trap ; 326: L14: CC23 INT3 35 ; INVALID-ARRAY-INDEX-ERROR ; 328: 24 BYTE #X24 ; R9 ; 329: 1D BYTE #X1D ; RDI ; 32A: 00 BYTE #X00 ; RAX ; 32B: L15: CC23 INT3 35 ; INVALID-ARRAY-INDEX-ERROR ; 32D: 1C BYTE #X1C ; RDI ; 32E: 25 BYTE #X25 ; R9 ; 32F: 00 BYTE #X00 ; RAX ; 330: L16: CC23 INT3 35 ; INVALID-ARRAY-INDEX-ERROR ; 332: 1C BYTE #X1C ; RDI ; 333: 21 BYTE #X21 ; R8 ; 334: 00 BYTE #X00 ; RAX ; 335: L17: 6A30 PUSH 48 ; 337: E849E2F6FE CALL #x52000585 ; CONS->R11 ; 33C: EB92 JMP L10 NIL