(define-module (embedded)
  #:use-module (guix utils)
  #:use-module (guix gexp)
  #:use-module (guix memoization)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module (guix build-system trivial)
  #:use-module (gnu packages)
  #:use-module (gnu packages embedded)
  #:use-module (gnu packages flex)
  #:use-module (gnu packages cross-base)
  #:use-module (gnu packages texinfo)
  #:use-module (guix build utils)
  #:use-module (gnu packages gcc)

  #:export (make-gcc-arm-none-eabi-12.3.rel1
            make-newlib-nano-arm-none-eabi-12.3.rel1
            make-newlib-arm-none-eabi-12.3.rel1
            arm-none-eabi-nano-toolchain-12.3.rel1
            arm-none-eabi-toolchain-12.3.rel1))

(define make-gcc-arm-none-eabi-12.3.rel1
  (mlambda ()
    (let ((xgcc (cross-gcc "arm-none-eabi"
                           #:xgcc gcc-12
                           #:xbinutils (cross-binutils "arm-none-eabi"))))
      (package (inherit xgcc)
               (source
                (origin
                  (inherit (package-source xgcc))
                  (method git-fetch)
                  (uri (git-reference
                        (url "git://gcc.gnu.org/git/gcc.git")
                        (commit "0f54a73b998b72f7c8452a63730ec3b16fc47854")))
                  (sha256
                   (base32 "0r6q0m3d8g3k3rkmnqjw8aw5fcnsrmywf4ispdkxmk1al3whk1vk"))))
               (native-inputs
                (modify-inputs (package-native-inputs xgcc)
                  (delete "isl")
                  (prepend flex isl-0.18)))
               (arguments
                (substitute-keyword-arguments (package-arguments xgcc)
                  ((#:phases phases)
                   #~(modify-phases #$phases

                       (add-after 'set-paths 'augment-CPLUS_INCLUDE_PATH
                         (lambda* (#:key inputs #:allow-other-keys)
                           (let ((gcc (assoc-ref inputs  "gcc")))
                             ;; Remove the default compiler from
                             ;; CPLUS_INCLUDE_PATH to prevent header conflict
                             ;; with the GCC from native-inputs.
                             (setenv "CPLUS_INCLUDE_PATH"
                                     (string-join
                                      (delete (string-append gcc "/include/c++")
                                              (string-split
                                               (getenv "CPLUS_INCLUDE_PATH")
                                               #\:))
                                      ":"))
                             (format #t
                                     "environment variable `CPLUS_INCLUDE_PATH'\
 changed to ~a~%"
                                     (getenv "CPLUS_INCLUDE_PATH")))))))
                  ((#:configure-flags flags)
                   ;; The configure flags are largely identical to the flags
                   ;; used by the "GCC ARM embedded" project.
                   #~(append (list "--disable-libgomp"
                                   "--disable-libmudflap"
                                   "--disable-libquadmath"
                                   "--disable-shared"
                                   "--disable-nls"
                                   "--disable-threads"
                                   "--disable-tls"
                                   "--without-cloog"
                                   "--without-isl"
                                   "--with-newlib"
                                   "--with-headers=yes"
                                   "--enable-checking=release"
                                   "--enable-languages=c,c++"
                                   "--with-gnu-as"
                                   "--with-gnu-ld"
                                   "--enable-multilib"
                                   "--with-host-libstdcxx=-static-libgcc \
-Wl,-Bstatic,-lstdc++,-Bdynamic -lm"
                                   "--with-multilib-list=aprofile,rmprofile")
                             (delete "--disable-multilib" #$flags)))))
               (native-search-paths
                (list (search-path-specification
                       (variable "CROSS_C_INCLUDE_PATH")
                       (files '("arm-none-eabi/include")))
                      (search-path-specification
                       (variable "CROSS_CPLUS_INCLUDE_PATH")
                       (files '("arm-none-eabi/include/c++"
                                "arm-none-eabi/include/c++/arm-none-eabi"
                                ; C has to be last since c++ headers use
                                ; #include_next <stdlib.h> inside of <cstdlib>
                                ; Heh! :)
                                "arm-none-eabi/include")))
                      (search-path-specification
                       (variable "CROSS_LIBRARY_PATH")
                       (files '("arm-none-eabi/lib")))))))))

(define make-base-newlib-arm-none-eabi-12.3.rel1
  (mlambda (base)
    (let ((commit "4c7d0dfec5793cbf5cf3930b91f930479126d8ce")
          (revision "0"))
      (package
        (inherit base)
        (version (git-version "3.0.0" revision commit))
        (source
         (origin
           (method git-fetch)
           (uri (git-reference
                 (url "http://sourceware.org/git/newlib-cygwin.git")
                 (commit commit)))
           (sha256
            (base32
             "0drs9v8avh4y2h5bs0ixjn9x662jzkkikx8z034wgl41dxmn6786"))))
        (arguments
         (substitute-keyword-arguments (package-arguments base)
           ((#:phases original-phases)
            #~(modify-phases #$original-phases
                (replace 'fix-references-to-/bin/sh
                  (lambda _
                    (substitute* '("libgloss/arm/cpu-init/Makefile.inc"
                                   "libgloss/arm/Makefile.inc"
                                   "libgloss/libnosys/Makefile.inc"
                                   "libgloss/Makefile.in")
                      (("/bin/sh") (which "sh")))
                    #t))))
           ;; The configure flags are identical to the flags used by the "GCC
           ;; ARM embedded" project.
           ((#:configure-flags flags)
            #~(cons* "--enable-newlib-io-c99-formats"
                     "--enable-newlib-retargetable-locking"
                     "--enable-newlib-mb"
                     "--enable-newlib-reent-check-verify"
                     "--enable-newlib-register-fini"
                     #$flags))))
        (native-inputs
         `(("xbinutils" ,(cross-binutils "arm-none-eabi"))
           ("xgcc" ,(make-gcc-arm-none-eabi-12.3.rel1))
           ("texinfo" ,texinfo)))))))

(define make-newlib-nano-arm-none-eabi-12.3.rel1
  (mlambda ()
    (make-base-newlib-arm-none-eabi-12.3.rel1 (make-newlib-nano-arm-none-eabi))))

(define make-newlib-arm-none-eabi-12.3.rel1
  (mlambda ()
    (make-base-newlib-arm-none-eabi-12.3.rel1 (make-newlib-arm-none-eabi))))

(define make-libstdc++-12.3.rel1
  (mlambda (xgcc newlib)
    (let* ((newlib-with-xgcc
            (package
              (inherit newlib)
              (native-inputs
               (alist-replace "xgcc" (list xgcc)
                              (package-native-inputs newlib)))))
           (base ((@@ (gnu packages embedded) make-libstdc++-arm-none-eabi) xgcc newlib-with-xgcc))
           (src (package-source base)))
      (package
        (inherit base)
        (source
         (origin
           (inherit src)
           (patches
            (cons* (local-file "./patches/newlib-getentropy.patch")
                   (origin-patches src)))))
        ;; TODO add back the debug phase after figuring out
        ;; how the Guix build system / gcc build phases create the
        ;; debug phase
        (outputs '("out"))
        (arguments (substitute-keyword-arguments (package-arguments base)
                     ((#:configure-flags flags)
                      #~(cons* "--with-target-subdir=yes"
                               "CFLAGS=-ffunction-sections -fdata-sections"
                               (string-append "--libdir="
                                              #$output
                                              "/arm-none-eabi/lib")
                               #$flags))))))))

(define make-libstdc++-nano-12.3.rel1
  (mlambda (xgcc newlib-nano)
    (let ((base (make-libstdc++-12.3.rel1 xgcc newlib-nano)))
      (package
        (inherit base)
        (name "libstdc++-arm-none-eabi-nano")
        (arguments (substitute-keyword-arguments (package-arguments base)
                     ((#:configure-flags flags)
                      #~(cons* "CFLAGS=-ffunction-sections -fdata-sections -fno-exceptions"
                               (filter
                                  (lambda (flag)
                                    (not (string-prefix? "CFLAGS=" flag)))
                                  #$flags)))
                     ((#:phases phases)
                      #~(modify-phases #$phases
                          ;; This is mostly the same as for newlib-nano
                          (add-after 'install 'hardlink-libstdc++
                            (lambda* (#:key outputs #:allow-other-keys)
                              (let ((out (assoc-ref outputs "out")))
                                ;; The nano.specs file says that newlib-nano files should
                                ;; end in "_nano.a" instead of just ".a".  Note that this
                                ;; applies to all the multilib folders too.
                                (for-each
                                 (lambda (file)
                                   (link file
                                         (string-append
                                          ;; Strip ".a" off the end
                                          (substring file 0 (- (string-length file) 2))
                                          ;; Add "_nano.a" onto the end
                                          "_nano.a")))
                                 (find-files
                                  out "^(libstdc\\+\\+.a|libsupc\\+\\+.a)$")))))))))))))

(define make-arm-none-eabi-toolchain
  (mlambda (xgcc newlib)
    "Produce a cross-compiler toolchain package with the compiler XGCC and the
C library variant NEWLIB."
    (let ((newlib-with-xgcc
           (package
             (inherit newlib)
             (native-inputs
              (alist-replace "xgcc" (list xgcc)
                             (package-native-inputs newlib))))))
      (package
        (name "arm-none-eabi-toolchain")
        (version (package-version xgcc))
        (source #f)
        (build-system trivial-build-system)
        (arguments
         '(#:modules ((guix build union))
           #:builder
           (begin
             (use-modules (ice-9 match)
                          (guix build union))
             (match %build-inputs
               (((names . directories) ...)
                (union-build (assoc-ref %outputs "out")
                             directories))))))
        (propagated-inputs
         `(("binutils" ,(cross-binutils "arm-none-eabi"))
           ("libstdc++" ,(make-libstdc++-12.3.rel1 xgcc newlib))
           ("gcc" ,xgcc)
           ("newlib" ,newlib-with-xgcc)))
        (synopsis "Complete GCC tool chain for ARM bare metal development")
        (description "This package provides a complete GCC tool chain for ARM
bare metal development.  This includes the GCC arm-none-eabi cross compiler
and newlib (or newlib-nano) as the C library.  The supported programming
languages are C and C++.")
        (home-page (package-home-page xgcc))
        (license (package-license xgcc))))))

(define make-arm-none-eabi-nano-toolchain
  (mlambda (xgcc newlib-nano)
    (let ((base (make-arm-none-eabi-toolchain xgcc newlib-nano)))
      (package
        (inherit base)
        (name "arm-none-eabi-nano-toolchain")
        (propagated-inputs
         (modify-inputs (package-propagated-inputs base)
           (replace "libstdc++" (make-libstdc++-nano-12.3.rel1 xgcc newlib-nano))))))))

(define arm-none-eabi-toolchain-12.3.rel1
  (make-arm-none-eabi-toolchain
   (make-gcc-arm-none-eabi-12.3.rel1)
   (make-newlib-arm-none-eabi-12.3.rel1)))

(define arm-none-eabi-nano-toolchain-12.3.rel1
  (make-arm-none-eabi-nano-toolchain
   (make-gcc-arm-none-eabi-12.3.rel1)
   (make-newlib-nano-arm-none-eabi-12.3.rel1)))