Hashing of prelex for cptypes

original commit: c3d5c784cdf1ffe73abc35f824e588509d98df38
This commit is contained in:
Jon Zeppieri 2017-08-13 18:54:08 -04:00 committed by Gustavo Massaccesi
parent e37833b603
commit 168065175d

View File

@ -18,7 +18,7 @@
sorry! make-preinfo preinfo? preinfo-lambda? preinfo-sexpr preinfo-sexpr-set! preinfo-src
make-preinfo-lambda preinfo-lambda-name preinfo-lambda-name-set! preinfo-lambda-flags preinfo-lambda-libspec
prelex? make-prelex prelex-name prelex-name-set! prelex-flags prelex-flags-set!
prelex-source prelex-operand prelex-operand-set! prelex-uname make-prelex*
prelex-source prelex-operand prelex-operand-set! prelex-uname prelex-counter make-prelex*
target-fixnum? target-bignum?)
(module (lookup-primref primref? primref-name primref-flags primref-arity primref-signatures primref-level)
@ -78,15 +78,16 @@
prelex-flags prelex-flags-set!
prelex-source
prelex-operand prelex-operand-set!
prelex-uname)
prelex-uname
prelex-counter)
(define-record-type prelex
(nongenerative #{prelex grpmhtzqa9bflxfggfu6pp-0})
(nongenerative #{prelex grpmhtzqa9bflxfggfu6pp-1})
(sealed #t)
(fields (mutable name) (mutable flags) source (mutable operand) (mutable $uname))
(fields (mutable name) (mutable flags) source (mutable operand) (mutable $uname) (mutable $counter))
(protocol
(lambda (new)
(lambda (name flags source operand)
(new name flags source operand #f)))))
(new name flags source operand #f #f)))))
(define prelex-uname
(lambda (id)
(or (prelex-$uname id)
@ -94,6 +95,16 @@
(with-tc-mutex
(or (prelex-$uname id)
(begin (prelex-$uname-set! id uname) uname)))))))
(define counter 0)
(define prelex-counter
(lambda (id)
(or (prelex-$counter id)
(with-tc-mutex
(or (prelex-$counter id)
(let ([c counter])
(set! counter (fx1+ counter))
(prelex-$counter-set! id c)
c))))))
(record-writer (record-type-descriptor prelex)
(lambda (x p wr)
(fprintf p "~s" (prelex-name x)))))