(module XEd
   (main edit)
   (extern
    (include "stdio.h")
;   (type void* (opaque) "void*")
    (type FILE* (opaque) "FILE*")
    (macro stdout::FILE* "stdout")
    (macro fopen::FILE* (::string ::string) "fopen")
    (macro fclose::int (::FILE*) "fclose")
    
    (macro ftell::long (::FILE*) "ftell")
    (macro fseek::int (::FILE* ::long ::int) "fseek")
    (macro SEEK-SET::int "SEEK_SET")
    (macro SEEK-CUR::int "SEEK_CUR")
    (macro SEEK-END::int "SEEK_END")

    (macro fread::int (::string ::int ::int ::FILE*) "fread")
    (macro fwrite::int (::void* ::int ::int ::FILE*) "fwrite")
    (macro fputc::int (::int ::FILE*) "fputc")
    (macro fputs::int (::string ::FILE*) "fputs")
    (macro fprintf::int (::FILE* ::string . ::long) "fprintf")

    (include "errno.h")
    (macro errno::int "errno")
    (macro perror::void (::string) "perror")
    )
   )

(define (hide::void* x) (pragma::void* "((void*)$1)" x))

(define (read-from s)
;   (display* "Reading from: " s #\newline)
   (let ((v (with-input-from-string s read)))
;     (display* "read: " v #\newline)
      v))

(define (parse-arg s)
   (read/rp (regular-grammar
		  ((odigit (in "01234567"))
		   (number (or (: "#x" (+ xdigit))
			       (: "#o" (+ odigit))
			       (: "#d" (+ digit))
			       (+ digit)))
		   (size (in "owlq"))
		   )
	       ((: (submatch number) "=" (submatch number) (submatch size))
		(list 'replace
		      (read-from (the-submatch 1))
		      (read-from (the-submatch 2))
		      (read-from (the-submatch 3))))
	       ((: "@" (submatch number) (submatch size))
		(list 'show
		      (read-from (the-submatch 1))
		      #f
		      (read-from (the-submatch 2))))
	       (else #f))
	    (open-input-string s)))


(define (show-value f::FILE* s)
   (let* ((octets (case s
		     ((o) 1)
		     ((w) 2)
		     ((l) 4)
		     ((q) 8)
		     (else 8)))
	  (buffer (make-string octets))
	  (rc (fread buffer octets 1 f)))
      (if (= rc -1)
	  (begin
	     (perror (string-append "Reading " (number->string octets) " octets"))
	     (exit rc))
	  (let ((read-at (- (ftell f) octets)))
	     (display* "Value at " read-at "(" (number->string read-at 16) "): "
		       (map (lambda (c) (number->string (char->integer c) 16))
			    (string->list buffer))
		       #\newline)))
      ))
	     
	  

(define (write-value f::FILE* v s)
   (let* ((value-bytes (append '(0 0 0 0 0 0 0 0)
			       (let build ((v v) (bytes '()))
				  (if (= v 0)
				      bytes
				      (build (quotient v 256)
					     (cons (modulo v 256) bytes)))
				  )))
	  (write-bytes (list-tail value-bytes
				  (- (length value-bytes)
				     (case s
					((o) 1)
					((w) 2)
					((l) 4)
					((q) 8)
					(else 0)))
				  )))
      (map (lambda (c)
;	      (display* "writing byte " c #\newline)
	      (let ((rc (fputc c f)))
		 (if (= rc -1)
		     (begin
			(perror "writing byte")
			(exit errno)))))
	   write-bytes)))


(define (edit-action f::FILE* a o v s)
;   (display* "Edit action: " a " offset=" o " value=" v " size=" s #\newline)
   (case a
      ((replace) (fseek f o SEEK-SET)
		 (write-value f v s))
      ((show) (fseek f o SEEK-SET)
	      (show-value f s))
      (else
       (display* "Unknown action code: " a #\newline))
      ))

(define (new-edit-env) new-edit-env)

(define (edit argv)
   (if (< (length argv) 2)
       (begin
	  (display* "usage: xed <edit-spec>* <file>" #\newline
		    "edit-spec: <offset>=<value>" #\newline
		    "           @<offset><size>" #\newline
		    "offset: <integer>" #\newline
		    "value: <integer><size>" #\newline
		    "integer: <decimal>|#x<hex>|#o<octal>" #\newline
		    "size: o|w|l|q" #\newline)
	  (exit 0))

       (let* ((edit-env (new-edit-env)))
	  (call-with-values
	     (lambda ()
		(let parse ((args argv)
			    (edits '())
			    (file #f))
		   (if (null? args)
		       (values edits file)
		       (let* ((arg (car args))
			      (remaining (cdr args))
			      (edit-or-file (parse-arg arg)))
			  (if edit-or-file
			      (parse remaining (cons edit-or-file edits) file)
			      (parse remaining edits arg)))
		       )))
	     (lambda (edits file-name)
;		(display* "editting file: " file-name ", edits: " edits #\newline)
		(let ((file (fopen file-name "r+")))
;		   (fprintf stdout "file* = %08x" (pragma::long "(long)$1" file)) (newline)
		   (for-each (lambda (e)
				(apply (lambda (a o v s)
					  (edit-action file a o v s))
				       e))
			     edits)
		   (fclose file)))
	     ))
       ))