| Hi- Last night I put in place a bunch of enhancements to the intrasymbol syntax logic in my version of ac.acm. Of course, it's pretty easy to do. Just wanted to share the code for these changes and show them in action, in case someone finds them useful. These changes are designed for the official arc2.tar, not the anarkia version. First, I put in place the logic to allow nested lookups using intrasymbols: arc> (= people (obj bob (obj age 27 gender 'male)
amy (obj age 32 gender 'female)))
#hash((amy . #hash((gender . female) (age . 32))) (bob . #hash((gender . male) (age . 27))))
arc> ((people 'amy) 'age)
32
arc> people!amy!age
32
arc> (= x 'gender)
gender
arc> people!amy.x
female
Then, I added the logic to allow mixing of composition and indexing symbols: arc> (string people!amy!age)
"32"
arc> string:people!amy!age
"32"
arc> upcase:string:people!amy.x
"FEMALE"
This also works with a "dangling dot", which calls the terminal function without parameters: arc> sqrt:rand.
0.9711225857284392
Finally, I changed lists to allow non-integer indices. Instead of giving an error, it will now treat the list as an association list. This means that we can perform lookups into alists just as with hash tables- Of course, this feature cannot be used with alists that use integers as keys. arc> (= foo '((a b) (c d) (e f)))
((a b) (c d) (e f))
arc> foo.1
(c d)
arc> foo.2.0
e
arc> (foo 'c)
d
arc> foo!e
f
Those are the sum total of the enhancements. Since none of the current arc2.tar library code uses the intrasymbol syntax, these changes are fully compatible with the current system.Just redefine the following ac.scm functions to activate these changes: (define (ar-apply fn args)
(cond ((procedure? fn) (apply fn args))
((pair? fn) (let ((x (car args)))
(if (integer? x)
(list-ref fn x)
(cadr (assoc x fn)))))
((string? fn) (string-ref fn (car args)))
((hash-table? fn) (ar-nill (hash-table-get fn (car args) #f)))
(#t (err "Function call on inappropriate object" fn args))))
(define (expand-compose sym)
(let ((elts (map (lambda (tok)
(if (eqv? (car tok) #\~)
(if (null? (cdr tok))
'no
`(complement ,(chars->value (cdr tok))))
(chars->value tok)))
(tokens (lambda (c) (eqv? c #\:))
(symbol->chars sym)
'()
'()
#f))))
(if (null? (cdr elts))
(car elts)
(let ((x (car (reverse elts))))
(if (ssyntax? x)
(list (cons 'compose (reverse (cdr (reverse elts)))) (expand-sexpr x))
(cons 'compose elts))))))
(define (build-sexpr toks)
(if (= (length toks) 1)
(list (chars->value (car toks)))
(let* ((r (reverse toks))
(x (build-sexpr (reverse (cddr r))))
(y (if (= 1 (length x))
(car x)
x)))
(cond ((null? (car r))
(list y))
((eqv? (cadr r) #\.)
(list y (chars->value (car r))))
((eqv? (cadr r) #\!)
(list y (list 'quote (chars->value (car r)))))))))
|
