Hi, for/hash is giving me a syntax-error, but the error is in macro-expanded code which is not shown by default and which is also seemingly inaccessible via the macro-stepper. The for/hash expression works outside my macro, so I guess it's my fault, but it would help if the syntax-error could be a bit more informative. The code:
#lang racket
(require "dependent-boxes.rkt")
;;; this fails
(define model
(dependent-boxes
((years)
(income)
(expenses)
(profit
(for/hash ((y years))
(values
y
(- (hash-ref income y 0)
(hash-ref expenses y 0) )))) )))
;;; this works fine
(define years '(1 2 3))
(define income '#hash((1 . 100)(2 . 90)(3 . 70)) )
(define expenses '#hash((1 . 100)(2 . 90)(3 . 70)) )
(for/hash ((y years))
(values y (- (hash-ref income y 0)
(hash-ref expenses y 0) )))
The error:
$ racket test-for.rkt
test-for.rkt:12:6: for/hash: bad syntax in: for/hash
=== context ===
standard-module-name-resolver
Some help would be appreciated.
Marijn
#lang racket
(provide dependent-boxes agraph-topological-sort agraph-outnodes)
;for splicing-let
(require racket/splicing)
;for mcons and friends
(require racket/mpair)
;;; is any tree-element cmp-equivalent to element?
(define (tree-member? tree element cmp)
(let loop ((tree tree))
(if (null? tree) #f
(let ((elt (car tree)))
(or (if (pair? elt) (loop elt) (cmp elt element))
(loop (cdr tree)))))))
;;; does the formula reference the variable?
(define (formula-refs-var? expr var)
(tree-member? expr var eq?) )
;;; which of the variables in a list are referenced by the formula?
(define (formula-refs-vars formula vars)
(filter (lambda (var) (formula-refs-var? formula var)) vars) )
;;; create an alist-represented graph with an outgoing link for each dependency
present in the rules
(define (rules->deps rules)
(let ((vars (map car rules)))
(map (lambda (rule)
(cons (car rule) (formula-refs-vars (cdr rule) vars)))
rules)) )
;;; list of nodes in the alist-graph that satisfy the predicate
(define (agraph-find-nodes graph pred)
(map car (filter pred graph)) )
;;; list of nodes in the alist-graph that link to node
(define (agraph-incoming-nodes graph node)
(agraph-find-nodes graph (lambda (link) (memq node (cdr link)))) )
(define (agraph-outnodes graph node)
(cdr (assoc node graph)) )
;;; invert an alist-represented graph
(define (agraph-invert graph)
(map (lambda (link)
(let ((node (car link)))
(cons node (agraph-incoming-nodes graph node))))
graph) )
;;; list of nodes in the alist-graph that are roots (nodes without incoming
nodes)
(define (agraph-roots graph)
(agraph-find-nodes graph (lambda (link) (null? (agraph-incoming-nodes graph
(car link))))) )
;;; find the roots (nodes without incoming nodes) of a vector-graph
(define (vgraph-roots graph)
(let ((roots (make-vector (vector-length graph) #t)))
(for* ((node graph) (n node)) (vector-set! roots n #f))
(for/list ((i (vector-length graph)) #:when (vector-ref roots i)) i)) )
;;; transform an agraph to a vgraph and a decode hash
(define (vgraph+decoding<-agraph agraph)
(let-values
(((encoding decoding node#)
(for*/fold ((encoding (hash)) (decoding (hash)) (node# 0))
((link agraph) (node link)
#:unless (hash-has-key? encoding node))
(values (hash-set encoding node node#)
(hash-set decoding node# node)
(+ 1 node#) ))))
(define vgraph (make-vector node#))
(define (encode n) (hash-ref encoding n))
(for ((link agraph))
(vector-set! vgraph (encode (car link)) (map encode (cdr link))))
(values vgraph decoding) ) )
(define (agraph<-vgraph+decoding vgraph decoding)
(define (decode n) (hash-ref decoding n))
(for/fold ((agraph '())) ((n (in-range (- (vector-length vgraph) 1) -1 -1)))
(cons (cons (decode n) (map decode (vector-ref vgraph n))) agraph) ) )
;;; do a depth-first-traversal of a vector-represented graph
;;; each node is folded the first time it is visited (with pre-op)
;;; and again when its subforest has been visited (with post-op) over unit
(define (vgraph-depth-first-traversal graph roots pre-op post-op unit)
(let ((visited? (make-vector (vector-length graph) #f)))
(define (visit node ret)
(vector-set! visited? node #t)
(post-op node (visit*
(vector-ref graph node)
(pre-op node ret))))
(define (visit* nodes ret)
(if (null? nodes) ret
(let ((node (car nodes)))
(visit*
(cdr nodes)
(if (vector-ref visited? node) ret
(visit node ret))))))
(visit* roots unit)))
;;; topologically sort a vector-represented graph
(define (vgraph-topological-sort vgraph)
(reverse (vgraph-depth-first-traversal vgraph (vgraph-roots vgraph) (lambda
(x y) y) cons '())))
;;; topologically sort an alist-represented graph
(define (agraph-topological-sort agraph)
(let-values (((vgraph decoding) (vgraph+decoding<-agraph agraph)))
(map (lambda (v) (hash-ref decoding v))
(vgraph-topological-sort vgraph))) )
;; (define-syntax (dependent-boxes stx)
;; (syntax-case stx ()
;; ((_ . x)
;; #`(let-syntax
;; ((with-variables
;; (syntax-rules #,(map car (syntax->list stx)
;; (_ ))
#|
(define-syntax define-dependent-boxes
(syntax-rules ()
((_ name ((variable . rule) ...))
(define name
(let*
((value-store (list (mcons 'variable #f) ...))
(rules
(letrec-syntax
((with-variables
(syntax-rules (variable ...)
((_ (a (... ...))) ((with-variables a) (... ...)))
((_ variable) (assoc 'variable value-store))
...
((_ non-variable) non-variable) ))
(rule-with-variables
(syntax-rules ()
((_ ()) #f)
((_ (r)) (lambda () (with-variables r))) )) )
(list `(variable ,(rule-with-variables rule)) ...) )) )
(cons value-store rules))))))
|#
;; (define-dependent-boxes
;; box-rules
;; ((a)
;; (b (* 2 a))
;; (c (+ 2 a b))))
;;
;; box-rules
(define-syntax dependent-boxes
(syntax-rules ()
((_ ((_variable_ . _rule_) ...))
(let ()
(splicing-let ((value-store (mlist (mcons '_variable_ #f) ...)))
(define (show-value-store)
(mlist->list value-store))
(define (variable-ref variable)
(mcdr (massoc variable value-store)))
(define (variable-set! variable value)
(set-mcdr! (massoc variable value-store) value)))
(splicing-let
((rule-store
(letrec-syntax
((with-variables
(syntax-rules (_variable_ ...)
((_ (a (... ...))) ((with-variables a) (... ...)))
((_ _variable_) (variable-ref '_variable_))
...
((_ non-variable) non-variable) ))
(rule-with-variables
(syntax-rules ()
((_ ()) #f)
((_ (rule)) (lambda () (with-variables rule))) )) )
(list `(_variable_ ,(rule-with-variables _rule_)) ...))))
(define (variable-rule-ref variable)
(cadr (assoc variable rule-store))))
(define (update-variable variable value)
(when (not (variable-rule-ref variable))
(variable-set! variable value)
(propagate)))
(define topological-order
(agraph-topological-sort (rules->deps '((_variable_ . _rule_) ...))))
(define (propagate)
(for-each
(lambda (node)
(let ((rule (variable-rule-ref node)))
(when rule (variable-set! node (rule)))))
topological-order))
(lambda args
(if (null? args)
(raise-arity-error '|<dependent-boxes-closure>| (arity-at-least 1))
(case (car args)
((show) (show-value-store))
((get-value) (variable-ref (cadr args)))
((get-rule) (variable-rule-ref (cadr args)))
((update-value) (apply update-variable (cdr args)))
))) ))))
signature.asc
Description: OpenPGP digital signature
____________________ Racket Users list: http://lists.racket-lang.org/users
