; C Library
;
; Copyright (C) 2026 Kestrel Institute (http://www.kestrel.edu)
;
; License: A 3-clause BSD license. See the LICENSE file distributed with ACL2.
;
; Author: Alessandro Coglio (www.alessandrocoglio.info)

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

(in-package "C$")

(include-book "files")
(include-book "printer")
(include-book "standard")
(include-book "code-ensembles")

(include-book "kestrel/file-io-light/write-bytes-to-file-bang" :dir :system)
(include-book "std/system/constant-value" :dir :system)
(include-book "kestrel/utilities/er-soft-plus" :dir :system)
(include-book "kestrel/utilities/keyword-value-lists" :dir :system)
(include-book "std/util/error-value-tuples" :dir :system)
(include-book "system/pseudo-event-formp" :dir :system)

(local (include-book "std/system/partition-rest-and-keyword-args" :dir :system))
(local (include-book "std/system/w" :dir :system))
(local (include-book "std/alists/top" :dir :system))
(local (include-book "std/typed-alists/symbol-alistp" :dir :system))
(local (include-book "std/typed-lists/character-listp" :dir :system))
(local (include-book "std/typed-lists/string-listp" :dir :system))

(local (include-book "kestrel/built-ins/disable" :dir :system))
(local (acl2::disable-most-builtin-logic-defuns))
(local (acl2::disable-builtin-rewrite-rules-for-defaults))
(set-induction-depth-limit 0)

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

(defrulel unsigned-byte-listp-8-when-byte-listp
  (implies (byte-listp x)
           (acl2::unsigned-byte-listp 8 x))
  :induct t
  :enable (byte-listp bytep unsigned-byte-p))

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

(defxdoc+ output-files-implementation
  :parents (output-files)
  :short "Implementation of @(tsee output-files)."
  :long
  (xdoc::topstring
   (xdoc::p
    "This also implements the programmatic interface @(tsee output-files-prog).
     The flag @('progp'), passed to some of the implementation functions below,
     says whether the programmatic interface has been called."))
  :order-subtopics t
  :default-parent t)

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

(defval *output-files-allowed-options*
  :short "Keyword options accepted by @(tsee output-files)."
  (list :const
        :base-dir
        :printer-options)
  ///
  (assert-event (keyword-listp *output-files-allowed-options*))
  (assert-event (no-duplicatesp-eq *output-files-allowed-options*)))

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

(defval *output-files-printer-options*
  :short "Keyword options accepted in
          the @(':printer-options') of @(tsee output-files)."
  (list :indentation-size)
  ///
  (assert-event (keyword-listp *output-files-printer-options*))
  (assert-event (no-duplicatesp-eq *output-files-printer-options*)))

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

(define output-files-process-const/arg (arg
                                        (options symbol-alistp)
                                        (progp booleanp)
                                        (wrld plist-worldp))
  :returns (mv erp (code code-ensemblep))
  :short "Process the @(':const') or @('arg') input."
  (b* (((reterr) (irr-code-ensemble))
       (const-option (assoc-eq :const options))
       ((erp code)
        (if progp
            (b* (((when const-option)
                  (reterr (msg "The :CONST input must not be supplied ~
                                to the programmatic interface."))))
              (retok arg))
          (b* (((unless const-option)
                (reterr (msg "The :CONST input must be supplied, ~
                              but it was not supplied.")))
               (const (cdr const-option))
               ((unless (symbolp const))
                (reterr (msg "The :CONST input must be a symbol, ~
                              but it is ~x0 instead."
                             const)))
               (code (acl2::constant-value const wrld)))
            (retok code))))
       (desc (if progp
                 "the required (i.e. non-keyword-option) input"
               (msg "the value of the ~x0 named constant, ~
                     specified by the :CONST input,"
                    (cdr const-option))))
       ((unless (code-ensemblep code))
        (reterr (msg "~@0 must be a code ensemble, ~
                      but it is ~x1 instead."
                     desc code)))
       ((unless (code-ensemble-unambp code))
        (reterr (msg "The code ensemble ~x0 passed as ~@1 ~
                      is ambiguous."
                     code desc)))
       ((unless (code-ensemble-aidentp code))
        (reterr (msg "The code ensemble ~x0 passed as ~@1 ~
                      contains non-all-ASCII identifiers."
                     code desc)))
       ((unless (or (ienv->gcc/clang (code-ensemble->ienv code))
                    (trans-ensemble-standardp
                     (code-ensemble->trans-units code))))
        (reterr (msg "The code ensemble ~x0 passed as ~@1 ~
                      uses non-standard syntax (i.e. GCC/Clang extensions), ~
                      but the implementation environment indicates that ~
                      GCC/Clang extensions are not enabled."
                     code desc))))
    (retok code))

  ///

  (defret code-ensemblep-when-output-files-process-const/arg
    (implies (not erp)
             (code-ensemblep code)))

  (defret code-ensemble-unambp-when-output-files-process-const/arg
    (implies (not erp)
             (code-ensemble-unambp code)))

  (defret code-ensemble-aidentp-when-output-files-process-const/arg
    (implies (not erp)
             (code-ensemble-aidentp code)))

  (in-theory
   (disable code-ensemblep-when-output-files-process-const/arg
            code-ensemble-unambp-when-output-files-process-const/arg
            code-ensemble-aidentp-when-output-files-process-const/arg)))

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

(define output-files-process-base-dir ((options symbol-alistp))
  :returns (mv erp (base-dir stringp))
  :short "Process the @(':base-dir') input."
  (b* (((reterr) "")
       (base-dir-option (assoc-eq :base-dir options))
       (base-dir (if base-dir-option
                     (cdr base-dir-option)
                   "."))
       ((unless (stringp base-dir))
        (reterr (msg "The :BASE-DIR input must be a string, ~
                      but it is ~x0 instead."
                     base-dir)))
       (base-dir-chars (str::explode base-dir))
       ((unless (consp base-dir-chars))
        (reterr (msg "The :BASE-DIR input must be not empty, ~
                      but it is the empty string instead.")))
       (base-dir-chars (if (and (consp (cdr base-dir-chars))
                                (eql (car (last base-dir-chars)) #\/))
                           (butlast base-dir-chars 1)
                         base-dir-chars))
       (base-dir (str::implode base-dir-chars)))
    (retok base-dir)))

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

(define output-files-process-printer-options ((options symbol-alistp))
  :returns (mv erp
               (indent-size posp)
               (paren-nested-conds booleanp))
  :short "Process the @(':printer-options') input."
  (b* (((reterr) 1 nil)
       (printer-options-option (assoc-eq :printer-options options))
       (printer-options (if printer-options-option
                            (cdr printer-options-option)
                          nil))
       ((unless (keyword-value-listp printer-options))
        (reterr (msg "The :PRINTER-OPTIONS input must be ~
                      a value-keyword list, ~
                      but it is ~x0 instead."
                     printer-options)))
       (printer-options-alist (keyword-value-list-to-alist printer-options))
       (printer-options-keywords (strip-cars printer-options-alist))
       ((unless (no-duplicatesp-eq printer-options-keywords))
        (reterr (msg "The list of keywords in the :PRINTER-OPTIONS input ~
                      must have no duplicates, ~
                      but the supplied :PRINTER-OPTIONS input ~x0 ~
                      violates that requirement."
                     printer-options)))
       ((unless (subsetp-eq printer-options-keywords
                            *output-files-printer-options*))
        (reterr (msg "The list of keywords in the :PRINTER-OPTIONS input ~
                      must be among ~&0, ~
                      but the supplied :PRINTER-OPTIONS input ~x1 ~
                      violates that requirement."
                     *output-files-printer-options*
                     printer-options)))
       ;; Process :INDENTATION-SIZE sub-input.
       (indent-size-option (assoc-eq :indentation-size
                                     printer-options-alist))
       (indent-size (if indent-size-option
                        (cdr indent-size-option)
                      2))
       ((unless (posp indent-size))
        (reterr (msg "The :INDENTATION-LEVEL option ~
                      of the :PRINTER-OPTIONS input ~
                      must be a positive integer, ~
                      but it is ~x0 instead."
                     indent-size)))
       ;; Process :PARENTHESIZE-NESTED-CONDITIONALS input.
       (paren-nested-conds-option (assoc-eq :parenthesize-nested-conditional
                                            printer-options-alist))
       (paren-nested-conds (if paren-nested-conds-option
                               (cdr paren-nested-conds-option)
                             nil))
       ((unless (booleanp paren-nested-conds))
        (reterr (msg "The :PARENTHESIZE-NESTED-CONDITIONALS option ~
                      of the :PRINTER-OPTIONS input ~
                      must be a boolean, ~
                      but it is ~x0 instead."
                     paren-nested-conds))))
    (retok indent-size paren-nested-conds)))

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

(define output-files-process-inputs (arg
                                     (args true-listp)
                                     (progp booleanp)
                                     (wrld plist-worldp))
  :guard (implies (not progp) (not arg))
  :returns (mv erp
               (code
                code-ensemblep
                :hints
                (("Goal"
                  :in-theory
                  (enable
                   code-ensemblep-when-output-files-process-const/arg))))
               (base-dir stringp)
               (indent-size posp)
               (paren-nested-conds booleanp))
  :short "Process the inputs."
  :long
  (xdoc::topstring
   (xdoc::p
    "If @('progp') is @('t'),
     @('arg') is the required (i.e. non-keyword-option) input
     of the macro that provides the programmatic interface;
     if instead @('progp') is @('nil'), @('arg') is @('nil').
     In all cases, @('args') are all the remaining inputs
     of the (event or programmatic) macro.")
   (xdoc::p
    "If @('progp') is @('nil'),
     the code ensemble
     is taken from the @(':const') input, which must be present.
     If instead @('progp') is @('t'),
     the code ensemble or file set
     is taken from the required input @('arg'),
     and the @(':const') input must be absent.")
   (xdoc::p
    "The @('code') result of this function is the code ensemble.
     The other results are the homonymous inputs
     (some are sub-inputs of the @(':printer-options') input).")
   (xdoc::p
    "If the @(':base-dir') string is not @('/') but ends with @('/'),
     we remove the ending @('/').
     This is for uniformity when concatenating this
     with the files specified in the @(':files') input."))
  (b* (((reterr) (irr-code-ensemble) "" 1 nil)
       ;; Check and obtain inputs.
       ((mv erp extra options)
        (partition-rest-and-keyword-args args *output-files-allowed-options*))
       (inputs-desc (msg "a code ensemble and the options ~&0"
                         *output-files-allowed-options*))
       ((when erp)
        (reterr (msg "The inputs must be ~@0, ~
                      but instead they are ~x1."
                     inputs-desc
                     args)))
       ((when extra)
        (reterr (msg "The inputs must be ~@0, ~
                      but instead the extra inputs ~x1 were supplied."
                     inputs-desc
                     extra)))
       ;; Process the inputs.
       ((erp code)
        (output-files-process-const/arg arg options progp wrld))
       ((erp base-dir) (output-files-process-base-dir options))
       ((erp indent-size paren-nested-conds)
        (output-files-process-printer-options options)))
    (retok code
           base-dir
           indent-size
           paren-nested-conds))
  :guard-hints (("Goal" :in-theory (enable acl2::alistp-when-symbol-alistp
                                           msgp
                                           character-alistp)))

  ///

  (defret code-ensemble-unambp-of-output-files-process-inputs
    (implies (not erp)
             (code-ensemble-unambp code))
    :hints
    (("Goal"
      :in-theory
      (enable code-ensemble-unambp-when-output-files-process-const/arg))))

  (defret code-aidentp-of-output-files-process-inputs
    (implies (not erp)
             (code-ensemble-aidentp code))
    :hints
    (("Goal"
      :in-theory
      (enable code-ensemble-aidentp-when-output-files-process-const/arg)))))

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

(define output-files-gen-files ((code code-ensemblep)
                                (base-dir stringp)
                                (indent-size posp)
                                (paren-nested-conds booleanp)
                                state)
  :guard (and (code-ensemble-unambp code)
              (code-ensemble-aidentp code))
  :returns (mv erp state)
  :short "Generate the files."
  (b* (((reterr) state)
       ;; Print the abstract syntax.
       (options (make-priopt :indent-size indent-size
                             :paren-nested-conds paren-nested-conds))
       (tunits (code-ensemble->trans-units code))
       (files (print-fileset tunits
                             options
                             (ienv->dialect (code-ensemble->ienv code))))
       ;; Write the files to the file system.
       ((erp state)
        (output-files-gen-files-loop (fileset->files files) base-dir state)))
    (retok state))
  :guard-hints (("Goal" :in-theory (enable code-ensemble-aidentp)))
  :prepwork
  ((define output-files-gen-files-loop ((map filepath-filedata-mapp)
                                        (base-dir stringp)
                                        state)
     :returns (mv erp state)
     :parents nil
     (b* (((reterr) state)
          ((when (omap::emptyp map)) (retok state))
          ((mv filepath data) (omap::head map))
          (file-string (filepath->string filepath))
          (path-to-write (str::cat base-dir "/" file-string))
          ((mv erp state) (acl2::write-bytes-to-file! (filedata->bytes data)
                                                      path-to-write
                                                      'output-files
                                                      state))
          ((when erp)
           (reterr (msg "Writing ~x0 failed." path-to-write))))
       (output-files-gen-files-loop (omap::tail map) base-dir state)))))

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

(define output-files-process-inputs-and-gen-files (arg
                                                   (args true-listp)
                                                   (progp booleanp)
                                                   state)
  :guard (implies (not progp) (not arg))
  :returns (mv erp state)
  :short "Process the inputs and generate the files."
  (b* (((reterr) state)
       ((erp tunits
             base-dir
             indent-size
             paren-nested-conds)
        (output-files-process-inputs arg args progp (w state)))
       ((erp state)
        (output-files-gen-files tunits
                                base-dir
                                indent-size
                                paren-nested-conds
                                state)))
    (retok state)))

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

(define output-files-fn ((args true-listp) (ctx ctxp) state)
  :returns (mv erp (event pseudo-event-formp) state)
  :short "Event expansion of @(tsee output-files) from the inputs."
  :long
  (xdoc::topstring
   (xdoc::p
    "We set the flag @('progp') for the programmatic interface to @('nil')."))
  (b* (((mv erp state)
        (output-files-process-inputs-and-gen-files nil args nil state))
       ((when erp) (er-soft+ ctx t '(_) "~@0" erp)))
    (acl2::value '(value-triple :invisible))))

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

(defsection output-files-definition
  :short "Definition of the @(tsee output-files) macro."
  (defmacro output-files (&rest args)
    `(make-event-terse
      (output-files-fn ',args 'output-files state))))

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

(defxdoc+ output-files-prog
  :parents (output-files)
  :short "Programmatic interface to @(tsee output-files)."
  :long
  (xdoc::topstring
   (xdoc::p
    "This (non-event) macro provides
     a programmatic interface to the functionality of @(tsee output-files).
     It has the form:")
   (xdoc::codeblock
    "(output-files-prog code"
    "                   :base-dir        ...  ; default \".\""
    "                   :printer-options ...  ; default nil"
    "  )")
   (xdoc::p
    "This is the same as @(tsee output-files),
     except that there is no @(':const') input,
     and there is a required (i.e. non-keyword-option) input
     which must be the code ensemble.
     This macro writes the files,
     and returns an "
    (xdoc::seetopic "acl2::error-value-tuples" "error-value tuple")
    " consisting of @('state'), i.e. the ACL2 @(see state).")
   (xdoc::p
    "Note that the macro implicitly takes @(tsee state),
     so it must be used in a context where @(tsee state) is available."))
  :order-subtopics t
  :default-parent t)

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

(define output-files-prog-fn (arg (args true-listp) state)
  :returns (mv erp state)
  :short "Implementation of @(tsee output-files-prog)."
  :long
  (xdoc::topstring
   (xdoc::p
    "We set the flag @('progp') for the programmatic interface to @('t').
     We ignore the event returned as result,
     and instead return the file set."))
  (b* (((reterr) state)
       ((erp state)
        (output-files-process-inputs-and-gen-files arg args t state)))
    (retok state)))

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

(defsection output-files-prog-definition
  :short "Definition of the @(tsee output-files-prog) macro."
  (defmacro output-files-prog (arg &rest args)
    `(output-files-prog-fn ,arg ',args state)))
