From e37833b603360ca7c3329a80d5073770a275c632 Mon Sep 17 00:00:00 2001 From: Gustavo Massaccesi Date: Sun, 2 Apr 2017 13:03:56 -0300 Subject: [PATCH] Add `signatures` field to primref record primref.ss, primvars.ss original commit: 0d044806bd5c645bf2c4caf701c2615d6150f8bf --- s/base-lang.ss | 4 ++-- s/primref.ss | 4 ++-- s/primvars.ss | 11 ++++++----- 3 files changed, 10 insertions(+), 9 deletions(-) diff --git a/s/base-lang.ss b/s/base-lang.ss index 8a18331ca6..3787eb6279 100644 --- a/s/base-lang.ss +++ b/s/base-lang.ss @@ -14,14 +14,14 @@ ;;; limitations under the License. (module (Lsrc Lsrc? Ltype Ltype? unparse-Ltype unparse-Lsrc count-Lsrc - lookup-primref primref? primref-name primref-level primref-flags primref-arity + lookup-primref primref? primref-name primref-level primref-flags primref-arity primref-signatures 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* target-fixnum? target-bignum?) - (module (lookup-primref primref? primref-name primref-flags primref-arity primref-level) + (module (lookup-primref primref? primref-name primref-flags primref-arity primref-signatures primref-level) (include "primref.ss") (define $lookup-primref diff --git a/s/primref.ss b/s/primref.ss index 6f734bb8e8..16438fc667 100644 --- a/s/primref.ss +++ b/s/primref.ss @@ -14,9 +14,9 @@ ;;; limitations under the License. (define-record-type primref - (nongenerative #{primref a0xltlrcpeygsahopkplcn-2}) + (nongenerative #{primref a0xltlrcpeygsahopkplcn-3}) (sealed #t) - (fields name flags arity)) + (fields name flags arity signatures)) (define primref-level (lambda (pr) diff --git a/s/primvars.ss b/s/primvars.ss index 3a5b6748aa..a1bb600173 100644 --- a/s/primvars.ss +++ b/s/primvars.ss @@ -18,19 +18,19 @@ (include "primref.ss") (define record-prim! - (lambda (prim unprefixed flags arity boolean-valued?) + (lambda (prim unprefixed flags arity boolean-valued? signatures) (unless (eq? unprefixed prim) ($sputprop prim '*unprefixed* unprefixed)) (let ([flags (if boolean-valued? (fxlogor flags (prim-mask boolean-valued)) flags)] [arity (and (not (null? arity)) arity)]) ($sputprop prim '*flags* flags) (when (any-set? (prim-mask (or primitive system)) flags) - ($sputprop prim '*prim2* (make-primref prim flags arity)) - ($sputprop prim '*prim3* (make-primref prim (fxlogor flags (prim-mask unsafe)) arity)))))) + ($sputprop prim '*prim2* (make-primref prim flags arity signatures)) + ($sputprop prim '*prim3* (make-primref prim (fxlogor flags (prim-mask unsafe)) arity signatures)))))) (define-syntax setup (lambda (x) (import priminfo) - ; sort vector of primitive names so boot files compare equal + ; sort vector of primitive names so boot files compare equal (let ([v-prim (vector-sort (lambda (x y) (string<=? (symbol->string x) (symbol->string y))) (primvec))]) (let ([v-info (vector-map get-priminfo v-prim)]) #`(vector-for-each record-prim! @@ -38,7 +38,8 @@ '#,(datum->syntax #'* (vector-map priminfo-unprefixed v-info)) '#,(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-boolean? v-info)) + '#,(datum->syntax #'* (vector-map priminfo-signatures v-info))))))) (for-each (lambda (x) (for-each (lambda (key) ($sremprop x key)) '(*prim2* *prim3* *flags* *unprefixed*))) (oblist)) setup)