#lang racket/base
(require (prefix-in racket: (only-in racket/math pi sinh cosh sqr
                                     sgn conjugate))
         (prefix-in racket: racket/base)
         racket/provide
	 racket/local
	 (for-syntax racket/base)
         racket/stxparam
         
         (only-in '#%paramz
                  exception-handler-key
                  parameterization-key
                  break-enabled-key))

(require (prefix-in kernel: '#%kernel))


(provide exception-handler-key
         parameterization-key
         break-enabled-key)


(provide define-syntax-parameter
         syntax-parameterize)

;; constants
(define pi racket:pi)
(define e (racket:exp 1))


(define my-current-print-mode "write")
(define current-print-mode
  (case-lambda
    [() my-current-print-mode]
    [(v) (set! my-current-print-mode v)]))

(provide current-print-mode)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Primitive function stubs

;; provide-stub-function
(define-syntax (provide-stub-function stx)
  (syntax-case stx ()
    [(_ name-or-name-pair ...)
     (with-syntax ([(provided-name ...)
                    (map (lambda (name-or-pair)
                           (syntax-case name-or-pair ()
                             [x
                              (identifier? #'x)
                              #'x]
                             [(x y)
                              #'x]))
                         (syntax->list #'(name-or-name-pair ...)))]
                   [(impl-name ...) 
                    (map (lambda (name)
                           (syntax-case name ()
                             [an-id
                              (identifier? #'an-id)
                              (datum->syntax name 
                                             (string->symbol
                                              (string-append "racket:"
                                                             (symbol->string 
                                                              (syntax-e name))))
                                             name)]
                             [(an-id an-impl-name)
                              #'an-impl-name]))
                         (syntax->list #'(name-or-name-pair ...)))])
       (syntax/loc stx
         (begin (begin (define (provided-name . args) 
                         (racket:apply impl-name args))
                       (provide provided-name))
                ...)))]))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Provides
(provide pi
         e
         null
         eof
         #%plain-module-begin
	 #%module-begin
	 #%datum
	 #%app
         #%plain-app
	 #%top-interaction
	 #%top
         module
         define
	 define-values
         let-syntax
	 let-values
	 let*-values
	 define-struct
         struct
         if
	 cond
	 else
         =>
	 case
	 quote
	 unquote
	 unquote-splicing
	 lambda
	 case-lambda
	 let
	 let*
	 letrec
	 letrec-values
	 local
	 begin
	 begin0
	 set!
	 and
	 or
	 when
	 unless
         do
         require
	 for-syntax
         for-template
	 define-for-syntax
	 begin-for-syntax
	 prefix-in
	 only-in
         rename-in
         except-in
	 provide
	 planet
	 all-defined-out
	 all-from-out
         prefix-out
	 except-out
	 rename-out
	 struct-out
         filtered-out
         combine-in
         protect-out
         combine-out

         
         define-syntax-rule
	 define-syntax
	 define-syntaxes


         let/cc
	 with-continuation-mark

         hash?
         hash-equal?
         hash-eq?
         hash-eqv?
         hash
         hasheqv
         hasheq
         make-hash
         make-hasheqv
         make-hasheq
         make-immutable-hash
         make-immutable-hasheqv
         make-immutable-hasheq
         hash-copy
         hash-ref
         hash-set!
         hash-set
         hash-remove!
         hash-remove
         equal-hash-code
         hash-count


         ;; Kernel inlinable
         *
	 -
	 +
	 =
	 /
	 sub1
	 add1
	 <
	 >
	 <=
	 >=
         cons
         car
         cdr
         list
         list?
         pair?
         null?
         not
         eq?
         values

         ;; The version of apply in racket/base is doing some stuff that
         ;; we are not handling yet.  So we expose the raw apply here instead.
         (rename-out [kernel:apply apply])
         call-with-values

         gensym


         srcloc
         make-srcloc
         srcloc?
         srcloc-source
         srcloc-line
         srcloc-column
         srcloc-position
         srcloc-span


         make-struct-type
         make-struct-field-accessor
         make-struct-field-mutator
         struct-type?

         exn:fail
         struct:exn:fail
         prop:exn:srclocs


         current-inexact-milliseconds
         current-seconds
         

         abort-current-continuation
         
         ;; needed for cs019-local
         #%stratified-body
         )


(define (-identity x) x)

(define (-undefined? x)
  (letrec ([y y])
    (eq? x y)))



;; Many of these should be pushed upward rather than stubbed, so that
;; Racket's compiler can optimize these.
(provide-stub-function

 current-output-port
 current-print 



 write
 write-byte
 display
 newline
 displayln

 
 current-continuation-marks
 continuation-mark-set->list
 
;;  continuation-mark-set?
;;  continuation-mark-set->list

;;  struct-constructor-procedure?
;;  struct-predicate-procedure?
;;  struct-accessor-procedure?
;;  struct-mutator-procedure?

;;  make-arity-at-least
;;  arity-at-least?
;;  arity-at-least-value


;;  compose
;;  current-inexact-milliseconds
;;  current-seconds
  void
  random
;;  sleep
;;  (identity -identity)

raise  
error
raise-type-error
raise-mismatch-error

make-exn
make-exn:fail
make-exn:fail:contract
make-exn:fail:contract:arity
make-exn:fail:contract:variable
make-exn:fail:contract:divide-by-zero

exn-message
exn-continuation-marks


;;  exn?
;;  exn:fail?
;;  exn:fail:contract?
;;  exn:fail:contract:arity?
;;  exn:fail:contract:variable?
;;  exn:fail:contract:divide-by-zero?
  abs
  quotient
  remainder
  modulo
  max
  min
  gcd
  lcm
  floor
  ceiling
  round
  truncate
  numerator
  denominator
  expt
  exp
  log
  sin
  sinh
  cos
  cosh
  tan
  asin
  acos
  atan
  sqr
  sqrt
  integer-sqrt
  sgn
  make-rectangular
  make-polar
  real-part
  imag-part
  angle
  magnitude
  conjugate
  inexact->exact
  exact->inexact
  number->string
  string->number
  procedure?
  procedure-arity
  procedure-arity-includes?
  procedure-rename
  ;;  (undefined? -undefined?)
;;  immutable?
void?
symbol?
string?
char?
boolean?
vector?
struct?
;;  bytes?
byte?
number?
complex?
real?
rational?
integer?
exact-integer?
exact?
exact-nonnegative-integer?
inexact?
odd?
even?
zero?
positive?
negative?
box?
;;  hash?

  equal?
  eqv?
  
  caar
  cdar
  cadr
  cddr
  caaar
  cdaar
  cadar
  cddar
  caadr
  cdadr
  caddr
  cdddr
  caaaar
  cdaaar
  cadaar
  cddaar
  caadar
  cdadar
  caddar
  cdddar
  caaadr
  cdaadr
  cadadr
  cddadr
  caaddr
  cdaddr
  cadddr
  cddddr
  
  length
  list*
  list-ref
;;  list-tail
  append
  reverse
  for-each
  map
  andmap
  ormap
  memq
  memv
  member
  memf
  assq
  assv
  assoc
;;  sort
  box
;;  box-immutable
  unbox
  set-box!
;;  make-hash
;;  make-hasheq
;;  hash-set!
;;  hash-ref
;;  hash-remove!
;;  hash-map
;;  hash-for-each
  make-string
  string
  string-length
  string-ref
  string=?
  string<?
  string>?
  string<=?
  string>=?
  string-ci=?
  string-ci<?
  string-ci>?
  string-ci<=?
  string-ci>=?

  string-copy
  substring
  string-append
  string->list
  list->string
  string->symbol
  symbol->string
  
  format
  printf
  fprintf
;;  string->immutable-string
  string-set!
;;  string-fill!
;;  make-bytes
;;  bytes
;;  bytes->immutable-bytes
;;  bytes-length
;;  bytes-ref
;;  bytes-set!
;;  subbytes
;;  bytes-copy
;;  bytes-fill!
;;  bytes-append
;;  bytes->list
;;  list->bytes
;;  bytes=?
;;  bytes<?
;;  bytes>?
  make-vector
  vector
  vector-length
  vector-ref
  vector-set!
  vector->list
  list->vector
  char=?
  char<?
  char>?
  char<=?
  char>=?
  char-ci=?
  char-ci<?
  char-ci>?
  char-ci<=?
  char-ci>=?
  char-alphabetic?
  char-numeric?
  char-whitespace?
  char-upper-case?
  char-lower-case?
  char->integer
  integer->char
  char-upcase
  char-downcase

  
  ;; these are defined in bootstrapped-primitives in Whalesong's compiler package
  call-with-current-continuation
  call/cc

  ;;  call-with-continuation-prompt
  ;;  abort-current-continuation
  default-continuation-prompt-tag
  make-continuation-prompt-tag
  continuation-prompt-tag?

  make-reader-graph
  make-placeholder
  placeholder-set!

  eof-object?
  read-byte


  hash-has-key?
  hash-keys
  hash-values
  )





(provide set-car! set-cdr!)

(define (set-car! x v)
  (error 'set-car! "Not available outside JavaScript context."))

(define (set-cdr! x v)
  (error 'set-car! "Not available outside JavaScript context."))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;