;;; Modules
;;; Copyright (C) 2024, 2025 Igalia, S.L.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

;;; Commentary:
;;;
;;; Run-time representation of module trees.
;;;
;;; Code:

(library (hoot primitives-module)
  (export initialize-primitives!)
  (import (hoot modules)
          (hoot errors)
          (hoot primitives))

  (define (install-primitive-definitions! m)
    (define-syntax-rule (install! prim v)
      (begin
        (module-define! m 'prim v #:mutable? #f)
        (module-export! m 'prim)))
    (define-syntax-rule (install/1! prim)
      (install! prim (lambda (a) (prim a))))
    (define-syntax-rule (install/2! prim)
      (install! prim (lambda (a b) (prim a b))))
    (define-syntax-rule (install/3! prim)
      (install! prim (lambda (a b c) (prim a b c))))
    (define-syntax-rule (install-placeholder! prim)
      (install! prim (lambda args (error "placeholder definition" 'prim))))

    (install! target-runtime (lambda () 'hoot))
    (install/2! %*)
    (install/2! %+)
    (install/2! %-)
    (install/2! %/)
    (install/2! %<)
    (install/2! %<=)
    (install/2! %=)
    (install/2! %>)
    (install/2! %>=)
    (install! %abort-to-prompt %abort-to-prompt)
    (install/1! %abs)
    (install/1! %acos)
    (install/2! %append)
    (install/2! %ash)
    (install/1! %asin)
    (install! %atan (case-lambda ((x) (%atan x)) ((x y) (%atan x y))))
    (install/3! %atomic-box-compare-and-swap!)
    (install/1! %atomic-box-ref)
    (install/2! %atomic-box-set!)
    (install/2! %atomic-box-swap!)
    (install/1! %bitvector?)
    (install/1! %box-ref)
    (install/2! %box-set!)
    (install/2! %bytevector-ieee-double-native-ref)
    (install/3! %bytevector-ieee-double-native-set!)
    (install/2! %bytevector-ieee-single-native-ref)
    (install/3! %bytevector-ieee-single-native-set!)
    (install/1! %bytevector-length)
    (install/2! %bytevector-s16-native-ref)
    (install/3! %bytevector-s16-native-set!)
    (install/2! %bytevector-s32-native-ref)
    (install/3! %bytevector-s32-native-set!)
    (install/2! %bytevector-s64-native-ref)
    (install/3! %bytevector-s64-native-set!)
    (install/2! %bytevector-s8-ref)
    (install/3! %bytevector-s8-set!)
    (install/2! %bytevector-u16-native-ref)
    (install/3! %bytevector-u16-native-set!)
    (install/2! %bytevector-u32-native-ref)
    (install/3! %bytevector-u32-native-set!)
    (install/2! %bytevector-u64-native-ref)
    (install/3! %bytevector-u64-native-set!)
    (install/2! %bytevector-u8-ref)
    (install/3! %bytevector-u8-set!)
    (install/1! %bytevector?)
    (install/3! %call-with-prompt)
    (install-placeholder! %call-with-values) ; /2
    (install/1! %car)
    (install/1! %cdr)
    (install/1! %ceiling)
    (install/1! %char->integer)
    (install/1! %char?)
    (install/1! %complex?)
    (install/2! %cons)
    (install/1! %cos)
    (install-placeholder! %dynamic-wind) ; /3
    (install/1! %eof-object?)
    (install/2! %eq?)
    (install/2! %eqv?)
    (install/1! %exact-integer?)
    (install/1! %exact?)
    (install/1! %floor)
    (install/1! %fluid-ref)
    (install/2! %fluid-set!)
    (install/1! %inexact)
    (install/1! %inexact?)
    (install/1! %integer->char)
    (install/1! %integer?)
    (install/1! %keyword->symbol)
    (install/1! %keyword?)
    (install/2! %logand)
    (install-placeholder! %logbit?) ; /2
    (install/2! %logior)
    (install-placeholder! %lognot) ; /1
    (install/2! %logtest)
    (install/2! %logxor)
    (install/1! %make-atomic-box)
    (install/1! %make-box)
    (install-placeholder! %make-struct)
    (install/2! %make-vector)
    (install/2! %modulo)
    (install/1! %null?)
    (install/1! %number?)
    (install/1! %pair?)
    (install/1! %procedure?)
    (install/2! %quotient)
    (install/1! %raise-exception)
    (install/1! %rational?)
    (install/1! %real?)
    (install/2! %remainder)
    (install/2! %set-car!)
    (install/2! %set-cdr!)
    (install/1! %sin)
    (install/1! %sqrt)
    (install/1! %string->symbol)
    (install/1! %string->utf8)
    (install/1! %string-length)
    (install/2! %string-ref)
    (install-placeholder! %string-utf8-length) ; /1
    (install/1! %string?)
    (install-placeholder! %struct-ref) ; /2
    (install-placeholder! %struct-set!) ; /3
    (install/1! %struct-vtable)
    (install/1! %struct?)
    (install/1! %symbol->keyword)
    (install/1! %symbol->string)
    (install/1! %symbol?)
    (install/1! %tan)
    (install/1! %utf8->string)
    (install! %values %values)
    (install/1! %vector-length)
    (install/2! %vector-ref)
    (install/3! %vector-set!)
    (install/1! %vector?)
    (install/2! %with-dynamic-state)
    (install/3! %with-fluid*)
    (install! apply apply)

    ;; TODO:
    (install-placeholder! %cons*)
    (install-placeholder! %datum->syntax)
    (install-placeholder! %error)
    (install-placeholder! %inline-wasm)
    (install-placeholder! %syntax->datum)
    (install-placeholder! %the-eof-object)
    (install-placeholder! %vector)
    (install-placeholder! %wasm-import)
    (install-placeholder! bound-identifier=?)
    (install-placeholder! free-identifier=?)
    (install-placeholder! generate-temporaries)
    (install-placeholder! gensym)
    (install-placeholder! guile:bytevector-copy!)
    (install-placeholder! guile:fluid?)
    (install-placeholder! guile:hash)
    (install-placeholder! guile:hashq)
    (install-placeholder! guile:hashv)
    (install-placeholder! guile:make-bytevector)
    (install-placeholder! guile:make-fluid)
    (install-placeholder! guile:make-parameter)
    (install-placeholder! guile:make-record-type)
    (install-placeholder! guile:make-regexp)
    (install-placeholder! guile:make-syntax)
    (install-placeholder! guile:make-void-port)
    (install-placeholder! guile:match:count)
    (install-placeholder! guile:match:end)
    (install-placeholder! guile:match:start)
    (install-placeholder! guile:match:string)
    (install-placeholder! guile:match:substring)
    (install-placeholder! guile:parameter-converter)
    (install-placeholder! guile:parameter-fluid)
    (install-placeholder! guile:parameter?)
    (install-placeholder! guile:pk)
    (install-placeholder! guile:record-type-parents)
    (install-placeholder! guile:regexp-exec)
    (install-placeholder! guile:regexp-match?)
    (install-placeholder! guile:regexp?)
    (install-placeholder! guile:string->list)
    (install-placeholder! guile:string-copy)
    (install-placeholder! guile:struct-vtable?)
    (install-placeholder! guile:syntax-expression)
    (install-placeholder! guile:syntax-module)
    (install-placeholder! guile:syntax-module-bindings)
    (install-placeholder! guile:syntax-sourcev)
    (install-placeholder! guile:syntax-wrap)
    (install-placeholder! guile:syntax?)
    (install-placeholder! guile:vtable-index-printer)
    (install-placeholder! identifier?)
    (install-placeholder! include-from-path)
    (install-placeholder! make-variable-transformer)
    (install-placeholder! procedure-property)
    (install-placeholder! syntax-local-binding)
    (install-placeholder! syntax-violation)

    (install-placeholder! _)
    (install-placeholder! ...)
    (install-placeholder! =>)
    (install-placeholder! else)
    (install-placeholder! lambda)
    (install-placeholder! case-lambda)
    (install-placeholder! define)
    (install-placeholder! let)
    (install-placeholder! let*)
    (install-placeholder! letrec)
    (install-placeholder! letrec*)
    (install-placeholder! or)
    (install-placeholder! and)
    (install-placeholder! begin)
    (install-placeholder! if)
    (install-placeholder! cond)
    (install-placeholder! case)
    (install-placeholder! when)
    (install-placeholder! unless)
    (install-placeholder! do)
    (install-placeholder! set!)
    (install-placeholder! quote)
    (install-placeholder! quasiquote)
    (install-placeholder! unquote)
    (install-placeholder! unquote-splicing)
    (install-placeholder! include)
    (install-placeholder! include-ci)
    (install-placeholder! define-syntax)
    (install-placeholder! let-syntax)
    (install-placeholder! letrec-syntax)
    (install-placeholder! syntax-rules)
    (install-placeholder! syntax-error)
    (install-placeholder! define-syntax-rule)
    (install-placeholder! syntax-case)
    (install-placeholder! syntax)
    (install-placeholder! quasisyntax)
    (install-placeholder! unsyntax)
    (install-placeholder! unsyntax-splicing)
    (install-placeholder! with-syntax)
    (install-placeholder! identifier-syntax)
    (install-placeholder! lambda*)
    (install-placeholder! case-lambda*)
    (install-placeholder! define*)

    #t)
  
  (define (initialize-primitives! mod)
    (install-primitive-definitions! mod)
    (%values)))
