Skip to content

add option to suppress debugging #4

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
natethern wants to merge 1 commit into
base: master
Choose a base branch
from
Open

add option to suppress debugging #4

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 8 additions & 2 deletions src/loki.scm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,8 @@
(string-append
"loki v" *version* "\n"))

(define opt-debug debug)

(define-record-type <loki-options>
(make-loki-options targets args)
loki-options?
Expand All @@ -33,7 +35,11 @@
(display-and-exit-proc (version-string)))
(option '(#\h "help") #f #f
(display-and-exit-proc
"Usage: TODO, someone please fill this in...")))
"Usage: TODO, someone please fill this in..."))
(option '(#\n #\q "nodebug" "quiet") #f #f
(lambda (opt name arg options)
(set! opt-debug (lambda args #f))
options)))
(lambda (opt name arg loads)
(error "Unrecognized option" name))
(let ((mode 'targets)) ; targets | options
Expand All @@ -55,7 +61,7 @@
(with-loki-command-line (loki-options-args options) (lambda ()
(for-each
(lambda (target)
(load-module-from-cache (make-path target)))
(load-module-from-cache (make-path target) opt-debug))
(loki-options-targets options))))))

(with-exception-handler
Expand Down
16 changes: 10 additions & 6 deletions src/loki/compiler/loader.sld
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,9 +25,11 @@
serialize-module
deserialize-module)
(begin

(define *module-dirs* '("src"))

(define opt-debug debug)

(define (serialize-export e) (cons (car e) (serialize-binding (cdr e))))
(define (deserialize-export e) (cons (car e) (deserialize-binding (cdr e))))
(define (serialize-import e)
Expand Down Expand Up @@ -239,8 +241,10 @@
(core::module-visited?-set! module #f)
(core::module-invoked?-set! module #f)
(import-module (core::module-name module)))

(define (load-module-from-cache path)

(define (load-module-from-cache path . debug-arg)
(if (pair? debug-arg)
(set! opt-debug (car debug-arg)) #f)
(let* ((path (wrap-path path))
(path-string (path->string path))
(cache-path (path->string (path-with-suffix path "so"))))
Expand All @@ -249,21 +253,21 @@
(if (and (file-exists? cache-path)
(>= (file-mtime cache-path)
(file-mtime path-string)))
(let* ((foo (debug "before deserialize"))
(let* ((foo (opt-debug "before deserialize"))
(module (deserialize-module (syntax->datum (car (read-file cache-path #f)))))
(imported-libraries (core::module-imported-libraries module)))
(for-each (lambda (imported-module) (load-module (car imported-module)))
imported-libraries)
(register-module! module)
(import-module (core::module-name module))
(debug "deserialized module from" cache-path)
(opt-debug "deserialized module from" cache-path)
module)
(let* ((module (expand-module (read-file path #f)
with-default-loader '() #f))
(serialized (serialize-module module)))
(register-module! module)
(import-module (core::module-name module))
(debug "caching module to" cache-path)
(opt-debug "caching module to" cache-path)
(with-output-to-file cache-path (lambda () (write serialized)))
module))))

Expand Down