#lang racket/base
(require "../compile/known.rkt")

(provide register-known-primitives!)

(define (register-known-primitives! seen-defns)
  ;; Register some core primitives that have specific properties:
  (hash-set! seen-defns 'struct:exn:fail (known-struct-op 'struct-type 2))
  (hash-set! seen-defns 'make-thread-cell (known-struct-op 'constructor 1))
  (hash-set! seen-defns 'make-continuation-prompt-tag (known-struct-op 'constructor 1))
  (hash-set! seen-defns 'make-weak-hash (known-struct-op 'constructor 0))
  (hash-set! seen-defns 'make-hash (known-struct-op 'constructor 0))
  (hash-set! seen-defns 'gensym (known-struct-op 'constructor 0))
  (hash-set! seen-defns 'string (known-struct-op 'constructor 2))
  (hash-set! seen-defns 'cons (known-struct-op 'constructor 2))
  (hash-set! seen-defns 'vector (known-struct-op 'constructor #t))
  (hash-set! seen-defns 'list (known-struct-op 'constructor #t))
  (hash-set! seen-defns 'eq? (known-struct-op 'constructor 2))
  (hash-set! seen-defns 'not (known-predicate 'anything))
  (hash-set! seen-defns 'null? (known-predicate 'null))
  (hash-set! seen-defns 'integer? (known-predicate 'integer))
  (hash-set! seen-defns 'symbol? (known-predicate 'symbol))
  (hash-set! seen-defns 'exact-integer? (known-predicate 'exact-integer))
  (hash-set! seen-defns 'list? (known-predicate 'list))
  (hash-set! seen-defns 'length (known-function-of-satisfying '(list) 'exact-integer))
  (hash-set! seen-defns 'arithmetic-shift (known-function-of-satisfying '(exact-integer exact-integer) 'exact-integer))
  (hash-set! seen-defns 'arity-at-least? (known-predicate 'arity-at-least))
  (hash-set! seen-defns 'arity-at-least-value (known-function-of-satisfying '(arity-at-least) 'exact-integer))
  (hash-set! seen-defns 'procedure? (known-predicate 'procedure))
  (hash-set! seen-defns 'procedure-arity (known-function-of-satisfying '(procedure) 'any))
  (hash-set! seen-defns 'procedure-arity-mask (known-function-of-satisfying '(procedure) 'exact-integer))
  (hash-set! seen-defns 'procedure-realm (known-function-of-satisfying '(procedure) 'symbol))
  (hash-set! seen-defns 'object-name (known-function 1 #t)) ; hack: assumes no procedure-valued `prop:object-name` property
  (hash-set! seen-defns 'procedure-rename (known-function-of-satisfying '(procedure symbol symbol) 'procedure))
  (hash-set! seen-defns 'procedure-reduce-arity-mask (known-function-of-satisfying '(procedure exact-integer (or symbol false) symbol) 'procedure))
  (hash-set! seen-defns 'prop:custom-write (known-property-of-function 3))
  (hash-set! seen-defns 'prop:exn:srclocs (known-property-of-function 1))
  (hash-set! seen-defns 'prop:method-arity-error (known-property))
  (hash-set! seen-defns 'prop:incomplete-arity (known-property))
  (hash-set! seen-defns 'prop:impersonator-of (known-property-of-function 1))
  (hash-set! seen-defns 'prop:arity-string (known-property-of-function 1)))
