k-lang.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 B. Wilson <elaexuotee@wilsonb.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (bmw packages k-lang)
  #:use-module ((gnu packages compression) #:select (unzip))
  #:use-module ((gnu packages readline) #:select (rlwrap))
  #:use-module ((gnu packages llvm) #:select (clang-toolchain-13))
  #:use-module ((guix build-system gnu) #:select (gnu-build-system))
  #:use-module ((guix build-system trivial) #:select (trivial-build-system))
  #:use-module ((guix download) #:select (url-fetch))
  #:use-module ((guix git-download) #:select (git-fetch
                                              git-reference
                                              git-file-name
                                              git-version))
  #:use-module (guix gexp)
  #:use-module ((guix licenses) #:prefix license: #:select (agpl3 expat))
  #:use-module (guix packages)
  #:use-module ((guix utils) #:select (cc-for-target)))


(define-public ngn-k
  (let ((commit "cb36213657b6c5b2fe3bb1c88c4de7fe975f84ed")
        (revision "1"))
    (package
      (name "ngn-k")
      (version (git-version "0.0.0" revision commit))
      (source
        (origin
          (method git-fetch)
          (uri (git-reference
                 (url "https://codeberg.org/ngn/k.git")
                 (commit commit)))
          (file-name (git-file-name name version))
          (sha256
            (base32 "1140avqsqaa1pyh937rcd04snbkcgngmkg3dkmsbj6kw0jnrgf1z"))))
      (build-system gnu-build-system)
      (inputs (list rlwrap))
      (arguments
       `(#:make-flags (list (string-append "CC=" ,(cc-for-target)))
         #:test-target "t"
         #:phases
         (modify-phases %standard-phases
          (replace 'configure
            (lambda* (#:key outputs #:allow-other-keys)
              (let* ((out (assoc-ref outputs "out"))
                     (k (string-append out "/k")))
                (substitute* "repl.k"
                  (("^#!k") (string-append "#!" k "\n"))))))
          (replace 'build
            (lambda* (#:key make-flags #:allow-other-keys)
              (let ((build-target "k"))
                (apply invoke "make" `(,@make-flags ,build-target)))))
          (replace 'install
            (lambda* (#:key inputs outputs #:allow-other-keys)
              (let* ((out (assoc-ref outputs "out"))
                     (bin (string-append out "/bin"))
                     (k (string-append bin "/k"))
                     (rlwrap (string-append
                               (assoc-ref inputs "rlwrap")
                               "/bin/rlwrap")))

                 (define* (rlwrap-prog prog #:key rlwrap (sh (which "bash")))
                   (let* ((real-prog (string-append (dirname prog) "/."
                                                    (basename prog) "-real"))
                          (prog-tmp (string-append real-prog "-tmp")))
                     (link prog real-prog)
                     (call-with-output-file prog-tmp
                       (lambda (port)
                         (format port
                                 "#!~a~%exec -a \"$0\" \"~a\" \"~a\" \"$@\"~%"
                                 sh rlwrap (canonicalize-path real-prog))))
                     (chmod prog-tmp #o755)
                     (rename-file prog-tmp prog)))

                (mkdir-p bin)
                (copy-file "repl.k" (string-append bin "/krepl"))
                (copy-file "k" k)
                (rlwrap-prog k #:rlwrap rlwrap)))))))
      (home-page "https://codeberg.org/ngn/k")
      (synopsis "Implementation of the K6 vector programming language")
      (description "ngn/k is a simple fast vector programming language, an
implementation of the K6 dialect of K.")
      (license license:agpl3))))

(define-public shakti
  (let ((hash "1xd1hvannqky80yvin06rdw3jc92px8ig1fhrv311nw6mbb1xf5z"))
    (package
      (name "shakti")
      (version (string-append "0." (string-take hash 6)))
      (source
        (origin
          (method url-fetch)
          (uri "https://shakti.com/k/k.zip")
          (sha256 (base32 hash))))
      (build-system trivial-build-system)
      (native-inputs (list clang-toolchain-13 unzip))
      (arguments
       (list
        #:modules `((guix build utils))
        #:builder
        #~(begin
            (use-modules ((guix build utils)))
            (let* ((source (assoc-ref %build-inputs "source"))
                   (clang-toolchain (assoc-ref %build-inputs "clang-toolchain"))
                   (clang-13 (string-append clang-toolchain "/bin/clang-13"))
                   (unzip-pkg (assoc-ref %build-inputs "unzip"))
                   (unzip (string-append unzip-pkg "/bin/unzip"))
                   (out (assoc-ref %outputs "out")))
              (mkdir-p (string-append out "/bin"))
              (invoke unzip source)
              (invoke clang-13 "-Os" "-o" (string-append out "/bin/shakti")
                      "a.c" "-fno-builtin" "-funsigned-char" "-ffast-math"
                      "-fno-finite-math-only" "-fno-unwind-tables"
                      "-Wno-incompatible-pointer-types" "-Wno-parentheses"
                      "-mavx2" "-mfma" "-mpclmul" "-mbmi2" "-nostdlib")))))
      (synopsis "Free Shakti K implementation by Arthur Whitney")
      (home-page "https://shakti.com/")
      (description "Free Shakti K implementation by Arthur Whitney")
      (license license:expat))))