From: plugd <plugd@thelambdalab.xyz>
Date: Tue, 11 Apr 2023 20:51:05 +0000 (+0200)
Subject: Z-string encoding.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=d37274a6c61c5b4c7638518bb2c76499758cb9d1;p=ez.git

Z-string encoding.
---

diff --git a/ez.el b/ez.el
index a4cf5e7..2dec2d7 100644
--- a/ez.el
+++ b/ez.el
@@ -1,6 +1,6 @@
 ;;; ez.el --- Emacs Z-machine
 
-;; Copyright (C) 2021 Tim Vaughan
+;; Copyright (C) 2021,2022,2023 Tim Vaughan
 
 ;; Author: Tim Vaughan <timv@ughan.xyz>
 ;; Created: 13 Oct 2021
@@ -84,6 +84,12 @@
 (defvar ez-abbrevtab-addr nil)
 (defvar ez-globalvartab-addr nil)
 
+(defvar ez-dict-entries nil
+  "Parsed dictionary")
+
+(defvar ez-dict-separators nil
+  "Parsed dictionary")
+
 (defun ez-mem-ref-byte (addr)
   (aref ez-memory addr))
 
@@ -320,23 +326,44 @@
 (defun ez-get-zstring (base-addr)
   (cdr (ez-get-zstring-and-length base-addr)))
 
+(defun ez-encode (string)
+  "Encodes a string as a 2-word 5-padded Z-string.
+Used for matching input with dictionary entries when tokenizing."
+  (let ((chars
+         (mapcan
+          (lambda (c)
+            (cond
+             ((seq-contains-p (elt ez-zstring-alphabets 0) c)
+              (list (seq-position (elt ez-zstring-alphabets 0) c)))
+             ((seq-contains-p (elt ez-zstring-alphabets 1) c)
+              (list 4 (seq-position (elt ez-zstring-alphabets 1) c)))
+             ((seq-contains-p (elt ez-zstring-alphabets 2) c)
+              (list 5 (seq-position (elt ez-zstring-alphabets 2) c)))
+             (t
+              (list 5 6 (lsh c -5) (logand c #b11111)))))
+          string)))
+    (if (< (length chars) 6)
+        (append chars (make-list (- 6 (length chars)) 5))
+      (take 6 chars))))
+
 ;; Dictionary
 
-(defun ez-get-dictionary ()
+(defun ez-parse-dictionary ()
   (let* ((nseps (ez-mem-ref-byte ez-dict-base))
          (separators
           (mapcar (lambda (i) (ez-mem-ref-byte (+ ez-dict-base i)))
                   (number-sequence 1 nseps)))
          (bytes-per-entry (ez-mem-ref-byte (+ ez-dict-base 1 nseps)))
-         (nentries (ez-mem-ref-word (+ ez-dict-base 1 nseps 1)))
+         (nentries (ez-mem-ref-word (+ ez-dict-base 2 nseps)))
          (entries-base (+ ez-dict-base nseps 4))
          (entries nil))
     (dotimes (i nentries)
       (let ((this-base (+ entries-base (* 7 i))))
-        (setq entries (cons (cons this-base
-                                  (ez-get-zstring this-base))
+        (setq entries (cons (cons (ez-get-zstring this-base)
+                                  this-base)
                             entries))))
-    (list entries separators entries)))
+    (setq ez-dict-entries (reverse entries))
+    (setq ez-dict-separators separators)))
 
 ;; Call stack
 
@@ -867,20 +894,40 @@
   'wait-for-input)
 
 (defun ez-op-read2 (input-string)
-  (let ((baddr1 (car ez--next-read-args))
-        (baddr2 (cadr ez--next-read-args)))
+  (let* ((baddr1 (car ez--next-read-args))
+         (baddr2 (cadr ez--next-read-args))
+         (dict (ez-get-dictionary))
+         (separators (car dict))
+         (wordlist (cdr dict))
+         (token-start 0))
 
     (dotimes (i (length input-string))
-      (ez-mem-set-byte (+ baddr1 1 i) (downcase (elt input-string i))))
+      (let ((char (elt input-string i)))
+        (ez-mem-set-byte (+ baddr1 1 i) char)
     (ez-mem-set-byte (+ baddr1 1 (length input-string)) 0)
-    
-    ))
+
+    (ez--tokenize baddr1 baddr2)))))
+
+(defun ez--tokenize (taddr baddr)
+
+  (let ((unfinished t)
+        (token-start 0)
+        (token-end 0)
+        (token-string ""))
+    (while unfinished
+      (let ((char (ez-mem-ref-byte (+ taddr 1 token-end))))
+        (cond
+         ((eq char ?\s))
+         ((memq char ez-dict-separators))
+         )
+      ))))
 
 ;; Execution loop
 
 (defun ez-load-and-run (filename)
   (ez-load-file filename)
   (ez-parse-header)
+  (ez-parse-dictionary)
   (setq ez-call-stack (list (ez-make-call-stack-frame ez-start-pc)))
 
   (ez-run))
@@ -921,8 +968,10 @@
   (interactive)
   (if (not (eq ez-machine-state 'wait-for-input))
       (error "Z-machine not ready for input."))
-  (let ((input-string (with-current-buffer "*ez*"
-                        (buffer-substring ez-input-marker (point-max)))))
+  (let ((input-string
+         (downcase
+          (with-current-buffer "*ez*"
+            (buffer-substring ez-input-marker (point-max))))))
     (delete-region ez-input-marker (point-max))
     (ez-print (concat input-string "\n"))
     (ez-debug-message "\tReceived string \"%s\"" input-string)
@@ -951,7 +1000,8 @@
     (setq-local buffer-read-only t)
     (let ((inhibit-read-only t)
           (old-point (point)))
-      (hexl-mode-exit)
+      (if (eq major-mode 'hexl-mode)
+          (hexl-mode-exit))
       (erase-buffer)
       (insert ez-memory)
       (setq-local buffer-undo-list nil)