Browse Source

refactor w/out br/quicklang

canon
Hazel Levine 8 months ago
parent
commit
b0489fa0b8
Signed by: hazel GPG Key ID: 1884029A28789A62
  1. 2
      day8/day8.input.rkt
  2. 56
      day8/gc/part1.rkt
  3. 56
      day8/gc/part2.rkt
  4. 27
      lib/common.rkt

2
day8/day8.input.rkt

@ -1,4 +1,4 @@
#lang gc/part2
#lang gc/part1
acc +48
nop +308
acc +33

56
day8/gc/part1.rkt

@ -1,26 +1,26 @@
#lang br/quicklang
(require racket/set)
(provide
(rename-out [gc-module-begin #%module-begin])
gc-op
gc-program)
#lang racket
(require "../../lib/common.rkt"
syntax/parse/define
syntax/strip-context
(for-syntax syntax/parse))
(provide (rename-out [gc-module-begin #%module-begin])
#%datum
gc-op)
(module+ reader
(provide read-syntax))
(define (read-syntax _ port)
(define gc-datums
(for/list ([gc-str (in-lines port)]
[line-num (in-naturals)])
(when (non-empty-string? gc-str)
(match-define (list op (app string->number num)) (string-split gc-str))
(format-datum '(gc-op ~a ~a ~a) line-num op num))))
(strip-bindings
(for/list ([gc-str (in-lines port)]
#:when (non-empty-string? gc-str))
(match-define (list op (app string->number num)) (string-split gc-str))
(format-datum '(gc-op ~a ~a) op num)))
(strip-context
#`(module gc-module gc/part1
#,@gc-datums)))
(define-macro (gc-module-begin OP ...)
#'(#%module-begin
(gc-program OP ...)))
(define-simple-macro (gc-module-begin OP ...)
(#%module-begin (run-program (vector OP ...))))
(define (run-program gc-ops)
(define (run-program/a apl [visited (mutable-set)])
@ -32,21 +32,21 @@
(run-program/a (apply (vector-ref gc-ops pos) apl) visited)]))
(run-program/a (list 0 0)))
; XXX: lolwut
(define-macro (gc-program OPS ...)
#'(begin
(displayln (run-program (list->vector (rest (list OPS ...)))))))
(define-macro-cases gc-op
[(gc-op LINE-NUM nop NUM) #'(gc-nop LINE-NUM NUM)]
[(gc-op LINE-NUM acc NUM) #'(gc-acc LINE-NUM NUM)]
[(gc-op LINE-NUM jmp NUM) #'(gc-jmp LINE-NUM NUM)])
(define ((gc-nop line-num num) pos acc)
(define-syntax (gc-op caller-stx)
(syntax-parse caller-stx
[(_ (~literal nop) NUM) #`(gc-nop NUM)]
[(_ (~literal acc) NUM) #`(gc-acc NUM)]
[(_ (~literal jmp) NUM) #`(gc-jmp NUM)]
[else
(raise-syntax-error
'gc-op
(format "invalid opcode: ~a" (syntax->datum caller-stx)))]))
(define ((gc-nop num) pos acc)
(list (add1 pos) acc))
(define ((gc-acc line-num num) pos acc)
(define ((gc-acc num) pos acc)
(list (add1 pos) (+ num acc)))
(define ((gc-jmp line-num num) pos acc)
(define ((gc-jmp num) pos acc)
(list (+ num pos) acc))

56
day8/gc/part2.rkt

@ -1,29 +1,26 @@
#lang br/quicklang
(require racket/set)
(provide
(rename-out [gc-module-begin #%module-begin])
gc-op
gc-program)
#lang racket
(require "../../lib/common.rkt"
syntax/parse/define
syntax/strip-context
(for-syntax syntax/parse))
(provide (rename-out [gc-module-begin #%module-begin])
#%datum
gc-op)
(module+ reader
(provide read-syntax))
(define (read-syntax _ port)
(define gc-datums
(for/list ([gc-str (in-lines port)]
[line-num (in-naturals)])
(when (non-empty-string? gc-str)
(match-define (list op (app string->number num)) (string-split gc-str))
(format-datum '(gc-op ~a ~a ~a) line-num op num))))
(strip-bindings
(for/list ([gc-str (in-lines port)]
#:when (non-empty-string? gc-str))
(match-define (list op (app string->number num)) (string-split gc-str))
(format-datum '(gc-op ~a ~a) op num)))
(strip-context
#`(module gc-module gc/part2
#,@gc-datums)))
(define-macro (gc-module-begin OP ...)
#'(#%module-begin
(gc-program OP ...)))
(define-macro (gc-program OPS ...)
#'(begin (displayln (run-program (list->vector (rest (list OPS ...)))))))
(define-simple-macro (gc-module-begin OP ...)
(#%module-begin (run-program (vector OP ...))))
(define (tser lst)
(match lst
@ -50,20 +47,25 @@
[(cons 'loop _) (void)]
[(cons 'term acc) (leave acc)]))))
(define-macro-cases gc-op
[(gc-op LINE-NUM nop NUM) #'(gc-nop LINE-NUM NUM)]
[(gc-op LINE-NUM acc NUM) #'(gc-acc LINE-NUM NUM)]
[(gc-op LINE-NUM jmp NUM) #'(gc-jmp LINE-NUM NUM)])
(define-syntax (gc-op caller-stx)
(syntax-parse caller-stx
[(_ (~literal nop) NUM) #`(gc-nop NUM)]
[(_ (~literal acc) NUM) #`(gc-acc NUM)]
[(_ (~literal jmp) NUM) #`(gc-jmp NUM)]
[else
(raise-syntax-error
'gc-op
(format "invalid opcode: ~a" (syntax->datum caller-stx)))]))
(define ((gc-nop line-num num) pos acc alt)
(define ((gc-nop num) pos acc alt)
(if alt
((gc-jmp line-num num) pos acc #f)
((gc-jmp num) pos acc #f)
(list (add1 pos) acc #f)))
(define ((gc-acc line-num num) pos acc alt)
(define ((gc-acc num) pos acc alt)
(list (add1 pos) (+ num acc) #f))
(define ((gc-jmp line-num num) pos acc alt)
(define ((gc-jmp num) pos acc alt)
(if alt
((gc-nop line-num num) pos acc #f)
((gc-nop num) pos acc #f)
(list (+ num pos) acc #f)))

27
lib/common.rkt

@ -6,6 +6,9 @@
dbg
values->list
list->values
blank?
datum?
format-datum
answer)
(define (dbg a)
@ -18,6 +21,30 @@
(define (list->values lst)
(apply values lst))
(define (blank? str)
(for/and ([c (in-string str)])
(char-blank? c)))
(define (datum? x)
(or (list? x) (symbol? x)))
(define (string->datum str)
(unless (blank? str)
(define result (read (open-input-string (format "(~a)" str))))
(if (= (length result) 1)
(car result)
result)))
(define (format-datum datum-template . args)
(unless (datum? datum-template)
(raise-argument-error 'format-datums "datum?" datum-template))
(string->datum (apply format (format "~a" datum-template)
(map (lambda (arg)
(if (syntax? arg)
(syntax->datum arg)
arg))
args))))
(define (answer day part answer)
(printf "answer ~a.~a: ~s\n" day part answer)
(unless (aoc-complete? day part)

Loading…
Cancel
Save