#lang racket/base

;; The information gathered here from Racket needs to be done in a
;; different way in the long run. Most of the same information is
;; in "kernel-primitives.scm", etc.

(provide known-procedures
         known-constructors
         known-struct-type-property/immediate-guards
         known-constants)

(define known-struct-type-property/immediate-guards
  '(prop:procedure
    prop:equal+hash
    prop:custom-write
    prop:evt))

;; Constructors with arities:
(define known-constructors
  '([cons 2]
    [list any]
    [vector any]))

(define-values (known-procedures known-constants)
  ;; Register primitives
  (let ([ns (make-base-namespace)])
    (parameterize ([current-namespace ns])
      (namespace-require 'racket/unsafe/ops)
      (namespace-require 'racket/flonum)
      (namespace-require 'racket/fixnum))
    (for/fold ([known-procedures null] [known-constants null]) ([s (in-list (namespace-mapped-symbols ns))])
      (with-handlers ([exn:fail? (lambda (x) (values known-procedures known-constants))])
        (cond
         [(procedure? (eval s ns))
          (values (cons s known-procedures) known-constants)]
         [(or (memq s known-struct-type-property/immediate-guards)
              (assq s known-constructors))
          (values known-procedures known-constants)]
         [else
          (values known-procedures (cons s known-constants))])))))

(module+ main
  (require racket/pretty)
  
  (call-with-output-file
   "known-primitive.sls"
   #:exists 'truncate
   (lambda (o)
     (displayln ";; this file is generated by known-primitive.rkt" o)
     (pretty-write
      `(library (known-primitive)
        (export known-procedures
                known-constructors
                known-struct-type-property/immediate-guards
                known-constants)
        (import (chezscheme))
        (define known-procedures ',(sort known-procedures symbol<?))
        (define known-constructors ',known-constructors)
        (define known-struct-type-property/immediate-guards ',known-struct-type-property/immediate-guards)
        (define known-constants ',(sort known-constants symbol<?)))
      o))))

 The information gathered here from Racket needs to be done in a
 different way in the long run. Most of the same information is
 in "kernel-primitives.scm", etc.
 Constructors with arities:
 Register primitives
#lang racket/base


(provide known-procedures
         known-constructors
         known-struct-type-property/immediate-guards
         known-constants)

(define known-struct-type-property/immediate-guards
  '(prop:procedure
    prop:equal+hash
    prop:custom-write
    prop:evt))

(define known-constructors
  '([cons 2]
    [list any]
    [vector any]))

(define-values (known-procedures known-constants)
  (let ([ns (make-base-namespace)])
    (parameterize ([current-namespace ns])
      (namespace-require 'racket/unsafe/ops)
      (namespace-require 'racket/flonum)
      (namespace-require 'racket/fixnum))
    (for/fold ([known-procedures null] [known-constants null]) ([s (in-list (namespace-mapped-symbols ns))])
      (with-handlers ([exn:fail? (lambda (x) (values known-procedures known-constants))])
        (cond
         [(procedure? (eval s ns))
          (values (cons s known-procedures) known-constants)]
         [(or (memq s known-struct-type-property/immediate-guards)
              (assq s known-constructors))
          (values known-procedures known-constants)]
         [else
          (values known-procedures (cons s known-constants))])))))

(module+ main
  (require racket/pretty)
  
  (call-with-output-file
   "known-primitive.sls"
   #:exists 'truncate
   (lambda (o)
     (displayln ";; this file is generated by known-primitive.rkt" o)
     (pretty-write
      `(library (known-primitive)
        (export known-procedures
                known-constructors
                known-struct-type-property/immediate-guards
                known-constants)
        (import (chezscheme))
        (define known-procedures ',(sort known-procedures symbol<?))
        (define known-constructors ',known-constructors)
        (define known-struct-type-property/immediate-guards ',known-struct-type-property/immediate-guards)
        (define known-constants ',(sort known-constants symbol<?)))
      o))))
