git @ Cat's Eye Technologies Decoy / master junk / thencemuffin.scm
master

Tree @master (Download .tar.gz)

thencemuffin.scm @master — raw · history · blame 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
; SPDX-FileCopyrightText: Copyright (c) 2023-2024 Chris Pressey, Cat's Eye Technologies.
; This work is distributed under a 2-clause BSD license. For more information, see:
; SPDX-License-Identifier: LicenseRef-BSD-2-Clause-X-Decoy

;/*
; * Thencemuffin: a just plain inexcusable esolang
; */

(define module "thencemuffin")

(import-from "stdenv" (list or not >= equal? string-ref length))

(import-from "rux-rolli" (
    (newComposite as new-composite)
    (getTextChild as get-text-child)
    (getPlayfieldChild as get-playfield-child)
    (getStackChild as get-stack-child)

    (newPlayfield as new-playfield)
    (setCursor as set-cursor)
    put
    (moveCursor as move-cursor)

    (newRange as new-range)
    (getRangeIndex as get-range-index)

    (newCursor as new-cursor)

    (newText as new-text)
    (getString as get-string)
    (getRanges as get-ranges)
    (moveRange as move-range)

    (newStack as new-stack)
    push
    pop

    (nextWith as next-with)
    (haltWith as halt-with)
    (inputWith as input-with)
))

(define array-index list)  ; FIXME (import-from "js-interop" (array-index))

(define load (lambda (program-text)
  (new-composite (list
    (new-text program-text (list (new-range 0 1)))
    (put 0 0 "X" (set-cursor "IP" (new-cursor 0 0 1 0) (new-playfield)))
    (new-stack (list))
  ))
))

(define next (lambda (configuration)
  (let* ((text  (get-text-child configuration 0))
         (pf    (get-playfield-child configuration 1))
         (stack (get-stack-child configuration 2)))
    (if (or (not text) (not pf) (not stack))
      (halt-with configuration)
      (let* ((range (array-index 0 (get-ranges text))))
        (if (>= (get-range-index range) (length (get-string text)))
          (halt-with configuration)
          (let* ((next-text (move-range text 0 1))
                 (char (string-ref (get-string text) (get-range-index range))))
            (if (equal? char "I")
              (input-with (new-composite (list next-text pf (push "*" stack))))
              (let* ((next-stack
                       (if (equal? char "S")
                         (if (pop stack) (pop stack) stack)
                         (push "A" stack)))
                   (next-pf (move-cursor "IP" 1 0 (put 2 1 char pf))))
                (next-with (new-composite (list next-text next-pf next-stack))))))))))
))

(define recv (lambda (configuration input)
  (let* ((text  (get-text-child configuration 0))
         (pf    (get-playfield-child configuration 1))
         (stack (get-stack-child configuration 2)))
    (if (or (not text) (not pf) (not stack))
      (halt-with configuration)
      (next-with (new-composite (list text pf (push stack input))))))
))