utils.rkt

#lang racket

; (provide append-line
;          get-c-string
;          convert-id-to-c)

(provide (all-defined-out))

(define (get-c-string s)
  (string->symbol (convert-id-to-c s)))

(define (true? x) (if x #t #f))

; appends a line in the program, default mode is append, if not specified
(define (append-line filename line [mode 'append])
  (define outfile (open-output-file #:exists mode filename))
  (displayln line outfile)
  (close-output-port outfile))

; appends a list of lines in the program
(define (append-list-to-file filename lst [mode 'append])
  (define outfile (open-output-file #:exists mode filename))

  (for ([item lst])
    (displayln item outfile))

  (close-output-port outfile))

; takes a slog file and returns it as a string
(define (open-slog file-path)
  (file->string file-path))

; read a certain amount of lines within a file
(define (read-x-lines file-path x)
  (define lines (file->lines file-path))
  (take lines x))

(define (write-to-file file-path content)
  (with-output-to-file file-path (lambda () (display content)) #:exists 'replace))

; Takes a symbol as input and returns a string that represents a C-compatible identifier
(define (convert-id-to-c sym)
  (foldr string-append
         (string-append)
         (map (λ (ch)
                (cond
                  [(or (char-alphabetic? ch) (char-numeric? ch) (eq? ch #\_)) (string ch)]
                  [else (string-append "_u" (number->string (char->integer ch)))]))
              (string->list (symbol->string sym)))))


(define (within-int-32bit-range? val)
  (and (<= -2147483648 val) (<= val 2147483647))
  ; #f
  )

(define (within-float-32bit-range? val)
  (and (<= -16777216 val) (<= val 16777216))
  ; #f
  )


(define (find-global-constants-helper exp env)
  ; (displayln exp)
  (match exp
    ['() env]
    [(? symbol?) env]
    [(? string?) env]
    [(? number?) env]
    [(? integer?) env]
    [(? flonum?) env]
    [(? number?) env]
    [(? boolean?) env]
    [`(let ([,lhs ,val]) ,letbody)
     (find-global-constants-helper letbody
                                   (match val
                                     [`(quote ,(? exact-integer? val))
                                      (if (within-int-32bit-range? val)
                                          (hash-set env val `(int ,(gensym 'int)))
                                          (hash-set env val `(mpz ,(gensym 'mpz))))]
                                     [`(quote ,(? flonum? val))
                                      (if (within-float-32bit-range? val)
                                          (hash-set env val `(float ,(gensym 'float)))
                                          (hash-set env val `(mpf ,(gensym 'mpf))))]
                                     [`(quote ,(? boolean? val))
                                      (cond
                                        [(true? val)
                                         (hash-set env val `(bool-true ,(gensym 'bool_t))) ]
                                        [else
                                         (hash-set env val `(bool-false ,(gensym 'bool_f)))]
                                        )]
                                     [_ (find-global-constants-helper val env)]))]
    [`(if ,ec ,et ,ef)
     (find-global-constants-helper et (find-global-constants-helper ef env))]
    [`(apply ,e0 ,e1)
     (find-global-constants-helper e0 (find-global-constants-helper e1 env))]
    [`(,ef ,eas ...)
     (find-global-constants-helper ef (find-global-constants-helper eas env))]
    ))

;;; takes a lambda and rewrites it in terms of lets
(define (lambda-to-let e)
  
  (define (desugar-exp exp)
    (match exp
      [(? symbol?) exp]
      [(? number?) exp]
      [(? boolean?) exp]
      [`((lambda (,xs ...) ,body) ,args ...)
       `(let ,(map list xs args) ,(desugar-exp body))]
    
      [`((lambda ,(? symbol? x) ,body) ,args ...)
       `(let ([,x ,(if (null? (cdr args))
                       (car args)
                       `(list ,@args))]) ,x)]
    
      [`(,ef ,ea-list ...)
       (cons (desugar-exp ef) (map desugar-exp ea-list))]

      [else (raise `(error ,(format "lambda-to-let: unknown s-expression!: ~a" exp)))]))

  
  (define ((alpha-rename env) e)
    (define rename gensym)
    
    (match (desugar-exp e)
      [`(let ([,xs ,es] ...) ,e0)
       (define xs+ (map rename xs))
       (define env+ (foldl (lambda (x x+ env) (hash-set env x x+)) env xs xs+))
     
       `(let ,(map list xs+ (map (alpha-rename env) es)) ,((alpha-rename env+) e0))]
      
      [(? symbol? x) (hash-ref env x (lambda () x))]
      [`',dat `',dat]
      [(? number?) e]
      [`(,es ...) (map (alpha-rename env) es)]))

  ;((alpha-rename (hash)) e)
  (desugar-exp e))


(define (print-color text color)
  (display "\x1b[")
  (display color)
  (display "m")
  (display text)
  (display "\x1b[0m"))

(define (print-red text)
  (print-color text "31"))

(define (print-green text)
  (print-color text "32"))

(define (print-yellow text)
  (print-color text "33"))

(define (write-to-c file content)
  (with-output-to-file file (lambda () (display content)) #:exists 'replace))

(define (verify-correctness file desugar alphatize anf cps closure)
  (cond
    [(and (equal? desugar alphatize) (equal? alphatize anf) (equal? anf cps) (equal? cps closure))
     (print-green "\nEach output stage matched!")
     (displayln "\n")]
    [else
     (print-red "\nYour outputs did not match for ")
     (display (~a file "\n\n"))]))

(define (verify-dir out-dir)
  (unless (directory-exists? out-dir)
    (pretty-print out-dir)
    (make-directory out-dir)))

; This is still in testing
(define (verify-answer-file answer-file)
  (unless (file-exists? answer-file)
    (displayln "Outputting necessary answer file")
    (write-to-c answer-file "")))

(define (verify-cmake cmake-file)
  (unless (file-exists? cmake-file)
    (displayln "Outputting necessary CMakeLists.txt file")
    (write-to-c
     cmake-file
     "# variable for ../ and ../../ directories

cmake_path(GET CMAKE_CURRENT_SOURCE_DIR PARENT_PATH testing_dir)
cmake_path(GET testing_dir PARENT_PATH main_dir)

get_filename_component(TEST_NAME ${CMAKE_CURRENT_SOURCE_DIR} NAME)
# linking gtest
add_library(GTest::GTest INTERFACE IMPORTED)
target_link_libraries(GTest::GTest INTERFACE gtest_main)

# executable for the code generated by the emit-cpp.rkt
add_executable(${TEST_NAME}_exec ${CMAKE_CURRENT_SOURCE_DIR}/compiler-out/${TEST_NAME}_cpp_program.cpp)
target_link_libraries(${TEST_NAME}_exec
PRIVATE
prelude)

# executable for the test driver
add_executable(${TEST_NAME}_test driver.cpp)
target_include_directories(${TEST_NAME}_test PUBLIC ${main_dir} ${testing_dir})
target_link_libraries(${TEST_NAME}_test
PRIVATE
GTest::GTest
prelude
testing)

# adds a test to be tracked by the cmake
add_test(${TEST_NAME}_test ${TEST_NAME}_test)")))

(define (verify-driver test-name driver-file)
  (unless (file-exists? driver-file)
    (displayln "Outputting the necessary C++ driver file")
    (write-to-c
     driver-file
     (string-replace
      "
// Please don't edit this file, this file is created by test.rkt,
// to regenerate this file, delete the file and run this test using test.rkt
#include <prelude.hpp>
#include <testing.hpp>
#include <gtest/gtest.h>
#include <iostream>

TEST(test-name_Test, desugar)
{
    std::string answer = readFileToString(\"../../../tests/test-name/answer\");
    std::string desugar_res = readFileToString(\"../../../tests/test-name/output/test-name_desugar_res.out\");
    ASSERT_EQ(answer, desugar_res);
}

TEST(test-name_Test, alphatize)
{
    std::string answer = readFileToString(\"../../../tests/test-name/answer\");
    std::string alphatize_res = readFileToString(\"../../../tests/test-name/output/test-name_alphatize_res.out\");
    ASSERT_EQ(answer, alphatize_res);
}

TEST(test-name_Test, anf)
{
    std::string answer = readFileToString(\"../../../tests/test-name/answer\");
    std::string anf_res = readFileToString(\"../../../tests/test-name/output/test-name_anf_res.out\");
    ASSERT_EQ(answer, anf_res);
}

TEST(test-name_Test, closure)
{
    std::string answer = readFileToString(\"../../../tests/test-name/answer\");
    std::string closure_res = readFileToString(\"../../../tests/test-name/output/test-name_closure_res.out\");
    ASSERT_EQ(answer, closure_res);
}

TEST(test-name_Test, cps)
{
    std::string answer = readFileToString(\"../../../tests/test-name/answer\");
    std::string cps_res = readFileToString(\"../../../tests/test-name/output/test-name_cps_res.out\");
    ASSERT_EQ(answer, cps_res);
}

TEST(test-name_Test, CPP_test)
{
    std::string answer = readFileToString(\"../../../tests/test-name/answer\");
    std::string output = executeAndGetOutput(\"./test-name_exec\");
    writeStringToFile(\"../../../tests/test-name/output/test-name_cpp_res.out\",output);
    ASSERT_TRUE(racketCompare(answer, output) == true);
}

TEST(test-name_Test, memleak_check)
{
    int mem_ret = system(\"valgrind --quiet --suppressions=../../../supressions.supp --error-exitcode=10 --leak-check=full ./test-name_exec > /dev/null\");
    ASSERT_NE(WEXITSTATUS(mem_ret),10);
}

int main(int argc, char** argv)
{
    ::testing::InitGoogleTest(&argc, argv);
    return RUN_ALL_TESTS();
}"
      "test-name"
      test-name))))
; end further testing section