suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

make true flag automatic

Browse Source 
original commit: a88ae6cec82e428a37827b12c0886dfc76569067
This commit is contained in:
Gustavo Massaccesi 2019-01-23 18:15:49 -03:00
parent 2a20927ac2
commit 9c36f8dc3d
2 changed files with 26 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
s/priminfo.ss
View File

@ -14,7 +14,7 @@
;;; limitations under the License.
(module priminfo (priminfo-unprefixed priminfo-libraries priminfo-mask priminfo-signatures priminfo-arity primvec
get-priminfo priminfo-boolean? priminfo-result-arity)
get-priminfo priminfo-boolean? priminfo-true? priminfo-result-arity)
(define-record-type priminfo
(nongenerative)
(sealed #t)
@ -55,6 +55,28 @@
'single]
[else 'multiple]))))
(define priminfo-true?
(lambda (info)
(let ([signature* (priminfo-signatures info)])
(cond
[(null? signature*) 'unknown]
[(andmap (lambda (sig)
(let ([out (cdr sig)])
(and (pair? out)
(null? (cdr out))
(or (pair? (car out))
(not (or (eq? (car out) 'ptr)
(eq? (car out) 'sub-ptr)
(eq? (car out) 'boolean)
(eq? (car out) 'bottom)
(eq? (car out) 'who)
(let ([name (symbol->string (car out))])
(and (>= (string-length name) 6)
(string=? (substring name 0 6) "maybe-")))))))))
signature*)
'true]
[else #;(newline) #;(display (list info)) 'other]))))
(define signature->interface
(lambda (sig)
(define (ellipsis? x) (eq? x '...))

4
s/primvars.ss
View File

@ -18,10 +18,11 @@
(include "primref.ss")
(define record-prim!
(lambda (prim unprefixed flags arity boolean-valued? result-arity signatures)
(lambda (prim unprefixed flags arity boolean-valued? true-valued? result-arity signatures)
(unless (eq? unprefixed prim) ($sputprop prim '*unprefixed* unprefixed))
(let* ([flags (if boolean-valued? (fxlogor flags (prim-mask boolean-valued)) flags)]
[flags (if (eq? 'single result-arity) (fxlogor flags (prim-mask single-valued)) flags)]
[flags (if (eq? 'true true-valued?) (fxlogor flags (prim-mask true)) flags)]
[arity (and (not (null? arity)) arity)])
(when (and (eq? result-arity 'multiple) (any-set? (prim-mask single-valued) flags))
($oops 'prims "inconsistent single-value information for ~s" prim))
@ -42,6 +43,7 @@
'#,(datum->syntax #'* (vector-map priminfo-mask v-info))
'#,(datum->syntax #'* (vector-map priminfo-arity v-info))
'#,(datum->syntax #'* (vector-map priminfo-boolean? v-info))
'#,(datum->syntax #'* (vector-map priminfo-true? v-info))
'#,(datum->syntax #'* (vector-map priminfo-result-arity v-info))
'#,(datum->syntax #'* (vector-map priminfo-signatures v-info)))))))