about summary refs log tree commit diff stats
path: root/mu.arc.t
diff options
context:
space:
mode:
Diffstat (limited to 'mu.arc.t')
-rw-r--r--mu.arc.t172
1 files changed, 116 insertions, 56 deletions
diff --git a/mu.arc.t b/mu.arc.t
index 9124f98a..dabd522f 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -2789,6 +2789,8 @@
 
 )  ; section 100
 
+(section 9
+
 ;; Separating concerns
 ;
 ; Lightweight tools can also operate on quoted lists of statements surrounded
@@ -3184,6 +3186,8 @@
           '(((2 integer) <- copy (0 literal))))
   (prn "F - 'def!' clears all previous clauses"))
 
+)  ; section 9
+
 ;; ---
 
 (section 100  ; string utilities
@@ -3297,73 +3301,123 @@
 
 ;; unit tests for various helpers
 
+; tokenize-args
+(prn "tokenize-args")
+(assert:iso '((a b) (c d))
+            (tokenize-arg 'a:b/c:d))
+(assert:iso '((a b) (1 d))
+            (tokenize-arg 'a:b/1:d))
+(assert:iso '<-
+            (tokenize-arg '<-))
+
+(assert:iso '((((default-scope scope-address)) <- ((new)) ((scope literal)) ((30 literal)))
+              foo)
+            (tokenize-args
+              '((default-scope:scope-address <- new scope:literal 30:literal)
+                foo)))
+
 ; absolutize
+(prn "absolutize")
 (reset)
-(if (~iso '(4 integer) (absolutize '(4 integer)))
+(if (~iso '((4 integer)) (absolutize '((4 integer))))
   (prn "F - 'absolutize' works without routine"))
 (= routine* make-routine!foo)
-(if (~iso '(4 integer) (absolutize '(4 integer)))
+(if (~iso '((4 integer)) (absolutize '((4 integer))))
   (prn "F - 'absolutize' works without default-scope"))
 (= rep.routine*!call-stack.0!default-scope 10)
 (= memory*.10 5)  ; bounds check for default-scope
-(if (~iso '(14 integer global) (absolutize '(4 integer)))
+(if (~iso '((14 integer) (global))
+          (absolutize '((4 integer))))
   (prn "F - 'absolutize' works with default-scope"))
-(absolutize '(5 integer))
+(absolutize '((5 integer)))
 (if (~posmatch "no room" rep.routine*!error)
   (prn "F - 'absolutize' checks against default-scope bounds"))
 
 ; addr
+(prn "addr")
 (reset)
 (= routine* nil)
-(if (~is 4 (addr '(4 integer)))
+;? (prn 111)
+(if (~is 4 (addr '((4 integer))))
   (prn "F - directly addressed operands are their own address"))
-(if (~is 4 (addr '(4 integer-address)))
+;? (quit)
+(if (~is 4 (addr '((4 integer-address))))
   (prn "F - directly addressed operands are their own address - 2"))
-(if (~is 4 (addr '(4 literal)))
+(if (~is 4 (addr '((4 literal))))
   (prn "F - 'addr' doesn't understand literals"))
+;? (prn 201)
 (= memory*.4 23)
-(if (~is 23 (addr '(4 integer-address deref)))
+;? (prn 202)
+(if (~is 23 (addr '((4 integer-address) (deref))))
   (prn "F - 'addr' works with indirectly-addressed 'deref'"))
+;? (quit)
 (= memory*.3 4)
-(if (~is 23 (addr '(3 integer-address-address deref deref)))
+(if (~is 23 (addr '((3 integer-address-address) (deref) (deref))))
   (prn "F - 'addr' works with multiple 'deref'"))
 
 (= routine* make-routine!foo)
-(if (~is 4 (addr '(4 integer)))
+(if (~is 4 (addr '((4 integer))))
   (prn "F - directly addressed operands are their own address inside routines"))
-(if (~is 4 (addr '(4 integer-address)))
+(if (~is 4 (addr '((4 integer-address))))
   (prn "F - directly addressed operands are their own address inside routines - 2"))
-(if (~is 4 (addr '(4 literal)))
+(if (~is 4 (addr '((4 literal))))
   (prn "F - 'addr' doesn't understand literals inside routines"))
 (= memory*.4 23)
-(if (~is 23 (addr '(4 integer-address deref)))
+(if (~is 23 (addr '((4 integer-address) (deref))))
   (prn "F - 'addr' works with indirectly-addressed 'deref' inside routines"))
 
+;? (prn 301)
 (= rep.routine*!call-stack.0!default-scope 10)
+;? (prn 302)
 (= memory*.10 5)  ; bounds check for default-scope
-(if (~is 14 (addr '(4 integer)))
+;? (prn 303)
+(if (~is 14 (addr '((4 integer))))
   (prn "F - directly addressed operands in routines add default-scope"))
-(if (~is 14 (addr '(4 integer-address)))
+;? (quit)
+(if (~is 14 (addr '((4 integer-address))))
   (prn "F - directly addressed operands in routines add default-scope - 2"))
-(if (~is 14 (addr '(4 literal)))
+(if (~is 14 (addr '((4 literal))))
   (prn "F - 'addr' doesn't understand literals"))
 (= memory*.14 23)
-(if (~is 23 (addr '(4 integer-address deref)))
+(if (~is 23 (addr '((4 integer-address) (deref))))
   (prn "F - 'addr' adds default-scope before 'deref', not after"))
+;? (quit)
 
 ; deref
+(prn "deref")
 (reset)
 (= memory*.3 4)
-(if (~iso '(4 integer) (deref '(3 integer-address deref)))
+(if (~iso '((4 integer))
+          (deref '((3 integer-address)
+                   (deref))))
   (prn "F - 'deref' handles simple addresses"))
-(if (~iso '(4 integer deref) (deref '(3 integer-address deref deref)))
+(if (~iso '((4 integer) (deref))
+          (deref '((3 integer-address)
+                   (deref)
+                   (deref))))
   (prn "F - 'deref' deletes just one deref"))
 (= memory*.4 5)
-(if (~iso '(5 integer) (deref:deref '(3 integer-address-address deref deref)))
+(if (~iso '((5 integer))
+          (deref:deref '((3 integer-address-address)
+                         (deref)
+                         (deref))))
   (prn "F - 'deref' can be chained"))
 
+; array-len
+(prn "array-len")
+(reset)
+(= memory*.35 4)
+(if (~is 4 (array-len '((35 integer-boolean-pair-array))))
+  (prn "F - 'array-len'"))
+(= memory*.34 35)
+(if (~is 4 (array-len '((34 integer-boolean-pair-array-address) (deref))))
+  (prn "F - 'array-len'"))
+;? (quit)
+
 ; sizeof
+(prn "sizeof")
 (reset)
+;? (prn 401)
 (if (~is 1 sizeof!integer)
   (prn "F - 'sizeof' works on primitives"))
 (if (~is 1 sizeof!integer-address)
@@ -3373,126 +3427,132 @@
 (if (~is 3 sizeof!integer-point-pair)
   (prn "F - 'sizeof' works on records with record fields"))
 
-(if (~is 1 (sizeof '(34 integer)))
+;? (prn 410)
+(if (~is 1 (sizeof '((34 integer))))
   (prn "F - 'sizeof' works on primitive operands"))
-(if (~is 1 (sizeof '(34 integer-address)))
+(if (~is 1 (sizeof '((34 integer-address))))
   (prn "F - 'sizeof' works on address operands"))
-(if (~is 2 (sizeof '(34 integer-boolean-pair)))
+(if (~is 2 (sizeof '((34 integer-boolean-pair))))
   (prn "F - 'sizeof' works on record operands"))
-(if (~is 3 (sizeof '(34 integer-point-pair)))
+(if (~is 3 (sizeof '((34 integer-point-pair))))
   (prn "F - 'sizeof' works on record operands with record fields"))
-(if (~is 2 (sizeof '(34 integer-boolean-pair-address deref)))
+(if (~is 2 (sizeof '((34 integer-boolean-pair-address) (deref))))
   (prn "F - 'sizeof' works on pointers to records"))
 (= memory*.35 4)  ; size of array
 (= memory*.34 35)
-;? (= dump-trace* (obj whitelist '("sizeof")))
-(if (~is 9 (sizeof '(34 integer-boolean-pair-array-address deref)))
+;? (= dump-trace* (obj whitelist '("sizeof" "array-len")))
+(if (~is 9 (sizeof '((34 integer-boolean-pair-array-address) (deref))))
   (prn "F - 'sizeof' works on pointers to arrays"))
 ;? (quit)
 
+;? (prn 420)
 (= memory*.4 23)
-(if (~is 24 (sizeof '(4 integer-array)))
+(if (~is 24 (sizeof '((4 integer-array))))
   (prn "F - 'sizeof' reads array lengths from memory"))
 (= memory*.3 4)
-(if (~is 24 (sizeof '(3 integer-array-address deref)))
+(if (~is 24 (sizeof '((3 integer-array-address) (deref))))
   (prn "F - 'sizeof' handles pointers to arrays"))
 (= memory*.14 34)
 (= routine* make-routine!foo)
-(if (~is 24 (sizeof '(4 integer-array)))
+(if (~is 24 (sizeof '((4 integer-array))))
   (prn "F - 'sizeof' reads array lengths from memory inside routines"))
 (= rep.routine*!call-stack.0!default-scope 10)
 (= memory*.10 5)  ; bounds check for default-scope
-(if (~is 35 (sizeof '(4 integer-array)))
+(if (~is 35 (sizeof '((4 integer-array))))
   (prn "F - 'sizeof' reads array lengths from memory using default-scope"))
 (= memory*.35 4)  ; size of array
 (= memory*.14 35)
 ;? (= dump-trace* (obj whitelist '("sizeof")))
 (aif rep.routine*!error (prn "error - " it))
-(if (~is 9 (sizeof '(4 integer-boolean-pair-array-address deref)))
+(if (~is 9 (sizeof '((4 integer-boolean-pair-array-address) (deref))))
   (prn "F - 'sizeof' works on pointers to arrays using default-scope"))
 ;? (quit)
 
 ; m
+(prn "m")
 (reset)
-(if (~is 4 (m '(4 literal)))
+(if (~is 4 (m '((4 literal))))
   (prn "F - 'm' avoids reading memory for literals"))
-(if (~is 4 (m '(4 offset)))
+(if (~is 4 (m '((4 offset))))
   (prn "F - 'm' avoids reading memory for offsets"))
 (= memory*.4 34)
-(if (~is 34 (m '(4 integer)))
+(if (~is 34 (m '((4 integer))))
   (prn "F - 'm' reads memory for simple types"))
 (= memory*.3 4)
-(if (~is 34 (m '(3 integer-address deref)))
+(if (~is 34 (m '((3 integer-address) (deref))))
   (prn "F - 'm' redirects addresses"))
 (= memory*.2 3)
-(if (~is 34 (m '(2 integer-address-address deref deref)))
+(if (~is 34 (m '((2 integer-address-address) (deref) (deref))))
   (prn "F - 'm' multiply redirects addresses"))
-(if (~iso (annotate 'record '(34 nil)) (m '(4 integer-boolean-pair)))
+(if (~iso (annotate 'record '(34 nil)) (m '((4 integer-boolean-pair))))
   (prn "F - 'm' supports compound records"))
 (= memory*.5 35)
 (= memory*.6 36)
-(if (~iso (annotate 'record '(34 35 36)) (m '(4 integer-point-pair)))
+(if (~iso (annotate 'record '(34 35 36)) (m '((4 integer-point-pair))))
   (prn "F - 'm' supports records with compound fields"))
-(if (~iso (annotate 'record '(34 35 36)) (m '(3 integer-point-pair-address deref)))
+(if (~iso (annotate 'record '(34 35 36)) (m '((3 integer-point-pair-address) (deref))))
   (prn "F - 'm' supports indirect access to records"))
 (= memory*.4 2)
-(if (~iso (annotate 'record '(2 35 36)) (m '(4 integer-array)))
+(if (~iso (annotate 'record '(2 35 36)) (m '((4 integer-array))))
   (prn "F - 'm' supports access to arrays"))
-(if (~iso (annotate 'record '(2 35 36)) (m '(3 integer-array-address deref)))
+(if (~iso (annotate 'record '(2 35 36)) (m '((3 integer-array-address) (deref))))
   (prn "F - 'm' supports indirect access to arrays"))
 
 ; setm
+(prn "setm")
 (reset)
-(setm '(4 integer) 34)
+(setm '((4 integer)) 34)
 (if (~is 34 memory*.4)
   (prn "F - 'setm' writes primitives to memory"))
-(setm '(3 integer-address) 4)
+(setm '((3 integer-address)) 4)
 (if (~is 4 memory*.3)
   (prn "F - 'setm' writes addresses to memory"))
-(setm '(3 integer-address deref) 35)
+(setm '((3 integer-address) (deref)) 35)
 (if (~is 35 memory*.4)
   (prn "F - 'setm' redirects writes"))
 (= memory*.2 3)
-(setm '(2 integer-address-address deref deref) 36)
+(setm '((2 integer-address-address) (deref) (deref)) 36)
 (if (~is 36 memory*.4)
   (prn "F - 'setm' multiply redirects writes"))
-(setm '(4 integer-integer-pair) (annotate 'record '(23 24)))
+;? (prn 505)
+(setm '((4 integer-integer-pair)) (annotate 'record '(23 24)))
 (if (~memory-contains 4 '(23 24))
   (prn "F - 'setm' writes compound records"))
 (assert (is memory*.7 nil))
-(setm '(7 integer-point-pair) (annotate 'record '(23 24 25)))
+;? (prn 506)
+(setm '((7 integer-point-pair)) (annotate 'record '(23 24 25)))
 (if (~memory-contains 7 '(23 24 25))
   (prn "F - 'setm' writes records with compound fields"))
 (= routine* make-routine!foo)
-(setm '(4 integer-point-pair) (annotate 'record '(33 34)))
+(setm '((4 integer-point-pair)) (annotate 'record '(33 34)))
 (if (~posmatch "incorrect size" rep.routine*!error)
   (prn "F - 'setm' checks size of target"))
 (wipe routine*)
-(setm '(3 integer-point-pair-address deref) (annotate 'record '(43 44 45)))
+(setm '((3 integer-point-pair-address) (deref)) (annotate 'record '(43 44 45)))
 (if (~memory-contains 4 '(43 44 45))
   (prn "F - 'setm' supports indirect writes to records"))
-(setm '(2 integer-point-pair-address-address deref deref) (annotate 'record '(53 54 55)))
+(setm '((2 integer-point-pair-address-address) (deref) (deref)) (annotate 'record '(53 54 55)))
 (if (~memory-contains 4 '(53 54 55))
   (prn "F - 'setm' supports multiply indirect writes to records"))
-(setm '(4 integer-array) (annotate 'record '(2 31 32)))
+(setm '((4 integer-array)) (annotate 'record '(2 31 32)))
 (if (~memory-contains 4 '(2 31 32))
   (prn "F - 'setm' writes arrays"))
-(setm '(3 integer-array-address deref) (annotate 'record '(2 41 42)))
+(setm '((3 integer-array-address) (deref)) (annotate 'record '(2 41 42)))
 (if (~memory-contains 4 '(2 41 42))
   (prn "F - 'setm' supports indirect writes to arrays"))
 (= routine* make-routine!foo)
-(setm '(4 integer-array) (annotate 'record '(2 31 32 33)))
+(setm '((4 integer-array)) (annotate 'record '(2 31 32 33)))
 (if (~posmatch "invalid array" rep.routine*!error)
   (prn "F - 'setm' checks that array written is well-formed"))
 (= routine* make-routine!foo)
 ;? (prn 111)
 ;? (= dump-trace* (obj whitelist '("sizeof" "setm")))
-(setm '(4 integer-boolean-pair-array) (annotate 'record '(2 31 nil 32 nil 33)))
+(setm '((4 integer-boolean-pair-array)) (annotate 'record '(2 31 nil 32 nil 33)))
 (if (~posmatch "invalid array" rep.routine*!error)
   (prn "F - 'setm' checks that array of records is well-formed"))
 (= routine* make-routine!foo)
 ;? (prn 222)
-(setm '(4 integer-boolean-pair-array) (annotate 'record '(2 31 nil 32 nil)))
+(setm '((4 integer-boolean-pair-array)) (annotate 'record '(2 31 nil 32 nil)))
 (if (posmatch "invalid array" rep.routine*!error)
   (prn "F - 'setm' checks that array of records is well-formed - 2"))
 (wipe routine*)
generated by cgit-pink 1.4.1-2-gfad0 (git 2.36.2.497.gbbea4dcf42) at 2024-06-28 00:25:28 +0000