Browse Source

create compile script

develop
haskal 1 year ago
parent
commit
06e0534895
  1. 101
      private/compile.rkt
  2. 2
      racket-sass
  3. 3
      scripts/init

101
private/compile.rkt

@ -0,0 +1,101 @@
#lang racket
;; compiler
(struct rule [inputs output compiler] #:transparent)
(define (generate-operations rules)
(define nodes (mutable-set))
(define edges (make-hash))
(define edges-rev (make-hash))
(define (edge-add! from to)
(when (equal? from to)
(error "loop edge" from to))
(set-add! nodes from)
(set-add! nodes to)
(if (hash-has-key? edges from)
(set-add! (hash-ref edges from) to)
(hash-set! edges from (mutable-set to)))
(if (hash-has-key? edges-rev to)
(set-add! (hash-ref edges-rev to) from)
(hash-set! edges-rev to (mutable-set from))))
;; construct graph
(for ([rule (in-set rules)])
(for ([input (in-list (rule-inputs rule))])
(edge-add! input rule))
(when (hash-has-key? edges-rev (rule-output rule))
(error "duplicate output rule" (rule-output rule)))
(edge-add! rule (rule-output rule)))
;; construct topological sort
(define (topo-sort nodes edges)
(define temp-mark (mutable-set))
(define perm-mark (mutable-set))
;; visits recursively
(define (visit node sorted)
(cond
[(set-member? perm-mark node) sorted]
[(set-member? temp-mark node) (error "cycle detected")]
[else
(set-add! temp-mark node)
(define new-sorted
(for/fold ([s sorted]) ([neighbor (in-set (hash-ref edges node (set)))])
(visit neighbor s)))
(set-remove! temp-mark node)
(set-add! perm-mark node)
(cons node new-sorted)]))
(for/fold ([s '()]) ([node (in-set nodes)] #:unless (set-member? perm-mark node))
(visit node s)))
(define topo-sorted (topo-sort nodes edges))
;; everything where either the output does not exist, or one of the inputs does not exist, or one
;; of the inputs is newer than the output
(define (rule-dirty? rule)
(define (modt f)
(file-or-directory-modify-seconds f #f (lambda () #f)))
(define output-time (modt (rule-output rule)))
(define input-times (map modt (rule-inputs rule)))
(or (false? output-time)
(for/or ([time (in-list input-times)])
(or (false? time) (> time output-time)))))
(define initial-dirty (for/set ([rule (in-set rules)] #:when (rule-dirty? rule)) rule))
;; propagate the dirty set recursively
;; for each missing input, add the rule that generates the input
;; if outputs have dependents, add the dependents
(define (expand-dirty rule [dset (mutable-set)])
(unless (set-member? dset rule)
(set-add! dset rule)
(for ([dep (in-set (hash-ref edges (rule-output rule) (set)))])
(expand-dirty dep dset))
(for ([input (in-list (rule-inputs rule))])
(unless (or (file-exists? input) (link-exists? input) (directory-exists? input))
(define dep-revs (hash-ref edges-rev input (set)))
(when (zero? (set-count dep-revs))
(error "no rule to generate" input))
(for ([dep-rev (in-set dep-revs)])
(expand-dirty dep-rev dset)))))
dset)
(define dirty
(for/fold ([d (set)]) ([item (in-set initial-dirty)])
(set-union d (expand-dirty item))))
(define dirty-sorted
(for/list ([item (in-list topo-sorted)] #:when (set-member? dirty item))
item))
(unless (= (set-count dirty) (length dirty-sorted))
(error "self-check failed lmao"))
dirty-sorted)
(define compiler-rules
(set
(rule '("test.o") "my_binary" void)
(rule '("test.c") "test.o" void)))
(generate-operations compiler-rules)

2
racket-sass

@ -1 +1 @@
Subproject commit ce67a0344c88e4ccadbdaac85de628bce9c82b39
Subproject commit d45e54a24f34728172973931c86fc97d66a0b8d8

3
scripts/init

@ -42,7 +42,10 @@
; src and public
(make-directory "src")
(make-directory "src/posts")
(make-directory "public")
(make-directory "public/posts")
; task queue
(define c (sqlite3-connect #:database "taskq.sqlite3" #:mode 'create))

Loading…
Cancel
Save