Skip to content

Commit

Permalink
Merge pull request #106 from cmsc430/outlaw
Browse files Browse the repository at this point in the history
Outlaw
  • Loading branch information
dvanhorn authored Dec 31, 2021
2 parents 97c578b + 71d26dd commit 5661e87
Show file tree
Hide file tree
Showing 3 changed files with 1,185 additions and 0 deletions.
76 changes: 76 additions & 0 deletions langs/outlaw/combine.rkt
Original file line number Diff line number Diff line change
@@ -0,0 +1,76 @@
#lang racket
(provide main)

;; This is a utility for smashing together racket files into a single
;; monolithic program.
;; For example:
;; racket -t combine.rkt -m compile-stdin.rkt > outlaw.rkt
;; creates a file with all the source code needed for the Outlaw
;; compiler. You still have to:
;; a) comment out the standard library
;; b) remove all of the requires and provides to make a valid Racket program

;; String -> Void
;; Combine all the files fn depends upon, print to stdout
;; as one monolithic program
(define (main fn)
(printf "#lang racket\n")
(let ((fs (all-files fn)))
(for-each (lambda (f)
(displayln (string-append ";; " f)))
fs)
(print-files fs)))

;; Port -> [Listof S-Expr]
;; read all s-expression until eof
(define (read-all p)
(let ((r (read p)))
(if (eof-object? r)
'()
(cons r (read-all p)))))

(define (print-files fs)
(match fs
['() (void)]
[(cons f fs)
(displayln (make-string 72 #\;))
(displayln (string-append ";; " f "\n"))
(print-file f)
(print-files fs)]))

(define (print-file f)
(let ((p (open-input-file f)))
(read-line p) ; ignore #lang
(define (loop)
(let ((l (read-line p)))
(if (eof-object? l)
(begin (newline)
(close-input-port p))
(begin
(displayln l)
(loop)))))
(loop)))

(define (all-files fn)
(remove-duplicates (all-files* fn '())))

(define (all-files* fn seen)
(if (member fn seen)
'()
(let ((p (open-input-file fn)))
(read-line p) ; ignore #lang
(begin0
(let ((rs (get-requires (read-all p))))
(append (append-map (λ (f) (all-files* f (cons fn seen))) rs)
(list fn)))
(close-input-port p)))))

(define (get-requires s)
(match s
['() '()]
[(cons (cons 'require rs) s)
(append (filter string? rs) (get-requires s))]
[(cons _ s)
(get-requires s)]))


Loading

0 comments on commit 5661e87

Please sign in to comment.