shomks

kaitai/expr.rkt

@@ -5,6 +5,8 @@
          (prefix-in : parser-tools/lex-sre)
          parser-tools/yacc)
 
+(provide kexpr:parse kexpr:parse/string)
+
 (define-tokens kaitai-expr [boolean number string identifier])
 (define-empty-tokens kaitai-sym [eof + - * / % < <= > >= == != << >> & pipe ^ not and or ? : ~
                                  lparen rparen lbracket comma dot rbracket])
@@ -122,6 +124,18 @@
         [(exp) (list $1)]
         [(exp comma apply-args) (cons $1 $3)])]))
 
+
+;; parses a string to a kaitai expr AST
+(define (kexpr:parse/string str)
+  (let ([input (open-input-string str)])
+    (kaitai-parser (lambda () (kaitai-lexer input)))))
+
+;; like parse/string but accepts more types that could show up in the yaml
+(define (kexpr:parse thing)
+  (match thing
+    [(? integer?) thing]
+    [(? string?) (kexpr:parse/string thing)]))
+
 ;; kaitai expr AST
 ;; it's like racket mostly. builtins are
 ;; - all the builtin operators
@@ -130,10 +144,10 @@
 ;; - (get obj attr): references an attribute on an object
 ;; primitive types: boolean, number, string, symbol (identifier)
 
-(define test2 "true and 'a' != 'b' ? -1 + ~bits : ('hello' + 'world').substring(2, 3)")
+; (define test2 "true and 'a' != 'b' ? -1 + ~bits : ('hello' + 'world').substring(2, 3)")
 ;; => '(if (and #t (!= "a" "b"))
 ;;         (+ -1 (~ bits))
 ;;         (apply (get (+ "hello" "world") substring) 2 3))
 
-(let ([input (open-input-string test2)])
+; (let ([input (open-input-string test2)])
-  (kaitai-parser (lambda () (kaitai-lexer input))))
+;   (kaitai-parser (lambda () (kaitai-lexer input))))

kaitai/main.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 
-(require (for-syntax racket/base racket/list racket/match racket/pretty))
+(require (for-syntax racket/base racket/list racket/match racket/pretty
+                     "expr.rkt"))
 (provide (rename-out [kaitai:module-begin #%module-begin])
          (except-out (all-from-out racket/base) #%module-begin))
 
@@ -29,22 +30,39 @@
 
 ;; idk yet
 (define-for-syntax (kaitai:process-ty defn [given-id #f])
+  (define (primitive-size prim-ty)
+    (match prim-ty
+      [(pregexp #px"^([us][1248])|(f[48])$")
+       (string->number (substring prim-ty 1))]
+      [_ (raise-syntax-error #f "unimplemented primitive type" prim-ty)]))
+
   (pretty-write defn)
   (define-values [id seqs] (get-id-seq defn given-id))
 
   (for ([(name subty) (in-hash (hash-ref defn "types" (hash)))])
     (kaitai:process-ty subty name))
 
-  (struct context [] #:transparent)
+  (struct context [io-pos] #:transparent)
 
-  (for/fold ([ctx (context)]) ([seq (in-list seqs)])
+  (for/fold ([ctx (context 0)]) ([seq (in-list seqs)])
-    (printf "seq: ~a\n" seq)
+    ; (printf "seq: ~a\n" seq)
+
+    (define seq-id (hash-ref seq "id" (make-rse "seq item has no id")))
 
     ;; each seq element has an implicit dependency on the last seq's end position
     ;; (the first seq depends on the parent element's start position)
     ;; additionally each seq has a length expression calculated from its type
 
-    ctx)
+    (define size-expr
+      (cond [(hash-has-key? seq "size") (kexpr:parse (hash-ref seq "size"))]
+            [(hash-has-key? seq "type") (primitive-size (hash-ref seq "type"))]
+            [else (raise-syntax-error #f "seq has unsolvable size" seq)]))
+
+    (define next-pos `(+ ,(context-io-pos ctx) ,size-expr))
+
+    (printf "~a: ~a to ~a\n" seq-id (context-io-pos ctx) next-pos)
+
+    (context next-pos))
 
   (void))
 

kaitai/scribblings/kaitai.scrbl

@@ -6,4 +6,4 @@
 
 @defmodule[kaitai]
 
-Package Description Here
+MEOW