├── .golangci.yaml ├── .gitattributes ├── tools └── extract │ ├── .gitignore │ ├── requirements.txt │ ├── config.json │ ├── copy_files.py │ ├── extract.py │ └── subroutines.py ├── lisp ├── emacs │ ├── commit.txt │ ├── README.md │ └── emacs-lisp │ │ ├── debug-early.el │ │ └── backquote.el ├── loadup-pimacs.el └── lt.el ├── etc ├── logo.png └── logo.xcf ├── core ├── character_set.go ├── system.go ├── callproc.go ├── utils.go ├── character.go ├── minibuffer.go ├── lisp_test.go ├── allocation.go ├── obarray.go ├── helpers_test.go ├── string_test.go ├── edit_functions.go ├── exec_context_test.go ├── interpreter.go ├── goroutine.go ├── keyboard.go ├── errors.go ├── string.go ├── buffer.go ├── keymap.go ├── types.go ├── symbols.go ├── character_table_test.go ├── pimacs_tools.go ├── character_table.go ├── print.go ├── helpers.go ├── interpreter_test.go ├── data.go ├── exec_context.go └── functions.go ├── test └── lisp │ ├── allocation-tests.el │ ├── goroutine-tests.el │ ├── character-table-tests.el │ ├── eval-tests.el │ ├── backquote-tests.el │ ├── read-tests.el │ ├── data-tests.el │ └── functions-tests.el ├── .gitignore ├── proto ├── proto.go └── key.go ├── go.mod ├── Makefile ├── .github └── workflows │ └── test.yml ├── pimacs.go ├── ui └── tui │ └── main.go ├── README.md └── go.sum /.golangci.yaml: -------------------------------------------------------------------------------- 1 | linters: 2 | disable: unused 3 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | lisp/emacs/** linguist-generated=true 2 | -------------------------------------------------------------------------------- /tools/extract/.gitignore: -------------------------------------------------------------------------------- 1 | /__pycache__ 2 | env/ 3 | sourceme 4 | -------------------------------------------------------------------------------- /lisp/emacs/commit.txt: -------------------------------------------------------------------------------- 1 | f7725d85f3132fb684032438f81defcb481892b7 2 | -------------------------------------------------------------------------------- /tools/extract/requirements.txt: -------------------------------------------------------------------------------- 1 | pyparsing==3.0.9 2 | black==24.3.0 3 | -------------------------------------------------------------------------------- /etc/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/federicotdn/pimacs/HEAD/etc/logo.png -------------------------------------------------------------------------------- /etc/logo.xcf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/federicotdn/pimacs/HEAD/etc/logo.xcf -------------------------------------------------------------------------------- /core/character_set.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | func (ec *execContext) symbolsOfCharacterSet() { 4 | ec.defSym(&ec.s.emacs, "emacs") 5 | } 6 | -------------------------------------------------------------------------------- /core/system.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "os" 5 | ) 6 | 7 | func (ec *execContext) openp(path, str, suffixes lispObject) (*os.File, error) { 8 | return nil, nil 9 | } 10 | -------------------------------------------------------------------------------- /test/lisp/allocation-tests.el: -------------------------------------------------------------------------------- 1 | ;;; allocation-tests.el --- Tests for allocation.go -*- lexical-binding: t; -*- 2 | 3 | (lt--deftest test-make-vector () 4 | (lt--should (equal (make-vector 5 1) [1 1 1 1 1])) 5 | (lt--should (equal (make-vector 0 0) []))) 6 | -------------------------------------------------------------------------------- /tools/extract/config.json: -------------------------------------------------------------------------------- 1 | { 2 | "emacs_commit": "f7725d85f3132fb684032438f81defcb481892b7", 3 | "emacs_branch": "master", 4 | "copy_lisp_files": [ 5 | "emacs-lisp/debug-early.el", 6 | "emacs-lisp/byte-run.el", 7 | "emacs-lisp/backquote.el", 8 | "subr.el" 9 | ] 10 | } 11 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Binaries for programs and plugins 2 | *.exe 3 | *.exe~ 4 | *.dll 5 | *.so 6 | *.dylib 7 | 8 | # Test binary, built with `go test -c` 9 | *.test 10 | 11 | # Output of the go coverage tool, specifically when used with LiteIDE 12 | *.out 13 | 14 | # Dependency directories (remove the comment below to include it) 15 | # vendor/ 16 | 17 | # pimacs 18 | /pimacs 19 | test.el 20 | .venv 21 | -------------------------------------------------------------------------------- /lisp/emacs/README.md: -------------------------------------------------------------------------------- 1 | # Emacs Elisp files 2 | 3 | All Elisp files in this directory have been copied directly from the [Emacs (GNU Emacs)](https://www.gnu.org/software/emacs/) source code, in the `lisp/` directory. They are licensed under the GNU General Public License (version 3) as published by the Free Software Foundation. 4 | 5 | See the `commit.txt` file for information on which Emacs Git revision they were copied from. 6 | -------------------------------------------------------------------------------- /proto/proto.go: -------------------------------------------------------------------------------- 1 | package proto 2 | 3 | type InputEvent interface{} 4 | 5 | type InputEventKey struct { 6 | // TODO: This is too tightly coupled with tcell 7 | Rune rune 8 | Key Key 9 | Mod ModMask 10 | } 11 | 12 | func (ev *InputEventKey) HasMod(m ModMask) bool { 13 | return (ev.Mod & m) != 0 14 | } 15 | 16 | type DrawOp interface{} 17 | 18 | type DrawOpSetText struct { 19 | Text string 20 | } 21 | 22 | type DrawOpSpecial struct { 23 | Terminate bool 24 | } 25 | -------------------------------------------------------------------------------- /go.mod: -------------------------------------------------------------------------------- 1 | module github.com/federicotdn/pimacs 2 | 3 | go 1.21 4 | 5 | require github.com/gdamore/tcell/v2 v2.6.0 6 | 7 | require ( 8 | github.com/gdamore/encoding v1.0.0 // indirect 9 | github.com/lucasb-eyer/go-colorful v1.2.0 // indirect 10 | github.com/mattn/go-runewidth v0.0.14 // indirect 11 | github.com/rivo/uniseg v0.4.3 // indirect 12 | golang.org/x/sys v0.5.0 // indirect 13 | golang.org/x/term v0.5.0 // indirect 14 | golang.org/x/text v0.7.0 // indirect 15 | ) 16 | -------------------------------------------------------------------------------- /core/callproc.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "os" 5 | ) 6 | 7 | func (ec *execContext) getenvInternal(variable, env lispObject) (lispObject, error) { 8 | if !stringp(variable) { 9 | return ec.wrongTypeArgument(ec.s.stringp, variable) 10 | } 11 | 12 | val, ok := os.LookupEnv(xStringValue(variable)) 13 | if !ok { 14 | return ec.nil_, nil 15 | } 16 | 17 | return newUniOrMultibyteString(val), nil 18 | } 19 | 20 | func (ec *execContext) symbolsOfCallProc() { 21 | ec.defSubr2(nil, "getenv-internal", (*execContext).getenvInternal, 1) 22 | } 23 | -------------------------------------------------------------------------------- /core/utils.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "runtime" 5 | ) 6 | 7 | type osType int 8 | 9 | const ( 10 | osUnknown osType = iota 11 | osLinux 12 | osWindows 13 | osMacOS 14 | ) 15 | 16 | func getDefault[K comparable, V any](m map[K]V, key K, default_ V) V { 17 | val, ok := m[key] 18 | if !ok { 19 | return default_ 20 | } 21 | return val 22 | } 23 | 24 | func getOS() osType { 25 | switch runtime.GOOS { 26 | case "linux": 27 | return osLinux 28 | case "windows": 29 | return osWindows 30 | case "darwin": 31 | return osMacOS 32 | default: 33 | return osUnknown 34 | } 35 | 36 | } 37 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | SHELL = bash 2 | GOLANGCI_LINT_CACHE = ~/.cache/golangci-lint/latest 3 | 4 | build: 5 | go build 6 | 7 | clean-test: 8 | go clean -testcache 9 | 10 | clean: clean-test 11 | rm -rf pimacs 12 | sudo rm -rf $(GOLANGCI_LINT_CACHE) 13 | 14 | fmt: 15 | gofmt -s -w -l . 16 | 17 | checkfmt: 18 | test -z "$$(gofmt -l .)" 19 | 20 | run: build 21 | ./pimacs 22 | 23 | .PHONY: test 24 | test: 25 | go test -v ./... 26 | 27 | lint: 28 | docker run -t --rm -v $$(pwd):/app -v $(GOLANGCI_LINT_CACHE):/root/.cache -w /app golangci/golangci-lint:latest golangci-lint run -v 29 | 30 | pre-push: fmt lint test 31 | 32 | debug: 33 | dlv debug 34 | -------------------------------------------------------------------------------- /test/lisp/goroutine-tests.el: -------------------------------------------------------------------------------- 1 | ;;; goroutine-tests.el --- Tests for goroutine.go -*- lexical-binding: t; -*- 2 | 3 | (lt--deftest test-pimacs-go-simple () 4 | (defconst global nil) 5 | (lt--should-not global "no value") 6 | (defun mytest () 7 | (setq global 42)) 8 | (pimacs-go 'mytest) 9 | (pimacs-sleep 300) 10 | (lt--should (equal global 42) "equals 42")) 11 | 12 | (lt--deftest test-pimacs-go-channel () 13 | (setq ch (pimacs-chan 1)) 14 | (defun mytest () 15 | (pimacs-send ch 42)) 16 | (pimacs-go 'mytest) 17 | (lt--should (equal (car (pimacs-receive ch)) 42) 18 | "equals 42") 19 | (pimacs-close ch) 20 | (lt--should-not (cdr (pimacs-receive ch)) "closed channel")) 21 | -------------------------------------------------------------------------------- /test/lisp/character-table-tests.el: -------------------------------------------------------------------------------- 1 | ;;; character-table-tests.el --- Tests for character_table.go -*- lexical-binding: t; -*- 2 | 3 | (lt--deftest test-char-table-parent () 4 | (let ((child (make-char-table nil)) 5 | (parent (make-char-table nil))) 6 | (lt--should-not (char-table-parent child) "parent is nil") 7 | 8 | (set-char-table-parent child parent) 9 | (set-char-table-range parent '(140 . 141) "p") 10 | (lt--should (eq (char-table-parent child) parent) "parent is parent") 11 | 12 | (set-char-table-range child '(1 . 100) "foo") 13 | (lt--should (equal (char-table-range child 4) "foo") "val is foo") 14 | (lt--should (equal (char-table-range child 140) "p") "val is p"))) 15 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: Run tests 2 | on: 3 | push: 4 | branches: ["main"] 5 | paths-ignore: 6 | - '**.md' 7 | - 'LICENSE' 8 | - 'etc/*' 9 | - 'tools/*' 10 | pull_request: 11 | branches: ["main"] 12 | 13 | jobs: 14 | build: 15 | runs-on: ubuntu-latest 16 | steps: 17 | - uses: actions/checkout@v3 18 | - name: Set up Go 19 | uses: actions/setup-go@v4 20 | with: 21 | go-version: '1.21' 22 | - name: Check formatting 23 | run: make checkfmt 24 | - name: Run golangci-lint 25 | uses: golangci/golangci-lint-action@v3.7.0 26 | with: 27 | version: latest 28 | - name: Test 29 | run: make test 30 | -------------------------------------------------------------------------------- /tools/extract/copy_files.py: -------------------------------------------------------------------------------- 1 | from pathlib import Path 2 | import shutil 3 | 4 | 5 | def copy_files( 6 | config: dict, 7 | pimacs_base: Path, 8 | emacs_base: Path, 9 | emacs_commit: str, 10 | emacs_branch: str, 11 | ) -> None: 12 | lisp_files = config["copy_lisp_files"] 13 | for path in lisp_files: 14 | origin = Path(emacs_base / "lisp" / path) 15 | dest = Path(pimacs_base / "lisp" / "emacs" / path) 16 | dest.parent.mkdir(parents=True, exist_ok=True) 17 | 18 | print(f"copy {origin} to {dest}") 19 | shutil.copy(origin, dest) 20 | 21 | with open(pimacs_base / "lisp" / "emacs" / "commit.txt", "w") as f: 22 | f.write(emacs_commit) 23 | f.write("\n") 24 | -------------------------------------------------------------------------------- /lisp/loadup-pimacs.el: -------------------------------------------------------------------------------- 1 | ;;; loadup-pimacs.el --- Base file for Pimacs -*- lexical-binding: t; -*- 2 | 3 | ;; Eventually to be replaced with loadup.el 4 | 5 | (load "emacs-lisp/debug-early.el") 6 | (load "emacs-lisp/byte-run.el") 7 | (load "emacs-lisp/backquote.el") 8 | 9 | ;; TODO: Remove once subr.el is loaded 10 | (defmacro unless (cond &rest body) 11 | (cons 'if (cons cond (cons nil body)))) 12 | (defalias 'not #'null) 13 | (defmacro push (newelt place) 14 | (if (symbolp place) 15 | (list 'setq place 16 | (list 'cons newelt place)) 17 | (require 'macroexp) 18 | (macroexp-let2 macroexp-copyable-p x newelt 19 | (gv-letplace (getter setter) place 20 | (funcall setter `(cons ,x ,getter)))))) 21 | 22 | ;; (load "subr.el") 23 | 24 | ;;; pimacs.el ends here 25 | -------------------------------------------------------------------------------- /test/lisp/eval-tests.el: -------------------------------------------------------------------------------- 1 | ;;; eval-tests.el --- Tests for eval.go -*- lexical-binding: t; -*- 2 | 3 | (lt--deftest test-let-closure () 4 | (setq cl nil) 5 | (let ((a "hello")) 6 | (fset 'cl (function (lambda () (cons a a))))) 7 | 8 | (lt--should (equal (cl) (cons "hello" "hello")) 9 | "call cl gives (hello . hello)")) 10 | 11 | (lt--deftest test-let* () 12 | (let* (foo 13 | (a 1) 14 | (b (+ a 1)) 15 | (c (+ b 10)) 16 | (d "hello")) 17 | (lt--should-not foo "foo is nil") 18 | (lt--should (equal a 1) "a is 1") 19 | (lt--should (equal b 2) "b is 2") 20 | (lt--should (equal c 12) "b is 12") 21 | (lt--should (equal d "hello") "d is hello")) 22 | 23 | (lt--should-not (boundp 'a) "a is not bound")) 24 | 25 | (lt--deftest test-let*-closure () 26 | (setq cl nil) 27 | (let* ((a 1) 28 | (b (+ a 1)) 29 | (c (+ b 10))) 30 | (fset 'cl (function (lambda () (cons b c))))) 31 | 32 | (lt--should (equal (cl) (cons 2 12)) 33 | "call cl gives (2 . 12)")) 34 | -------------------------------------------------------------------------------- /core/character.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | const ( 4 | eightBitCodeOffset rune = 0x3fff00 5 | max5ByteChar rune = 0x3fff7f 6 | maxChar rune = 0x3fffff 7 | ) 8 | 9 | const ( 10 | charAlt rune = 1 << (22 + iota) 11 | charSuper 12 | charHyper 13 | charShift 14 | charCtrl 15 | charMeta 16 | charModMask rune = charAlt | charSuper | charHyper | charShift | charCtrl | charMeta 17 | ) 18 | 19 | func runeToLispInt(c rune) lispInt { 20 | return lispInt(c) 21 | } 22 | 23 | func lispIntToRune(i lispInt) rune { 24 | return rune(i) 25 | } 26 | 27 | func charValidp(c rune) bool { 28 | return 0 <= c && c <= maxChar 29 | } 30 | 31 | func byte8toChar(c rune) rune { 32 | return c + eightBitCodeOffset 33 | } 34 | 35 | func charByte8(c rune) bool { 36 | return c > max5ByteChar 37 | } 38 | 39 | func charToByte8(c rune) rune { 40 | if charByte8(c) { 41 | return c - eightBitCodeOffset 42 | } 43 | return c & 0xff 44 | } 45 | 46 | func asciiCharp(c rune) bool { 47 | return 0 <= c && c < 0x80 48 | } 49 | -------------------------------------------------------------------------------- /core/minibuffer.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "bufio" 5 | "fmt" 6 | "os" 7 | "strings" 8 | ) 9 | 10 | func (ec *execContext) readFromMinibuffer(prompt, initialContents, keymap, read, hist, defaultValue, inheritInputMethod lispObject) (lispObject, error) { 11 | if !stringp(prompt) { 12 | return ec.wrongTypeArgument(ec.s.stringp, prompt) 13 | } 14 | 15 | if !ec.v.nonInteractive.val { 16 | return ec.pimacsUnimplemented(ec.s.read, "only noninteractive read is supported") 17 | } 18 | 19 | fmt.Print(xStringValue(prompt)) 20 | 21 | reader := bufio.NewReader(os.Stdin) 22 | source, _ := reader.ReadString('\n') 23 | source = strings.TrimRight(source, "\r\n") 24 | 25 | result, err := ec.readFromString(newUniOrMultibyteString(source), ec.nil_, ec.nil_) 26 | if err != nil { 27 | return nil, err 28 | } 29 | 30 | return xCar(result), nil 31 | } 32 | 33 | func (ec *execContext) symbolsOfMinibuffer() { 34 | ec.defSubr7(&ec.s.readFromMinibuffer, "read-from-minibuffer", (*execContext).readFromMinibuffer, 1) 35 | } 36 | -------------------------------------------------------------------------------- /core/lisp_test.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "testing" 5 | ) 6 | 7 | var filenames = []string{ 8 | "character-table-tests.el", 9 | "eval-tests.el", 10 | "functions-tests.el", 11 | "goroutine-tests.el", 12 | "read-tests.el", 13 | "backquote-tests.el", 14 | "allocation-tests.el", 15 | "data-tests.el", 16 | } 17 | 18 | func TestLisp(t *testing.T) { 19 | t.Parallel() 20 | inp := newTestingInterpreter() 21 | err := inp.LoadFile("lt.el") 22 | if err != nil { 23 | t.Logf("failed to load 'lt.el': %v", err) 24 | t.FailNow() 25 | } 26 | 27 | for _, filename := range filenames { 28 | err = inp.LoadFile(filename) 29 | if err != nil { 30 | t.Logf("failed to load '%v': %+v", filename, err) 31 | t.FailNow() 32 | } 33 | } 34 | 35 | _, err = inp.ReadEvalPrin1("(lt--run-all-tests)") 36 | if err != nil { 37 | t.Logf("test(s) failure: %+v", err.Error()) 38 | info, err2 := inp.ReadEvalPrin1("lt--failure-info") 39 | if err2 != nil { 40 | t.Logf("failed to retrieve failure info: %+v", err2) 41 | } else { 42 | t.Logf("test(s) failure info: %+v", info) 43 | } 44 | t.Fail() 45 | } 46 | } 47 | -------------------------------------------------------------------------------- /core/allocation.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | func (ec *execContext) cons(car lispObject, cdr lispObject) (lispObject, error) { 4 | return newCons(car, cdr), nil 5 | } 6 | 7 | func (ec *execContext) list(args ...lispObject) (lispObject, error) { 8 | return ec.makeList(args...), nil 9 | } 10 | 11 | func (ec *execContext) makeVector(length, init lispObject) (lispObject, error) { 12 | if !integerp(length) { 13 | return ec.wrongTypeArgument(ec.s.integerp, length) 14 | } 15 | val := make([]lispObject, xIntegerValue(length)) 16 | for i := 0; i < len(val); i++ { 17 | val[i] = init 18 | } 19 | 20 | return newVector(val), nil 21 | } 22 | 23 | func (ec *execContext) pureCopy(obj lispObject) (lispObject, error) { 24 | // TODO: Without having a build/dump phase, maybe this implementation 25 | // is good enough? 26 | return obj, nil 27 | } 28 | 29 | func (ec *execContext) symbolsOfAllocation() { 30 | ec.defSubr2(nil, "cons", (*execContext).cons, 2) 31 | ec.defSubrM(nil, "list", (*execContext).list, 0) 32 | ec.defSubr2(nil, "make-vector", (*execContext).makeVector, 2) 33 | ec.defSubr1(nil, "purecopy", (*execContext).pureCopy, 1) 34 | } 35 | -------------------------------------------------------------------------------- /test/lisp/backquote-tests.el: -------------------------------------------------------------------------------- 1 | ;;; backquote-tests.el --- Tests for Emacs backquote.el -*- lexical-binding: t; -*- 2 | 3 | ;; Tests adapted from Emacs' backquote-tests.el 4 | ;; TODO: Replace for original test file 5 | 6 | (lt--deftest test-backquote-test-basic () 7 | (let ((lst '(ba bb bc)) 8 | (vec [ba bb bc])) 9 | (lt--should (equal 3 `,(eval '(+ x y) '((x . 1) (y . 2)))) "t1") 10 | (lt--should (equal vec `[,@lst]) "t2") 11 | (lt--should (equal `(a lst c) '(a lst c)) "t3") 12 | (lt--should (equal `(a ,lst c) '(a (ba bb bc) c)) "t4") 13 | (lt--should (equal `(a ,@lst c) '(a ba bb bc c)) "t5") 14 | (lt--should (equal `(a vec c) '(a vec c)) "t6") 15 | (lt--should (equal `(a ,vec c) '(a [ba bb bc] c)) "t7") 16 | (lt--should (equal `(a ,@vec c) '(a ba bb bc c)) "t8"))) 17 | 18 | (lt--deftest test-backquote-test-nested () 19 | "Test nested backquotes." 20 | (let ((lst '(ba bb bc)) 21 | (vec [ba bb bc])) 22 | (lt--should (equal `(a ,`(,@lst) c) `(a ,lst c)) "t1") 23 | (lt--should (equal `(a ,`[,@lst] c) `(a ,vec c)) "t2") 24 | (lt--should (equal `(a ,@`[,@lst] c) `(a ,@lst c)) "t3"))) 25 | -------------------------------------------------------------------------------- /pimacs.go: -------------------------------------------------------------------------------- 1 | package main 2 | 3 | import ( 4 | "bufio" 5 | "flag" 6 | "fmt" 7 | "github.com/federicotdn/pimacs/core" 8 | "github.com/federicotdn/pimacs/ui/tui" 9 | "os" 10 | "strings" 11 | ) 12 | 13 | func repl() { 14 | interpreter, err := core.NewInterpreterDefault() 15 | if err != nil { 16 | panic(err) 17 | } 18 | 19 | for { 20 | reader := bufio.NewReader(os.Stdin) 21 | eval := true 22 | 23 | fmt.Print("> ") 24 | source, _ := reader.ReadString('\n') 25 | source = strings.TrimRight(source, "\r\n") 26 | 27 | if source == "" { 28 | break 29 | } else if source[0] == '|' { 30 | eval = false 31 | source = source[1:] 32 | fmt.Println("[input will not be evaluated]") 33 | } 34 | 35 | var printed string 36 | var err error 37 | 38 | if eval { 39 | printed, err = interpreter.ReadEvalPrin1(source) 40 | } else { 41 | printed, err = interpreter.ReadPrin1(source) 42 | } 43 | 44 | if err != nil { 45 | fmt.Println("repl error:", err) 46 | } else { 47 | fmt.Println(printed) 48 | } 49 | } 50 | } 51 | 52 | func main() { 53 | var useTui bool 54 | flag.BoolVar(&useTui, "tui", false, "start Pimacs in TUI mode") 55 | flag.Parse() 56 | 57 | if useTui { 58 | tui.Run() 59 | } else { 60 | repl() 61 | } 62 | } 63 | -------------------------------------------------------------------------------- /core/obarray.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "sync" 5 | ) 6 | 7 | type obarrayType struct { 8 | val map[string]*lispSymbol 9 | // TODO: Change for RWMutex 10 | lock *sync.Mutex 11 | } 12 | 13 | func newObarray(addLock bool) obarrayType { 14 | var lock *sync.Mutex 15 | if addLock { 16 | lock = &sync.Mutex{} 17 | } 18 | return obarrayType{ 19 | val: make(map[string]*lispSymbol), 20 | lock: lock, 21 | } 22 | } 23 | 24 | func (ob *obarrayType) loadOrStoreSymbol(sym *lispSymbol) (*lispSymbol, bool) { 25 | if ob.lock != nil { 26 | ob.lock.Lock() 27 | defer ob.lock.Unlock() 28 | } 29 | 30 | name := xSymbolName(sym) 31 | prev, existed := ob.val[name] 32 | if existed { 33 | return prev, true 34 | } 35 | 36 | ob.val[name] = sym 37 | return sym, false 38 | } 39 | 40 | func (ob *obarrayType) removeSymbol(name string) bool { 41 | if ob.lock != nil { 42 | ob.lock.Lock() 43 | defer ob.lock.Unlock() 44 | } 45 | 46 | _, existed := ob.val[name] 47 | if !existed { 48 | return false 49 | } 50 | 51 | delete(ob.val, name) 52 | return true 53 | } 54 | 55 | func (ob *obarrayType) containsSymbol(name string) bool { 56 | if ob.lock != nil { 57 | ob.lock.Lock() 58 | defer ob.lock.Unlock() 59 | } 60 | 61 | _, existed := ob.val[name] 62 | return existed 63 | } 64 | -------------------------------------------------------------------------------- /core/helpers_test.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "errors" 5 | "testing" 6 | ) 7 | 8 | func TestHelpersBasic(t *testing.T) { 9 | t.Parallel() 10 | 11 | sym := &lispSymbol{name: newString("foo", false)} 12 | 13 | if !symbolp(sym) { 14 | t.Fail() 15 | } 16 | 17 | var obj lispObject = sym 18 | sym2 := xSymbol(obj) 19 | if sym.name != sym2.name { 20 | t.Fail() 21 | } 22 | } 23 | 24 | func TestCastFailure(t *testing.T) { 25 | t.Parallel() 26 | 27 | defer func() { 28 | if r := recover(); r == nil { 29 | t.Fail() 30 | } 31 | }() 32 | 33 | sym := &lispSymbol{name: newString("foo", false)} 34 | var obj lispObject = sym 35 | xInteger(obj) 36 | } 37 | 38 | func TestEnsure(t *testing.T) { 39 | t.Parallel() 40 | var obj lispObject = &lispInteger{val: 42} 41 | xEnsure(obj, nil) 42 | } 43 | 44 | func TestEnsureFailure(t *testing.T) { 45 | t.Parallel() 46 | defer func() { 47 | if r := recover(); r == nil { 48 | t.Fail() 49 | } 50 | }() 51 | 52 | xEnsure(nil, errors.New("fail")) 53 | } 54 | 55 | func TestObjAddr(t *testing.T) { 56 | t.Parallel() 57 | s1 := newString("hello", false) 58 | s2 := newString("hello", false) 59 | s3 := s1 60 | 61 | if objAddr(s1) != objAddr(s3) { 62 | t.Fail() 63 | } 64 | 65 | if objAddr(s1) == objAddr(s2) { 66 | t.Fail() 67 | } 68 | } 69 | -------------------------------------------------------------------------------- /core/string_test.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import "testing" 4 | 5 | func TestNewString(t *testing.T) { 6 | t.Parallel() 7 | 8 | s := newString("foo", false) 9 | if s.multibytep() { 10 | t.Fail() 11 | } 12 | 13 | s = newString("árbol", true) 14 | if !s.multibytep() { 15 | t.Fail() 16 | } 17 | } 18 | 19 | func TestUnibyteString(t *testing.T) { 20 | t.Parallel() 21 | 22 | s := newUniOrMultibyteString("hello") 23 | if s.size() != 5 { 24 | t.Fail() 25 | } 26 | if s.sizeBytes() != 5 { 27 | t.Fail() 28 | } 29 | if s.str() != "hello" { 30 | t.Fail() 31 | } 32 | if s.multibytep() { 33 | t.Fail() 34 | } 35 | 36 | s = newUniOrMultibyteString("") 37 | if s.multibytep() { 38 | t.Fail() 39 | } 40 | } 41 | 42 | func TestUnibyteStringFromNonUtf8(t *testing.T) { 43 | t.Parallel() 44 | 45 | s := newUniOrMultibyteString("\xff\xf0\xf1") 46 | if s.sizeBytes() != 3 { 47 | t.Fail() 48 | } 49 | if s.str() != "\xff\xf0\xf1" { 50 | t.Fail() 51 | } 52 | if s.multibytep() { 53 | t.Fail() 54 | } 55 | } 56 | 57 | func TestMultibyteString(t *testing.T) { 58 | t.Parallel() 59 | 60 | s := newUniOrMultibyteString("ñandú") 61 | if s.size() != 5 { 62 | t.Fail() 63 | } 64 | if s.sizeBytes() != 7 { 65 | t.Fail() 66 | } 67 | if s.str() != "ñandú" { 68 | t.Fail() 69 | } 70 | if !s.multibytep() { 71 | t.Fail() 72 | } 73 | } 74 | -------------------------------------------------------------------------------- /lisp/lt.el: -------------------------------------------------------------------------------- 1 | ;;; lt.el --- Like 0.1% of ERT -*- lexical-binding: t; -*- 2 | 3 | ;; lt == Lisp Testing 4 | ;; TODO: In the future, switch to ERT if possible. 5 | 6 | (setq lt--tests-to-run nil) 7 | (setq lt--failure-info nil) 8 | (setq lt--dbg-count 0) 9 | 10 | (defmacro lt--deftest (name arglist &rest body) 11 | (declare (indent 2)) 12 | (if (memq name lt--tests-to-run) 13 | (signal 'test-duplicated (symbol-name name))) 14 | (setq lt--tests-to-run (cons name lt--tests-to-run)) 15 | (list 'defalias 16 | (list 'quote name) 17 | (list 'function (cons 'lambda (cons arglist body))))) 18 | 19 | (defun lt--should (val &optional msg) 20 | (if (null val) 21 | (signal 'assertion-failure (or msg "(no details)")))) 22 | 23 | (defun lt--should-not (val &optional msg) 24 | (lt--should (null val) msg)) 25 | 26 | (defun lt--debug (val) 27 | (princ "!!! DEBUG " t) 28 | (princ lt--dbg-count t) 29 | (princ ": " t) 30 | (princ val t) 31 | (princ "\n" t) 32 | (setq lt--dbg-count (+ lt--dbg-count 1))) 33 | 34 | (defun lt--run-all-tests () 35 | (setq lt--tests-to-run (reverse lt--tests-to-run)) 36 | (while lt--tests-to-run 37 | (setq test (car lt--tests-to-run)) 38 | (princ "+++ LISP: " t) 39 | (princ (symbol-name test) t) 40 | (princ "\n" t) 41 | (unwind-protect (funcall test) 42 | (setq lt--failure-info (symbol-name test))) 43 | (setq lt--tests-to-run (cdr lt--tests-to-run)))) 44 | 45 | ;;; lt.el ends here 46 | -------------------------------------------------------------------------------- /test/lisp/read-tests.el: -------------------------------------------------------------------------------- 1 | ;;; read-tests.el --- Tests for read.go -*- lexical-binding: t; -*- 2 | 3 | (lt--deftest test-unintern () 4 | (lt--should (intern "hello") "intern a symbol ok") 5 | (lt--should (unintern "hello") "unintern a symbol ok") 6 | (setq mysym 'someverylongsymbol) 7 | (lt--should (unintern mysym) "unintern a symbol ok (2)") 8 | (lt--should-not (unintern "thisdoesnotexist") "not unintern a symbol ok")) 9 | 10 | (lt--deftest test-read-integer () 11 | (lt--should (equal #x10 16)) 12 | (lt--should (equal #x010 16)) 13 | (lt--should (equal #x0 0)) 14 | (lt--should (equal #o10 8)) 15 | (lt--should (equal #o0 0)) 16 | (lt--should (equal #b110 6)) 17 | (lt--should (equal #b0 0))) 18 | 19 | (lt--deftest test-read-char-escape-hex () 20 | (lt--should (equal ?\x10 16)) 21 | (lt--should (equal ?\x0 0)) 22 | (lt--should (equal ?\xA 10)) 23 | (lt--should (equal ?\x0A 10)) 24 | (lt--should (equal ?\x00A 10))) 25 | 26 | (lt--deftest test-read-char-escape-mod () 27 | (lt--should (equal ?\M-a #o1000000141) "M-a") 28 | (lt--should (equal ?\M-v #o1000000166) "M-v") 29 | (lt--should (equal ?\C-g #o7) "C-g") 30 | (lt--should (equal ?\M-\C-g #o1000000007) "M-C-g") 31 | (lt--should (equal ?\C-? #o177) "C-?") 32 | ;; Reading ?\C- alone yields -1, but using it in a larger expression 33 | ;; yields 67108896 (Emacs bug?). 34 | (lt--should (equal (car (read-from-string "?\\C-")) -1) "C-") 35 | ;; Note: at time of writing, Emacs also requires a space after the 36 | ;; cdr here, otherwise it results in a parsing error (probably a bug). 37 | (lt--should (equal (cons ?\C- ?\C- ) (cons 67108896 67108896)))) 38 | -------------------------------------------------------------------------------- /test/lisp/data-tests.el: -------------------------------------------------------------------------------- 1 | ;;; data-tests.el --- Tests for data.go -*- lexical-binding: t; -*- 2 | 3 | (lt--deftest test-1+ () 4 | (lt--should (equal (1+ 1) 2))) 5 | 6 | (lt--deftest test-arithmetic-op () 7 | (lt--should (= (+ 1 2 3) 6)) 8 | (lt--should (= (+ 1) 1)) 9 | (lt--should (= (+) 0)) 10 | 11 | (lt--should (= (logior 4 2 1) 7))) 12 | 13 | (lt--deftest test-arithmetic-cmp () 14 | (lt--should (= 1 1)) 15 | (lt--should-not (= 1 2)) 16 | 17 | (lt--should (/= 1 2)) 18 | (lt--should-not (/= 1 1)) 19 | 20 | (lt--should (< 1 2)) 21 | (lt--should-not (< 2 1)) 22 | 23 | (lt--should (> 2 1)) 24 | (lt--should-not (> 1 2)) 25 | 26 | (lt--should (<= 1 1)) 27 | (lt--should (<= 1 2)) 28 | (lt--should-not (<= 3 1)) 29 | 30 | (lt--should (>= 1 1)) 31 | (lt--should (>= 2 1)) 32 | (lt--should-not (>= 1 3)) 33 | 34 | (lt--should (< 1 2 3 4)) 35 | (lt--should-not (< 1 2 3 4 3)) 36 | 37 | (lt--should (< 1)) 38 | (lt--should (= 100))) 39 | 40 | (lt--deftest test-aref () 41 | (let ((v [100 200 300]) 42 | (s "hello") 43 | (s2 "aaább")) 44 | (lt--should (= (aref v 0) 100)) 45 | (lt--should (= (aref s 0) ?h)) 46 | (lt--should (= (aref s 2) ?l)) 47 | (lt--should (= (aref s2 2) ?á)) 48 | (lt--should (= (aref s2 4) ?b)))) 49 | 50 | (lt--deftest test-% () 51 | (lt--should (= (% 1 -2) 1)) 52 | (lt--should (= (% 10 2) 0))) 53 | 54 | (lt--deftest test-* () 55 | (lt--should (= (*) 1)) 56 | (lt--should (= (* 0) 0)) 57 | (lt--should (= (* 0 -2) 0)) 58 | (lt--should (= (* 1 -2) -2)) 59 | (lt--should (= (* -1 -2) 2)) 60 | (lt--should (= (* 10 2) 20))) 61 | 62 | (lt--deftest test-aset () 63 | (let ((v [100 200 300])) 64 | (aset v 0 99) 65 | (lt--should (= (aref v 0) 99)))) 66 | -------------------------------------------------------------------------------- /ui/tui/main.go: -------------------------------------------------------------------------------- 1 | package tui 2 | 3 | import ( 4 | "github.com/federicotdn/pimacs/core" 5 | "github.com/federicotdn/pimacs/proto" 6 | "github.com/gdamore/tcell/v2" 7 | ) 8 | 9 | func Run() { 10 | s, err := tcell.NewScreen() 11 | if err != nil { 12 | panic(err) 13 | } 14 | if err := s.Init(); err != nil { 15 | panic(err) 16 | } 17 | 18 | inp, err := core.NewInterpreterDefault() 19 | if err != nil { 20 | panic(err) 21 | } 22 | 23 | tcellEvents := make(chan tcell.Event) 24 | quit := make(chan struct{}) 25 | 26 | go s.ChannelEvents(tcellEvents, quit) 27 | go inp.RecursiveEdit() 28 | 29 | drawOpsChan := inp.DrawOpsChan() 30 | inputEventsChan := inp.InputEventsChan() 31 | 32 | loop: 33 | for { 34 | select { 35 | case event := <-tcellEvents: 36 | switch ev := event.(type) { 37 | case *tcell.EventKey: 38 | mod, key, ch := ev.Modifiers(), ev.Key(), ev.Rune() 39 | inputEventsChan <- &proto.InputEventKey{ 40 | Rune: ch, 41 | Key: proto.Key(key), 42 | Mod: proto.ModMask(mod), 43 | } 44 | } 45 | case rawOp := <-drawOpsChan: 46 | switch op := rawOp.(type) { 47 | case *proto.DrawOpSetText: 48 | s.Clear() 49 | 50 | col := 0 51 | row := 0 52 | width, height := s.Size() 53 | for _, r := range []rune(op.Text) { //nolint: staticcheck,gosimple 54 | if r == '\n' { 55 | col = 0 56 | row++ 57 | } else { 58 | s.SetContent(col, row, r, nil, tcell.StyleDefault) 59 | col++ 60 | } 61 | 62 | if col >= width { 63 | col = 0 64 | row++ 65 | } 66 | 67 | if row >= height { 68 | col = 0 69 | row = 0 70 | } 71 | } 72 | 73 | s.Show() 74 | case *proto.DrawOpSpecial: 75 | break loop 76 | } 77 | } 78 | } 79 | 80 | <-inp.Done() 81 | close(quit) 82 | s.Fini() 83 | } 84 | -------------------------------------------------------------------------------- /core/edit_functions.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | func (ec *execContext) styledFormat(str lispObject, message bool, objects ...lispObject) (lispObject, error) { 4 | if !stringp(str) { 5 | return ec.wrongTypeArgument(ec.s.stringp, str) 6 | } 7 | 8 | format := []rune(xStringValue(str)) 9 | result := []rune{} 10 | multibyte := false 11 | i := 0 12 | n := 0 13 | 14 | for i < len(format) { 15 | c := format[i] 16 | i++ 17 | 18 | if c == '%' { 19 | if i >= len(format) { 20 | return ec.signalError("Format string ends in middle of format specifier") 21 | } 22 | 23 | conversion := format[i] 24 | i++ 25 | 26 | if conversion == '%' { 27 | result = append(result, '%') 28 | continue 29 | } 30 | 31 | if n >= len(objects) { 32 | return ec.signalError("Not enough arguments for format string") 33 | } 34 | 35 | if conversion == 's' || conversion == 'S' { 36 | noEscape := ec.boolVal(conversion == 's') 37 | out, err := ec.prin1ToString(objects[n], noEscape, ec.nil_) 38 | if err != nil { 39 | return nil, err 40 | } 41 | 42 | result = append(result, []rune(xStringValue(out))...) 43 | } 44 | 45 | n++ 46 | continue 47 | } 48 | 49 | multibyte = multibyte || !asciiCharp(c) 50 | result = append(result, c) 51 | } 52 | 53 | return newString(string(result), multibyte), nil 54 | } 55 | 56 | func (ec *execContext) formatMessage(args ...lispObject) (lispObject, error) { 57 | return ec.styledFormat(args[0], true, args[1:]...) 58 | } 59 | 60 | func (ec *execContext) format(args ...lispObject) (lispObject, error) { 61 | return ec.styledFormat(args[0], false, args[1:]...) 62 | } 63 | 64 | func (ec *execContext) symbolsOfEditFunctions() { 65 | ec.defSubrM(nil, "format", (*execContext).format, 1) 66 | ec.defSubrM(nil, "format-message", (*execContext).formatMessage, 1) 67 | } 68 | -------------------------------------------------------------------------------- /tools/extract/extract.py: -------------------------------------------------------------------------------- 1 | import argparse 2 | import json 3 | import subprocess 4 | from pathlib import Path 5 | 6 | import copy_files 7 | import subroutines 8 | 9 | PIMACS_REPO_PATH = (Path(__file__) / "../../..").resolve() 10 | CONFIG_FILE = "config.json" 11 | 12 | 13 | def main() -> None: 14 | parser = argparse.ArgumentParser() 15 | parser.add_argument("--emacs-repo-path", required=True) 16 | subparsers = parser.add_subparsers(required=True, dest="subparser") 17 | 18 | subparsers.add_parser( 19 | "subrs", help="Generate Emacs subroutine JSON description file" 20 | ) 21 | subparsers.add_parser("copy", help="Copy selected Emacs files") 22 | 23 | args = parser.parse_args() 24 | 25 | with open(CONFIG_FILE) as f: 26 | config = json.load(f) 27 | 28 | emacs_commit = subprocess.check_output( 29 | "git rev-parse HEAD", text=True, shell=True, cwd=Path(args.emacs_repo_path) 30 | ).strip() 31 | emacs_branch = subprocess.check_output( 32 | "git branch --show-current", 33 | text=True, 34 | shell=True, 35 | cwd=Path(args.emacs_repo_path), 36 | ).strip() 37 | 38 | if config["emacs_commit"] != emacs_commit: 39 | raise Exception( 40 | f"Target Emacs revision does not match repository revision: " 41 | f'want {config["emacs_commit"]}, have {emacs_commit}' 42 | ) 43 | if config["emacs_branch"] != emacs_branch: 44 | raise Exception( 45 | f"Target Emacs branch does not match repository branch: " 46 | f'want \'{config["emacs_branch"]}\', have \'{emacs_branch}\'' 47 | ) 48 | 49 | match args.subparser: 50 | case "subrs": 51 | subroutines.extract_subroutines( 52 | PIMACS_REPO_PATH, Path(args.emacs_repo_path), emacs_commit, emacs_branch 53 | ) 54 | case "copy": 55 | copy_files.copy_files( 56 | config, 57 | PIMACS_REPO_PATH, 58 | Path(args.emacs_repo_path), 59 | emacs_commit, 60 | emacs_branch, 61 | ) 62 | case _: 63 | raise Exception("Unknown command") 64 | 65 | 66 | if __name__ == "__main__": 67 | main() 68 | -------------------------------------------------------------------------------- /core/exec_context_test.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "encoding/json" 5 | "os" 6 | "testing" 7 | ) 8 | 9 | func TestIteration(t *testing.T) { 10 | t.Parallel() 11 | ec := newTestingInterpreter().ec 12 | 13 | cases := [][]lispObject{ 14 | {}, 15 | {newInteger(1)}, 16 | {newInteger(123), newInteger(2), newInteger(10)}, 17 | } 18 | 19 | for _, c := range cases { 20 | head := ec.makeList(c...) 21 | produced := []lispObject{} 22 | 23 | iter := ec.iterate(head) 24 | for ; iter.hasNext(); head = iter.nextCons() { 25 | produced = append(produced, xCar(head)) 26 | } 27 | 28 | if iter.hasError() { 29 | t.Fail() 30 | } 31 | 32 | if len(c) != len(produced) { 33 | t.Fail() 34 | } 35 | 36 | for i := 0; i < len(c); i++ { 37 | if xIntegerValue(c[i]) != xIntegerValue(produced[i]) { 38 | t.Fail() 39 | } 40 | } 41 | } 42 | } 43 | 44 | func TestIterationFail(t *testing.T) { 45 | t.Parallel() 46 | ec := newTestingInterpreter().ec 47 | 48 | heads := []lispObject{ 49 | newCons(newInteger(1), newInteger(10)), 50 | newCons(newInteger(1), newCons(newInteger(1), newInteger(10))), 51 | newInteger(100), 52 | } 53 | 54 | for _, head := range heads { 55 | iter := ec.iterate(head) 56 | for ; iter.hasNext(); iter.nextCons() { 57 | } 58 | 59 | if !iter.hasError() { 60 | t.Fail() 61 | } 62 | } 63 | } 64 | 65 | type subroutine struct { 66 | Lname string `json:"lname"` 67 | MinArgs int `json:"minargs"` 68 | MaxArgs int `json:"maxargs"` 69 | } 70 | 71 | type subroutineData struct { 72 | Subroutines []subroutine `json:"subroutines"` 73 | } 74 | 75 | func TestSubroutineSignatures(t *testing.T) { 76 | t.Parallel() 77 | ec := newTestingInterpreter().ec 78 | 79 | data, err := os.ReadFile("../test/data/emacs_subroutines.json") 80 | if err != nil { 81 | t.Fatal(err) 82 | } 83 | 84 | var sd subroutineData 85 | err = json.Unmarshal(data, &sd) 86 | if err != nil { 87 | t.Fatal(err) 88 | } 89 | 90 | for _, s := range sd.Subroutines { 91 | sym, ok := ec.obarray.val[s.Lname] 92 | if !ok || !subroutinep(sym.function) { 93 | continue 94 | } 95 | 96 | subr := xSubroutine(sym.function) 97 | 98 | if subr.minArgs != s.MinArgs { 99 | t.Errorf("minargs mismatch for: '%v'", s.Lname) 100 | continue 101 | } 102 | 103 | if subr.maxArgs != s.MaxArgs { 104 | t.Errorf("maxargs mismatch for: '%v'", s.Lname) 105 | } 106 | } 107 | } 108 | -------------------------------------------------------------------------------- /proto/key.go: -------------------------------------------------------------------------------- 1 | package proto 2 | 3 | // Based on tcell/v2/key.go 4 | 5 | type ModMask int16 6 | type Key int16 7 | 8 | const ( 9 | ModShift ModMask = 1 << iota 10 | ModCtrl 11 | ModAlt 12 | ModMeta 13 | ) 14 | 15 | const ( 16 | KeyNUL Key = iota 17 | KeySOH 18 | KeySTX 19 | KeyETX 20 | KeyEOT 21 | KeyENQ 22 | KeyACK 23 | KeyBEL 24 | KeyBackspace 25 | KeyTab 26 | KeyLF 27 | KeyVT 28 | KeyFF 29 | KeyEnter 30 | KeySO 31 | KeySI 32 | KeyDLE 33 | KeyDC1 34 | KeyDC2 35 | KeyDC3 36 | KeyDC4 37 | KeyNAK 38 | KeySYN 39 | KeyETB 40 | KeyCAN 41 | KeyEM 42 | KeySUB 43 | KeyEscape 44 | KeyFS 45 | KeyGS 46 | KeyRS 47 | KeyUS 48 | KeyDEL Key = 127 49 | ) 50 | 51 | const ( 52 | KeyCtrlSpace Key = iota 53 | KeyCtrlA 54 | KeyCtrlB 55 | KeyCtrlC 56 | KeyCtrlD 57 | KeyCtrlE 58 | KeyCtrlF 59 | KeyCtrlG 60 | KeyCtrlH 61 | KeyCtrlI 62 | KeyCtrlJ 63 | KeyCtrlK 64 | KeyCtrlL 65 | KeyCtrlM 66 | KeyCtrlN 67 | KeyCtrlO 68 | KeyCtrlP 69 | KeyCtrlQ 70 | KeyCtrlR 71 | KeyCtrlS 72 | KeyCtrlT 73 | KeyCtrlU 74 | KeyCtrlV 75 | KeyCtrlW 76 | KeyCtrlX 77 | KeyCtrlY 78 | KeyCtrlZ 79 | KeyCtrlLeftSq 80 | KeyCtrlBackslash 81 | KeyCtrlRightSq 82 | KeyCtrlCarat 83 | KeyCtrlUnderscore 84 | ) 85 | 86 | const ( 87 | KeyRune Key = iota + 256 88 | KeyUp 89 | KeyDown 90 | KeyRight 91 | KeyLeft 92 | KeyUpLeft 93 | KeyUpRight 94 | KeyDownLeft 95 | KeyDownRight 96 | KeyCenter 97 | KeyPgUp 98 | KeyPgDn 99 | KeyHome 100 | KeyEnd 101 | KeyInsert 102 | KeyDelete 103 | KeyHelp 104 | KeyExit 105 | KeyClear 106 | KeyCancel 107 | KeyPrint 108 | KeyPause 109 | KeyBacktab 110 | KeyF1 111 | KeyF2 112 | KeyF3 113 | KeyF4 114 | KeyF5 115 | KeyF6 116 | KeyF7 117 | KeyF8 118 | KeyF9 119 | KeyF10 120 | KeyF11 121 | KeyF12 122 | KeyF13 123 | KeyF14 124 | KeyF15 125 | KeyF16 126 | KeyF17 127 | KeyF18 128 | KeyF19 129 | KeyF20 130 | KeyF21 131 | KeyF22 132 | KeyF23 133 | KeyF24 134 | KeyF25 135 | KeyF26 136 | KeyF27 137 | KeyF28 138 | KeyF29 139 | KeyF30 140 | KeyF31 141 | KeyF32 142 | KeyF33 143 | KeyF34 144 | KeyF35 145 | KeyF36 146 | KeyF37 147 | KeyF38 148 | KeyF39 149 | KeyF40 150 | KeyF41 151 | KeyF42 152 | KeyF43 153 | KeyF44 154 | KeyF45 155 | KeyF46 156 | KeyF47 157 | KeyF48 158 | KeyF49 159 | KeyF50 160 | KeyF51 161 | KeyF52 162 | KeyF53 163 | KeyF54 164 | KeyF55 165 | KeyF56 166 | KeyF57 167 | KeyF58 168 | KeyF59 169 | KeyF60 170 | KeyF61 171 | KeyF62 172 | KeyF63 173 | KeyF64 174 | ) 175 | -------------------------------------------------------------------------------- /core/interpreter.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "fmt" 5 | "github.com/federicotdn/pimacs/proto" 6 | ) 7 | 8 | type Interpreter struct { 9 | ec *execContext 10 | } 11 | 12 | type InterpreterConfig struct { 13 | loadPathPrepend []string 14 | } 15 | 16 | func terminate(format string, v ...interface{}) { 17 | panic(fmt.Sprintf(format, v...)) 18 | } 19 | 20 | func NewInterpreterDefault() (*Interpreter, error) { 21 | return NewInterpreter(InterpreterConfig{}) 22 | } 23 | 24 | func NewInterpreter(config InterpreterConfig) (*Interpreter, error) { 25 | ec, err := newExecContext(config.loadPathPrepend) 26 | if err != nil { 27 | return nil, err 28 | } 29 | 30 | return &Interpreter{ec: ec}, nil 31 | } 32 | 33 | func newTestingInterpreter() *Interpreter { 34 | // When running tests, Go sets the CWD to the package's 35 | // directory 36 | ec, err := newExecContext([]string{"../lisp", "../lisp/emacs", "../test/lisp"}) 37 | if err != nil { 38 | panic(err) 39 | } 40 | ec.testing = true 41 | return &Interpreter{ec: ec} 42 | } 43 | 44 | func (inp *Interpreter) InputEventsChan() chan<- proto.InputEvent { 45 | return inp.ec.events 46 | } 47 | 48 | func (inp *Interpreter) DrawOpsChan() <-chan proto.DrawOp { 49 | return inp.ec.ops 50 | } 51 | 52 | func (inp *Interpreter) Done() <-chan bool { 53 | return inp.ec.done 54 | } 55 | 56 | func (inp *Interpreter) RecursiveEdit() { 57 | xEnsure(inp.ec.recursiveEdit()) 58 | inp.ec.done <- true 59 | } 60 | 61 | func (inp *Interpreter) LoadFile(filename string) error { 62 | _, err := inp.ec.load(newString(filename, true), inp.ec.nil_, inp.ec.nil_, inp.ec.nil_, inp.ec.nil_) 63 | return err 64 | } 65 | 66 | func (inp *Interpreter) ReadPrin1(source string) (string, error) { 67 | str := newString(source, true) 68 | result, err := inp.ec.readFromString(str, inp.ec.nil_, inp.ec.nil_) 69 | if err != nil { 70 | return "", err 71 | } 72 | 73 | printed, err := inp.ec.prin1ToString(xCar(result), inp.ec.nil_, inp.ec.nil_) 74 | if err != nil { 75 | return "", err 76 | } 77 | 78 | return xStringValue(printed), nil 79 | } 80 | 81 | func (inp *Interpreter) ReadEvalPrin1(source string) (string, error) { 82 | str := newString(source, true) 83 | obj, err := inp.ec.readFromString(str, inp.ec.nil_, inp.ec.nil_) 84 | if err != nil { 85 | return "", err 86 | } 87 | 88 | result, err := inp.ec.evalSub(xCar(obj)) 89 | if err != nil { 90 | return "", err 91 | } 92 | 93 | printed, err := inp.ec.prin1ToString(result, inp.ec.nil_, inp.ec.nil_) 94 | if err != nil { 95 | return "", err 96 | } 97 | 98 | return xStringValue(printed), nil 99 | } 100 | -------------------------------------------------------------------------------- /core/goroutine.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "time" 5 | ) 6 | 7 | func (parentEc *execContext) makeGoroutine(function, name lispObject) (lispObject, error) { 8 | newEc := parentEc.copyExecContext() 9 | 10 | go func() { 11 | defer newEc.unwind()() 12 | 13 | // Lexical binding by default 14 | if err := newEc.stackPushLet(newEc.gl.lexicalBinding.sym, newEc.t); err != nil { 15 | newEc.terminate("error in goroutine: '%+v'", err) 16 | } 17 | if err := newEc.setupInternalInterpreterEnv(); err != nil { 18 | newEc.terminate("error in goroutine: '%+v'", err) 19 | } 20 | 21 | // TODO: Should not actually terminate, but having this for now 22 | // helps in finding bugs with makeGoroutine. 23 | _, err := newEc.funcall(function) 24 | if err != nil { 25 | newEc.terminate("error in goroutine: '%+v'", err) 26 | } 27 | }() 28 | 29 | return parentEc.nil_, nil 30 | } 31 | 32 | func (ec *execContext) sleep(ms lispObject) (lispObject, error) { 33 | if !naturalp(ms) { 34 | return ec.wrongTypeArgument(ec.s.integerp, ms) 35 | } 36 | 37 | time.Sleep(time.Duration(xIntegerValue(ms)) * time.Millisecond) 38 | 39 | return ec.nil_, nil 40 | } 41 | 42 | func (ec *execContext) makeChannel(capacity lispObject) (lispObject, error) { 43 | c := 0 44 | if capacity != ec.nil_ && naturalp(capacity) { 45 | c = int(xIntegerValue(capacity)) 46 | } else { 47 | return ec.wrongTypeArgument(ec.s.integerp, capacity) 48 | } 49 | 50 | return &lispChannel{ 51 | val: make(chan lispObject, c), 52 | }, nil 53 | } 54 | 55 | func (ec *execContext) channelSend(channel, obj lispObject) (lispObject, error) { 56 | if !channelp(channel) { 57 | return ec.wrongTypeArgument(ec.s.channelp, channel) 58 | } 59 | 60 | xChannel(channel).val <- obj 61 | return obj, nil 62 | } 63 | 64 | func (ec *execContext) channelReceive(channel lispObject) (lispObject, error) { 65 | if !channelp(channel) { 66 | return ec.wrongTypeArgument(ec.s.channelp, channel) 67 | } 68 | 69 | obj, ok := <-xChannel(channel).val 70 | if !ok { 71 | obj = ec.nil_ 72 | } 73 | return newCons(obj, ec.boolVal(ok)), nil 74 | } 75 | 76 | func (ec *execContext) channelClose(channel lispObject) (lispObject, error) { 77 | if !channelp(channel) { 78 | return ec.wrongTypeArgument(ec.s.channelp, channel) 79 | } 80 | 81 | close(xChannel(channel).val) 82 | return ec.nil_, nil 83 | } 84 | 85 | func (ec *execContext) symbolsOfGoroutine() { 86 | ec.defSubr2(nil, "pimacs-go", (*execContext).makeGoroutine, 1) 87 | ec.defSubr1(nil, "pimacs-sleep", (*execContext).sleep, 1) 88 | ec.defSubr1(nil, "pimacs-chan", (*execContext).makeChannel, 0) 89 | ec.defSubr2(nil, "pimacs-send", (*execContext).channelSend, 2) 90 | ec.defSubr1(nil, "pimacs-receive", (*execContext).channelReceive, 1) 91 | ec.defSubr1(nil, "pimacs-close", (*execContext).channelClose, 1) 92 | } 93 | -------------------------------------------------------------------------------- /core/keyboard.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "fmt" 5 | "github.com/federicotdn/pimacs/proto" 6 | ) 7 | 8 | type commandLoopState struct { 9 | inputHist []*proto.InputEventKey 10 | debug bool 11 | } 12 | 13 | func (ec *execContext) handleInputEventKey(state *commandLoopState, ev *proto.InputEventKey) bool { 14 | state.inputHist = append(state.inputHist, ev) 15 | 16 | if ev.Rune == '`' { 17 | state.debug = !state.debug 18 | ec.gl.currentBuf.contents = "" 19 | } 20 | 21 | if state.debug { 22 | ec.gl.currentBuf.contents = "KEY: " 23 | 24 | if ev.HasMod(proto.ModAlt) { 25 | ec.gl.currentBuf.contents += "Alt " 26 | } 27 | if ev.HasMod(proto.ModCtrl) { 28 | ec.gl.currentBuf.contents += "Ctrl " 29 | } 30 | if ev.HasMod(proto.ModShift) { 31 | ec.gl.currentBuf.contents += "Shift " 32 | } 33 | if ev.HasMod(proto.ModMeta) { 34 | ec.gl.currentBuf.contents += "Meta " 35 | } 36 | 37 | ec.gl.currentBuf.contents += fmt.Sprintf("key: <%v> | rune: <%v> <%c>", ev.Key, ev.Rune, ev.Rune) 38 | ec.ops <- &proto.DrawOpSetText{Text: ec.gl.currentBuf.contents} 39 | 40 | return false 41 | } 42 | 43 | if ev.Key == proto.KeyCtrlC || ev.Key == proto.KeyEscape { 44 | ec.ops <- &proto.DrawOpSpecial{Terminate: true} 45 | return true 46 | } 47 | 48 | if ev.Key == proto.KeyEnter { 49 | // TODO: Don't manipulate buffer contents like this 50 | str := newString(ec.gl.currentBuf.contents, true) 51 | ec.gl.currentBuf.contents = "" 52 | 53 | obj, err := ec.readFromString(str, ec.nil_, ec.nil_) 54 | if err != nil { 55 | ec.ops <- &proto.DrawOpSetText{Text: err.Error()} 56 | return false 57 | } 58 | 59 | result, err := ec.evalSub(xCar(obj)) 60 | if err != nil { 61 | ec.ops <- &proto.DrawOpSetText{Text: err.Error()} 62 | return false 63 | } 64 | 65 | printed, err := ec.prin1ToString(result, ec.nil_, ec.nil_) 66 | if err != nil { 67 | ec.ops <- &proto.DrawOpSetText{Text: err.Error()} 68 | return false 69 | } 70 | 71 | ec.ops <- &proto.DrawOpSetText{Text: xStringValue(printed)} 72 | } else { 73 | ec.gl.currentBuf.contents += string(ev.Rune) 74 | ec.ops <- &proto.DrawOpSetText{Text: ec.gl.currentBuf.contents} 75 | } 76 | return false 77 | } 78 | 79 | func (ec *execContext) recursiveEdit() (lispObject, error) { 80 | state := commandLoopState{} 81 | loop: 82 | for { 83 | rawEv := <-ec.events 84 | switch ev := rawEv.(type) { 85 | case *proto.InputEventKey: 86 | terminate := ec.handleInputEventKey(&state, ev) 87 | if terminate { 88 | break loop 89 | } 90 | } 91 | 92 | } 93 | return ec.nil_, nil 94 | } 95 | 96 | func (ec *execContext) symbolsOfKeyboard() { 97 | ec.defVarLisp(&ec.v.metaPrefixChar, "meta-prefix-char", newInteger(0o33)) 98 | 99 | ec.defSubr0(&ec.s.recursiveEdit, "recursive-edit", (*execContext).recursiveEdit) 100 | } 101 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 |

2 | pimacs 3 |
4 |

5 | 6 | ## Summary 7 | 8 | A partial, experimental implementation of an Elisp (Emacs Lisp) interpreter, written in Go. 9 | 10 | ## Project goals 11 | - Practice Go development. 12 | - Learn more about the Emacs internals, particularly the Elisp interpreter. 13 | - Learn about Lisp interpreter design in general. 14 | - Practice reading C code. 15 | - Learn about lower level functions such as `setjmp`, `longjmp`, etc. 16 | - Learn about the general challenges found when creating a text editor. 17 | 18 | ## Usage 19 | Assuming you have the Go compiler installed, simply use `make build` to compile Pimacs, and then `./pimacs` to start the REPL. 20 | 21 | Note that many, many Elisp functions and macros are **not** implemented. You can, however, use the following (among others): 22 | ``` 23 | intern read-from-string read load eval funcall apply progn prog1 cond 24 | setq and or if while quote function defconst let let* catch 25 | unwind-protect condition-case throw signal prin1 print princ 26 | prin1-to-string null sequencep consp listp symbolp stringp 27 | number-or-marker-p char-or-string-p integerp numberp bufferp 28 | characterp char-table-p vectorp boundp fboundp makunbound fmakunbound 29 | car cdr car-safe cdr-safe setcar setcdr symbol-plist symbol-name set 30 | fset symbol-value symbol-function eq defalias + < bare-symbol cons 31 | list length equal eql assq assoc memq get put plistp plist-get plist-put 32 | nconc provide nreverse reverse require nthcdr nth mapcar buffer-string 33 | insert current-buffer set-buffer get-buffer buffer-name buffer-list 34 | get-buffer-create read-from-minibuffer getenv-internal recursive-edit 35 | make-char-table char-table-range set-char-table-range 36 | char-table-parent set-char-table-parent multibyte-string-p % 37 | ``` 38 | 39 | Note that some of these may be only partially implemented, or be a stub/placeholder. 40 | 41 | ### Examples 42 | Set a variable and read it: 43 | ```elisp 44 | > (setq greeting "hello") 45 | "hello" 46 | > greeting 47 | "hello" 48 | ``` 49 | 50 | Create a function and call it: 51 | ```elisp 52 | > (fset 'twice (function (lambda (x) (+ x x)))) 53 | (lambda (x) (+ x x)) 54 | > (twice 21) 55 | 42 56 | ``` 57 | 58 | Try out a non-local exit: 59 | ```elisp 60 | > (catch 'test (throw 'test 123)) 61 | 123 62 | ``` 63 | 64 | Create a vector of integers: 65 | ```elisp 66 | > (setq vec [1 2 3 4]) 67 | [1 2 3 4] 68 | > (vectorp vec) 69 | t 70 | ``` 71 | 72 | Use backquotes: 73 | ```elisp 74 | > (setq lst '(2 3 4)) 75 | (2 3 4) 76 | > `(1 ,@lst 5 6) 77 | (1 2 3 4 5 6) 78 | ``` 79 | 80 | Create a multibyte string: 81 | ```elisp 82 | > (setq s "ñandú") 83 | "ñandú" 84 | > (multibyte-string-p s) 85 | t 86 | ``` 87 | 88 | ## Design and general notes 89 | In order to read about the design choices for Pimacs, how it works internally, and how it is different from Emacs' Elisp interpreter, see the [design.md](etc/design.md) document. 90 | 91 | ## Tests 92 | Use `make test` to run the test suite. 93 | 94 | ## Similar projects 95 | Check out [Rune](https://github.com/CeleritasCelery/rune), a re-implementation of Emacs from scratch using Rust. 96 | 97 | ## License 98 | Like Emacs, Pimacs is licensed under the GNU General Public License, version 3. 99 | -------------------------------------------------------------------------------- /core/errors.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "fmt" 5 | ) 6 | 7 | func (ec *execContext) signalN(errorSymbol lispObject, args ...lispObject) (lispObject, error) { 8 | list := ec.makeList(args...) 9 | return ec.signal(errorSymbol, list) 10 | } 11 | 12 | func (ec *execContext) signalError(format string, v ...interface{}) (lispObject, error) { 13 | message := newString(fmt.Sprintf(format, v...), true) 14 | return ec.signalN(ec.s.error_, message) 15 | } 16 | 17 | func (ec *execContext) wrongTypeArgument(predicate, value lispObject) (lispObject, error) { 18 | return ec.signalN(ec.s.wrongTypeArgument, predicate, value) 19 | } 20 | 21 | func (ec *execContext) wrongNumberOfArguments(fn lispObject, count lispInt) (lispObject, error) { 22 | return ec.signalN(ec.s.wrongNumberofArguments, fn, newInteger(count)) 23 | } 24 | 25 | func (ec *execContext) pimacsUnimplemented(fn lispObject, format string, v ...interface{}) (lispObject, error) { 26 | message := newString(fmt.Sprintf(format, v...), true) 27 | return ec.signalN(ec.s.pimacsUnimplemented, message) 28 | } 29 | 30 | func (ec *execContext) invalidReadSyntax(format string, v ...interface{}) (lispObject, error) { 31 | message := newString(fmt.Sprintf(format, v...), true) 32 | return ec.signalN(ec.s.invalidReadSyntax, message) 33 | } 34 | 35 | func (ec *execContext) argsOutOfRange(objs ...lispObject) (lispObject, error) { 36 | return ec.signalN(ec.s.argsOutOfRange, objs...) 37 | } 38 | 39 | func (ec *execContext) defError(symbol *lispObject, tail lispObject, name, msg string) { 40 | ec.defSym(symbol, name) 41 | xEnsure(ec.put(*symbol, ec.s.errorConditions, newCons(*symbol, tail))) 42 | xEnsure(ec.put(*symbol, ec.s.errorMessage, newString(msg, false))) 43 | } 44 | 45 | func (ec *execContext) symbolsOfErrors() { 46 | ec.defSym(&ec.s.errorConditions, "error-conditions") 47 | ec.defSym(&ec.s.errorMessage, "error-message") 48 | 49 | ec.defError(&ec.s.error_, ec.nil_, "error", "error") 50 | errorTail := ec.makeList(ec.s.error_) 51 | 52 | ec.defError(&ec.s.quit, ec.nil_, "quit", "Quit") 53 | ec.defError(&ec.s.userError, errorTail, "user-error", "") 54 | ec.defError(&ec.s.wrongLengthArgument, errorTail, "wrong-length-argument", "Wrong length argument") 55 | ec.defError(&ec.s.wrongTypeArgument, errorTail, "wrong-type-argument", "Wrong type argument") 56 | ec.defError(&ec.s.argsOutOfRange, errorTail, "args-out-of-range", "Args out of range") 57 | ec.defError(&ec.s.voidFunction, errorTail, "void-function", "Symbol's function definition is void") 58 | ec.defError(&ec.s.invalidFunction, errorTail, "invalid-function", "Invalid function") 59 | ec.defError(&ec.s.voidVariable, errorTail, "void-variable", "Symbol's value as variable is void") 60 | ec.defError(&ec.s.wrongNumberofArguments, errorTail, "wrong-number-of-arguments", "Wrong number of arguments") 61 | ec.defError(&ec.s.endOfFile, errorTail, "end-of-file", "End of file during parsing") 62 | ec.defError(&ec.s.noCatch, errorTail, "no-catch", "No catch for tag") 63 | ec.defError(&ec.s.settingConstant, errorTail, "setting-constant", "Attempt to set a constant symbol") 64 | ec.defError(&ec.s.invalidReadSyntax, errorTail, "invalid-read-syntax", "Invalid read syntax") 65 | ec.defError(&ec.s.pimacsUnimplemented, errorTail, "pimacs-unimplemented", "Unimplemented feature") 66 | ec.defError(&ec.s.circularList, errorTail, "circular-list", "List contains a loop") 67 | ec.defError(&ec.s.fileMissing, errorTail, "file-missing", "No such file or directory") 68 | ec.defError(&ec.s.arithError, errorTail, "arith-error", "Arithmetic error") 69 | } 70 | -------------------------------------------------------------------------------- /test/lisp/functions-tests.el: -------------------------------------------------------------------------------- 1 | ;;; functions-tests.el --- Tests for functions.go -*- lexical-binding: t; -*- 2 | 3 | (lt--deftest test-reverse () 4 | (lt--should (equal (reverse '(1 2 3 4)) 5 | '(4 3 2 1)) 6 | "list reversed") 7 | (lt--should (equal (reverse ()) ()) "empty list reversed") 8 | (lt--should (equal (reverse [1 2 3 4]) 9 | [4 3 2 1]) 10 | "vec reversed") 11 | (lt--should (equal (reverse []) []) 12 | "empty vec reversed")) 13 | 14 | (lt--deftest test-eq () 15 | (lt--should (eq 'a 'a) "a eq a") 16 | (lt--should-not (eq 'a 'b) "not a eq b") 17 | (lt--should-not (eq 1 1) "not 1 eq 1") 18 | (let ((foo "hello")) 19 | (lt--should (eq foo foo) "foo eq foo"))) 20 | 21 | (lt--deftest test-eql () 22 | (lt--should (eql 'a 'a) "a eql a") 23 | (lt--should (eql 1 1) "1 eql 1") 24 | (lt--should-not (eql "hello" "hello") "not hello eql hello")) 25 | 26 | (lt--deftest test-equal () 27 | (lt--should (equal 'a 'a) "a equal a") 28 | (lt--should (equal 1 1) "1 equal 1") 29 | (lt--should (equal "hello" "hello") "hello equal hello") 30 | (lt--should-not (equal [] nil))) 31 | 32 | (lt--deftest test-delq () 33 | (lt--should (equal '(1 2 3 4 5) 34 | (delq 'a '(1 2 3 a 4 5))) 35 | "list equal after delq (1)") 36 | (lt--should (equal '(1 2 3 4 5) 37 | (delq 'a '(a 1 2 3 a 4 5))) 38 | "list equal after delq (2)") 39 | (lt--should (equal '(1 2 3 4 5) 40 | (delq 'a '(a 1 2 3 a 4 5 a a))) 41 | "list equal after delq (3)") 42 | (lt--should (equal '() 43 | (delq 'a '(a a a))) 44 | "list equal after delq (4)") 45 | (lt--should (equal nil (delq 'a nil)) 46 | "list equal after delq (6)")) 47 | 48 | (lt--deftest test-hash-table-eq () 49 | (setq ht (make-hash-table :test 'eq)) 50 | (setq key "key") 51 | (puthash 'a 123 ht) 52 | (puthash 100 "hello" ht) 53 | (puthash key "v" ht) 54 | 55 | (lt--should-not (gethash 'b ht)) 56 | (lt--should-not (gethash 100 ht)) 57 | (lt--should (equal (gethash 'a ht) 123) "eql 123") 58 | (lt--should (equal (gethash 'b ht 123) 123) "eql 123 default") 59 | (lt--should (equal (gethash key ht) "v")) 60 | (clrhash ht) 61 | (lt--should-not (gethash 'a ht)) 62 | (lt--should (equal (gethash 'a ht "X") "X"))) 63 | 64 | (lt--deftest test-hash-table-eql () 65 | (setq ht (make-hash-table :test 'eql)) 66 | (setq key "key") 67 | (puthash 'a 123 ht) 68 | (puthash 100 "hello" ht) 69 | (puthash key "v" ht) 70 | 71 | (lt--should (equal (gethash 100 ht) "hello")) 72 | (lt--should (equal (gethash 'a ht) 123) "eql 123") 73 | (lt--should (equal (gethash key ht) "v")) 74 | (lt--should-not (gethash "key" ht))) 75 | 76 | (lt--deftest test-hash-table-equal () 77 | (setq ht (make-hash-table :test 'equal)) 78 | (setq key "key") 79 | (puthash 'a 123 ht) 80 | (puthash 100 "hello" ht) 81 | (puthash key "v" ht) 82 | 83 | (lt--should (equal (gethash 100 ht) "hello")) 84 | (lt--should (equal (gethash 'a ht) 123) "eql 123") 85 | (lt--should (equal (gethash key ht) "v")) 86 | (lt--should (equal (gethash "key" ht) "v")) 87 | (lt--should-not (gethash "kEy" ht))) 88 | 89 | (lt--deftest test-hash-table-remhash () 90 | (setq ht (make-hash-table :test 'eql)) 91 | (puthash 123 "hello" ht) 92 | (puthash 124 "hello" ht) 93 | (lt--should (equal (gethash 123 ht) "hello")) 94 | (remhash 123 ht) 95 | (lt--should-not (gethash 123 ht)) 96 | (lt--should (equal (gethash 124 ht) "hello"))) 97 | 98 | (lt--deftest test-vconcat () 99 | (lt--should (equal [1 2 3 4] (vconcat [1 2] [3 4]))) 100 | (lt--should (equal [1 2 3 4] (vconcat [1 2] '(3 4)))) 101 | (lt--should (equal [1 2 3 4] (vconcat [1 2] '(3 4) nil))) 102 | (lt--should (equal (vconcat nil) []))) 103 | -------------------------------------------------------------------------------- /go.sum: -------------------------------------------------------------------------------- 1 | github.com/gdamore/encoding v1.0.0 h1:+7OoQ1Bc6eTm5niUzBa0Ctsh6JbMW6Ra+YNuAtDBdko= 2 | github.com/gdamore/encoding v1.0.0/go.mod h1:alR0ol34c49FCSBLjhosxzcPHQbf2trDkoo5dl+VrEg= 3 | github.com/gdamore/tcell/v2 v2.6.0 h1:OKbluoP9VYmJwZwq/iLb4BxwKcwGthaa1YNBJIyCySg= 4 | github.com/gdamore/tcell/v2 v2.6.0/go.mod h1:be9omFATkdr0D9qewWW3d+MEvl5dha+Etb5y65J2H8Y= 5 | github.com/lucasb-eyer/go-colorful v1.2.0 h1:1nnpGOrhyZZuNyfu1QjKiUICQ74+3FNCN69Aj6K7nkY= 6 | github.com/lucasb-eyer/go-colorful v1.2.0/go.mod h1:R4dSotOR9KMtayYi1e77YzuveK+i7ruzyGqttikkLy0= 7 | github.com/mattn/go-runewidth v0.0.14 h1:+xnbZSEeDbOIg5/mE6JF0w6n9duR1l3/WmbinWVwUuU= 8 | github.com/mattn/go-runewidth v0.0.14/go.mod h1:Jdepj2loyihRzMpdS35Xk/zdY8IAYHsh153qUoGf23w= 9 | github.com/rivo/uniseg v0.2.0/go.mod h1:J6wj4VEh+S6ZtnVlnTBMWIodfgj8LQOQFoIToxlJtxc= 10 | github.com/rivo/uniseg v0.4.3 h1:utMvzDsuh3suAEnhH0RdHmoPbU648o6CvXxTx4SBMOw= 11 | github.com/rivo/uniseg v0.4.3/go.mod h1:FN3SvrM+Zdj16jyLfmOkMNblXMcoc8DfTHruCPUcx88= 12 | github.com/yuin/goldmark v1.4.13/go.mod h1:6yULJ656Px+3vBD8DxQVa3kxgyrAnzto9xy5taEt/CY= 13 | golang.org/x/crypto v0.0.0-20190308221718-c2843e01d9a2/go.mod h1:djNgcEr1/C05ACkg1iLfiJU5Ep61QUkGW8qpdssI0+w= 14 | golang.org/x/crypto v0.0.0-20210921155107-089bfa567519/go.mod h1:GvvjBRRGRdwPK5ydBHafDWAxML/pGHZbMvKqRZ5+Abc= 15 | golang.org/x/mod v0.6.0-dev.0.20220419223038-86c51ed26bb4/go.mod h1:jJ57K6gSWd91VN4djpZkiMVwK6gcyfeH4XE8wZrZaV4= 16 | golang.org/x/net v0.0.0-20190620200207-3b0461eec859/go.mod h1:z5CRVTTTmAJ677TzLLGU+0bjPO0LkuOLi4/5GtJWs/s= 17 | golang.org/x/net v0.0.0-20210226172049-e18ecbb05110/go.mod h1:m0MpNAwzfU5UDzcl9v0D8zg8gWTRqZa9RBIspLL5mdg= 18 | golang.org/x/net v0.0.0-20220722155237-a158d28d115b/go.mod h1:XRhObCWvk6IyKnWLug+ECip1KBveYUHfp+8e9klMJ9c= 19 | golang.org/x/sync v0.0.0-20190423024810-112230192c58/go.mod h1:RxMgew5VJxzue5/jJTE5uejpjVlOe/izrB70Jof72aM= 20 | golang.org/x/sync v0.0.0-20220722155255-886fb9371eb4/go.mod h1:RxMgew5VJxzue5/jJTE5uejpjVlOe/izrB70Jof72aM= 21 | golang.org/x/sys v0.0.0-20190215142949-d0b11bdaac8a/go.mod h1:STP8DvDyc/dI5b8T5hshtkjS+E42TnysNCUPdjciGhY= 22 | golang.org/x/sys v0.0.0-20201119102817-f84b799fce68/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= 23 | golang.org/x/sys v0.0.0-20210615035016-665e8c7367d1/go.mod h1:oPkhp1MJrh7nUepCBck5+mAzfO9JrbApNNgaTdGDITg= 24 | golang.org/x/sys v0.0.0-20220520151302-bc2c85ada10a/go.mod h1:oPkhp1MJrh7nUepCBck5+mAzfO9JrbApNNgaTdGDITg= 25 | golang.org/x/sys v0.0.0-20220722155257-8c9f86f7a55f/go.mod h1:oPkhp1MJrh7nUepCBck5+mAzfO9JrbApNNgaTdGDITg= 26 | golang.org/x/sys v0.5.0 h1:MUK/U/4lj1t1oPg0HfuXDN/Z1wv31ZJ/YcPiGccS4DU= 27 | golang.org/x/sys v0.5.0/go.mod h1:oPkhp1MJrh7nUepCBck5+mAzfO9JrbApNNgaTdGDITg= 28 | golang.org/x/term v0.0.0-20201126162022-7de9c90e9dd1/go.mod h1:bj7SfCRtBDWHUb9snDiAeCFNEtKQo2Wmx5Cou7ajbmo= 29 | golang.org/x/term v0.0.0-20210927222741-03fcf44c2211/go.mod h1:jbD1KX2456YbFQfuXm/mYQcufACuNUgVhRMnK/tPxf8= 30 | golang.org/x/term v0.5.0 h1:n2a8QNdAb0sZNpU9R1ALUXBbY+w51fCQDN+7EdxNBsY= 31 | golang.org/x/term v0.5.0/go.mod h1:jMB1sMXY+tzblOD4FWmEbocvup2/aLOaQEp7JmGp78k= 32 | golang.org/x/text v0.3.0/go.mod h1:NqM8EUOU14njkJ3fqMW+pc6Ldnwhi/IjpwHt7yyuwOQ= 33 | golang.org/x/text v0.3.3/go.mod h1:5Zoc/QRtKVWzQhOtBMvqHzDpF6irO9z98xDceosuGiQ= 34 | golang.org/x/text v0.3.7/go.mod h1:u+2+/6zg+i71rQMx5EYifcz6MCKuco9NR6JIITiCfzQ= 35 | golang.org/x/text v0.7.0 h1:4BRB4x83lYWy72KwLD/qYDuTu7q9PjSagHvijDw7cLo= 36 | golang.org/x/text v0.7.0/go.mod h1:mrYo+phRRbMaCq/xk9113O4dZlRixOauAjOtrjsXDZ8= 37 | golang.org/x/tools v0.0.0-20180917221912-90fa682c2a6e/go.mod h1:n7NCudcB/nEzxVGmLbDWY5pfWTLqBcC2KZ6jyYvM4mQ= 38 | golang.org/x/tools v0.0.0-20191119224855-298f0cb1881e/go.mod h1:b+2E5dAYhXwXZwtnZ6UAqBI28+e2cm9otk0dWdXHAEo= 39 | golang.org/x/tools v0.1.12/go.mod h1:hNGJHUnrk76NpqgfD5Aqm5Crs+Hm0VOH/i9J2+nxYbc= 40 | golang.org/x/xerrors v0.0.0-20190717185122-a985d3407aa7/go.mod h1:I/5z698sn9Ka8TeJc9MKroUUfqBBauWjQqLJ2OPfmY0= 41 | -------------------------------------------------------------------------------- /core/string.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "errors" 5 | "unicode/utf8" 6 | ) 7 | 8 | var indexErr = errors.New("index out of range") 9 | 10 | // |------------+------------------------------------+-------------------------------------| 11 | // | | string-backed (val) | []byte-backed (valMut != nil) | 12 | // |------------+------------------------------------+-------------------------------------| 13 | // | size_ < 0 | Unibyte immutable string | Unibyte mutable string | 14 | // | | Ideal for storing ASCII runes | Good for use as a raw bytes buffer. | 15 | // | | that will not be modified. | size_ is -1. | 16 | // | | size_ is -1. | | 17 | // |------------+------------------------------------+-------------------------------------| 18 | // | size_ >= 0 | Multibyte immutable string | Multibyte mutable string | 19 | // | | Ideal for storing Unicode runes | Will copy bytes when calling str()! | 20 | // | | that will not be modified. | | 21 | // | | size_ contains the number of runes | size_ is 0. | 22 | // | | the string has. | | 23 | // |------------+------------------------------------+-------------------------------------| 24 | type lispString struct { 25 | valMut []byte 26 | val string 27 | size_ int 28 | } 29 | 30 | func newStringInternal(val string, multibyte bool, size_ int) *lispString { 31 | if multibyte && size_ < 0 { 32 | size_ = utf8.RuneCountInString(val) 33 | } 34 | return &lispString{ 35 | val: val, 36 | size_: size_, 37 | } 38 | } 39 | 40 | func newString(val string, multibyte bool) *lispString { 41 | return newStringInternal(val, multibyte, -1) 42 | } 43 | 44 | func newUniOrMultibyteString(val string) *lispString { 45 | multibyte := false 46 | size_ := 0 47 | 48 | tmp := val 49 | for len(tmp) > 0 { 50 | r, width := utf8.DecodeRuneInString(tmp) 51 | if r == utf8.RuneError { 52 | size_ = len(val) 53 | break 54 | } 55 | 56 | size_++ 57 | tmp = tmp[width:] 58 | } 59 | 60 | if size_ < len(val) { 61 | multibyte = true 62 | } else { 63 | size_ = -1 64 | } 65 | return newStringInternal(val, multibyte, size_) 66 | } 67 | 68 | func (ls *lispString) multibytep() bool { 69 | return ls.size_ >= 0 70 | } 71 | 72 | func (ls *lispString) aref(i int) (lispInt, error) { 73 | if i < 0 { 74 | return 0, indexErr 75 | } 76 | if ls.multibytep() { 77 | if ls.valMut == nil { 78 | // We are multibyte - size check is only cheap 79 | // if we are immutable 80 | if i >= ls.size() { 81 | return 0, indexErr 82 | } 83 | 84 | for j, c := range ls.val { 85 | if j == i { 86 | return runeToLispInt(c), nil 87 | } 88 | } 89 | 90 | // We should never get here 91 | return 0, indexErr 92 | } 93 | 94 | return 0, errors.New("string aref unimplemented") 95 | } 96 | 97 | // We are unibyte, so size check is cheap 98 | if i >= ls.size() { 99 | return 0, indexErr 100 | } 101 | 102 | if ls.valMut == nil { 103 | return lispInt(ls.val[i]), nil 104 | } 105 | return lispInt(ls.valMut[i]), nil 106 | } 107 | 108 | // str returns the lispString as a Go string. if size_ is negative 109 | // (unibyte string), the string will simply contain the byte contents 110 | // of the lispString in no specific encoding. If size_ is 111 | // non-negative, str will return a UTF-8 encoded string. 112 | func (ls *lispString) str() string { 113 | if ls.valMut == nil { 114 | return ls.val 115 | } 116 | // Do a copy of the mutable value 117 | return string(ls.valMut) 118 | } 119 | 120 | func (ls *lispString) size() int { 121 | if ls.multibytep() { 122 | if ls.valMut == nil { 123 | return ls.size_ 124 | } 125 | return utf8.RuneCount(ls.valMut) 126 | } 127 | return ls.sizeBytes() 128 | } 129 | 130 | func (ls *lispString) sizeBytes() int { 131 | if ls.valMut == nil { 132 | return len(ls.val) 133 | } 134 | return len(ls.valMut) 135 | } 136 | 137 | func (ls *lispString) emptyp() bool { 138 | return ls.sizeBytes() == 0 139 | } 140 | 141 | func (ls *lispString) getType() lispType { 142 | return lispTypeString 143 | } 144 | -------------------------------------------------------------------------------- /core/buffer.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | func (ec *execContext) insert(args ...lispObject) (lispObject, error) { 4 | for _, arg := range args { 5 | if characterp(arg) { 6 | ec.gl.currentBuf.contents += string(xIntegerRune(arg)) 7 | } else if stringp(arg) { 8 | ec.gl.currentBuf.contents += xStringValue(arg) 9 | } else { 10 | return ec.wrongTypeArgument(ec.s.charOrStringp, arg) 11 | } 12 | } 13 | 14 | return ec.nil_, nil 15 | } 16 | 17 | func (ec *execContext) bufferString() (lispObject, error) { 18 | return newString(ec.gl.currentBuf.contents, true), nil 19 | } 20 | 21 | func (ec *execContext) currentBuffer() (lispObject, error) { 22 | return ec.gl.currentBuf, nil 23 | } 24 | 25 | func (ec *execContext) currentBufferInternal() lispObject { 26 | return xEnsure(ec.currentBuffer()) 27 | } 28 | 29 | func (ec *execContext) setBufferIfLive(obj lispObject) { 30 | buf := xBuffer(obj) 31 | if buf.live { 32 | ec.setBufferInternal(buf) 33 | } 34 | } 35 | 36 | func (ec *execContext) setBufferInternal(buf *lispBuffer) { 37 | ec.gl.currentBuf = buf 38 | } 39 | 40 | func (ec *execContext) setBuffer(bufferOrName lispObject) (lispObject, error) { 41 | obj, err := ec.getBuffer(bufferOrName) 42 | if err != nil { 43 | return nil, err 44 | } 45 | 46 | if obj == ec.nil_ { 47 | return ec.signalError("No buffer named %v", bufferOrName) 48 | } 49 | 50 | buf := xBuffer(obj) 51 | if !buf.live { 52 | return ec.signalError("Selecting deleted buffer") 53 | } 54 | 55 | ec.setBufferInternal(buf) 56 | return obj, nil 57 | } 58 | 59 | func (ec *execContext) loadOrStoreBuffer(name string, buf *lispBuffer) (*lispBuffer, bool) { 60 | ec.buffersLock.Lock() 61 | defer ec.buffersLock.Unlock() 62 | 63 | prev, existed := ec.buffers[name] 64 | if existed { 65 | return prev, true 66 | } 67 | 68 | if buf != nil { 69 | ec.buffers[name] = buf 70 | } 71 | return buf, false 72 | } 73 | 74 | func (ec *execContext) getBuffer(bufferOrName lispObject) (lispObject, error) { 75 | if bufferp(bufferOrName) { 76 | return bufferOrName, nil 77 | } else if !stringp(bufferOrName) { 78 | return ec.wrongTypeArgument(ec.s.stringp, bufferOrName) 79 | } 80 | 81 | buf, existed := ec.loadOrStoreBuffer(xStringValue(bufferOrName), nil) 82 | if !existed { 83 | return ec.nil_, nil 84 | } 85 | return buf, nil 86 | } 87 | 88 | func (ec *execContext) getBufferCreate(bufferOrName, inhibitBufferHooks lispObject) (lispObject, error) { 89 | if bufferp(bufferOrName) { 90 | return bufferOrName, nil 91 | } else if !stringp(bufferOrName) { 92 | return ec.wrongTypeArgument(ec.s.stringp, bufferOrName) 93 | } 94 | 95 | if xStringEmptyp(bufferOrName) { 96 | return ec.signalError("Empty string for buffer name is not allowed") 97 | } 98 | 99 | buf := newBuffer(bufferOrName) 100 | buf, _ = ec.loadOrStoreBuffer(xStringValue(bufferOrName), buf) 101 | 102 | return buf, nil 103 | } 104 | 105 | func (ec *execContext) bufferName(obj lispObject) (lispObject, error) { 106 | if obj == ec.nil_ { 107 | obj = ec.currentBufferInternal() 108 | } else if !bufferp(obj) { 109 | return ec.wrongTypeArgument(ec.s.bufferp, obj) 110 | } 111 | 112 | buf := xBuffer(obj) 113 | if !buf.live { 114 | return ec.nil_, nil 115 | } 116 | 117 | return buf.name, nil 118 | } 119 | 120 | func (ec *execContext) bufferList(frame lispObject) (lispObject, error) { 121 | ec.buffersLock.RLock() 122 | defer ec.buffersLock.RUnlock() 123 | 124 | buffers := make([]lispObject, 0, len(ec.buffers)) 125 | for _, buf := range ec.buffers { 126 | buffers = append(buffers, buf) 127 | } 128 | 129 | return ec.makeList(buffers...), nil 130 | } 131 | 132 | func (ec *execContext) symbolsOfBuffer() { 133 | ec.defSubr0(nil, "buffer-string", (*execContext).bufferString) 134 | ec.defSubrM(nil, "insert", (*execContext).insert, 0) 135 | ec.defSubr0(nil, "current-buffer", (*execContext).currentBuffer) 136 | ec.defSubr1(nil, "set-buffer", (*execContext).setBuffer, 1) 137 | ec.defSubr1(nil, "get-buffer", (*execContext).getBuffer, 1) 138 | ec.defSubr1(nil, "buffer-name", (*execContext).bufferName, 0) 139 | ec.defSubr1(nil, "buffer-list", (*execContext).bufferList, 0) 140 | ec.defSubr2(nil, "get-buffer-create", (*execContext).getBufferCreate, 1) 141 | } 142 | 143 | func (ec *execContext) initBufferGoroutineLocals() { 144 | // TODO: Use another buffer in new goroutines? 145 | // TODO: What to do on error? 146 | buf := xEnsure(ec.getBufferCreate(newString("*scratch*", false), ec.nil_)) 147 | ec.gl.currentBuf = xBuffer(buf) 148 | } 149 | -------------------------------------------------------------------------------- /core/keymap.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | func (ec *execContext) makeKeymap(str lispObject) (lispObject, error) { 4 | tail := ec.nil_ 5 | if str != ec.nil_ { 6 | tail = ec.makeList(str) 7 | } 8 | 9 | table, err := ec.makeCharTable(ec.s.keymap, ec.s.nil_) 10 | if err != nil { 11 | return nil, err 12 | } 13 | return newCons(ec.s.keymap, newCons(table, tail)), nil 14 | } 15 | 16 | func (ec *execContext) makeSparseKeymap(str lispObject) (lispObject, error) { 17 | if str != ec.nil_ { 18 | return ec.makeList(ec.s.keymap, str), nil 19 | } 20 | return ec.makeList(ec.s.keymap), nil 21 | } 22 | 23 | func (ec *execContext) keymapp(object lispObject) (lispObject, error) { 24 | keymap, err := ec.getKeymap(object, false, false) 25 | if err != nil { 26 | return nil, err 27 | } 28 | return ec.bool(keymap != ec.nil_) 29 | } 30 | 31 | func (ec *execContext) getKeymap(object lispObject, errIfNotKeymap, autoload bool) (lispObject, error) { 32 | // TODO: Autoload is currently ignored 33 | if object == ec.nil_ { 34 | if errIfNotKeymap { 35 | return ec.wrongTypeArgument(ec.s.keymapp, object) 36 | } 37 | return ec.nil_, nil 38 | } else if consp(object) && xCar(object) == ec.s.keymap { 39 | return object, nil 40 | } 41 | 42 | tem := ec.indirectFunctionInternal(object) 43 | if consp(tem) { 44 | if xCar(tem) == ec.s.keymap { 45 | return tem, nil 46 | } 47 | 48 | if (autoload || !errIfNotKeymap) && xCar(tem) == ec.s.autoload { 49 | return ec.pimacsUnimplemented(ec.s.nil_, "no autoload for keymaps") 50 | } 51 | } 52 | 53 | if errIfNotKeymap { 54 | return ec.wrongTypeArgument(ec.s.keymapp, object) 55 | } 56 | return ec.nil_, nil 57 | } 58 | 59 | func (ec *execContext) defineKey(keymap, key, def, remove lispObject) (lispObject, error) { 60 | var err error 61 | keymap, err = ec.getKeymap(keymap, true, true) 62 | if err != nil { 63 | return nil, err 64 | } 65 | 66 | if !arrayp(key) { 67 | return ec.wrongTypeArgument(ec.s.arrayp, key) 68 | } 69 | 70 | metaBit := rune(0x80) 71 | if vectorp(key) || (stringp(key) && xStringMultibytep(key)) { 72 | metaBit = charMeta 73 | } 74 | metized := false 75 | lengthObj, err := ec.length(key) 76 | if err != nil { 77 | return nil, err 78 | } 79 | length := xIntegerValue(lengthObj) 80 | 81 | // TODO: Implementation incomplete 82 | 83 | var idx lispInt 84 | for { 85 | c, err := ec.aref(key, newInteger(idx)) 86 | if err != nil { 87 | return nil, err 88 | } 89 | 90 | if integerp(c) && 91 | ((xIntegerValue(c) & runeToLispInt(metaBit)) != 0) && 92 | !metized { 93 | 94 | c = ec.v.metaPrefixChar.val 95 | metized = true 96 | } else { 97 | if integerp(c) { 98 | i := xInteger(c) 99 | i.val &= ^runeToLispInt(metaBit) 100 | } 101 | 102 | idx++ 103 | metized = false 104 | } 105 | 106 | if !integerp(c) && 107 | !symbolp(c) && 108 | (!consp(c) || (integerp(xCar(c)) && idx != length)) { 109 | 110 | // TODO: This should be message 111 | ec.warning("Key sequence contains invalid event '%+v'", c) 112 | } 113 | 114 | if idx == length { 115 | return ec.storeInKeymap(keymap, c, def, remove != ec.nil_) 116 | } 117 | 118 | cmd, err := ec.accessKeymap(keymap, c, false, true, true) 119 | if err != nil { 120 | return nil, err 121 | } 122 | 123 | if cmd == ec.nil_ { 124 | cmd, err = ec.defineAsPrefix(keymap, c) 125 | if err != nil { 126 | return nil, err 127 | } 128 | } 129 | 130 | keymap, err = ec.getKeymap(cmd, false, true) 131 | if err != nil { 132 | return nil, err 133 | } 134 | if !consp(keymap) { 135 | return ec.signalError("Key sequence starts with non-prefix key") 136 | } 137 | } 138 | } 139 | 140 | func (ec *execContext) storeInKeymap(keymap, idx, def lispObject, remove bool) (lispObject, error) { 141 | return ec.nil_, nil 142 | } 143 | 144 | func (ec *execContext) accessKeymap(keymap, idx lispObject, tOk, noInherit, autoload bool) (lispObject, error) { 145 | return ec.nil_, nil 146 | } 147 | 148 | func (ec *execContext) defineAsPrefix(keymap, c lispObject) (lispObject, error) { 149 | return ec.nil_, nil 150 | } 151 | 152 | func (ec *execContext) useGlobalMap(keymap lispObject) (lispObject, error) { 153 | ec.warning("stub invoked: use-global-map") 154 | return ec.nil_, nil 155 | } 156 | 157 | func (ec *execContext) symbolsOfKeymap() { 158 | ec.defSym(&ec.s.keymap, "keymap") 159 | 160 | ec.defSubr1(nil, "make-keymap", (*execContext).makeKeymap, 0) 161 | ec.defSubr1(nil, "make-sparse-keymap", (*execContext).makeSparseKeymap, 0) 162 | ec.defSubr4(nil, "define-key", (*execContext).defineKey, 3) 163 | ec.defSubr1(&ec.s.keymapp, "keymapp", (*execContext).keymapp, 1) 164 | ec.defSubr1(nil, "use-global-map", (*execContext).useGlobalMap, 1) 165 | } 166 | -------------------------------------------------------------------------------- /lisp/emacs/emacs-lisp/debug-early.el: -------------------------------------------------------------------------------- 1 | ;;; debug-early.el --- Dump a Lisp backtrace without frills -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2022-2024 Free Software Foundation, Inc. 4 | 5 | ;; Author: Alan Mackenzie 6 | ;; Maintainer: emacs-devel@gnu.org 7 | ;; Keywords: internal, backtrace, bootstrap. 8 | ;; Package: emacs 9 | 10 | ;; This file is part of GNU Emacs. 11 | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify 13 | ;; it under the terms of the GNU General Public License as published by 14 | ;; the Free Software Foundation, either version 3 of the License, or 15 | ;; (at your option) any later version. 16 | 17 | ;; GNU Emacs is distributed in the hope that it will be useful, 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;; GNU General Public License for more details. 21 | 22 | ;; You should have received a copy of the GNU General Public License 23 | ;; along with GNU Emacs. If not, see . 24 | 25 | ;;; Commentary: 26 | 27 | ;; This file dumps a backtrace on stderr when an error is thrown. It 28 | ;; has no dependencies on any Lisp libraries and is thus used for 29 | ;; generating backtraces for bugs in the early parts of bootstrapping. 30 | ;; It is also always used in batch mode. It was introduced in Emacs 31 | ;; 29, before which there was no backtrace available during early 32 | ;; bootstrap. 33 | 34 | ;;; Code: 35 | 36 | ;; For bootstrap reasons, we cannot use any macros here since they're 37 | ;; not defined yet. 38 | 39 | (defalias 'debug-early-backtrace 40 | #'(lambda (&optional base) 41 | "Print a trace of Lisp function calls currently active. 42 | The output stream used is the value of `standard-output'. 43 | 44 | This is a simplified version of the standard `backtrace' 45 | function, intended for use in debugging the early parts 46 | of the build process." 47 | (princ "\n") 48 | (let ((print-escape-newlines t) 49 | (print-escape-control-characters t) 50 | (print-escape-nonascii t) 51 | (prin1 (if (and (fboundp 'cl-prin1) 52 | (fboundp 'cl-defmethod) ;Used by `cl-print'. 53 | (condition-case nil 54 | (require 'cl-print) 55 | (error nil))) 56 | #'cl-prin1 57 | #'prin1)) 58 | (first t)) 59 | (mapbacktrace 60 | #'(lambda (evald func args _flags) 61 | (if first 62 | ;; The first is the debug-early entry point itself. 63 | (setq first nil) 64 | (let ((args args)) 65 | (if evald 66 | (progn 67 | (princ " ") 68 | (funcall prin1 func) 69 | (princ "(")) 70 | (progn 71 | (princ " (") 72 | (setq args (cons func args)))) 73 | (if args 74 | (while (progn 75 | (funcall prin1 (car args)) 76 | (setq args (cdr args))) 77 | (princ " "))) 78 | (princ ")\n")))) 79 | base)))) 80 | 81 | (defalias 'debug--early 82 | #'(lambda (error base) 83 | (princ "\nError: ") 84 | (prin1 (car error)) ; The error symbol. 85 | (princ " ") 86 | (prin1 (cdr error)) ; The error data. 87 | (debug-early-backtrace base))) 88 | 89 | (defalias 'debug-early ;Called from C. 90 | #'(lambda (&rest args) 91 | "Print an error message with a backtrace of active Lisp function calls. 92 | The output stream used is the value of `standard-output'. 93 | 94 | The Emacs core calls this function after an error has been 95 | signaled, and supplies two ARGS. These are the symbol 96 | `error' (which is ignored) and a cons of the error symbol and the 97 | error data. 98 | 99 | `debug-early' is a simplified version of `debug', and is 100 | available during the early parts of the build process. It is 101 | superseded by `debug' after enough Lisp has been loaded to 102 | support the latter, except in batch mode which always uses 103 | `debug-early'. 104 | 105 | \(In versions of Emacs prior to Emacs 29, no backtrace was 106 | available before `debug' was usable.)" 107 | (debug--early (car (cdr args)) #'debug-early))) ; The error object. 108 | 109 | (defalias 'debug-early--handler ;Called from C. 110 | #'(lambda (err) 111 | (if backtrace-on-error-noninteractive 112 | (debug--early err #'debug-early--handler)))) 113 | 114 | (defalias 'debug-early--muted ;Called from C. 115 | #'(lambda (err) 116 | (save-current-buffer 117 | (set-buffer (get-buffer-create "*Redisplay-trace*")) 118 | (goto-char (point-max)) 119 | (if (bobp) nil 120 | (let ((separator "\n\n\n\n")) 121 | (save-excursion 122 | ;; The C code tested `backtrace_yet', instead we 123 | ;; keep a max of 10 backtraces. 124 | (if (search-backward separator nil t 10) 125 | (delete-region (point-min) (match-end 0)))) 126 | (insert separator))) 127 | (insert "-- Caught at " (current-time-string) "\n") 128 | (let ((standard-output (current-buffer))) 129 | (debug--early err #'debug-early--muted)) 130 | (setq delayed-warnings-list 131 | (cons '(error "Error in a redisplay Lisp hook. See buffer *Redisplay-trace*") 132 | delayed-warnings-list))))) 133 | 134 | ;;; debug-early.el ends here. 135 | -------------------------------------------------------------------------------- /core/types.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | type enum int 4 | type lispType enum 5 | type symbolRedirectType enum 6 | 7 | type lispInt int64 8 | type lispFp float64 9 | 10 | const ( 11 | lispTypeSymbol lispType = iota + 1 12 | lispTypeInteger 13 | lispTypeString 14 | lispTypeCons 15 | lispTypeFloat 16 | lispTypeVector 17 | lispTypeSubroutine 18 | lispTypeBuffer 19 | lispTypeCharTable 20 | lispTypeHashTable 21 | lispTypeChannel 22 | lispTypeRecord 23 | lispTypeMarker 24 | argsMany = -1 25 | argsUnevalled = -2 26 | ) 27 | 28 | const ( 29 | symbolRedirectPlain symbolRedirectType = iota 30 | symbolRedirectAlias 31 | symbolRedirectLocal 32 | symbolRedirectFwd 33 | ) 34 | 35 | type lispFn0 func(*execContext) (lispObject, error) 36 | type lispFn1 func(*execContext, lispObject) (lispObject, error) 37 | type lispFn2 func(*execContext, lispObject, lispObject) (lispObject, error) 38 | type lispFn3 func(*execContext, lispObject, lispObject, lispObject) (lispObject, error) 39 | type lispFn4 func(*execContext, lispObject, lispObject, lispObject, lispObject) (lispObject, error) 40 | type lispFn5 func(*execContext, lispObject, lispObject, lispObject, lispObject, lispObject) (lispObject, error) 41 | type lispFn6 func(*execContext, lispObject, lispObject, lispObject, lispObject, lispObject, lispObject) (lispObject, error) 42 | type lispFn7 func(*execContext, lispObject, lispObject, lispObject, lispObject, lispObject, lispObject, lispObject) (lispObject, error) 43 | type lispFn8 func(*execContext, lispObject, lispObject, lispObject, lispObject, lispObject, lispObject, lispObject, lispObject) (lispObject, error) 44 | type lispFnM func(*execContext, ...lispObject) (lispObject, error) 45 | type lispFn interface{} 46 | 47 | type lispObject interface { 48 | getType() lispType 49 | } 50 | 51 | type lispSymbol struct { 52 | name lispObject 53 | val lispObject 54 | function lispObject 55 | plist lispObject 56 | special bool 57 | redirect symbolRedirectType 58 | fwd forward 59 | } 60 | 61 | type forward interface { 62 | value(*execContext) lispObject 63 | setValue(*execContext, lispObject) error 64 | } 65 | 66 | type forwardBase struct { 67 | sym *lispSymbol 68 | } 69 | 70 | type forwardBool struct { 71 | forwardBase 72 | val bool 73 | } 74 | 75 | type forwardLispObj struct { 76 | forwardBase 77 | val lispObject 78 | } 79 | 80 | type lispCons struct { 81 | car lispObject 82 | cdr lispObject 83 | } 84 | 85 | type lispInteger struct { 86 | val lispInt 87 | } 88 | 89 | type lispFloat struct { 90 | val lispFp 91 | } 92 | 93 | type lispVector struct { 94 | val []lispObject 95 | } 96 | 97 | type lispRecord struct { 98 | val []lispObject 99 | type_ lispObject 100 | } 101 | 102 | type lispSubroutine struct { 103 | callabe lispFn 104 | minArgs int 105 | maxArgs int 106 | noReturn bool 107 | name string 108 | } 109 | 110 | type lispBuffer struct { 111 | contents string 112 | live bool 113 | name lispObject 114 | } 115 | 116 | type lispCharTableEntry struct { 117 | start lispInt 118 | end lispInt 119 | val lispObject 120 | } 121 | 122 | type lispCharTable struct { 123 | val []lispCharTableEntry 124 | subtype *lispSymbol 125 | parent *lispCharTable 126 | defaultVal lispObject 127 | extraSlots lispInt 128 | } 129 | 130 | type lispHashTableTest struct { 131 | name lispObject 132 | hashFunction lispObject 133 | compFunction lispObject 134 | } 135 | 136 | type lispHashTableEntry struct { 137 | key lispObject 138 | val lispObject 139 | code lispInt 140 | } 141 | 142 | type lispHashTable struct { 143 | val map[lispInt][]lispHashTableEntry 144 | test *lispHashTableTest 145 | } 146 | 147 | type lispChannel struct { 148 | val chan lispObject 149 | } 150 | 151 | func (s *lispSubroutine) setAttrs(noReturn bool) { 152 | s.noReturn = noReturn 153 | } 154 | 155 | func (ls *lispSymbol) getType() lispType { 156 | return lispTypeSymbol 157 | } 158 | 159 | func (ls *lispSymbol) setAttributes(value, function, plist lispObject, special bool) { 160 | ls.val = value 161 | ls.function = function 162 | ls.plist = plist 163 | ls.special = special 164 | } 165 | 166 | func (fb *forwardBool) value(ec *execContext) lispObject { 167 | if fb.val { 168 | return ec.t 169 | } 170 | return ec.nil_ 171 | } 172 | 173 | func (fb *forwardBool) setValue(ec *execContext, val lispObject) error { 174 | if val == ec.nil_ { 175 | fb.val = false 176 | } else { 177 | fb.val = true 178 | } 179 | return nil 180 | } 181 | 182 | func (fl *forwardLispObj) value(_ *execContext) lispObject { 183 | return fl.val 184 | } 185 | 186 | func (fl *forwardLispObj) setValue(ec *execContext, val lispObject) error { 187 | fl.val = val 188 | return nil 189 | } 190 | 191 | func (lc *lispCons) getType() lispType { 192 | return lispTypeCons 193 | } 194 | 195 | func (li *lispInteger) getType() lispType { 196 | return lispTypeInteger 197 | } 198 | 199 | func (lf *lispFloat) getType() lispType { 200 | return lispTypeFloat 201 | } 202 | 203 | func (lv *lispVector) getType() lispType { 204 | return lispTypeVector 205 | } 206 | 207 | func (ls *lispSubroutine) getType() lispType { 208 | return lispTypeSubroutine 209 | } 210 | 211 | func (lb *lispBuffer) getType() lispType { 212 | return lispTypeBuffer 213 | } 214 | 215 | func (ct *lispCharTable) getType() lispType { 216 | return lispTypeCharTable 217 | } 218 | 219 | func (ht *lispHashTable) getType() lispType { 220 | return lispTypeHashTable 221 | } 222 | 223 | func (ch *lispChannel) getType() lispType { 224 | return lispTypeChannel 225 | } 226 | 227 | func (e *lispCharTableEntry) contains(c lispInt) bool { 228 | return e.start <= c && c <= e.end 229 | } 230 | -------------------------------------------------------------------------------- /core/symbols.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "reflect" 5 | ) 6 | 7 | type symbols struct { 8 | // Essential runtime objects 9 | nil_ lispObject 10 | t lispObject 11 | unbound lispObject 12 | 13 | // Subroutine symbols 14 | sequencep lispObject 15 | listp lispObject 16 | plistp lispObject 17 | consp lispObject 18 | symbolp lispObject 19 | stringp lispObject 20 | channelp lispObject 21 | numberOrMarkerp lispObject 22 | integerOrMarkerp lispObject 23 | charOrStringp lispObject 24 | hashTablep lispObject 25 | integerp lispObject 26 | bufferp lispObject 27 | keymapp lispObject 28 | characterp lispObject 29 | arrayp lispObject 30 | quote lispObject 31 | backquote lispObject 32 | comma lispObject 33 | commaAt lispObject 34 | function lispObject 35 | read lispObject 36 | equal lispObject 37 | eval lispObject 38 | setq lispObject 39 | prin1 lispObject 40 | readFromMinibuffer lispObject 41 | recursiveEdit lispObject 42 | charTablep lispObject 43 | reverse lispObject 44 | mapCar lispObject 45 | eql lispObject 46 | eq lispObject 47 | sxHashEq lispObject 48 | sxHashEql lispObject 49 | sxHashEqual lispObject 50 | sxHashEqualIncludingProperties lispObject 51 | 52 | // Errors 53 | error_ lispObject 54 | quit lispObject 55 | userError lispObject 56 | wrongLengthArgument lispObject 57 | wrongTypeArgument lispObject 58 | argsOutOfRange lispObject 59 | voidFunction lispObject 60 | invalidFunction lispObject 61 | voidVariable lispObject 62 | wrongNumberofArguments lispObject 63 | endOfFile lispObject 64 | noCatch lispObject 65 | settingConstant lispObject 66 | invalidReadSyntax lispObject 67 | pimacsUnimplemented lispObject 68 | circularList lispObject 69 | fileMissing lispObject 70 | arithError lispObject 71 | 72 | // Misc. symbols 73 | errorConditions lispObject 74 | errorMessage lispObject 75 | lambda lispObject 76 | closure lispObject 77 | macro lispObject 78 | andRest lispObject 79 | andOptional lispObject 80 | readChar lispObject 81 | charTableExtraSlots lispObject 82 | wholeNump lispObject 83 | cTest lispObject 84 | cSize lispObject 85 | cPureCopy lispObject 86 | cRehashSize lispObject 87 | cRehashThreshold lispObject 88 | cWeakness lispObject 89 | key lispObject 90 | value lispObject 91 | hashTableTest lispObject 92 | keyOrValue lispObject 93 | keyAndValue lispObject 94 | variableDocumentation lispObject 95 | riskyLocalVariable lispObject 96 | emacs lispObject 97 | subfeatures lispObject 98 | keymap lispObject 99 | autoload lispObject 100 | } 101 | 102 | type vars struct { 103 | // Variables with static Go values 104 | nonInteractive forwardBool 105 | standardOutput forwardLispObj 106 | standardInput forwardLispObj 107 | loadPath forwardLispObj 108 | pimacsRepo forwardLispObj 109 | features forwardLispObj 110 | systemType forwardLispObj 111 | metaPrefixChar forwardLispObj 112 | } 113 | 114 | func (ec *execContext) initSymbols() { 115 | s := ec.s 116 | 117 | // Set up nil and unbound first so that we can use ec.defSym() 118 | // and other symbol-related functions 119 | unbound := ec.makeSymbol(newString("unbound", false), false) 120 | nil_ := ec.makeSymbol(newString("nil", false), false) 121 | 122 | // Set their attributes 123 | unbound.setAttributes(unbound, nil_, nil_, false) 124 | nil_.setAttributes(nil_, nil_, nil_, true) 125 | 126 | // Intern nil 127 | ec.obarray.loadOrStoreSymbol(nil_) 128 | 129 | // nil and unbound are now complete, next up set them in 130 | // execContext.symbols 131 | s.unbound = unbound 132 | s.nil_ = nil_ 133 | 134 | // Create t 135 | t := ec.defSym(&s.t, "t") 136 | t.val = t 137 | t.special = true 138 | s.t = t 139 | 140 | // Set up convenience accessors in execContext 141 | ec.t = s.t 142 | ec.nil_ = s.nil_ 143 | } 144 | 145 | func (ec *execContext) checkSymbolValues() { 146 | v := reflect.ValueOf(*ec.s) 147 | 148 | for i := 0; i < v.NumField(); i++ { 149 | field := v.Field(i) 150 | if field.IsNil() { 151 | ec.terminate("initialization error: symbol not initialized: 'symbols.%+v'", v.Type().Field(i).Name) 152 | } 153 | } 154 | } 155 | 156 | func (ec *execContext) checkVarValues() { 157 | v := reflect.ValueOf(*ec.v) 158 | 159 | for i := 0; i < v.NumField(); i++ { 160 | field := v.Field(i) 161 | 162 | sym := field.FieldByName("sym") 163 | if sym == (reflect.Value{}) { 164 | ec.terminate("initialization error: invalid forward type: 'vars.%+v'", v.Type().Field(i).Name) 165 | } else if sym.IsNil() { 166 | ec.terminate("initialization error: forward value not initialized: 'vars.%+v'", v.Type().Field(i).Name) 167 | } 168 | } 169 | } 170 | -------------------------------------------------------------------------------- /core/character_table_test.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "testing" 5 | ) 6 | 7 | func TestCharTableSet(t *testing.T) { 8 | t.Parallel() 9 | ec := newTestingInterpreter().ec 10 | maxChar := runeToLispInt(maxChar) 11 | 12 | type insertion struct { 13 | from, to lispInt 14 | text string 15 | } 16 | 17 | type testCase struct { 18 | insertions []insertion 19 | expected []lispCharTableEntry 20 | } 21 | 22 | cases := []testCase{ 23 | { 24 | insertions: []insertion{}, 25 | expected: []lispCharTableEntry{}, 26 | }, 27 | { 28 | insertions: []insertion{ 29 | {0, 1, "foo"}, 30 | }, 31 | expected: []lispCharTableEntry{ 32 | {0, 1, newString("foo", false)}, 33 | }, 34 | }, 35 | { 36 | insertions: []insertion{ 37 | {0, 0, "foo"}, 38 | {1, 1, "x"}, 39 | {4, 4, "y"}, 40 | }, 41 | expected: []lispCharTableEntry{ 42 | {0, 0, newUniOrMultibyteString("foo")}, 43 | {1, 1, newUniOrMultibyteString("x")}, 44 | {4, 4, newUniOrMultibyteString("y")}, 45 | }, 46 | }, 47 | { 48 | insertions: []insertion{ 49 | {0, 0, "foo"}, 50 | {1, 1, "x"}, 51 | {4, 4, "y"}, 52 | {0, 10, "--"}, 53 | }, 54 | expected: []lispCharTableEntry{ 55 | {0, 10, newUniOrMultibyteString("--")}, 56 | }, 57 | }, 58 | { 59 | insertions: []insertion{ 60 | {10, 20, "foo"}, 61 | {15, 25, "foo"}, 62 | }, 63 | expected: []lispCharTableEntry{ 64 | {10, 14, newUniOrMultibyteString("foo")}, 65 | {15, 25, newUniOrMultibyteString("foo")}, 66 | }, 67 | }, 68 | { 69 | insertions: []insertion{ 70 | {0, 1, "foo"}, 71 | {2, 10, "bar"}, 72 | }, 73 | expected: []lispCharTableEntry{ 74 | {0, 1, newUniOrMultibyteString("foo")}, 75 | {2, 10, newUniOrMultibyteString("bar")}, 76 | }, 77 | }, 78 | { 79 | insertions: []insertion{ 80 | {0, 1, "foo"}, 81 | {1, 10, "bar"}, 82 | }, 83 | expected: []lispCharTableEntry{ 84 | {0, 0, newUniOrMultibyteString("foo")}, 85 | {1, 10, newUniOrMultibyteString("bar")}, 86 | }, 87 | }, 88 | { 89 | insertions: []insertion{ 90 | {0, 10, "foo"}, 91 | {5, 15, "bar"}, 92 | }, 93 | expected: []lispCharTableEntry{ 94 | {0, 4, newUniOrMultibyteString("foo")}, 95 | {5, 15, newUniOrMultibyteString("bar")}, 96 | }, 97 | }, 98 | { 99 | insertions: []insertion{ 100 | {0, 10, "foo"}, 101 | {5, 15, "bar"}, 102 | {0, 15, "x"}, 103 | }, 104 | expected: []lispCharTableEntry{ 105 | {0, 15, newUniOrMultibyteString("x")}, 106 | }, 107 | }, 108 | { 109 | insertions: []insertion{ 110 | {0, 20, "foo"}, 111 | {5, 15, "bar"}, 112 | }, 113 | expected: []lispCharTableEntry{ 114 | {0, 4, newUniOrMultibyteString("foo")}, 115 | {5, 15, newUniOrMultibyteString("bar")}, 116 | {16, 20, newUniOrMultibyteString("foo")}, 117 | }, 118 | }, 119 | { 120 | insertions: []insertion{ 121 | {0, maxChar, "foo"}, 122 | }, 123 | expected: []lispCharTableEntry{ 124 | {0, maxChar, newUniOrMultibyteString("foo")}, 125 | }, 126 | }, 127 | { 128 | insertions: []insertion{ 129 | {0, maxChar, "foo"}, 130 | {maxChar, maxChar, "x"}, 131 | }, 132 | expected: []lispCharTableEntry{ 133 | {0, maxChar - 1, newUniOrMultibyteString("foo")}, 134 | {maxChar, maxChar, newUniOrMultibyteString("x")}, 135 | }, 136 | }, 137 | { 138 | insertions: []insertion{ 139 | {0, maxChar, "foo"}, 140 | {10, 10, "bar"}, 141 | }, 142 | expected: []lispCharTableEntry{ 143 | {0, 9, newUniOrMultibyteString("foo")}, 144 | {10, 10, newUniOrMultibyteString("bar")}, 145 | {11, maxChar, newUniOrMultibyteString("foo")}, 146 | }, 147 | }, 148 | } 149 | 150 | for i, case_ := range cases { 151 | ct := xCharTable(xEnsure(ec.makeCharTable(ec.nil_, ec.nil_))) 152 | for _, ins := range case_.insertions { 153 | ec.charTableSet(ct, ins.from, ins.to, newUniOrMultibyteString(ins.text)) 154 | } 155 | 156 | if len(ct.val) != len(case_.expected) { 157 | t.Logf("entries length mismatch: case index %v", i) 158 | t.Logf("entries length mismatch: table dump: %+v", ct.val) 159 | t.FailNow() 160 | } 161 | 162 | for j := 0; j < len(ct.val); j++ { 163 | have := ct.val[j] 164 | want := case_.expected[j] 165 | 166 | if have.end != want.end || 167 | have.start != want.start || 168 | xStringValue(have.val) != xStringValue(want.val) { 169 | 170 | t.Logf("entry mismatch: have '%+v', want '%+v'", have, want) 171 | t.Logf("entry mismatch: case index %v, entry %v", i, j) 172 | t.Logf("entry mismatch: table dump: %+v", ct.val) 173 | t.FailNow() 174 | } 175 | } 176 | } 177 | } 178 | 179 | func TestCharTableLookup(t *testing.T) { 180 | t.Parallel() 181 | ec := newTestingInterpreter().ec 182 | ct := xCharTable(xEnsure(ec.makeCharTable(ec.nil_, ec.nil_))) 183 | 184 | ct.val = []lispCharTableEntry{ 185 | {start: 2, end: 10}, 186 | {start: 11, end: 20}, 187 | {start: 30, end: 31}, 188 | } 189 | 190 | type testCase struct { 191 | c lispInt 192 | expectedIdx int 193 | expectedFound bool 194 | } 195 | 196 | cases := []testCase{ 197 | {c: 0, expectedIdx: 0, expectedFound: false}, 198 | {c: 2, expectedIdx: 0, expectedFound: true}, 199 | {c: 5, expectedIdx: 0, expectedFound: true}, 200 | {c: 10, expectedIdx: 0, expectedFound: true}, 201 | {c: 11, expectedIdx: 1, expectedFound: true}, 202 | {c: 20, expectedIdx: 1, expectedFound: true}, 203 | {c: 21, expectedIdx: 2, expectedFound: false}, 204 | {c: 25, expectedIdx: 2, expectedFound: false}, 205 | {c: 30, expectedIdx: 2, expectedFound: true}, 206 | {c: 31, expectedIdx: 2, expectedFound: true}, 207 | {c: 35, expectedIdx: 3, expectedFound: false}, 208 | {c: 100, expectedIdx: 3, expectedFound: false}, 209 | } 210 | 211 | for i, case_ := range cases { 212 | idx, found := ec.charTableLookupInternal(ct, case_.c) 213 | if idx != case_.expectedIdx || found != case_.expectedFound { 214 | t.Logf("mismatched character table lookup: case index %v", i) 215 | t.Fail() 216 | } 217 | } 218 | } 219 | -------------------------------------------------------------------------------- /tools/extract/subroutines.py: -------------------------------------------------------------------------------- 1 | import json 2 | from pathlib import Path 3 | 4 | from pyparsing import ( 5 | Literal, 6 | Regex, 7 | QuotedString, 8 | SkipTo, 9 | Opt, 10 | StringStart, 11 | StringEnd, 12 | delimited_list, 13 | ) 14 | 15 | DEFUN_EXPR_IDENTIFIER = Regex(r"[0-9a-zA-Z_-]+") 16 | DEFUN_EXPR_NUMBER = Regex(r"[0-9]+") 17 | DEFUN_EXPR = ( 18 | StringStart() 19 | + Literal("DEFUN") 20 | + "(" 21 | + QuotedString('"')("lname") 22 | + "," 23 | + DEFUN_EXPR_IDENTIFIER("fnname") 24 | + "," 25 | + DEFUN_EXPR_IDENTIFIER("sname") 26 | + "," 27 | + (DEFUN_EXPR_NUMBER | DEFUN_EXPR_IDENTIFIER)("minargs") 28 | + "," 29 | + (DEFUN_EXPR_NUMBER | "MANY" | "UNEVALLED")("maxargs") 30 | + "," 31 | + (DEFUN_EXPR_NUMBER | QuotedString('"', esc_char="\\", multiline=True) | "NULL")( 32 | "intspec" 33 | ) 34 | + "," 35 | + "doc:" 36 | + "/*" 37 | + SkipTo("*/")("doc") 38 | + "*/" 39 | + Opt("attributes:" + (Literal("noreturn") | "const")("attributes")) 40 | + ")" 41 | + ( 42 | ( 43 | Literal("(") 44 | + ( 45 | delimited_list( 46 | Opt("register") + "Lisp_Object" + DEFUN_EXPR_IDENTIFIER("args*"), 47 | min=1, 48 | ) 49 | | "void" 50 | | Literal("ptrdiff_t nargs, Lisp_Object *args") 51 | | Literal("ptrdiff_t n, Lisp_Object *args") 52 | ) 53 | + ")" 54 | ) 55 | | StringEnd() 56 | ) 57 | ) 58 | EMACS_CONSTANTS = { 59 | "coding_arg_max": 13, 60 | "charset_arg_max": 17, 61 | } 62 | 63 | 64 | def process_defun(defun: dict) -> dict: 65 | val = defun["maxargs"] 66 | try: 67 | maxargs = int(val) 68 | if maxargs < 0 or maxargs > 8: 69 | raise ValueError(val) 70 | except ValueError: 71 | if val == "MANY": 72 | maxargs = -1 73 | elif val == "UNEVALLED": 74 | maxargs = -2 75 | else: 76 | raise ValueError(val) 77 | 78 | defun["maxargs"] = maxargs 79 | 80 | val = defun["minargs"] 81 | try: 82 | minargs = int(val) 83 | except ValueError: 84 | minargs = EMACS_CONSTANTS[val] 85 | 86 | defun["minargs"] = minargs 87 | defun["doc"] = defun["doc"].strip() 88 | defun["args"] = list(defun["args"]) if defun["args"] is not None else None 89 | 90 | return defun 91 | 92 | 93 | def extract_defuns(path: Path) -> list[dict]: 94 | with open(path) as f: 95 | contents = f.read() 96 | 97 | lines = contents.splitlines() 98 | current_defun = [] 99 | defuns = [] 100 | 101 | for line in lines: 102 | if line.startswith("DEFUN"): 103 | if current_defun: 104 | raise Exception( 105 | "Previous DEFUN not closed: " + "\n".join(current_defun) 106 | ) 107 | 108 | current_defun.append(line) 109 | elif line.startswith("{"): 110 | if not current_defun: 111 | continue 112 | 113 | defun = "\n".join(current_defun) 114 | current_defun.clear() 115 | 116 | try: 117 | parsed = DEFUN_EXPR.parse_string(defun, parse_all=True) 118 | except Exception: 119 | print(f"----- context: ----- (file: {path})") 120 | print(defun) 121 | print("--------------------") 122 | raise 123 | 124 | result = { 125 | "lname": parsed["lname"], 126 | "fnname": parsed["fnname"], 127 | "sname": parsed["sname"], 128 | "minargs": parsed["minargs"], 129 | "maxargs": parsed["maxargs"], 130 | "intspec": parsed["intspec"], 131 | "args": parsed.get("args"), 132 | "attributes": parsed.get("attributes"), 133 | "doc": parsed["doc"], 134 | "path": path.name, 135 | } 136 | 137 | defuns.append(process_defun(result)) 138 | elif current_defun: 139 | current_defun.append(line) 140 | 141 | if current_defun: 142 | raise Exception("Previous DEFUN not closed: " + "\n".join(current_defun)) 143 | 144 | return defuns 145 | 146 | 147 | def resolve_repeated(defuns: list[dict]) -> list[dict]: 148 | processed = {} 149 | 150 | for defun in defuns: 151 | lname = defun["lname"] 152 | prev = processed.get(lname) 153 | if prev: 154 | prev["maxargs"] = max(prev["maxargs"], defun["maxargs"]) 155 | 156 | for attr in ["minargs", "attributes", "intspec"]: 157 | if prev[attr] != defun[attr]: 158 | raise Exception(f"{attr} incompatibility for {lname}") 159 | 160 | prev["doc"] += "\n\n" + defun["doc"] 161 | else: 162 | processed[lname] = defun 163 | 164 | return sorted(processed.values(), key=lambda d: d["lname"]) 165 | 166 | 167 | def ignore_file(filename: str) -> bool: 168 | return any( 169 | [ 170 | filename == "msdos.c", 171 | filename == "dosfns.c", 172 | "android" in filename, 173 | "haiku" in filename, 174 | ] 175 | ) 176 | 177 | 178 | def extract_subroutines( 179 | pimacs_base: Path, emacs_base: Path, emacs_commit: str, emacs_branch: str 180 | ) -> None: 181 | all_defuns = [] 182 | 183 | for p in sorted(emacs_base.joinpath("src").rglob("*")): 184 | if not p.suffix == ".c" or ignore_file(p.name): 185 | continue 186 | 187 | defuns = extract_defuns(p) 188 | all_defuns.extend(defuns) 189 | 190 | all_defuns = resolve_repeated(all_defuns) 191 | 192 | target = pimacs_base / "test" / "data" / "emacs_subroutines.json" 193 | with open(target, "w") as f: 194 | data = { 195 | "subroutines": all_defuns, 196 | "stats": { 197 | "subroutines_count": len(all_defuns), 198 | "constants_count": len(EMACS_CONSTANTS), 199 | } 200 | } 201 | json.dump(data, f, indent=4, sort_keys=True) 202 | 203 | print("wrote", target) 204 | -------------------------------------------------------------------------------- /core/pimacs_tools.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import "fmt" 4 | 5 | const ( 6 | debugReprMaxDepth = 3 7 | debugReprLispStackMaxLineLen = 80 8 | debugReprLongStringLen = 25 9 | ) 10 | 11 | func debugRepr(objs ...lispObject) string { 12 | switch len(objs) { 13 | case 0: 14 | return "[]" 15 | case 1: 16 | return debugReprInternal(objs[0], debugReprMaxDepth) 17 | default: 18 | s := "[]lispObject{" 19 | for i, obj := range objs { 20 | s += debugReprInternal(obj, debugReprMaxDepth) 21 | if i < len(objs)-1 { 22 | s += ", " 23 | } 24 | } 25 | s += "}" 26 | return s 27 | } 28 | } 29 | 30 | func debugReprInternal(obj lispObject, depth int) string { 31 | if depth <= 0 { 32 | return "?" 33 | } 34 | depth-- 35 | 36 | if obj == nil { 37 | return "null" 38 | } 39 | 40 | switch obj.getType() { 41 | case lispTypeCons: 42 | list := true 43 | elems := 0 44 | tail := obj 45 | s := "(" 46 | 47 | for ; consp(tail); tail = xCdr(tail) { 48 | if tail != obj { 49 | s += " " 50 | } 51 | elems++ 52 | s += debugReprInternal(xCar(tail), depth) 53 | } 54 | 55 | if symbolp(tail) && xSymbolName(tail) == "nil" { 56 | s += ")" 57 | } else { 58 | list = false 59 | s += fmt.Sprintf(" . %v)", debugReprInternal(tail, depth)) 60 | } 61 | 62 | if list && elems == 2 { 63 | first := xCar(obj) 64 | val := xCar(xCdr(obj)) 65 | if symbolp(first) && xSymbolName(first) == "quote" { 66 | return fmt.Sprintf("'%v", debugReprInternal(val, depth)) 67 | } 68 | } 69 | 70 | return s 71 | case lispTypeFloat: 72 | return fmt.Sprintf("%v", xFloatValue(obj)) 73 | case lispTypeString: 74 | val := xStringValue(obj) 75 | if len(val) > debugReprLongStringLen { 76 | val = val[:debugReprLongStringLen] + "..." 77 | } 78 | return fmt.Sprintf("\"%v\"", val) 79 | case lispTypeInteger: 80 | return fmt.Sprintf("%v", xIntegerValue(obj)) 81 | case lispTypeSymbol: 82 | sym := xSymbol(obj) 83 | if sym.val == sym || sym.function == sym { 84 | return xSymbolName(sym) 85 | } 86 | 87 | s := fmt.Sprintf("%v", xSymbolName(sym)) 88 | 89 | val := "?" 90 | switch sym.redirect { 91 | case symbolRedirectPlain: 92 | val = debugReprInternal(sym.val, depth) 93 | case symbolRedirectFwd: 94 | val = "FWD" 95 | } 96 | if val == "unbound" { 97 | val = "" 98 | } 99 | 100 | fn := debugReprInternal(sym.function, depth) 101 | if fn == "nil" { 102 | fn = "" 103 | } 104 | 105 | if val != "" || fn != "" { 106 | s += "{" 107 | 108 | if val != "" { 109 | s += fmt.Sprintf("=%v", val) 110 | } 111 | 112 | if fn != "" { 113 | if val != "" { 114 | s += "," 115 | } 116 | s += fmt.Sprintf("f=%v", fn) 117 | } 118 | 119 | s += "}" 120 | } 121 | 122 | return s 123 | case lispTypeVector: 124 | s := "[" 125 | val := xVector(obj).val 126 | for i, elem := range val { 127 | s += debugReprInternal(elem, depth) 128 | if i < len(val)-1 { 129 | s += ", " 130 | } 131 | } 132 | return s + "]" 133 | case lispTypeBuffer: 134 | buf := xBuffer(obj) 135 | return fmt.Sprintf("buf(name=%v, live=%v)", buf.name, buf.live) 136 | case lispTypeSubroutine: 137 | subr := xSubroutine(obj) 138 | return fmt.Sprintf("subr(%v)", subr.name) 139 | case lispTypeCharTable: 140 | return fmt.Sprintf("chartab(subtype=%v)", xCharTable(obj).subtype) 141 | case lispTypeChannel: 142 | return fmt.Sprintf("channel(%v)", xChannel(obj).val) 143 | case lispTypeHashTable: 144 | table := xHashTable(obj) 145 | s := "hashtable{" 146 | i := 0 147 | for k, v := range table.val { 148 | s += fmt.Sprintf("%v: %v", k, v) 149 | if i < len(table.val)-1 { 150 | s += ", " 151 | } 152 | i++ 153 | } 154 | 155 | return s + "}" 156 | default: 157 | return "" 158 | } 159 | } 160 | 161 | func debugReprLispStack(stack []stackEntry) string { 162 | lispStack := "" 163 | for i := len(stack) - 1; i >= 0; i-- { 164 | 165 | switch elem := stack[i].(type) { 166 | case *stackEntryBacktrace: 167 | functionName := "" 168 | if symbolp(elem.function) { 169 | functionName = xSymbolName(elem.function) 170 | } 171 | 172 | lispStack += fmt.Sprintf(" - bt: %v(", functionName) 173 | 174 | for j, arg := range elem.args { 175 | printed := debugRepr(arg) 176 | if len(printed) > debugReprLispStackMaxLineLen { 177 | printed = printed[:debugReprLispStackMaxLineLen] + "[...]" 178 | } 179 | lispStack += printed 180 | 181 | if j < len(elem.args)-1 { 182 | lispStack += " " 183 | } 184 | } 185 | 186 | lispStack += ")" 187 | case *stackEntryLet: 188 | lispStack += fmt.Sprintf(" - let: %v = %v", debugRepr(elem.symbol), debugRepr(elem.oldVal)) 189 | case *stackEntryLetForwarded: 190 | lispStack += fmt.Sprintf(" - letfwd: %v = %v", debugRepr(elem.symbol), debugRepr(elem.oldVal)) 191 | default: 192 | lispStack += " - other" 193 | } 194 | 195 | if i > 0 { 196 | lispStack += "\n" 197 | } 198 | 199 | } 200 | return lispStack 201 | } 202 | 203 | func (ec *execContext) pimacsSymbolDebug(symbol lispObject) (lispObject, error) { 204 | if !symbolp(symbol) { 205 | return ec.wrongTypeArgument(ec.s.symbolp, symbol) 206 | } 207 | 208 | sym := xSymbol(symbol) 209 | val := xEnsure(ec.findSymbolValue(symbol)) 210 | fwd := ec.nil_ 211 | if sym.fwd != nil { 212 | fwd = sym.fwd.value(ec) 213 | } 214 | 215 | return ec.makeKwPlist(map[string]lispObject{ 216 | "value": val, 217 | "function": sym.function, 218 | "name": sym.name, 219 | "special": xEnsure(ec.bool(sym.special)), 220 | "plist": sym.plist, 221 | "redirect": newInteger(lispInt(sym.redirect)), 222 | "fwd": fwd, 223 | }) 224 | } 225 | 226 | func (ec *execContext) pimacsDebugRepr(objs ...lispObject) (lispObject, error) { 227 | return newString(debugRepr(objs...), true), nil 228 | } 229 | 230 | func (ec *execContext) symbolsOfPimacsTools() { 231 | ec.defVarLisp( 232 | &ec.v.pimacsRepo, 233 | "pimacs--repo", 234 | newString("https://github.com/federicotdn/pimacs", false), 235 | ) 236 | 237 | ec.defSubr1(nil, "pimacs--symbol-debug", (*execContext).pimacsSymbolDebug, 1) 238 | ec.defSubrM(nil, "pimacs--debug-repr", (*execContext).pimacsDebugRepr, 0) 239 | ec.defSubrM(nil, "dr", (*execContext).pimacsDebugRepr, 0) 240 | } 241 | -------------------------------------------------------------------------------- /core/character_table.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "slices" 5 | ) 6 | 7 | func (ec *execContext) makeCharTable(purpose, init lispObject) (lispObject, error) { 8 | if !symbolp(purpose) { 9 | return ec.wrongTypeArgument(ec.s.symbolp, purpose) 10 | } 11 | 12 | n, err := ec.get(purpose, ec.s.charTableExtraSlots) 13 | if err != nil { 14 | return nil, err 15 | } 16 | 17 | extra := lispInt(0) 18 | if n != ec.nil_ { 19 | if naturalp(n) && xIntegerValue(n) <= 10 { 20 | extra = xIntegerValue(n) 21 | } else { 22 | return ec.wrongTypeArgument(ec.s.wholeNump, n) 23 | } 24 | } 25 | 26 | return &lispCharTable{ 27 | subtype: xSymbol(purpose), 28 | defaultVal: init, 29 | extraSlots: extra, 30 | }, nil 31 | } 32 | 33 | func (ec *execContext) charTableLookupInternal(table *lispCharTable, c lispInt) (int, bool) { 34 | cmp := func(e lispCharTableEntry, v lispInt) int { 35 | return int(e.start - v) 36 | } 37 | index, found := slices.BinarySearchFunc(table.val, c, cmp) 38 | if found { 39 | // Found an entry with .start == c 40 | return index, true 41 | } 42 | 43 | if index > 0 && table.val[index-1].contains(c) { 44 | // Went one element back and it contains c 45 | return index - 1, true 46 | } 47 | 48 | return index, false 49 | } 50 | 51 | func (ec *execContext) charTableSet(table *lispCharTable, from, to lispInt, value lispObject) { 52 | if to < from { 53 | to = from 54 | } 55 | rep := []lispCharTableEntry{{start: from, end: to, val: value}} 56 | index, found := ec.charTableLookupInternal(table, from) 57 | elem := lispCharTableEntry{start: -1, end: -1} 58 | 59 | if !found && index > 0 { 60 | elem = table.val[index-1] 61 | } else if len(table.val) > 0 { 62 | elem = table.val[index] 63 | } 64 | 65 | if elem.contains(from) && elem.start < from { 66 | rep = append([]lispCharTableEntry{{ 67 | start: elem.start, 68 | end: from - 1, 69 | val: elem.val, 70 | }}, rep...) 71 | } 72 | 73 | index2, found := ec.charTableLookupInternal(table, to) 74 | 75 | if !found && index2 > 0 { 76 | elem = table.val[index2-1] 77 | } else if len(table.val) > 0 { 78 | elem = table.val[index2] 79 | } 80 | 81 | if elem.contains(to) && to < elem.end { 82 | rep = append(rep, lispCharTableEntry{ 83 | start: to + 1, 84 | end: elem.end, 85 | val: elem.val, 86 | }) 87 | } 88 | 89 | if index2 < len(table.val) { 90 | index2++ 91 | } 92 | table.val = slices.Replace(table.val, index, index2, rep...) 93 | } 94 | 95 | func (ec *execContext) charTableLookup(table *lispCharTable, c lispInt) (lispObject, error) { 96 | val := ec.nil_ 97 | index, found := ec.charTableLookupInternal(table, c) 98 | if found { 99 | val = table.val[index].val 100 | } 101 | if val == ec.nil_ { 102 | val = table.defaultVal 103 | } 104 | 105 | // Can use Go nil here because table.parent is *lispCharTable 106 | if val == ec.nil_ && table.parent != nil { 107 | return ec.charTableLookup(table.parent, c) 108 | } 109 | 110 | return val, nil 111 | } 112 | 113 | func (ec *execContext) charTableRange(table, range_ lispObject) (lispObject, error) { 114 | if !chartablep(table) { 115 | return ec.wrongTypeArgument(ec.s.charTablep, table) 116 | } 117 | 118 | ct := xCharTable(table) 119 | 120 | if range_ == ec.nil_ { 121 | return ct.defaultVal, nil 122 | } else if characterp(range_) { 123 | c := xIntegerValue(range_) 124 | return ec.charTableLookup(ct, c) 125 | } else if consp(range_) { 126 | if !characterp(xCar(range_)) { 127 | return ec.wrongTypeArgument(ec.s.characterp, xCar(range_)) 128 | } else if !characterp(xCdr(range_)) { 129 | return ec.wrongTypeArgument(ec.s.characterp, xCdr(range_)) 130 | } 131 | 132 | // Even though we have received a cons of (FROM . TO), we only use 133 | // the FROM part - Emacs does the same-ish. 134 | // See: https://lists.gnu.org/archive/html/emacs-devel/2023-09/msg00014.html 135 | from := xIntegerValue(xCar(range_)) 136 | return ec.charTableLookup(ct, from) 137 | } else { 138 | return ec.signalError("Invalid RANGE argument to `char-table-range'") 139 | } 140 | } 141 | 142 | func (ec *execContext) setCharTableRange(table, range_, value lispObject) (lispObject, error) { 143 | if !chartablep(table) { 144 | return ec.wrongTypeArgument(ec.s.charTablep, table) 145 | } 146 | 147 | ct := xCharTable(table) 148 | 149 | if range_ == ec.t { 150 | ec.charTableSet(ct, 0, runeToLispInt(maxChar), value) 151 | } else if range_ == ec.nil_ { 152 | ct.defaultVal = value 153 | } else if characterp(range_) { 154 | c := xInteger(range_) 155 | ec.charTableSet(ct, c.val, c.val, value) 156 | } else if consp(range_) { 157 | if !characterp(xCar(range_)) { 158 | return ec.wrongTypeArgument(ec.s.characterp, xCar(range_)) 159 | } else if !characterp(xCdr(range_)) { 160 | return ec.wrongTypeArgument(ec.s.characterp, xCdr(range_)) 161 | } 162 | 163 | ec.charTableSet(ct, xIntegerValue(xCar(range_)), xIntegerValue(xCdr(range_)), value) 164 | } else { 165 | return ec.signalError("Invalid RANGE argument to `set-char-table-range'") 166 | } 167 | 168 | return value, nil 169 | } 170 | 171 | func (ec *execContext) charTableParent(table lispObject) (lispObject, error) { 172 | if !chartablep(table) { 173 | return ec.wrongTypeArgument(ec.s.charTablep, table) 174 | } 175 | 176 | parent := xCharTable(table).parent 177 | if parent == nil { 178 | return ec.nil_, nil 179 | } 180 | return parent, nil 181 | } 182 | 183 | func (ec *execContext) setCharTableParent(table, parent lispObject) (lispObject, error) { 184 | if !chartablep(table) { 185 | return ec.wrongTypeArgument(ec.s.charTablep, table) 186 | } 187 | if parent != ec.nil_ { 188 | if !chartablep(parent) { 189 | return ec.wrongTypeArgument(ec.s.charTablep, parent) 190 | } 191 | 192 | for temp := xCharTable(parent); temp != nil; temp = temp.parent { 193 | if table == temp { 194 | return ec.signalError("Attempt to make a chartable be its own parent") 195 | } 196 | } 197 | } 198 | 199 | xCharTable(table).parent = xCharTable(parent) 200 | return parent, nil 201 | } 202 | 203 | func (ec *execContext) symbolsOfCharacterTable() { 204 | ec.defSym(&ec.s.charTableExtraSlots, "char-table-extra-slots") 205 | 206 | ec.defSubr2(nil, "make-char-table", (*execContext).makeCharTable, 1) 207 | ec.defSubr2(nil, "char-table-range", (*execContext).charTableRange, 2) 208 | ec.defSubr3(nil, "set-char-table-range", (*execContext).setCharTableRange, 3) 209 | ec.defSubr1(nil, "char-table-parent", (*execContext).charTableParent, 1) 210 | ec.defSubr2(nil, "set-char-table-parent", (*execContext).setCharTableParent, 2) 211 | } 212 | -------------------------------------------------------------------------------- /core/print.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "fmt" 5 | "strconv" 6 | "strings" 7 | ) 8 | 9 | func (ec *execContext) printStringE(str string, printCharFn lispObject, err error) error { 10 | if err != nil { 11 | return err 12 | } 13 | return ec.printString(str, printCharFn) 14 | } 15 | 16 | func (ec *execContext) printString(str string, printCharFn lispObject) error { 17 | if printCharFn == ec.nil_ { 18 | _, err := ec.insert(newString(str, true)) 19 | return err 20 | } 21 | 22 | if ec.v.nonInteractive.val && printCharFn == ec.t { 23 | fmt.Printf("%v", str) 24 | return nil 25 | } 26 | 27 | if printCharFn == ec.t { 28 | return xErrOnly(ec.pimacsUnimplemented(ec.s.prin1, "unknown print char function")) 29 | } 30 | 31 | _, err := ec.funcall(printCharFn, newString(str, true)) 32 | return err 33 | } 34 | 35 | func (ec *execContext) printInternalE(obj, printCharFn lispObject, escapeFlag bool, err error) error { 36 | if err != nil { 37 | return err 38 | } 39 | return ec.printInternal(obj, printCharFn, escapeFlag) 40 | } 41 | 42 | func (ec *execContext) printInternal(obj, printCharFn lispObject, escapeFlag bool) error { 43 | lispType := obj.getType() 44 | var s string 45 | 46 | switch lispType { 47 | case lispTypeSymbol: 48 | s = xSymbolName(obj) 49 | if s == "" { 50 | s = "##" 51 | break 52 | } 53 | 54 | confusing := false 55 | if _, err := strconv.ParseFloat(s, 64); err == nil { 56 | confusing = true 57 | } 58 | if strings.HasPrefix(s, ".") || strings.HasPrefix(s, "?") || strings.HasPrefix(s, "\\") { 59 | confusing = true 60 | } 61 | 62 | if confusing && escapeFlag { 63 | s = "\\" + s 64 | } 65 | case lispTypeInteger: 66 | s = fmt.Sprint(xIntegerValue(obj)) 67 | case lispTypeString: 68 | if escapeFlag { 69 | s = "\"" + xStringValue(obj) + "\"" 70 | } else { 71 | s = xStringValue(obj) 72 | } 73 | case lispTypeCons: 74 | err := ec.printString("(", printCharFn) 75 | for ; consp(obj); obj = xCdr(obj) { 76 | err = ec.printInternalE(xCar(obj), printCharFn, escapeFlag, err) 77 | if xCdr(obj) != ec.nil_ { 78 | err = ec.printStringE(" ", printCharFn, err) 79 | } 80 | } 81 | 82 | if obj != ec.nil_ { 83 | err = ec.printStringE(". ", printCharFn, err) 84 | err = ec.printInternalE(obj, printCharFn, escapeFlag, err) 85 | } 86 | 87 | return ec.printStringE(")", printCharFn, err) 88 | case lispTypeFloat: 89 | s = fmt.Sprint(xFloat(obj).val) 90 | case lispTypeVector: 91 | err := ec.printString("[", printCharFn) 92 | vec := xVector(obj) 93 | for i, obj := range vec.val { 94 | err = ec.printInternalE(obj, printCharFn, escapeFlag, err) 95 | 96 | if i < len(vec.val)-1 { 97 | err = ec.printStringE(" ", printCharFn, err) 98 | } 99 | } 100 | return ec.printStringE("]", printCharFn, err) 101 | case lispTypeCharTable: 102 | // Thread err through each print*E call so that we don't have to 103 | // check err a million times 104 | ct := xCharTable(obj) 105 | err := ec.printString("#^[", printCharFn) 106 | err = ec.printInternalE(ct.subtype, printCharFn, escapeFlag, err) 107 | err = ec.printStringE(" ", printCharFn, err) 108 | err = ec.printInternalE(ct.defaultVal, printCharFn, escapeFlag, err) 109 | err = ec.printStringE(" ", printCharFn, err) 110 | err = ec.printInternalE(newInteger(ct.extraSlots), printCharFn, escapeFlag, err) 111 | err = ec.printStringE(" ", printCharFn, err) 112 | 113 | parent := ec.nil_ 114 | if ct.parent != nil { 115 | parent = ct.parent 116 | } 117 | err = ec.printInternalE(parent, printCharFn, escapeFlag, err) 118 | 119 | for _, elem := range ct.val { 120 | err = ec.printStringE(" ", printCharFn, err) 121 | vec := []lispObject{ 122 | newInteger(elem.start), 123 | newInteger(elem.end), 124 | elem.val, 125 | } 126 | err = ec.printInternalE(newVector(vec), printCharFn, escapeFlag, err) 127 | } 128 | 129 | return ec.printStringE("]", printCharFn, err) 130 | case lispTypeBuffer: 131 | s = fmt.Sprintf("#", xBuffer(obj).name) 132 | case lispTypeChannel: 133 | s = "#" 134 | case lispTypeHashTable: 135 | table := xHashTable(obj) 136 | size := len(table.val) 137 | s = fmt.Sprintf("#", xSymbolName(table.test.name), size, size, &table.val) 138 | default: 139 | s = fmt.Sprintf("#", obj) 140 | } 141 | 142 | err := ec.printString(s, printCharFn) 143 | if err != nil { 144 | return err 145 | } 146 | 147 | return nil 148 | } 149 | 150 | func (ec *execContext) prin1ToString(obj, noEscape, overrides lispObject) (lispObject, error) { 151 | // TODO: Should this buffer be created via get-buffer-create? 152 | // Needs to be hidden from buffer list though 153 | bufObj := newBuffer(newString(" prin1", false)) 154 | 155 | _, err := ec.prin1(obj, bufObj, ec.nil_) 156 | if err != nil { 157 | return nil, err 158 | } 159 | 160 | return newString(bufObj.contents, true), nil 161 | } 162 | 163 | func (ec *execContext) printGeneric(obj, printCharFn lispObject, escapeFlag, newlines bool) (lispObject, error) { 164 | if printCharFn == ec.nil_ { 165 | printCharFn = ec.v.standardOutput.val 166 | } 167 | 168 | if printCharFn == ec.nil_ { 169 | printCharFn = ec.t 170 | } 171 | 172 | defer ec.unwind()() 173 | if bufferp(printCharFn) { 174 | ec.stackPushCurrentBuffer() 175 | _, err := ec.setBuffer(printCharFn) 176 | if err != nil { 177 | return nil, err 178 | } 179 | 180 | printCharFn = ec.nil_ 181 | } 182 | 183 | if newlines { 184 | err := ec.printString("\n", printCharFn) 185 | if err != nil { 186 | return nil, err 187 | } 188 | } 189 | 190 | err := ec.printInternal(obj, printCharFn, escapeFlag) 191 | if err != nil { 192 | return nil, err 193 | } 194 | 195 | if newlines { 196 | err := ec.printString("\n", printCharFn) 197 | if err != nil { 198 | return nil, err 199 | } 200 | } 201 | 202 | return obj, nil 203 | } 204 | 205 | func (ec *execContext) prin1(obj, printCharFn, overrides lispObject) (lispObject, error) { 206 | return ec.printGeneric(obj, printCharFn, true, false) 207 | } 208 | 209 | func (ec *execContext) print_(obj, printCharFn lispObject) (lispObject, error) { 210 | return ec.printGeneric(obj, printCharFn, true, true) 211 | } 212 | 213 | func (ec *execContext) princ(obj, printCharFn lispObject) (lispObject, error) { 214 | return ec.printGeneric(obj, printCharFn, false, false) 215 | } 216 | 217 | func (ec *execContext) symbolsOfPrint() { 218 | ec.defVarLisp(&ec.v.standardOutput, "standard-output", ec.t) 219 | 220 | ec.defSubr3(&ec.s.prin1, "prin1", (*execContext).prin1, 1) 221 | ec.defSubr2(nil, "print", (*execContext).print_, 1) 222 | ec.defSubr2(nil, "princ", (*execContext).princ, 1) 223 | ec.defSubr3(nil, "prin1-to-string", (*execContext).prin1ToString, 1) 224 | } 225 | -------------------------------------------------------------------------------- /core/helpers.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "reflect" 5 | ) 6 | 7 | // General helpers // 8 | 9 | func xEnsure(obj lispObject, err error) lispObject { 10 | if err != nil { 11 | terminate("cannot return value due to error: '%+v'", err) 12 | } 13 | 14 | return obj 15 | } 16 | 17 | func xErrOnly(obj lispObject, err error) error { 18 | if obj != nil { 19 | terminate("was handed a non-nil Lisp object: '%+v'", obj) 20 | } 21 | 22 | return err 23 | } 24 | 25 | func xCast[T lispObject](obj lispObject, typeName string) T { 26 | val, ok := obj.(T) 27 | if !ok { 28 | terminate("object is not a %v: '%+v'", typeName, obj) 29 | } 30 | 31 | return val 32 | } 33 | 34 | // Symbol helpers // 35 | 36 | func symbolp(obj lispObject) bool { 37 | return obj.getType() == lispTypeSymbol 38 | } 39 | 40 | func xSymbol(obj lispObject) *lispSymbol { 41 | return xCast[*lispSymbol](obj, "symbol") 42 | } 43 | 44 | func xSymbolName(obj lispObject) string { 45 | return xStringValue(xSymbol(obj).name) 46 | } 47 | 48 | // Cons helpers // 49 | 50 | func consp(obj lispObject) bool { 51 | return obj.getType() == lispTypeCons 52 | } 53 | 54 | func xCons(obj lispObject) *lispCons { 55 | return xCast[*lispCons](obj, "cons") 56 | } 57 | 58 | func xCarCdr(obj lispObject) (lispObject, lispObject) { 59 | cons := xCons(obj) 60 | return cons.car, cons.cdr 61 | } 62 | 63 | func xCar(obj lispObject) lispObject { 64 | return xCons(obj).car 65 | } 66 | 67 | func xCdr(obj lispObject) lispObject { 68 | return xCons(obj).cdr 69 | } 70 | 71 | func xCadr(obj lispObject) lispObject { 72 | return xCar(xCdr(obj)) 73 | } 74 | 75 | func xCddr(obj lispObject) lispObject { 76 | return xCdr(xCdr(obj)) 77 | } 78 | 79 | func xCdddr(obj lispObject) lispObject { 80 | return xCdr(xCdr(xCdr(obj))) 81 | } 82 | 83 | func xSetCar(cell, newCar lispObject) lispObject { 84 | xCons(cell).car = newCar 85 | return newCar 86 | } 87 | 88 | func xSetCdr(cell, newCdr lispObject) lispObject { 89 | xCons(cell).cdr = newCdr 90 | return newCdr 91 | } 92 | 93 | func newCons(car lispObject, cdr lispObject) *lispCons { 94 | return &lispCons{ 95 | car: car, 96 | cdr: cdr, 97 | } 98 | } 99 | 100 | // Subroutine helpers // 101 | 102 | func subroutinep(obj lispObject) bool { 103 | return obj.getType() == lispTypeSubroutine 104 | } 105 | 106 | func xSubroutine(obj lispObject) *lispSubroutine { 107 | return xCast[*lispSubroutine](obj, "subroutine") 108 | } 109 | 110 | // Vector helpers // 111 | 112 | func vectorp(obj lispObject) bool { 113 | return obj.getType() == lispTypeVector 114 | } 115 | 116 | func xVector(obj lispObject) *lispVector { 117 | return xCast[*lispVector](obj, "vector") 118 | } 119 | 120 | func xVectorValue(obj lispObject) []lispObject { 121 | return xVector(obj).val 122 | } 123 | 124 | func newVector(val []lispObject) *lispVector { 125 | return &lispVector{val: val} 126 | } 127 | 128 | // Buffer helpers // 129 | 130 | func bufferp(obj lispObject) bool { 131 | return obj.getType() == lispTypeBuffer 132 | } 133 | 134 | func xBuffer(obj lispObject) *lispBuffer { 135 | return xCast[*lispBuffer](obj, "buffer") 136 | } 137 | 138 | func newBuffer(name lispObject) *lispBuffer { 139 | return &lispBuffer{name: name, live: true} 140 | } 141 | 142 | // Char Table helpers // 143 | 144 | func chartablep(obj lispObject) bool { 145 | return obj.getType() == lispTypeCharTable 146 | } 147 | 148 | func xCharTable(obj lispObject) *lispCharTable { 149 | return xCast[*lispCharTable](obj, "character table") 150 | } 151 | 152 | // String helpers // 153 | 154 | func stringp(obj lispObject) bool { 155 | return obj.getType() == lispTypeString 156 | } 157 | 158 | func xString(obj lispObject) *lispString { 159 | return xCast[*lispString](obj, "string") 160 | } 161 | 162 | func xStringMultibytep(obj lispObject) bool { 163 | return xString(obj).multibytep() 164 | } 165 | 166 | func xStringValue(obj lispObject) string { 167 | return xString(obj).str() 168 | } 169 | 170 | func xStringEmptyp(obj lispObject) bool { 171 | return xString(obj).emptyp() 172 | } 173 | 174 | func xStringSize(obj lispObject) int { 175 | return xString(obj).size() 176 | } 177 | 178 | func xStringAref(obj lispObject, index int) (lispInt, error) { 179 | return xString(obj).aref(index) 180 | } 181 | 182 | // Integer helpers // 183 | 184 | func integerp(obj lispObject) bool { 185 | return obj.getType() == lispTypeInteger 186 | } 187 | 188 | func xInteger(obj lispObject) *lispInteger { 189 | return xCast[*lispInteger](obj, "integer") 190 | } 191 | 192 | func xIntegerValue(obj lispObject) lispInt { 193 | return xInteger(obj).val 194 | } 195 | 196 | func xIntegerRune(obj lispObject) rune { 197 | return lispIntToRune(xIntegerValue(obj)) 198 | } 199 | 200 | func newInteger(val lispInt) *lispInteger { 201 | return &lispInteger{ 202 | val: val, 203 | } 204 | } 205 | 206 | // Float helpers // 207 | 208 | func floatp(obj lispObject) bool { 209 | return obj.getType() == lispTypeFloat 210 | } 211 | 212 | func xFloat(obj lispObject) *lispFloat { 213 | return xCast[*lispFloat](obj, "float") 214 | } 215 | 216 | func xFloatValue(obj lispObject) lispFp { 217 | return xFloat(obj).val 218 | } 219 | 220 | func newFloat(val lispFp) *lispFloat { 221 | return &lispFloat{ 222 | val: val, 223 | } 224 | } 225 | 226 | // Channel helpers // 227 | 228 | func channelp(obj lispObject) bool { 229 | return obj.getType() == lispTypeChannel 230 | } 231 | 232 | func xChannel(obj lispObject) *lispChannel { 233 | return xCast[*lispChannel](obj, "channel") 234 | } 235 | 236 | // Marker helpers // 237 | 238 | func markerp(obj lispObject) bool { 239 | return obj.getType() == lispTypeMarker 240 | } 241 | 242 | // Hash table helpers // 243 | 244 | func hashtablep(obj lispObject) bool { 245 | return obj.getType() == lispTypeHashTable 246 | } 247 | 248 | func xHashTable(obj lispObject) *lispHashTable { 249 | return xCast[*lispHashTable](obj, "hash table") 250 | } 251 | 252 | // Cross-type helpers // 253 | 254 | func numberp(obj lispObject) bool { 255 | return integerp(obj) || floatp(obj) 256 | } 257 | 258 | func characterp(obj lispObject) bool { 259 | if !integerp(obj) { 260 | return false 261 | } 262 | return charValidp(xIntegerRune(obj)) 263 | } 264 | 265 | func arrayp(obj lispObject) bool { 266 | // TODO: Add more types 267 | return vectorp(obj) || stringp(obj) 268 | } 269 | 270 | func naturalp(obj lispObject) bool { 271 | return integerp(obj) && xIntegerValue(obj) >= 0 272 | } 273 | 274 | func numberOrMarkerp(obj lispObject) bool { 275 | return numberp(obj) || markerp(obj) 276 | } 277 | 278 | func integerOrMarkerp(obj lispObject) bool { 279 | return integerp(obj) || markerp(obj) 280 | } 281 | 282 | // Misc. Lisp Object utilities // 283 | 284 | func objAddr(obj lispObject) lispInt { 285 | u := reflect.ValueOf(obj).Pointer() 286 | return lispInt(u) 287 | } 288 | -------------------------------------------------------------------------------- /lisp/emacs/emacs-lisp/backquote.el: -------------------------------------------------------------------------------- 1 | ;;; backquote.el --- implement the ` Lisp construct -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 1990, 1992, 1994, 2001-2024 Free Software Foundation, 4 | ;; Inc. 5 | 6 | ;; Author: Rick Sladkey 7 | ;; Maintainer: emacs-devel@gnu.org 8 | ;; Keywords: extensions, internal 9 | ;; Package: emacs 10 | 11 | ;; This file is part of GNU Emacs. 12 | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify 14 | ;; it under the terms of the GNU General Public License as published by 15 | ;; the Free Software Foundation, either version 3 of the License, or 16 | ;; (at your option) any later version. 17 | 18 | ;; GNU Emacs is distributed in the hope that it will be useful, 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 | ;; GNU General Public License for more details. 22 | 23 | ;; You should have received a copy of the GNU General Public License 24 | ;; along with GNU Emacs. If not, see . 25 | 26 | ;;; Commentary: 27 | 28 | ;; When the Lisp reader sees `(...), it generates (\` (...)). 29 | ;; When it sees ,... inside such a backquote form, it generates (\, ...). 30 | ;; For ,@... it generates (\,@ ...). 31 | 32 | ;; This backquote will generate calls to the backquote-list* form. 33 | ;; Both a function version and a macro version are included. 34 | ;; The macro version is used by default because it is faster 35 | ;; and needs no run-time support. It should really be a subr. 36 | 37 | ;;; Code: 38 | 39 | (provide 'backquote) 40 | 41 | ;; function and macro versions of backquote-list* 42 | 43 | (defun backquote-list*-function (first &rest list) 44 | "Like `list' but the last argument is the tail of the new list. 45 | 46 | For example (backquote-list* \\='a \\='b \\='c) => (a b . c)" 47 | ;; The recursive solution is much nicer: 48 | ;; (if list (cons first (apply 'backquote-list*-function list)) first)) 49 | ;; but Emacs is not very good at efficiently processing recursion. 50 | (if list 51 | (let* ((rest list) (newlist (cons first nil)) (last newlist)) 52 | (while (cdr rest) 53 | (setcdr last (cons (car rest) nil)) 54 | (setq last (cdr last) 55 | rest (cdr rest))) 56 | (setcdr last (car rest)) 57 | newlist) 58 | first)) 59 | 60 | (defmacro backquote-list*-macro (first &rest list) 61 | "Like `list' but the last argument is the tail of the new list. 62 | 63 | For example (backquote-list* \\='a \\='b \\='c) => (a b . c)" 64 | ;; The recursive solution is much nicer: 65 | ;; (if list (list 'cons first (cons 'backquote-list*-macro list)) first)) 66 | ;; but Emacs is not very good at efficiently processing such things. 67 | (setq list (nreverse (cons first list)) 68 | first (car list) 69 | list (cdr list)) 70 | (if list 71 | (let* ((second (car list)) 72 | (rest (cdr list)) 73 | (newlist (list 'cons second first))) 74 | (while rest 75 | (setq newlist (list 'cons (car rest) newlist) 76 | rest (cdr rest))) 77 | newlist) 78 | first)) 79 | 80 | (defalias 'backquote-list* (symbol-function 'backquote-list*-macro)) 81 | 82 | ;; A few advertised variables that control which symbols are used 83 | ;; to represent the backquote, unquote, and splice operations. 84 | (defconst backquote-backquote-symbol '\` 85 | "Symbol used to represent a backquote or nested backquote.") 86 | 87 | (defconst backquote-unquote-symbol '\, 88 | "Symbol used to represent an unquote inside a backquote.") 89 | 90 | (defconst backquote-splice-symbol '\,@ 91 | "Symbol used to represent a splice inside a backquote.") 92 | 93 | (defmacro backquote (structure) 94 | "Argument STRUCTURE describes a template to build. 95 | 96 | The whole structure acts as if it were quoted except for certain 97 | places where expressions are evaluated and inserted or spliced in. 98 | 99 | For example: 100 | 101 | b => (ba bb bc) ; assume b has this value 102 | \\=`(a b c) => (a b c) ; backquote acts like quote 103 | \\=`(a ,b c) => (a (ba bb bc) c) ; insert the value of b 104 | \\=`(a ,@b c) => (a ba bb bc c) ; splice in the value of b 105 | 106 | Vectors work just like lists. Nested backquotes are permitted. 107 | 108 | Note that some macros, such as `pcase', use this symbol for other 109 | purposes." 110 | (cdr (backquote-process structure))) 111 | 112 | ;; GNU Emacs has no reader macros 113 | 114 | (defalias '\` (symbol-function 'backquote)) 115 | 116 | ;; backquote-process returns a dotted-pair of a tag (0, 1, or 2) and 117 | ;; the backquote-processed structure. 0 => the structure is 118 | ;; constant, 1 => to be unquoted, 2 => to be spliced in. 119 | ;; The top-level backquote macro just discards the tag. 120 | 121 | (defun backquote-delay-process (s level) 122 | "Process a (un|back|splice)quote inside a backquote. 123 | This simply recurses through the body." 124 | (let ((exp (backquote-listify (list (cons 0 (list 'quote (car s)))) 125 | (backquote-process (cdr s) level)))) 126 | (cons (if (eq (car-safe exp) 'quote) 0 1) exp))) 127 | 128 | (defun backquote-process (s &optional level) 129 | "Process the body of a backquote. 130 | S is the body. Returns a cons cell whose cdr is piece of code which 131 | is the macro-expansion of S, and whose car is a small integer whose value 132 | can either indicate that the code is constant (0), or not (1), or returns 133 | a list which should be spliced into its environment (2). 134 | LEVEL is only used internally and indicates the nesting level: 135 | 0 (the default) is for the toplevel nested inside a single backquote." 136 | (unless level (setq level 0)) 137 | (cond 138 | ((vectorp s) 139 | (let ((n (backquote-process (append s ()) level))) 140 | (if (= (car n) 0) 141 | (cons 0 s) 142 | (cons 1 (cond 143 | ((not (listp (cdr n))) 144 | (list 'vconcat (cdr n))) 145 | ((eq (nth 1 n) 'list) 146 | (cons 'vector (nthcdr 2 n))) 147 | ((eq (nth 1 n) 'append) 148 | (cons 'vconcat (nthcdr 2 n))) 149 | (t 150 | (list 'apply '(function vector) (cdr n)))))))) 151 | ((atom s) 152 | ;; FIXME: Use macroexp-quote! 153 | (cons 0 (if (or (null s) (eq s t) (not (symbolp s))) 154 | s 155 | (list 'quote s)))) 156 | ((eq (car s) backquote-unquote-symbol) 157 | (if (<= level 0) 158 | (cond 159 | ((> (length s) 2) 160 | ;; We could support it with: (cons 2 `(list . ,(cdr s))) 161 | ;; But let's not encourage such uses. 162 | (error "Multiple args to , are not supported: %S" s)) 163 | (t (cons (if (eq (car-safe (nth 1 s)) 'quote) 0 1) 164 | (nth 1 s)))) 165 | (backquote-delay-process s (1- level)))) 166 | ((eq (car s) backquote-splice-symbol) 167 | (if (<= level 0) 168 | (if (> (length s) 2) 169 | ;; (cons 2 `(append . ,(cdr s))) 170 | (error "Multiple args to ,@ are not supported: %S" s) 171 | (cons 2 (nth 1 s))) 172 | (backquote-delay-process s (1- level)))) 173 | ((eq (car s) backquote-backquote-symbol) 174 | (backquote-delay-process s (1+ level))) 175 | (t 176 | (let ((rest s) 177 | item firstlist list lists expression) 178 | ;; Scan this list-level, setting LISTS to a list of forms, 179 | ;; each of which produces a list of elements 180 | ;; that should go in this level. 181 | ;; The order of LISTS is backwards. 182 | ;; If there are non-splicing elements (constant or variable) 183 | ;; at the beginning, put them in FIRSTLIST, 184 | ;; as a list of tagged values (TAG . FORM). 185 | ;; If there are any at the end, they go in LIST, likewise. 186 | (while (and (consp rest) 187 | ;; Stop if the cdr is an expression inside a backquote or 188 | ;; unquote since this needs to go recursively through 189 | ;; backquote-process. 190 | (not (or (eq (car rest) backquote-unquote-symbol) 191 | (eq (car rest) backquote-backquote-symbol)))) 192 | (setq item (backquote-process (car rest) level)) 193 | (cond 194 | ((= (car item) 2) 195 | ;; Put the nonspliced items before the first spliced item 196 | ;; into FIRSTLIST. 197 | (if (null lists) 198 | (setq firstlist list 199 | list nil)) 200 | ;; Otherwise, put any preceding nonspliced items into LISTS. 201 | (if list 202 | (push (backquote-listify list '(0 . nil)) lists)) 203 | (push (cdr item) lists) 204 | (setq list nil)) 205 | (t 206 | (setq list (cons item list)))) 207 | (setq rest (cdr rest))) 208 | ;; Handle nonsplicing final elements, and the tail of the list 209 | ;; (which remains in REST). 210 | (if (or rest list) 211 | (push (backquote-listify list (backquote-process rest level)) 212 | lists)) 213 | ;; Turn LISTS into a form that produces the combined list. 214 | (setq expression 215 | (if (or (cdr lists) 216 | (eq (car-safe (car lists)) backquote-splice-symbol)) 217 | (cons 'append (nreverse lists)) 218 | (car lists))) 219 | ;; Tack on any initial elements. 220 | (if firstlist 221 | (setq expression (backquote-listify firstlist (cons 1 expression)))) 222 | (cons (if (eq (car-safe expression) 'quote) 0 1) expression))))) 223 | 224 | ;; backquote-listify takes (tag . structure) pairs from backquote-process 225 | ;; and decides between append, list, backquote-list*, and cons depending 226 | ;; on which tags are in the list. 227 | 228 | (defun backquote-listify (list old-tail) 229 | (let ((heads nil) (tail (cdr old-tail)) (list-tail list) (item nil)) 230 | (if (= (car old-tail) 0) 231 | (setq tail (eval tail) 232 | old-tail nil)) 233 | (while (consp list-tail) 234 | (setq item (car list-tail)) 235 | (setq list-tail (cdr list-tail)) 236 | (if (or heads old-tail (/= (car item) 0)) 237 | (setq heads (cons (cdr item) heads)) 238 | (setq tail (cons (eval (cdr item)) tail)))) 239 | (cond 240 | (tail 241 | (if (null old-tail) 242 | (setq tail (list 'quote tail))) 243 | (if heads 244 | (let ((use-list* (or (cdr heads) 245 | (and (consp (car heads)) 246 | (eq (car (car heads)) 247 | backquote-splice-symbol))))) 248 | (cons (if use-list* 'backquote-list* 'cons) 249 | (append heads (list tail)))) 250 | tail)) 251 | (t (cons 'list heads))))) 252 | 253 | 254 | ;; Give `,' and `,@' documentation strings which can be examined by C-h f. 255 | (put '\, 'function-documentation 256 | "See `\\=`' (also `pcase') for the usage of `,'.") 257 | (put '\, 'reader-construct t) 258 | 259 | (put '\,@ 'function-documentation 260 | "See `\\=`' for the usage of `,@'.") 261 | (put '\,@ 'reader-construct t) 262 | 263 | ;;; backquote.el ends here 264 | -------------------------------------------------------------------------------- /core/interpreter_test.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "errors" 5 | "fmt" 6 | "strings" 7 | "testing" 8 | ) 9 | 10 | type stringToStringTC struct { 11 | input string 12 | expected string 13 | err error 14 | inp *Interpreter 15 | } 16 | 17 | var anyError = fmt.Errorf("anyError") 18 | var globalInp = newTestingInterpreter() 19 | 20 | func testStringToString(t *testing.T, fn func(string, *Interpreter) (string, error), cases []stringToStringTC) { 21 | for _, tc := range cases { 22 | if tc.err != nil && tc.expected != "" { 23 | t.Fatalf("input: '%v' defines both expected value and error", tc.input) 24 | } 25 | 26 | output, err := fn(tc.input, tc.inp) 27 | if err != nil { 28 | if tc.err == nil { 29 | t.Logf("input: '%v' got error '%v'", tc.input, err) 30 | t.Fail() 31 | } else if !errors.Is(tc.err, anyError) && !errors.Is(tc.err, err) { 32 | t.Logf( 33 | "input: '%v' got error '%v' instead of error '%v'", 34 | tc.input, 35 | strings.Split(err.Error(), "\n")[0], 36 | strings.Split(tc.err.Error(), "\n")[0], 37 | ) 38 | t.Fail() 39 | } 40 | } else { 41 | if tc.err != nil { 42 | t.Logf("input: '%v' expected error '%v' instead of value '%v'", tc.input, tc.err, output) 43 | t.Fail() 44 | } else if output != tc.expected { 45 | t.Logf("input: '%v' expected '%v' but got '%v'", tc.input, tc.expected, output) 46 | t.Fail() 47 | } 48 | } 49 | } 50 | } 51 | 52 | func readPrin1(input string, inp *Interpreter) (string, error) { 53 | return globalInp.ReadPrin1(input) 54 | } 55 | 56 | func readEvalPrin1(input string, inp *Interpreter) (string, error) { 57 | if inp == nil { 58 | inp = globalInp 59 | } 60 | return inp.ReadEvalPrin1(input) 61 | } 62 | 63 | func TestReadPrint(t *testing.T) { 64 | testStringToString(t, readPrin1, []stringToStringTC{ 65 | {"1", "1", nil, nil}, 66 | {"-1", "-1", nil, nil}, 67 | {"0", "0", nil, nil}, 68 | {"-0", "0", nil, nil}, 69 | {"1.2", "1.2", nil, nil}, 70 | {"0.111", "0.111", nil, nil}, 71 | {".11", "0.11", nil, nil}, 72 | {".hello", "\\.hello", nil, nil}, 73 | {"123.123e-2", "1.23123", nil, nil}, 74 | {"123.123E-2", "1.23123", nil, nil}, 75 | {"nil", "nil", nil, nil}, 76 | {"()", "nil", nil, nil}, 77 | {"(1 . 1)", "(1 . 1)", nil, nil}, 78 | {"( . 2)", "", anyError, nil}, 79 | {"(. 2)", "", anyError, nil}, 80 | {"(1 2 3 . 4)", "(1 2 3 . 4)", nil, nil}, 81 | {"(. .test)", "", anyError, nil}, 82 | {"(.test .)", "(\\.test \\.)", nil, nil}, 83 | {"(. .)", "", anyError, nil}, 84 | {"( . .)", "", anyError, nil}, 85 | {"(1 . (2 . 3))", "(1 2 . 3)", nil, nil}, 86 | {"(1 1)", "(1 1)", nil, nil}, 87 | {"(1 2 .)", "(1 2 \\.)", nil, nil}, 88 | {"( 1 1 )", "(1 1)", nil, nil}, 89 | {"(.1 2)", "(0.1 2)", nil, nil}, 90 | {"(.)", "(\\.)", nil, nil}, 91 | {"((1 1))", "((1 1))", nil, nil}, 92 | {"((1 2 3) (4 5 6))", "((1 2 3) (4 5 6))", nil, nil}, 93 | {"(1 . (2 . (3 . nil)))", "(1 2 3)", nil, nil}, 94 | {"(", "", anyError, nil}, 95 | {"(123", "", anyError, nil}, 96 | {"(123 1 2 3", "", anyError, nil}, 97 | {"(123 1 2 3(", "", anyError, nil}, 98 | {"((())", "", anyError, nil}, 99 | {")", "", anyError, nil}, 100 | {"())", "nil", nil, nil}, 101 | {"foo", "foo", nil, nil}, 102 | {"foo\\ bar", "foo bar", nil, nil}, 103 | {"foo:bar", "foo:bar", nil, nil}, 104 | {"foo-bar", "foo-bar", nil, nil}, 105 | {"foo-bar?", "foo-bar?", nil, nil}, 106 | {"\\99", "\\99", nil, nil}, 107 | {"\\-10", "\\-10", nil, nil}, 108 | {"\\+10", "\\+10", nil, nil}, 109 | {"\\1.2", "\\1.2", nil, nil}, 110 | {"\\+", "+", nil, nil}, 111 | {"\\", "", anyError, nil}, 112 | {"foo\\", "", anyError, nil}, 113 | {"'(1 1)", "(quote (1 1))", nil, nil}, 114 | {"'1", "(quote 1)", nil, nil}, 115 | {"'", "", anyError, nil}, 116 | {"`(1 1)", "(` (1 1))", nil, nil}, 117 | {"`1", "(` 1)", nil, nil}, 118 | {"`", "", anyError, nil}, 119 | {"?a", "97", nil, nil}, 120 | {"?9", "57", nil, nil}, 121 | {"?\\9", "57", nil, nil}, 122 | {"?\\999", "", anyError, nil}, 123 | {"?999", "", anyError, nil}, 124 | {"? ", "32", nil, nil}, 125 | {"?", "", anyError, nil}, 126 | {"?\\n", "10", nil, nil}, 127 | {"?\\\n", "", anyError, nil}, 128 | {"?\\r", "13", nil, nil}, 129 | {"?\\ ", "32", nil, nil}, 130 | {"?\\71", "57", nil, nil}, 131 | {"?\\071", "57", nil, nil}, 132 | {"?\\0071", "", anyError, nil}, 133 | {"(+ 1 1) ; foo", "(+ 1 1)", nil, nil}, 134 | {"(+ 1 1) ;; foo", "(+ 1 1)", nil, nil}, 135 | {"(+ 1 1) ;; foo\n", "(+ 1 1)", nil, nil}, 136 | {"(+ 1 1) ;;; foo", "(+ 1 1)", nil, nil}, 137 | {"(+ 1 1);foo", "(+ 1 1)", nil, nil}, 138 | {"(+ 1 1);", "(+ 1 1)", nil, nil}, 139 | {";(+ 1 1)", "", anyError, nil}, 140 | {" ;(+ 1 1)", "", anyError, nil}, 141 | {" 1", "1", nil, nil}, 142 | {"\t1", "1", nil, nil}, 143 | {"\n\n1", "1", nil, nil}, 144 | {"\t1 ", "1", nil, nil}, 145 | {"", "", anyError, nil}, 146 | {`""`, `""`, nil, nil}, 147 | {`".1"`, `".1"`, nil, nil}, 148 | {`"hello"`, `"hello"`, nil, nil}, 149 | {`"'"`, `"'"`, nil, nil}, 150 | {`"''"`, `"''"`, nil, nil}, 151 | {"\"hello\nworld\"", "\"hello\nworld\"", nil, nil}, 152 | {`"hello\041"`, `"hello!"`, nil, nil}, 153 | {"\"hello \\\nworld\"", `"hello world"`, nil, nil}, 154 | {`"say \"hello\""`, `"say "hello""`, nil, nil}, 155 | {`"hello`, "", anyError, nil}, 156 | {`"`, "", anyError, nil}, 157 | {"\"hello \\\n", "", anyError, nil}, 158 | {"[]", "[]", nil, nil}, 159 | {"[1]", "[1]", nil, nil}, 160 | {"[1 2]", "[1 2]", nil, nil}, 161 | {"[1 2 ]", "[1 2]", nil, nil}, 162 | {"[ 1 2 ]", "[1 2]", nil, nil}, 163 | {"[1 2 (+ 1 1)]", "[1 2 (+ 1 1)]", nil, nil}, 164 | {"[", "", anyError, nil}, 165 | {"]", "", anyError, nil}, 166 | }) 167 | } 168 | 169 | func TestReadEvalPrint(t *testing.T) { 170 | testStringToString(t, readEvalPrin1, []stringToStringTC{ 171 | {"1", "1", nil, nil}, 172 | {"\"hello\"", "\"hello\"", nil, nil}, 173 | {"\"ñandú\"", "\"ñandú\"", nil, nil}, 174 | {"nil", "nil", nil, nil}, 175 | {"'nil", "nil", nil, nil}, 176 | {"t", "t", nil, nil}, 177 | {"'t", "t", nil, nil}, 178 | {"'-", "-", nil, nil}, 179 | {"'(1 . 2)", "(1 . 2)", nil, nil}, 180 | {"+", "", anyError, nil}, 181 | {"(+)", "0", nil, nil}, 182 | {"(*)", "1", nil, nil}, 183 | {"(* 1 a)", "", anyError, nil}, 184 | {"(* 0)", "0", nil, nil}, 185 | {"(* 3)", "3", nil, nil}, 186 | {"(* -1 2 -3)", "6", nil, nil}, 187 | {"(* 3.14 2 -3)", "", anyError, nil}, // NOTE: this will fail once arithmetic operators are implemented for floats 188 | {"(% 10 2)", "0", nil, nil}, 189 | {"(% 10 (+ 10 3))", "10", nil, nil}, 190 | {"(% 12332132122 10)", "2", nil, nil}, 191 | {"(eval '(% 2 10))", "2", nil, nil}, 192 | {"(% 12342 -10)", "2", nil, nil}, 193 | {"(% 2 a)", "", anyError, nil}, 194 | {"(% 2 1.2)", "", anyError, nil}, 195 | {"(% 2)", "", anyError, nil}, 196 | {"(+ 1)", "1", nil, nil}, 197 | {"(+ 1 1)", "2", nil, nil}, 198 | {"(+ 1 (+ 1 1))", "3", nil, nil}, 199 | {"(+ 1 nil)", "", anyError, nil}, 200 | {"(memq 'a '(a b c))", "(a b c)", nil, nil}, 201 | {"(memq 'a '(a . b))", "(a . b)", nil, nil}, 202 | {"(memq 'c '(a . b))", "", anyError, nil}, 203 | {"(length '(1 2 3))", "3", nil, nil}, 204 | {"(length '(1 2 . 3))", "", anyError, nil}, 205 | {"(eval '(+ 1 1))", "2", nil, nil}, 206 | {"(progn 1 2 3)", "3", nil, nil}, 207 | {"(progn)", "nil", nil, nil}, 208 | {"(progn (set 'a 42) a)", "42", nil, nil}, 209 | {"(length \"hello\")", "5", nil, nil}, 210 | {"(length \"helláá\")", "6", nil, nil}, 211 | {"foo", "", anyError, nil}, 212 | {"(foo 1)", "", anyError, nil}, 213 | {"(list 1 2 3)", "(1 2 3)", nil, nil}, 214 | {"(list)", "nil", nil, nil}, 215 | {"(cons)", "", anyError, nil}, 216 | {"(cons 1 2 3)", "", anyError, nil}, 217 | {"(if t 1 2)", "1", nil, nil}, 218 | {"(if nil 1 2)", "2", nil, nil}, 219 | {"(if t 42)", "42", nil, nil}, 220 | {"(if nil 42)", "nil", nil, nil}, 221 | {"unbound", "", anyError, nil}, 222 | {"(boundp 'asdf)", "nil", nil, nil}, 223 | {"(progn (setq aaa 1) (boundp 'aaa))", "t", nil, nil}, 224 | {"(fboundp 'asdf)", "nil", nil, nil}, 225 | {"(fboundp 'length)", "t", nil, nil}, 226 | {"(progn (set 'f '((b . 42))) (eval 'b f))", "42", nil, nil}, 227 | {"(eval)", "", anyError, nil}, 228 | {"(eval '(+ 1 1))", "2", nil, nil}, 229 | {"(eq nil nil)", "t", nil, nil}, 230 | {"(eq 'nil nil)", "t", nil, nil}, 231 | {"(eq nil ())", "t", nil, nil}, 232 | {"(eq t t)", "t", nil, nil}, 233 | {"(eq 't t)", "t", nil, nil}, 234 | {"(eq 1000 1000)", "nil", nil, nil}, 235 | {"(consp nil)", "nil", nil, nil}, 236 | {"(consp (cons 1 2))", "t", nil, nil}, 237 | {"(put 1 1)", "", anyError, nil}, 238 | {"(put 'a 'foo 1)", "1", nil, nil}, 239 | {"(progn (put 'a 'foo 42) (get 'a 'foo))", "42", nil, nil}, 240 | {"(progn (if nil 1 2 3 (set 'foo 42)) foo)", "42", nil, nil}, 241 | {"(throw 'f 1)", "", anyError, nil}, 242 | {"(catch 'f (throw 'f 1))", "1", nil, nil}, 243 | {"(catch 'k (throw 'f 1))", "", anyError, nil}, 244 | {"(catch)", "", anyError, nil}, 245 | {"(catch 'k)", "nil", nil, nil}, 246 | {"(progn (catch 'a (unwind-protect (throw 'a nil) (set 'foo 42))) foo)", "42", nil, nil}, 247 | {"(symbol-plist 'error)", "(error-conditions (error) error-message \"error\")", nil, nil}, 248 | {"(symbol-plist 'quit)", "(error-conditions (quit) error-message \"Quit\")", nil, nil}, 249 | {"(symbol-plist 'user-error)", "(error-conditions (user-error error) error-message \"\")", nil, nil}, 250 | {"(plist-put '(a 1 b 2) 'a 3)", "(a 3 b 2)", nil, nil}, 251 | {"(plist-put '(a 1 b 2) 'c 3)", "(a 1 b 2 c 3)", nil, nil}, 252 | {"(plist-put nil 'c 3)", "(c 3)", nil, nil}, 253 | {"(plist-put nil :foo 1)", "(:foo 1)", nil, nil}, 254 | {"(plist-put (cons 1 2) :a 1)", "", anyError, nil}, 255 | {"(plist-put 99 :a 1)", "", anyError, nil}, 256 | {"(condition-case nil 42)", "42", nil, nil}, 257 | {"(condition-case foo 42)", "42", nil, nil}, 258 | {"(condition-case nil (signal 'user-error nil))", "", anyError, nil}, 259 | {"(condition-case nil (signal 'user-error nil) (user-error 42))", "42", nil, nil}, 260 | {"(condition-case nil (signal 'user-error nil) (user-error 1) (user-error 2))", "1", nil, nil}, 261 | {"(condition-case nil (throw 'foo 1) (t 42))", "42", nil, nil}, 262 | {"(catch 'foo (condition-case nil (throw 'foo 1234) (t 42)))", "1234", nil, nil}, 263 | {"(condition-case a (signal 'error \"foo\") ((error) a))", "(error . \"foo\")", nil, nil}, 264 | {"(<)", "", anyError, nil}, 265 | {"(< 1 4)", "t", nil, nil}, 266 | {"(< 4 2)", "nil", nil, nil}, 267 | {"(< 4 4)", "nil", nil, nil}, 268 | {"(symbol-name '##)", `""`, nil, nil}, 269 | {"(equal 1 1)", "t", nil, nil}, 270 | {"(equal 1 2)", "nil", nil, nil}, 271 | {"(equal '(1 2 3) '(1 2 3))", "t", nil, nil}, 272 | {"(progn (fset 'foo (function (lambda (x) (+ x 1)))) (foo 1))", "2", nil, nil}, 273 | {"(progn (fset 'foo (function (lambda (x) (+ x 1)))) (funcall 'foo 1))", "2", nil, nil}, 274 | {"(progn (fset 'foo (function (lambda () \"foo\"))) (foo 1))", "", anyError, nil}, 275 | {"(progn (fset 'foo (function (lambda () \"foo\"))) (foo))", `"foo"`, nil, nil}, 276 | {"(progn (fset 'foo (function (lambda (&optional x) x))) (foo))", "nil", nil, nil}, 277 | {"(progn (fset 'foo (function (lambda (&optional x y) x))) (foo))", "nil", nil, nil}, 278 | {"(progn (fset 'foo (function (lambda (&rest x) x))) (foo 1 2 3))", "(1 2 3)", nil, nil}, 279 | {"(funcall '+)", "0", nil, nil}, 280 | {"(funcall '+ 1 2 3)", "6", nil, nil}, 281 | {"(funcall '+ 1 2 (+ 1 1))", "5", nil, nil}, 282 | {"(funcall 'list 1 2)", "(1 2)", nil, nil}, 283 | {"(funcall 'if t 1)", "", anyError, nil}, 284 | {"(apply 'cons)", "", anyError, nil}, 285 | {"(apply 'cons '(1 2))", "(1 . 2)", nil, nil}, 286 | {"(apply 'cons '(1))", "", anyError, nil}, 287 | {"(apply '+ 1 '(2 3 4))", "10", nil, nil}, 288 | {"(apply 'if '(t 1)", "", anyError, nil}, 289 | {"(apply 'eval '(t))", "t", nil, nil}, 290 | {`(progn (insert "foo") (buffer-string))`, `"foo"`, nil, nil}, 291 | {`(buffer-name (current-buffer))`, `"*scratch*"`, nil, nil}, 292 | {`(assq 'a '((a . b) (c . d)))`, `(a . b)`, nil, nil}, 293 | {`(assq 'f '((a . b) (c . d)))`, `nil`, nil, nil}, 294 | {`(assq 'f '((a . b) (c . d) . 123))`, "", anyError, nil}, 295 | {`(nconc)`, `nil`, nil, nil}, 296 | {`(nconc 1)`, `1`, nil, nil}, 297 | {`(nconc nil)`, `nil`, nil, nil}, 298 | {`(nconc '(1 2 3) '(4 5 6))`, `(1 2 3 4 5 6)`, nil, nil}, 299 | {`(nconc '(1 2 3) nil '(4 5 6))`, `(1 2 3 4 5 6)`, nil, nil}, 300 | {`(nconc '(1 2 3) '(4 5 6) 7)`, `(1 2 3 4 5 6 . 7)`, nil, nil}, 301 | {`(nconc (cons 1 2) '(4 5 6))`, `(1 4 5 6)`, nil, nil}, 302 | {`(length (buffer-list))`, `1`, nil, nil}, 303 | {"(getenv-internal \"FOO\")", "nil", nil, nil}, 304 | {"(intern \"\")", "##", nil, nil}, 305 | {`(intern "\\")`, `\\`, nil, nil}, 306 | {"(setq)", "nil", nil, nil}, 307 | {"(setq a 1)", "1", nil, nil}, 308 | {"(setq a 1 b 2)", "2", nil, nil}, 309 | {"(setq a 1 b 2 c)", "", anyError, nil}, 310 | {"(progn (setq a 1) 1)", "1", nil, nil}, 311 | {"(let)", "", anyError, nil}, 312 | {"(let (a) a)", "nil", nil, nil}, 313 | {"(let ((a nil)) a)", "nil", nil, nil}, 314 | {"(let ((a nil) (b 2)) b)", "2", nil, nil}, 315 | {"(let ((a nil) (b 2) c) c)", "nil", nil, nil}, 316 | {"(progn (let (abc321)) abc321)", "", anyError, nil}, 317 | {"noninteractive", "t", nil, nil}, 318 | {"(cons (let ((noninteractive nil)) noninteractive) noninteractive)", "(nil . t)", nil, nil}, 319 | {`(progn (setq pimacs--repo "hello") pimacs--repo)`, `"hello"`, nil, nil}, 320 | {"(plist-get (pimacs--symbol-debug 'pimacs--repo) :special)", "t", nil, nil}, 321 | {"[1 2 3]", "[1 2 3]", nil, nil}, 322 | {"[[[]]]", "[[[]]]", nil, nil}, 323 | {"[1 2 (+ 1 1)]", "[1 2 (+ 1 1)]", nil, nil}, 324 | {"(vectorp [])", "t", nil, nil}, 325 | {"(make-char-table nil)", "#^[nil nil 0 nil]", nil, nil}, 326 | }) 327 | } 328 | 329 | func TestReadEvalPrintSpecificErr(t *testing.T) { 330 | t.Parallel() 331 | inp := newTestingInterpreter() 332 | ec := inp.ec 333 | sentinel := newString("sentinel", false) 334 | 335 | // Note: all these will be run with the interpreter `inp`, not the global one 336 | cases := []stringToStringTC{ 337 | {"(1 . 2)", "", xErrOnly(ec.wrongTypeArgument(ec.s.listp, sentinel)), inp}, 338 | {"(foo 1 2 3)", "", xErrOnly(ec.signalN(ec.s.voidFunction)), inp}, 339 | {")", "", xErrOnly(ec.signalN(ec.s.invalidReadSyntax)), inp}, 340 | {"(char-table-range 123 123)", "", xErrOnly(ec.wrongTypeArgument(ec.s.charTablep, sentinel)), inp}, 341 | {"(signal 1 2)", "", xErrOnly(ec.wrongTypeArgument(ec.s.symbolp, sentinel)), inp}, 342 | {"(plist-put '(:b) :a 1)", "", xErrOnly(ec.wrongTypeArgument(ec.s.plistp, sentinel)), inp}, 343 | {"(plist-put '(1 2 3 . 4) :a 1)", "", xErrOnly(ec.wrongTypeArgument(ec.s.plistp, sentinel)), inp}, 344 | {"(make-hash-table :test)", "", xErrOnly(ec.wrongTypeArgument(ec.s.plistp, sentinel)), inp}, 345 | {"(make-hash-table :test 'eq :foo)", "", xErrOnly(ec.wrongTypeArgument(ec.s.plistp, sentinel)), inp}, 346 | {"(make-hash-table :test 'eq :foo 123)", "", xErrOnly(ec.signalError("")), inp}, 347 | {"(make-hash-table :test 'foo)", "", xErrOnly(ec.signalError("")), inp}, 348 | } 349 | 350 | testStringToString(t, readEvalPrin1, cases) 351 | } 352 | -------------------------------------------------------------------------------- /core/data.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | type arithmeticCmp int 4 | type arithmeticOp int 5 | 6 | const ( 7 | arithmeticCmpEqual arithmeticCmp = iota + 1 8 | arithmeticCmpNotEqual 9 | arithmeticCmpLess 10 | arithmeticCmpGreater 11 | arithmeticCmpLessOrEqual 12 | arithmeticCmpGreaterOrEqual 13 | ) 14 | 15 | const ( 16 | arithmeticOpAdd arithmeticOp = iota + 1 17 | arithmeticOpSub 18 | arithmeticOpMul 19 | arithmeticOpDiv 20 | arithmeticOpAnd 21 | arithmeticOpOr 22 | arithmeticOpXor 23 | ) 24 | 25 | func (ec *execContext) null(object lispObject) (lispObject, error) { 26 | return ec.bool(object == ec.nil_) 27 | } 28 | 29 | func (ec *execContext) sequencep(object lispObject) (lispObject, error) { 30 | return ec.bool(ec.listpBool(object) || arrayp(object)) 31 | } 32 | 33 | func (ec *execContext) consp(object lispObject) (lispObject, error) { 34 | return ec.bool(consp(object)) 35 | } 36 | 37 | func (ec *execContext) listpBool(object lispObject) bool { 38 | return (object == ec.nil_ || consp(object)) 39 | } 40 | 41 | func (ec *execContext) listp(object lispObject) (lispObject, error) { 42 | return ec.bool(ec.listpBool(object)) 43 | } 44 | 45 | func (ec *execContext) arrayp(object lispObject) (lispObject, error) { 46 | return ec.bool(arrayp(object)) 47 | } 48 | 49 | func (ec *execContext) atom(object lispObject) (lispObject, error) { 50 | return ec.bool(!consp(object)) 51 | } 52 | 53 | func (ec *execContext) symbolp(object lispObject) (lispObject, error) { 54 | return ec.bool(symbolp(object)) 55 | } 56 | 57 | func (ec *execContext) stringp(object lispObject) (lispObject, error) { 58 | return ec.bool(stringp(object)) 59 | } 60 | 61 | func (ec *execContext) multibyteStringp(object lispObject) (lispObject, error) { 62 | return ec.bool(stringp(object) && xStringMultibytep(object)) 63 | } 64 | 65 | func (ec *execContext) numberOrMarkerp(object lispObject) (lispObject, error) { 66 | return ec.bool(numberOrMarkerp(object)) 67 | } 68 | 69 | func (ec *execContext) integerOrMarkerp(object lispObject) (lispObject, error) { 70 | return ec.bool(integerOrMarkerp(object)) 71 | } 72 | 73 | func (ec *execContext) charOrStringp(object lispObject) (lispObject, error) { 74 | return ec.bool(characterp(object) || stringp(object)) 75 | } 76 | 77 | func (ec *execContext) integerp(object lispObject) (lispObject, error) { 78 | return ec.bool(integerp(object)) 79 | } 80 | 81 | func (ec *execContext) numberp(object lispObject) (lispObject, error) { 82 | return ec.bool(numberp(object)) 83 | } 84 | 85 | func (ec *execContext) characterp(object, ignore lispObject) (lispObject, error) { 86 | return ec.bool(characterp(object)) 87 | } 88 | 89 | func (ec *execContext) bufferp(object lispObject) (lispObject, error) { 90 | return ec.bool(bufferp(object)) 91 | } 92 | 93 | func (ec *execContext) vectorp(object lispObject) (lispObject, error) { 94 | return ec.bool(vectorp(object)) 95 | } 96 | 97 | func (ec *execContext) charTablep(object lispObject) (lispObject, error) { 98 | return ec.bool(chartablep(object)) 99 | } 100 | 101 | func (ec *execContext) channelp(object lispObject) (lispObject, error) { 102 | return ec.bool(channelp(object)) 103 | } 104 | 105 | func (ec *execContext) hashTablep(object lispObject) (lispObject, error) { 106 | return ec.bool(hashtablep(object)) 107 | } 108 | 109 | func (ec *execContext) boundp(symbol lispObject) (lispObject, error) { 110 | if !symbolp(symbol) { 111 | return ec.wrongTypeArgument(ec.s.symbolp, symbol) 112 | } 113 | val, err := ec.findSymbolValue(symbol) 114 | if err != nil { 115 | return nil, err 116 | } 117 | 118 | return ec.bool(val != ec.s.unbound) 119 | } 120 | 121 | func (ec *execContext) fboundp(symbol lispObject) (lispObject, error) { 122 | if !symbolp(symbol) { 123 | return ec.wrongTypeArgument(ec.s.symbolp, symbol) 124 | } 125 | return ec.bool(xSymbol(symbol).function != ec.nil_) 126 | } 127 | 128 | func (ec *execContext) makunbound(symbol lispObject) (lispObject, error) { 129 | _, err := ec.set(symbol, ec.s.unbound) 130 | if err != nil { 131 | return nil, err 132 | } 133 | return symbol, nil 134 | } 135 | 136 | func (ec *execContext) fmakunbound(symbol lispObject) (lispObject, error) { 137 | if !symbolp(symbol) { 138 | return ec.wrongTypeArgument(ec.s.symbolp, symbol) 139 | } 140 | xSymbol(symbol).function = ec.s.unbound 141 | return symbol, nil 142 | } 143 | 144 | func (ec *execContext) car(obj lispObject) (lispObject, error) { 145 | if obj == ec.nil_ { 146 | return ec.nil_, nil 147 | } 148 | 149 | if !consp(obj) { 150 | return ec.wrongTypeArgument(ec.s.listp, obj) 151 | } 152 | return xCar(obj), nil 153 | } 154 | 155 | func (ec *execContext) cdr(obj lispObject) (lispObject, error) { 156 | if obj == ec.nil_ { 157 | return ec.nil_, nil 158 | } 159 | 160 | if !consp(obj) { 161 | return ec.wrongTypeArgument(ec.s.listp, obj) 162 | } 163 | return xCdr(obj), nil 164 | } 165 | 166 | func (ec *execContext) carSafe(obj lispObject) (lispObject, error) { 167 | if !consp(obj) { 168 | return ec.nil_, nil 169 | } 170 | return xCar(obj), nil 171 | } 172 | 173 | func (ec *execContext) cdrSafe(obj lispObject) (lispObject, error) { 174 | if !consp(obj) { 175 | return ec.nil_, nil 176 | } 177 | return xCdr(obj), nil 178 | } 179 | 180 | func (ec *execContext) setCar(obj, newCar lispObject) (lispObject, error) { 181 | if !consp(obj) { 182 | return ec.wrongTypeArgument(ec.s.consp, obj) 183 | } 184 | xSetCar(obj, newCar) 185 | return newCar, nil 186 | } 187 | 188 | func (ec *execContext) setCdr(obj, newCdr lispObject) (lispObject, error) { 189 | if !consp(obj) { 190 | return ec.wrongTypeArgument(ec.s.consp, obj) 191 | } 192 | xSetCdr(obj, newCdr) 193 | return newCdr, nil 194 | } 195 | 196 | func (ec *execContext) indirectFunctionInternal(obj lispObject) lispObject { 197 | for symbolp(obj) && obj != ec.nil_ { 198 | obj = xSymbol(obj).function 199 | } 200 | return obj 201 | } 202 | 203 | func (ec *execContext) indirectFunction(obj, _ lispObject) (lispObject, error) { 204 | return ec.indirectFunctionInternal(obj), nil 205 | } 206 | 207 | func (ec *execContext) setDefaultInternal(symbol, val lispObject) error { 208 | if !symbolp(symbol) { 209 | return xErrOnly(ec.wrongTypeArgument(ec.s.symbolp, symbol)) 210 | } 211 | 212 | sym := xSymbol(symbol) 213 | 214 | switch sym.redirect { 215 | case symbolRedirectPlain: 216 | return ec.setInternal(symbol, val) 217 | default: 218 | ec.terminate("unknown symbol redirect type: '%+v'", sym.redirect) 219 | return nil 220 | } 221 | } 222 | 223 | func (ec *execContext) setDefault(symbol, val lispObject) (lispObject, error) { 224 | return val, ec.setDefaultInternal(symbol, val) 225 | } 226 | 227 | func (ec *execContext) setInternal(symbol, newVal lispObject) error { 228 | if !symbolp(symbol) { 229 | return xErrOnly(ec.wrongTypeArgument(ec.s.symbolp, symbol)) 230 | } 231 | 232 | sym := xSymbol(symbol) 233 | 234 | switch sym.redirect { 235 | case symbolRedirectPlain: 236 | sym.val = newVal 237 | return nil 238 | case symbolRedirectFwd: 239 | return sym.fwd.setValue(ec, newVal) 240 | default: 241 | ec.terminate("unknown symbol redirect type: '%+v'", sym.redirect) 242 | return nil 243 | } 244 | } 245 | 246 | func (ec *execContext) set(symbol, newVal lispObject) (lispObject, error) { 247 | err := ec.setInternal(symbol, newVal) 248 | if err != nil { 249 | return nil, err 250 | } 251 | return newVal, nil 252 | } 253 | 254 | func (ec *execContext) fset(symbol, definition lispObject) (lispObject, error) { 255 | if symbol == ec.nil_ && definition != ec.nil_ { 256 | return ec.signalN(ec.s.settingConstant, symbol) 257 | } 258 | 259 | if !symbolp(symbol) { 260 | return ec.wrongTypeArgument(ec.s.symbolp, symbol) 261 | } 262 | 263 | xSymbol(symbol).function = definition 264 | return definition, nil 265 | } 266 | 267 | func (ec *execContext) findSymbolValue(symbol lispObject) (lispObject, error) { 268 | if !symbolp(symbol) { 269 | return ec.wrongTypeArgument(ec.s.symbolp, symbol) 270 | } 271 | 272 | sym := xSymbol(symbol) 273 | var val lispObject 274 | 275 | switch sym.redirect { 276 | case symbolRedirectPlain: 277 | val = sym.val 278 | case symbolRedirectFwd: 279 | val = sym.fwd.value(ec) 280 | default: 281 | ec.terminate("unknown symbol redirect type: '%+v'", sym.redirect) 282 | } 283 | 284 | return val, nil 285 | } 286 | 287 | func (ec *execContext) symbolValue(symbol lispObject) (lispObject, error) { 288 | val, err := ec.findSymbolValue(symbol) 289 | if err != nil { 290 | return nil, err 291 | } 292 | if val == ec.s.unbound { 293 | return ec.signalN(ec.s.voidVariable, symbol) 294 | } 295 | 296 | return val, nil 297 | } 298 | 299 | func (ec *execContext) symbolFunction(symbol lispObject) (lispObject, error) { 300 | if !symbolp(symbol) { 301 | return ec.wrongTypeArgument(ec.s.symbolp, symbol) 302 | } 303 | 304 | return xSymbol(symbol).function, nil 305 | } 306 | 307 | func (ec *execContext) eq(obj1, obj2 lispObject) (lispObject, error) { 308 | return ec.bool(obj1 == obj2) 309 | } 310 | 311 | func (ec *execContext) defalias(symbol, definition, docstring lispObject) (lispObject, error) { 312 | return ec.fset(symbol, definition) 313 | } 314 | 315 | func (ec *execContext) symbolPlist(symbol lispObject) (lispObject, error) { 316 | if !symbolp(symbol) { 317 | return ec.wrongTypeArgument(ec.s.symbolp, symbol) 318 | } 319 | 320 | return xSymbol(symbol).plist, nil 321 | } 322 | 323 | func (ec *execContext) symbolName(symbol lispObject) (lispObject, error) { 324 | if !symbolp(symbol) { 325 | return ec.wrongTypeArgument(ec.s.symbolp, symbol) 326 | } 327 | 328 | return xSymbol(symbol).name, nil 329 | } 330 | 331 | func (ec *execContext) plusSign(objs ...lispObject) (lispObject, error) { 332 | if len(objs) == 0 { 333 | return newInteger(0), nil 334 | } 335 | if !integerOrMarkerp(objs[0]) { 336 | return ec.wrongTypeArgument(ec.s.integerOrMarkerp, objs[0]) 337 | } 338 | return ec.arithmeticOperate(arithmeticOpAdd, objs[0], objs[1:]...) 339 | } 340 | 341 | // remainder returns the remainder of X divided by Y. Both must be integers or markers. 342 | func (ec *execContext) remainder(x, y lispObject) (lispObject, error) { 343 | if !integerOrMarkerp(x) { 344 | return ec.wrongTypeArgument(ec.s.integerp, x) 345 | } 346 | 347 | if !integerOrMarkerp(y) { 348 | return ec.wrongTypeArgument(ec.s.integerp, y) 349 | } 350 | 351 | xVal := xIntegerValue(x) 352 | yVal := xIntegerValue(y) 353 | 354 | return newInteger(xVal % yVal), nil 355 | } 356 | 357 | func (ec *execContext) product(objs ...lispObject) (lispObject, error) { 358 | if len(objs) == 0 { 359 | return newInteger(1), nil 360 | } 361 | if !numberOrMarkerp(objs[0]) { 362 | return ec.wrongTypeArgument(ec.s.numberOrMarkerp, objs[0]) 363 | } 364 | return ec.arithmeticOperate(arithmeticOpMul, objs[0], objs[1:]...) 365 | 366 | } 367 | 368 | func (ec *execContext) logiOr(objs ...lispObject) (lispObject, error) { 369 | if len(objs) == 0 { 370 | return newInteger(0), nil 371 | } 372 | if !integerOrMarkerp(objs[0]) { 373 | return ec.wrongTypeArgument(ec.s.integerOrMarkerp, objs[0]) 374 | } 375 | return ec.arithmeticOperate(arithmeticOpOr, objs[0], objs[1:]...) 376 | } 377 | 378 | func (ec *execContext) onePlus(number lispObject) (lispObject, error) { 379 | if !numberOrMarkerp(number) { 380 | return ec.wrongTypeArgument(ec.s.numberOrMarkerp, number) 381 | } 382 | 383 | if integerp(number) { 384 | return newInteger(xIntegerValue(number) + 1), nil 385 | } 386 | return newFloat(xFloatValue(number) + 1.0), nil 387 | } 388 | 389 | func (ec *execContext) arithmeticFloatOperate(op arithmeticOp, val lispObject, objs ...lispObject) (lispObject, error) { 390 | return ec.pimacsUnimplemented(ec.nil_, "arithmetic operator for float is unimplemented") 391 | } 392 | 393 | func (ec *execContext) arithmeticOperate(op arithmeticOp, val lispObject, objs ...lispObject) (lispObject, error) { 394 | if !numberOrMarkerp(val) { 395 | return ec.wrongTypeArgument(ec.s.numberOrMarkerp, val) 396 | } else if markerp(val) { 397 | return ec.pimacsUnimplemented(ec.nil_, "arithmetic operator for markers is unimplemented") 398 | } else if floatp(val) { 399 | return ec.arithmeticFloatOperate(op, val, objs...) 400 | } 401 | 402 | accum := xIntegerValue(val) 403 | for _, obj := range objs { 404 | if !numberOrMarkerp(obj) { 405 | return ec.wrongTypeArgument(ec.s.numberOrMarkerp, obj) 406 | } else if !integerp(obj) { 407 | return ec.pimacsUnimplemented(ec.nil_, "arithmetic operator for markers/float is unimplemented") 408 | } 409 | 410 | next := xIntegerValue(obj) 411 | 412 | switch op { 413 | case arithmeticOpAdd: 414 | accum += next 415 | case arithmeticOpSub: 416 | accum -= next 417 | case arithmeticOpMul: 418 | accum *= next 419 | case arithmeticOpDiv: 420 | if next == 0 { 421 | return ec.signalN(ec.s.arithError) 422 | } 423 | accum /= next 424 | case arithmeticOpAnd: 425 | accum &= next 426 | case arithmeticOpOr: 427 | accum |= next 428 | case arithmeticOpXor: 429 | accum ^= next 430 | default: 431 | return ec.signalError("Unknown arithmetic operator") 432 | } 433 | } 434 | 435 | return newInteger(accum), nil 436 | } 437 | 438 | func (ec *execContext) arithmeticCompare(cmp arithmeticCmp, objs ...lispObject) (lispObject, error) { 439 | for i := 1; i < len(objs); i++ { 440 | if !numberp(objs[i-1]) { 441 | return ec.wrongTypeArgument(ec.s.numberOrMarkerp, objs[i-1]) 442 | } else if !numberp(objs[i]) { 443 | return ec.wrongTypeArgument(ec.s.numberOrMarkerp, objs[i]) 444 | } 445 | 446 | if !integerp(objs[i-1]) || !integerp(objs[i]) { 447 | return ec.pimacsUnimplemented(ec.nil_, "arithmetic comparison for floats is unimplemented") 448 | } 449 | 450 | i1 := xIntegerValue(objs[i-1]) 451 | i2 := xIntegerValue(objs[i]) 452 | cond := false 453 | 454 | switch cmp { 455 | case arithmeticCmpEqual: 456 | cond = (i1 == i2) 457 | case arithmeticCmpNotEqual: 458 | cond = (i1 != i2) 459 | case arithmeticCmpLess: 460 | cond = (i1 < i2) 461 | case arithmeticCmpGreater: 462 | cond = (i1 > i2) 463 | case arithmeticCmpLessOrEqual: 464 | cond = (i1 <= i2) 465 | case arithmeticCmpGreaterOrEqual: 466 | cond = (i1 >= i2) 467 | default: 468 | return ec.signalError("Unknown arithmetic comparison operator") 469 | } 470 | 471 | if !cond { 472 | return ec.false_() 473 | } 474 | } 475 | 476 | return ec.true_() 477 | } 478 | 479 | func (ec *execContext) lessThanSign(objs ...lispObject) (lispObject, error) { 480 | return ec.arithmeticCompare(arithmeticCmpLess, objs...) 481 | } 482 | 483 | func (ec *execContext) greaterThanSign(objs ...lispObject) (lispObject, error) { 484 | return ec.arithmeticCompare(arithmeticCmpGreater, objs...) 485 | } 486 | 487 | func (ec *execContext) equalsSign(objs ...lispObject) (lispObject, error) { 488 | return ec.arithmeticCompare(arithmeticCmpEqual, objs...) 489 | } 490 | 491 | func (ec *execContext) notEqualsSign(obj1, obj2 lispObject) (lispObject, error) { 492 | return ec.arithmeticCompare(arithmeticCmpNotEqual, obj1, obj2) 493 | } 494 | 495 | func (ec *execContext) lessThanEqualsSign(objs ...lispObject) (lispObject, error) { 496 | return ec.arithmeticCompare(arithmeticCmpLessOrEqual, objs...) 497 | } 498 | 499 | func (ec *execContext) greaterThanEqualsSign(objs ...lispObject) (lispObject, error) { 500 | return ec.arithmeticCompare(arithmeticCmpGreaterOrEqual, objs...) 501 | } 502 | 503 | func (ec *execContext) bareSymbol(sym lispObject) (lispObject, error) { 504 | // TODO: Is this correct? 505 | return sym, nil 506 | } 507 | 508 | func (ec *execContext) aref(array, index lispObject) (lispObject, error) { 509 | if !integerp(index) { 510 | return ec.wrongTypeArgument(ec.s.integerp, index) 511 | } 512 | 513 | idx := int(xIntegerValue(index)) 514 | if idx < 0 { 515 | return ec.argsOutOfRange(array, index) 516 | } 517 | 518 | switch array.getType() { 519 | case lispTypeString: 520 | val, err := xStringAref(array, idx) 521 | if err != nil { 522 | return ec.argsOutOfRange(array, index) 523 | } 524 | return newInteger(val), nil 525 | case lispTypeVector: 526 | val := xVectorValue(array) 527 | if idx >= len(val) { 528 | return ec.argsOutOfRange(array, index) 529 | } 530 | return val[idx], nil 531 | default: 532 | return ec.pimacsUnimplemented(ec.nil_, "aref unimplemented") 533 | } 534 | } 535 | 536 | func (ec *execContext) aset(array, index, elem lispObject) (lispObject, error) { 537 | if !integerp(index) { 538 | return ec.wrongTypeArgument(ec.s.integerp, index) 539 | } 540 | 541 | idx := int(xIntegerValue(index)) 542 | if idx < 0 { 543 | return ec.argsOutOfRange(array, index) 544 | } 545 | 546 | switch array.getType() { 547 | case lispTypeVector: 548 | val := xVectorValue(array) 549 | if idx >= len(val) { 550 | return ec.argsOutOfRange(array, index) 551 | } 552 | val[idx] = elem 553 | default: 554 | return ec.pimacsUnimplemented(ec.nil_, "aset unimplemented") 555 | } 556 | 557 | return elem, nil 558 | } 559 | 560 | func (ec *execContext) symbolsOfData() { 561 | ec.defSym(&ec.s.wholeNump, "wholenump") 562 | 563 | ec.defSubr1(nil, "null", (*execContext).null, 1) 564 | ec.defSubr1(&ec.s.sequencep, "sequencep", (*execContext).sequencep, 1) 565 | ec.defSubr1(&ec.s.consp, "consp", (*execContext).consp, 1) 566 | ec.defSubr1(&ec.s.listp, "listp", (*execContext).listp, 1) 567 | ec.defSubr1(&ec.s.arrayp, "arrayp", (*execContext).arrayp, 1) 568 | ec.defSubr1(nil, "atom", (*execContext).atom, 1) 569 | ec.defSubr1(&ec.s.symbolp, "symbolp", (*execContext).symbolp, 1) 570 | ec.defSubr1(&ec.s.stringp, "stringp", (*execContext).stringp, 1) 571 | ec.defSubr1(nil, "multibyte-string-p", (*execContext).multibyteStringp, 1) 572 | ec.defSubr1(&ec.s.numberOrMarkerp, "number-or-marker-p", (*execContext).numberOrMarkerp, 1) 573 | ec.defSubr1(&ec.s.integerOrMarkerp, "integer-or-marker-p", (*execContext).integerOrMarkerp, 1) 574 | ec.defSubr1(&ec.s.charOrStringp, "char-or-string-p", (*execContext).charOrStringp, 1) 575 | ec.defSubr1(&ec.s.integerp, "integerp", (*execContext).numberOrMarkerp, 1) 576 | ec.defSubr1(nil, "numberp", (*execContext).numberp, 1) 577 | ec.defSubr1(&ec.s.bufferp, "bufferp", (*execContext).bufferp, 1) 578 | ec.defSubr2(&ec.s.characterp, "characterp", (*execContext).characterp, 1) 579 | ec.defSubr1(&ec.s.charTablep, "char-table-p", (*execContext).charTablep, 1) 580 | ec.defSubr1(&ec.s.channelp, "channelp", (*execContext).channelp, 1) 581 | ec.defSubr1(nil, "vectorp", (*execContext).vectorp, 1) 582 | ec.defSubr1(&ec.s.hashTablep, "hashtablep", (*execContext).hashTablep, 1) 583 | ec.defSubr1(nil, "boundp", (*execContext).boundp, 1) 584 | ec.defSubr1(nil, "fboundp", (*execContext).fboundp, 1) 585 | ec.defSubr1(nil, "makunbound", (*execContext).makunbound, 1) 586 | ec.defSubr1(nil, "fmakunbound", (*execContext).fmakunbound, 1) 587 | ec.defSubr2(nil, "indirect-function", (*execContext).indirectFunction, 1) 588 | ec.defSubr1(nil, "car", (*execContext).car, 1) 589 | ec.defSubr1(nil, "cdr", (*execContext).cdr, 1) 590 | ec.defSubr1(nil, "car-safe", (*execContext).carSafe, 1) 591 | ec.defSubr1(nil, "cdr-safe", (*execContext).cdrSafe, 1) 592 | ec.defSubr2(nil, "setcar", (*execContext).setCar, 2) 593 | ec.defSubr2(nil, "setcdr", (*execContext).setCdr, 2) 594 | ec.defSubr1(nil, "symbol-plist", (*execContext).symbolPlist, 1) 595 | ec.defSubr1(nil, "symbol-name", (*execContext).symbolName, 1) 596 | ec.defSubr2(nil, "set", (*execContext).set, 2) 597 | ec.defSubr2(nil, "set-default", (*execContext).setDefault, 2) 598 | ec.defSubr2(nil, "fset", (*execContext).fset, 2) 599 | ec.defSubr1(nil, "symbol-value", (*execContext).symbolValue, 1) 600 | ec.defSubr1(nil, "symbol-function", (*execContext).symbolFunction, 1) 601 | ec.defSubr2(&ec.s.eq, "eq", (*execContext).eq, 2) 602 | ec.defSubr3(nil, "defalias", (*execContext).defalias, 2) 603 | ec.defSubrM(nil, "+", (*execContext).plusSign, 0) 604 | ec.defSubr2(nil, "%", (*execContext).remainder, 2) 605 | ec.defSubrM(nil, "*", (*execContext).product, 0) 606 | ec.defSubrM(nil, "logior", (*execContext).logiOr, 0) 607 | ec.defSubrM(nil, "<", (*execContext).lessThanSign, 1) 608 | ec.defSubrM(nil, ">", (*execContext).greaterThanSign, 1) 609 | ec.defSubrM(nil, "=", (*execContext).equalsSign, 1) 610 | ec.defSubr2(nil, "/=", (*execContext).notEqualsSign, 2) 611 | ec.defSubrM(nil, "<=", (*execContext).lessThanEqualsSign, 1) 612 | ec.defSubrM(nil, ">=", (*execContext).greaterThanEqualsSign, 1) 613 | ec.defSubr1(nil, "bare-symbol", (*execContext).bareSymbol, 1) 614 | ec.defSubr2(nil, "aref", (*execContext).aref, 2) 615 | ec.defSubr3(nil, "aset", (*execContext).aset, 3) 616 | ec.defSubr1(nil, "1+", (*execContext).onePlus, 1) 617 | } 618 | -------------------------------------------------------------------------------- /core/exec_context.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "fmt" 5 | "github.com/federicotdn/pimacs/proto" 6 | "strings" 7 | "sync" 8 | ) 9 | 10 | type stackEntryTag int 11 | 12 | const ( 13 | entryLet stackEntryTag = iota + 1 14 | entryLetForwarded 15 | entryCatch 16 | entryFnLispObject 17 | entryBacktrace 18 | ) 19 | 20 | type stackEntry interface { 21 | tag() stackEntryTag 22 | } 23 | 24 | type stackJumpTag struct { 25 | tag lispObject 26 | value lispObject 27 | } 28 | 29 | type stackJumpSignal struct { 30 | errorSymbol lispObject 31 | data lispObject 32 | goStack string 33 | lispStack string 34 | ec *execContext 35 | 36 | location []string 37 | } 38 | 39 | type goroutineLocals struct { 40 | stack []stackEntry 41 | currentBuf *lispBuffer 42 | obarray obarrayType 43 | 44 | internalInterpreterEnv forwardLispObj 45 | lexicalBinding forwardLispObj 46 | } 47 | 48 | type execContext struct { 49 | gl *goroutineLocals 50 | 51 | nil_ lispObject 52 | t lispObject 53 | s *symbols 54 | v *vars 55 | 56 | obarray obarrayType 57 | 58 | buffers map[string]*lispBuffer 59 | buffersLock *sync.RWMutex 60 | 61 | hashTestEq *lispHashTableTest 62 | hashTestEql *lispHashTableTest 63 | hashTestEqual *lispHashTableTest 64 | 65 | events chan proto.InputEvent 66 | ops chan proto.DrawOp 67 | done chan bool 68 | 69 | testing bool 70 | running bool 71 | } 72 | 73 | type stackEntryLet struct { 74 | symbol *lispSymbol 75 | oldVal lispObject 76 | } 77 | 78 | type stackEntryLetForwarded struct { 79 | symbol *lispSymbol 80 | oldVal lispObject 81 | } 82 | 83 | type stackEntryCatch struct { 84 | catchTag lispObject 85 | } 86 | 87 | type stackEntryFnLispObject struct { 88 | function func(lispObject) 89 | arg lispObject 90 | } 91 | 92 | type stackEntryBacktrace struct { 93 | debugOnExit bool 94 | function lispObject 95 | args []lispObject 96 | evaluated bool 97 | } 98 | 99 | func (jmp *stackJumpTag) Error() string { 100 | format := "stack jump: tag: '%+v'" 101 | if symbolp(jmp.tag) { 102 | return fmt.Sprintf(format, xSymbolName(jmp.tag)) 103 | } 104 | 105 | return fmt.Sprintf(format, jmp.tag) 106 | } 107 | 108 | func (jmp *stackJumpSignal) Is(target error) bool { 109 | other, ok := target.(*stackJumpSignal) 110 | if !ok { 111 | return false 112 | } 113 | 114 | if jmp.errorSymbol != other.errorSymbol { 115 | return false 116 | } 117 | 118 | ec := jmp.ec 119 | 120 | switch jmp.errorSymbol { 121 | case ec.s.wrongTypeArgument: 122 | ourData := xCdr(jmp.data) 123 | otherData := xCdr(other.data) 124 | if !consp(ourData) || !consp(otherData) { 125 | return false 126 | } 127 | 128 | ourPred := xCar(ourData) 129 | otherPred := xCar(otherData) 130 | return ourPred == otherPred 131 | default: 132 | // By default, two stack jumps with the same error 133 | // symbol are considered equal, unless a specific 134 | // handler for that error symbol is implemented 135 | return true 136 | } 137 | } 138 | 139 | func (jmp *stackJumpSignal) Error() string { 140 | message := "stack jump: signal:" 141 | ending := "\nbacktrace:\n" + jmp.lispStack + "\n\nat: " + jmp.goStack 142 | 143 | if jmp.location != nil { 144 | ending += "\nlocation:" 145 | for _, loc := range jmp.location { 146 | ending += fmt.Sprintf("\n - %v", loc) 147 | 148 | } 149 | } 150 | 151 | if !symbolp(jmp.errorSymbol) { 152 | message += fmt.Sprintf(" '%+v' ''", jmp.errorSymbol) 153 | return message 154 | } 155 | 156 | name := xSymbolName(jmp.errorSymbol) 157 | message += fmt.Sprintf(" '%+v'", name) 158 | 159 | originalData := xCdr(jmp.data) 160 | data := originalData 161 | if !consp(data) { 162 | if stringp(data) { 163 | message += fmt.Sprintf(" '%+v'", xStringValue(data)) 164 | } else { 165 | message += fmt.Sprintf(" '%+v'", data) 166 | } 167 | return message + ending 168 | } 169 | 170 | ec := jmp.ec 171 | 172 | switch jmp.errorSymbol { 173 | case ec.s.error_, ec.s.pimacsUnimplemented, ec.s.fileMissing, ec.s.invalidReadSyntax: 174 | message += fmt.Sprintf(" '%+v'", xStringValue(xCar(data))) 175 | case ec.s.voidVariable: 176 | message += fmt.Sprintf(" '%+v'", xSymbolName(xCar(data))) 177 | case ec.s.voidFunction: 178 | message += fmt.Sprintf(" '%+v'", xCar(data)) 179 | case ec.s.wrongTypeArgument: 180 | pred := xCar(data) 181 | val := xCar(xCdr(data)) 182 | message += fmt.Sprintf(" '%+v' '%+v'", xSymbolName(pred), val) 183 | case ec.s.wrongNumberofArguments: 184 | fn := xCar(data) 185 | 186 | for ; consp(fn); fn = xCar(fn) { 187 | } 188 | 189 | if symbolp(fn) { 190 | message += fmt.Sprintf(" '%+v'", xSymbolName(fn)) 191 | } else if subroutinep(fn) { 192 | message += fmt.Sprintf(" '%+v'", xSubroutine(fn).name) 193 | } else { 194 | message += " ''" 195 | } 196 | 197 | count := xCar(xCdr(data)) 198 | message += fmt.Sprintf(" '%+v'", xIntegerValue(count)) 199 | default: 200 | message += fmt.Sprintf(" '%+v'", originalData) 201 | 202 | } 203 | 204 | return message + ending 205 | } 206 | 207 | func (se *stackEntryLet) tag() stackEntryTag { 208 | return entryLet 209 | } 210 | 211 | func (se *stackEntryLetForwarded) tag() stackEntryTag { 212 | return entryLetForwarded 213 | } 214 | 215 | func (se *stackEntryCatch) tag() stackEntryTag { 216 | return entryCatch 217 | } 218 | 219 | func (se *stackEntryFnLispObject) tag() stackEntryTag { 220 | return entryFnLispObject 221 | } 222 | 223 | func (se *stackEntryBacktrace) tag() stackEntryTag { 224 | return entryBacktrace 225 | } 226 | 227 | func (ec *execContext) makeSymbol(name lispObject, init bool) *lispSymbol { 228 | sym := &lispSymbol{name: name} 229 | if init { 230 | sym.val = ec.s.unbound 231 | sym.function = ec.nil_ 232 | sym.plist = ec.nil_ 233 | } 234 | 235 | return sym 236 | } 237 | 238 | func (ec *execContext) makeList(objs ...lispObject) lispObject { 239 | if len(objs) == 0 { 240 | return ec.nil_ 241 | } 242 | 243 | tmp := newCons(objs[0], ec.nil_) 244 | val := tmp 245 | 246 | for _, obj := range objs[1:] { 247 | tmp.cdr = newCons(obj, ec.nil_) 248 | tmp = xCons(tmp.cdr) 249 | } 250 | 251 | return val 252 | } 253 | 254 | func (ec *execContext) makeKwPlist(objs map[string]lispObject) (lispObject, error) { 255 | if len(objs) == 0 { 256 | return ec.nil_, nil 257 | } 258 | 259 | val := ec.nil_ 260 | 261 | for key, obj := range objs { 262 | val = newCons(obj, val) 263 | sym, err := ec.intern(newString(":"+key, true), ec.nil_) 264 | if err != nil { 265 | return nil, err 266 | } 267 | val = newCons(sym, val) 268 | } 269 | 270 | return val, nil 271 | } 272 | 273 | type listIter struct { 274 | tail lispObject 275 | listHead lispObject 276 | err error 277 | ec *execContext 278 | predicate lispObject 279 | hasCycle bool 280 | } 281 | 282 | func (ec *execContext) iterate(tail lispObject) *listIter { 283 | li := &listIter{ 284 | tail: tail, 285 | listHead: tail, 286 | ec: ec, 287 | predicate: ec.s.listp, 288 | } 289 | 290 | // We may have been given already an object that is not a list 291 | li.checkTailType() 292 | 293 | return li 294 | } 295 | 296 | func (li *listIter) withPredicate(predicate lispObject) *listIter { 297 | li.predicate = predicate 298 | return li 299 | } 300 | 301 | func (li *listIter) hasNext() bool { 302 | return consp(li.tail) && !li.hasError() 303 | } 304 | 305 | func (li *listIter) checkTailType() { 306 | if !consp(li.tail) && li.tail != li.ec.nil_ { 307 | // List does not end with nil. 308 | // Signal using list start, not tail! 309 | li.err = xErrOnly(li.ec.wrongTypeArgument(li.predicate, li.listHead)) 310 | } 311 | } 312 | 313 | func (li *listIter) nextCons() lispObject { 314 | // TODO: incomplete 315 | // Need cycle detection still. 316 | li.tail = xCdr(li.tail) 317 | 318 | li.checkTailType() 319 | 320 | return li.tail 321 | } 322 | 323 | func (li *listIter) hasError() bool { 324 | return li.err != nil 325 | } 326 | 327 | func (li *listIter) circular() bool { 328 | return li.hasCycle 329 | } 330 | 331 | func (li *listIter) error() (lispObject, error) { 332 | return nil, li.err 333 | } 334 | 335 | func (ec *execContext) defSubrInternal(symbol *lispObject, fn lispFn, name string, minArgs, maxArgs int) *lispSubroutine { 336 | sub := &lispSubroutine{ 337 | callabe: fn, 338 | name: name, 339 | minArgs: minArgs, 340 | maxArgs: maxArgs, 341 | } 342 | 343 | if sub.maxArgs >= 0 && sub.minArgs > sub.maxArgs { 344 | ec.terminate("min args (got: %v) must be smaller or equal to max args (%v) (subroutine: '%+v')", minArgs, maxArgs, name) 345 | } 346 | 347 | sym := ec.defSym(symbol, sub.name) 348 | if sym.function != ec.s.nil_ { 349 | ec.terminate("subroutine value already set: '%+v'", name) 350 | } 351 | 352 | sym.function = sub 353 | if symbol != nil { 354 | *symbol = sym 355 | } 356 | 357 | return sub 358 | } 359 | 360 | func (ec *execContext) defSubr0(symbol *lispObject, name string, fn lispFn0) *lispSubroutine { 361 | return ec.defSubrInternal(symbol, fn, name, 0, 0) 362 | } 363 | 364 | func (ec *execContext) defSubr1(symbol *lispObject, name string, fn lispFn1, minArgs int) *lispSubroutine { 365 | return ec.defSubrInternal(symbol, fn, name, minArgs, 1) 366 | } 367 | 368 | func (ec *execContext) defSubr2(symbol *lispObject, name string, fn lispFn2, minArgs int) *lispSubroutine { 369 | return ec.defSubrInternal(symbol, fn, name, minArgs, 2) 370 | } 371 | 372 | func (ec *execContext) defSubr3(symbol *lispObject, name string, fn lispFn3, minArgs int) *lispSubroutine { 373 | return ec.defSubrInternal(symbol, fn, name, minArgs, 3) 374 | } 375 | 376 | func (ec *execContext) defSubr4(symbol *lispObject, name string, fn lispFn4, minArgs int) *lispSubroutine { 377 | return ec.defSubrInternal(symbol, fn, name, minArgs, 4) 378 | } 379 | 380 | func (ec *execContext) defSubr5(symbol *lispObject, name string, fn lispFn5, minArgs int) *lispSubroutine { 381 | return ec.defSubrInternal(symbol, fn, name, minArgs, 5) 382 | } 383 | 384 | func (ec *execContext) defSubr6(symbol *lispObject, name string, fn lispFn6, minArgs int) *lispSubroutine { 385 | return ec.defSubrInternal(symbol, fn, name, minArgs, 6) 386 | } 387 | 388 | func (ec *execContext) defSubr7(symbol *lispObject, name string, fn lispFn7, minArgs int) *lispSubroutine { 389 | return ec.defSubrInternal(symbol, fn, name, minArgs, 7) 390 | } 391 | 392 | func (ec *execContext) defSubr8(symbol *lispObject, name string, fn lispFn8, minArgs int) *lispSubroutine { 393 | return ec.defSubrInternal(symbol, fn, name, minArgs, 8) 394 | } 395 | 396 | func (ec *execContext) defSubrM(symbol *lispObject, name string, fn lispFnM, minArgs int) *lispSubroutine { 397 | return ec.defSubrInternal(symbol, fn, name, minArgs, argsMany) 398 | } 399 | func (ec *execContext) defSubrU(symbol *lispObject, name string, fn lispFn1, minArgs int) *lispSubroutine { 400 | return ec.defSubrInternal(symbol, fn, name, minArgs, argsUnevalled) 401 | } 402 | 403 | func (ec *execContext) defSym(symbol *lispObject, name string) *lispSymbol { 404 | if symbol != nil && *symbol != nil { 405 | // Maybe this pointer is already pointing at an initialized 406 | // symbol 407 | ec.terminate("symbol already initialized: '%+v'", *symbol) 408 | } 409 | 410 | obarray := &ec.obarray 411 | if ec.running { 412 | obarray = &ec.gl.obarray 413 | } 414 | if obarray.containsSymbol(name) { 415 | ec.terminate("symbol already interned: '%+v'", name) 416 | } 417 | 418 | obj, err := ec.internInternal(newString(name, true), obarray) 419 | if err != nil { 420 | ec.terminate("error interning symbol: '%+v'", err) 421 | } 422 | 423 | if symbol != nil { 424 | *symbol = obj 425 | } 426 | 427 | return xSymbol(obj) 428 | } 429 | 430 | func (ec *execContext) defVarLisp(fwd *forwardLispObj, name string, value lispObject) { 431 | if fwd.sym != nil { 432 | ec.terminate("variable already initialized: '%+v'", fwd) 433 | } 434 | sym := ec.defSym(nil, name) 435 | sym.special = true 436 | fwd.sym = sym 437 | fwd.val = value 438 | 439 | sym.redirect = symbolRedirectFwd 440 | sym.fwd = fwd 441 | } 442 | 443 | func (ec *execContext) defVarBool(fwd *forwardBool, name string, value bool) { 444 | if fwd.sym != nil { 445 | ec.terminate("variable already initialized: '%+v'", fwd) 446 | } 447 | sym := ec.defSym(nil, name) 448 | sym.special = true 449 | fwd.sym = sym 450 | fwd.val = value 451 | 452 | sym.redirect = symbolRedirectFwd 453 | sym.fwd = fwd 454 | } 455 | 456 | func (ec *execContext) initGoroutineLocals() { 457 | ec.defVarLisp(&ec.gl.lexicalBinding, "lexical-binding", ec.nil_) 458 | ec.defVarLisp(&ec.gl.internalInterpreterEnv, "internal-interpreter-environment", ec.nil_) 459 | ec.gl.obarray.removeSymbol("internal-interpreter-environment") 460 | 461 | ec.initBufferGoroutineLocals() // buffer.go 462 | } 463 | 464 | func newGoroutineLocals() *goroutineLocals { 465 | return &goroutineLocals{ 466 | obarray: newObarray(false), 467 | } 468 | } 469 | 470 | func newExecContext(loadPathPrepend []string) (*execContext, error) { 471 | ec := execContext{ 472 | gl: newGoroutineLocals(), 473 | s: &symbols{}, 474 | v: &vars{}, 475 | obarray: newObarray(true), 476 | buffers: make(map[string]*lispBuffer), 477 | buffersLock: &sync.RWMutex{}, 478 | // TODO: Move '10' to config value 479 | events: make(chan proto.InputEvent, 10), 480 | ops: make(chan proto.DrawOp, 10), 481 | done: make(chan bool), 482 | } 483 | 484 | // Symbol and vars basic initialization 485 | ec.initSymbols() // symbols.go 486 | ec.symbolsOfExecContext() // exec_context.go 487 | ec.symbolsOfErrors() // errors.go 488 | ec.symbolsOfRead() // read.go 489 | ec.symbolsOfEval() // eval.go 490 | ec.symbolsOfPrint() // print.go 491 | ec.symbolsOfData() // data.go 492 | ec.symbolsOfAllocation() // allocation.go 493 | ec.symbolsOfFunctions() // functions.go 494 | ec.symbolsOfBuffer() // buffer.go 495 | ec.symbolsOfMinibuffer() // minibuffer.go 496 | ec.symbolsOfCallProc() // callproc.go 497 | ec.symbolsOfKeyboard() // keyboard.go 498 | ec.symbolsOfCharacterTable() // character_table.go 499 | ec.symbolsOfCharacterSet() // character_set.go 500 | ec.symbolsOfGoroutine() // goroutine.go 501 | ec.symbolsOfPimacsTools() // pimacs_tools.go 502 | ec.symbolsOfEditFunctions() // edit_functions.go 503 | ec.symbolsOfKeymap() // keymap.go 504 | 505 | // Goroutine-specific initialization 506 | ec.initGoroutineLocals() 507 | 508 | ec.checkSymbolValues() 509 | ec.checkVarValues() 510 | 511 | ec.running = true 512 | 513 | // We are now ready to evaluate Elisp code 514 | return &ec, ec.loadElisp(loadPathPrepend) 515 | } 516 | 517 | func (ec *execContext) symbolsOfExecContext() { 518 | ec.defVarBool(&ec.v.nonInteractive, "noninteractive", true) 519 | 520 | val := ec.nil_ 521 | switch getOS() { 522 | case osLinux: 523 | val = ec.xIntern("gnu/linux") 524 | case osWindows: 525 | val = ec.xIntern("windows-nt") 526 | case osMacOS: 527 | val = ec.xIntern("darwin") 528 | case osUnknown: 529 | val = ec.xIntern("unknown") 530 | } 531 | 532 | ec.defVarLisp(&ec.v.systemType, "system-type", val) 533 | ec.defSym(&ec.s.riskyLocalVariable, "risky-local-variable") 534 | } 535 | 536 | func (ec *execContext) copyExecContext() *execContext { 537 | copy := *ec 538 | copy.gl = newGoroutineLocals() 539 | copy.initGoroutineLocals() 540 | return © 541 | } 542 | 543 | func (ec *execContext) loadElisp(loadPathPrepend []string) error { 544 | loadPath := []lispObject{} 545 | for _, elem := range loadPathPrepend { 546 | loadPath = append(loadPath, newString(elem, true)) 547 | } 548 | loadPath = append(loadPath, newString("lisp", false), newString("lisp/emacs", false)) 549 | 550 | ec.v.loadPath.val = ec.makeList(loadPath...) 551 | 552 | _, err := ec.load(newString("loadup-pimacs.el", false), ec.nil_, ec.nil_, ec.nil_, ec.nil_) 553 | return err 554 | } 555 | 556 | func (ec *execContext) listToSlice(list lispObject) ([]lispObject, error) { 557 | result := []lispObject{} 558 | 559 | iter := ec.iterate(list) 560 | for ; iter.hasNext(); list = iter.nextCons() { 561 | result = append(result, xCar(list)) 562 | } 563 | 564 | if iter.hasError() { 565 | return nil, xErrOnly(iter.error()) 566 | } 567 | 568 | return result, nil 569 | } 570 | 571 | func (ec *execContext) kwPlistToMap(plist lispObject) (map[string]lispObject, error) { 572 | result := make(map[string]lispObject) 573 | lastKey := "" 574 | 575 | iter := ec.iterate(plist).withPredicate(ec.s.plistp) 576 | for ; iter.hasNext(); plist = iter.nextCons() { 577 | elem := xCar(plist) 578 | 579 | if lastKey == "" { 580 | if symbolp(elem) && strings.HasPrefix(xSymbolName(elem), ":") { 581 | lastKey = xSymbolName(elem) 582 | } else { 583 | _, err := ec.signalError("Invalid plist key: '%+v'", elem) 584 | return nil, err 585 | } 586 | } else { 587 | _, ok := result[lastKey] 588 | if !ok { 589 | result[lastKey] = elem 590 | } 591 | lastKey = "" 592 | } 593 | } 594 | 595 | if lastKey != "" { 596 | // Last element was a key 597 | return nil, xErrOnly(ec.wrongTypeArgument(ec.s.plistp, plist)) 598 | } 599 | 600 | if iter.hasError() { 601 | return nil, xErrOnly(iter.error()) 602 | } 603 | 604 | return result, nil 605 | } 606 | 607 | func (ec *execContext) stackPushLet(symbol lispObject, value lispObject) error { 608 | sym := xSymbol(symbol) 609 | 610 | switch sym.redirect { 611 | case symbolRedirectPlain: 612 | ec.gl.stack = append(ec.gl.stack, &stackEntryLet{ 613 | symbol: sym, 614 | oldVal: sym.val, 615 | }) 616 | sym.val = value 617 | case symbolRedirectFwd: 618 | entry := &stackEntryLetForwarded{ 619 | symbol: sym, 620 | oldVal: sym.fwd.value(ec), 621 | } 622 | 623 | err := sym.fwd.setValue(ec, value) 624 | if err != nil { 625 | return err 626 | } 627 | ec.gl.stack = append(ec.gl.stack, entry) 628 | default: 629 | ec.terminate("unknown symbol redirect type: '%+v'", sym.redirect) 630 | } 631 | 632 | return nil 633 | } 634 | 635 | func (ec *execContext) stackPushCatch(tag lispObject) { 636 | ec.gl.stack = append(ec.gl.stack, &stackEntryCatch{ 637 | catchTag: tag, 638 | }) 639 | } 640 | 641 | func (ec *execContext) stackPushCurrentBuffer() { 642 | arg := ec.currentBufferInternal() 643 | ec.stackPushFnLispObject(ec.setBufferIfLive, arg) 644 | } 645 | 646 | func (ec *execContext) stackPushFnLispObject(function func(lispObject), arg lispObject) { 647 | ec.gl.stack = append(ec.gl.stack, &stackEntryFnLispObject{ 648 | function: function, 649 | arg: arg, 650 | }) 651 | } 652 | 653 | func (ec *execContext) stackPushBacktrace(function lispObject, args []lispObject, evaluated bool) { 654 | ec.gl.stack = append(ec.gl.stack, &stackEntryBacktrace{ 655 | function: function, 656 | args: args, 657 | evaluated: evaluated, 658 | }) 659 | } 660 | 661 | func (ec *execContext) catchInStack(tag lispObject) bool { 662 | for _, binding := range ec.gl.stack { 663 | if binding.tag() != entryCatch { 664 | continue 665 | } 666 | 667 | catchTag := binding.(*stackEntryCatch).catchTag 668 | if catchTag == tag { 669 | return true 670 | } 671 | } 672 | 673 | return false 674 | } 675 | 676 | // unwind returns an anonymous function that when called 677 | // will unwind the execution context stack to the point 678 | // where it was when unwind was called. 679 | // The most common way of invoking this function is: 680 | // defer ec.unwind()() 681 | func (ec *execContext) unwind() func() { 682 | size := ec.stackSize() 683 | return func() { 684 | ec.stackPopTo(size) 685 | } 686 | } 687 | 688 | func (ec *execContext) stackSize() int { 689 | return len(ec.gl.stack) 690 | } 691 | 692 | func (ec *execContext) stackPopTo(target int) { 693 | size := len(ec.gl.stack) 694 | if target < 0 || size < target { 695 | ec.terminate("unable to pop back to '%v', size is '%v'", target, size) 696 | } 697 | 698 | for len(ec.gl.stack) > target { 699 | current := ec.gl.stack[len(ec.gl.stack)-1] 700 | 701 | switch current.tag() { 702 | case entryLet: 703 | let := current.(*stackEntryLet) 704 | let.symbol.val = let.oldVal 705 | case entryLetForwarded: 706 | let := current.(*stackEntryLetForwarded) 707 | // Should not fail as we're just setting the old value back 708 | err := let.symbol.fwd.setValue(ec, let.oldVal) 709 | if err != nil { 710 | ec.terminate("could not restore forwarded symbol value: '%+v'", let) 711 | } 712 | case entryFnLispObject: 713 | entry := current.(*stackEntryFnLispObject) 714 | entry.function(entry.arg) 715 | case entryCatch: 716 | case entryBacktrace: 717 | default: 718 | ec.terminate("unknown stack item tag: '%v'", current.tag()) 719 | } 720 | 721 | ec.gl.stack = ec.gl.stack[:len(ec.gl.stack)-1] 722 | } 723 | } 724 | 725 | func (ec *execContext) boolVal(b bool) lispObject { 726 | if b { 727 | return ec.t 728 | } 729 | return ec.nil_ 730 | } 731 | 732 | func (ec *execContext) bool(b bool) (lispObject, error) { 733 | return ec.boolVal(b), nil 734 | } 735 | 736 | func (ec *execContext) true_() (lispObject, error) { 737 | return ec.bool(true) 738 | } 739 | 740 | func (ec *execContext) false_() (lispObject, error) { 741 | return ec.bool(false) 742 | } 743 | 744 | func (ec *execContext) warning(format string, v ...interface{}) { 745 | fmt.Printf(format+"\n", v...) 746 | } 747 | 748 | func (ec *execContext) terminate(format string, v ...interface{}) { 749 | if !ec.testing { 750 | stack := debugReprLispStack(ec.gl.stack) 751 | fmt.Println("backtrace:") 752 | fmt.Println(stack) 753 | } 754 | terminate(format, v...) 755 | } 756 | -------------------------------------------------------------------------------- /core/functions.go: -------------------------------------------------------------------------------- 1 | package core 2 | 3 | import ( 4 | "hash/fnv" 5 | "math" 6 | "slices" 7 | ) 8 | 9 | const sxHashMaxDepth = 3 10 | 11 | type lispHashTableLookupResult struct { 12 | entries []lispHashTableEntry 13 | i int 14 | code lispInt 15 | err error 16 | } 17 | 18 | func (ec *execContext) listLength(obj lispObject) (int, error) { 19 | num := 0 20 | 21 | iter := ec.iterate(obj) 22 | for ; iter.hasNext(); iter.nextCons() { 23 | num += 1 24 | } 25 | 26 | if iter.hasError() { 27 | return 0, xErrOnly(iter.error()) 28 | } 29 | 30 | return num, nil 31 | } 32 | 33 | func (ec *execContext) length(obj lispObject) (lispObject, error) { 34 | num := 0 35 | 36 | switch obj.getType() { 37 | case lispTypeString: 38 | num = xStringSize(obj) 39 | case lispTypeCons: 40 | var err error 41 | num, err = ec.listLength(obj) 42 | if err != nil { 43 | return nil, err 44 | } 45 | case lispTypeVector: 46 | num = len(xVector(obj).val) 47 | default: 48 | if obj != ec.nil_ { 49 | return ec.wrongTypeArgument(ec.s.sequencep, obj) 50 | } 51 | } 52 | 53 | return newInteger(lispInt(num)), nil 54 | } 55 | 56 | func (ec *execContext) assq(key, alist lispObject) (lispObject, error) { 57 | iter := ec.iterate(alist) 58 | for ; iter.hasNext(); alist = iter.nextCons() { 59 | element := xCar(alist) 60 | 61 | if consp(element) && xCar(element) == key { 62 | return element, nil 63 | } 64 | } 65 | 66 | if iter.hasError() { 67 | return iter.error() 68 | } 69 | 70 | return ec.nil_, nil 71 | } 72 | 73 | func (ec *execContext) assoc(key, alist, testFn lispObject) (lispObject, error) { 74 | iter := ec.iterate(alist) 75 | for ; iter.hasNext(); alist = iter.nextCons() { 76 | element := xCar(alist) 77 | 78 | if consp(element) { 79 | equal, err := ec.equal(xCar(element), key) 80 | if err != nil { 81 | return nil, err 82 | } 83 | 84 | if equal == ec.t { 85 | return element, nil 86 | } 87 | } 88 | } 89 | 90 | if iter.hasError() { 91 | return iter.error() 92 | } 93 | 94 | return ec.nil_, nil 95 | } 96 | 97 | func (ec *execContext) memq(elt, list lispObject) (lispObject, error) { 98 | iter := ec.iterate(list) 99 | for ; iter.hasNext(); list = iter.nextCons() { 100 | if xCar(list) == elt { 101 | return list, nil 102 | } 103 | } 104 | 105 | if iter.hasError() { 106 | return iter.error() 107 | } 108 | 109 | return ec.nil_, nil 110 | } 111 | 112 | func (ec *execContext) eql(o1, o2 lispObject) (lispObject, error) { 113 | if o1 == o2 { 114 | return ec.true_() 115 | } 116 | 117 | t1, t2 := o1.getType(), o2.getType() 118 | if t1 != t2 { 119 | return ec.false_() 120 | } 121 | 122 | switch t1 { 123 | case lispTypeInteger: 124 | if xIntegerValue(o1) == xIntegerValue(o2) { 125 | return ec.true_() 126 | } 127 | case lispTypeFloat: 128 | // TODO: Probably not correct, needs to match Emacs eql 129 | if xFloatValue(o1) == xFloatValue(o2) { 130 | return ec.true_() 131 | } 132 | } 133 | 134 | return ec.false_() 135 | } 136 | 137 | func (ec *execContext) equal(o1, o2 lispObject) (lispObject, error) { 138 | if o1 == o2 { 139 | return ec.true_() 140 | } 141 | 142 | t1, t2 := o1.getType(), o2.getType() 143 | if t1 != t2 { 144 | return ec.false_() 145 | } 146 | 147 | switch t1 { 148 | case lispTypeCons: 149 | iter := ec.iterate(o1) 150 | for ; iter.hasNext(); o1 = iter.nextCons() { 151 | if !consp(o2) { 152 | return ec.false_() 153 | } 154 | 155 | equal, err := ec.equal(xCar(o1), xCar(o2)) 156 | if err != nil { 157 | return nil, err 158 | } 159 | if equal == ec.nil_ { 160 | return ec.false_() 161 | } 162 | 163 | equal, err = ec.equal(xCdr(o1), xCdr(o2)) 164 | if err != nil { 165 | return nil, err 166 | } 167 | if equal != ec.nil_ { 168 | return ec.true_() 169 | } 170 | 171 | o2 = xCdr(o2) 172 | } 173 | 174 | if iter.hasError() { 175 | return iter.error() 176 | } 177 | 178 | return ec.false_() 179 | case lispTypeFloat: 180 | fallthrough 181 | case lispTypeInteger: 182 | return ec.eql(o1, o2) 183 | case lispTypeString: 184 | return ec.bool(xStringValue(o1) == xStringValue(o2)) 185 | case lispTypeSymbol: 186 | // Symbols must match exactly (eq). 187 | return ec.false_() 188 | case lispTypeVector: 189 | v1 := xVector(o1) 190 | v2 := xVector(o2) 191 | 192 | if len(v1.val) != len(v2.val) { 193 | return ec.false_() 194 | } 195 | 196 | for i := 0; i < len(v1.val); i++ { 197 | equal, err := ec.equal(v1.val[i], v2.val[i]) 198 | if err != nil { 199 | return nil, err 200 | } 201 | if equal == ec.nil_ { 202 | return ec.false_() 203 | } 204 | } 205 | 206 | return ec.true_() 207 | default: 208 | return ec.pimacsUnimplemented(ec.s.equal, "implementation missing for object type '%v'", t1) 209 | } 210 | } 211 | 212 | func (ec *execContext) plistp(object lispObject) (lispObject, error) { 213 | return ec.nil_, nil 214 | } 215 | 216 | func (ec *execContext) plistPut(plist, prop, val, predicate lispObject) (lispObject, error) { 217 | prev := ec.nil_ 218 | tail := plist 219 | iter := ec.iterate(tail).withPredicate(ec.s.plistp) 220 | 221 | for ; iter.hasNext(); tail = iter.nextCons() { 222 | next := xCdr(tail) 223 | if !consp(next) { 224 | return ec.wrongTypeArgument(ec.s.plistp, plist) 225 | } 226 | 227 | if prop == xCar(tail) { 228 | _, err := ec.setCar(xCdr(tail), val) 229 | if err != nil { 230 | return nil, err 231 | } 232 | return plist, nil 233 | } 234 | 235 | prev = tail 236 | // Advance in pairs when traversing plist 237 | iter.nextCons() 238 | } 239 | 240 | if iter.hasError() { 241 | return iter.error() 242 | } 243 | 244 | if prev == ec.nil_ { 245 | return newCons(prop, newCons(val, plist)), nil 246 | } else { 247 | newCell := newCons(prop, newCons(val, xCdr(xCdr(prev)))) 248 | _, err := ec.setCdr(xCdr(prev), newCell) 249 | if err != nil { 250 | return nil, err 251 | } 252 | 253 | return plist, nil 254 | } 255 | } 256 | 257 | func (ec *execContext) plistGet(plist, prop, predicate lispObject) (lispObject, error) { 258 | iter := ec.iterate(plist) 259 | 260 | for ; iter.hasNext(); plist = iter.nextCons() { 261 | if !consp(xCdr(plist)) { 262 | break 263 | } 264 | 265 | if prop == xCar(plist) { 266 | return xCar(xCdr(plist)), nil 267 | } 268 | 269 | // Advance in pairs when traversing plist 270 | iter.nextCons() 271 | } 272 | 273 | return ec.nil_, nil 274 | } 275 | 276 | func (ec *execContext) get(symbol, propName lispObject) (lispObject, error) { 277 | plist, err := ec.symbolPlist(symbol) 278 | if err != nil { 279 | return nil, err 280 | } 281 | return ec.plistGet(plist, propName, ec.nil_) 282 | } 283 | 284 | func (ec *execContext) put(symbol, propName, value lispObject) (lispObject, error) { 285 | plist, err := ec.symbolPlist(symbol) 286 | if err != nil { 287 | return nil, err 288 | } 289 | 290 | plist, err = ec.plistPut(plist, propName, value, ec.nil_) 291 | if err != nil { 292 | return nil, err 293 | } 294 | 295 | xSymbol(symbol).plist = plist 296 | return value, nil 297 | } 298 | 299 | func (ec *execContext) concat(args ...lispObject) (lispObject, error) { 300 | result := "" 301 | multibyte := false 302 | 303 | for _, arg := range args { 304 | switch { 305 | case stringp(arg): 306 | s := xString(arg) 307 | result += s.str() 308 | multibyte = multibyte || s.multibytep() 309 | case arg == ec.nil_: 310 | case consp(arg): 311 | fallthrough 312 | case vectorp(arg): 313 | fallthrough 314 | default: 315 | return ec.wrongTypeArgument(ec.s.sequencep, arg) 316 | } 317 | } 318 | 319 | return newString(result, multibyte), nil 320 | } 321 | 322 | func (ec *execContext) vconcat(args ...lispObject) (lispObject, error) { 323 | result := []lispObject{} 324 | 325 | for _, arg := range args { 326 | switch { 327 | case vectorp(arg): 328 | vec := xVector(arg) 329 | result = append(result, vec.val...) 330 | case arg == ec.nil_: 331 | case consp(arg): 332 | iter := ec.iterate(arg) 333 | for ; iter.hasNext(); arg = iter.nextCons() { 334 | result = append(result, xCar(arg)) 335 | } 336 | 337 | if iter.hasError() { 338 | return iter.error() 339 | } 340 | case stringp(arg): 341 | fallthrough 342 | default: 343 | return ec.wrongTypeArgument(ec.s.sequencep, arg) 344 | } 345 | } 346 | 347 | return newVector(result), nil 348 | } 349 | 350 | func (ec *execContext) append_(args ...lispObject) (lispObject, error) { 351 | result := ec.nil_ 352 | last := ec.nil_ 353 | 354 | for _, arg := range args { 355 | switch { 356 | case consp(arg): 357 | head := newCons(xCar(arg), ec.nil_) 358 | prev := head 359 | arg = xCdr(arg) 360 | 361 | iter := ec.iterate(arg) 362 | for ; iter.hasNext(); arg = iter.nextCons() { 363 | next := newCons(xCar(arg), ec.nil_) 364 | xSetCdr(prev, next) 365 | prev = next 366 | } 367 | 368 | if iter.hasError() { 369 | return iter.error() 370 | } 371 | 372 | if result == ec.nil_ { 373 | result = head 374 | } else { 375 | xSetCdr(last, head) 376 | } 377 | last = prev 378 | case arg == ec.nil_: 379 | case vectorp(arg): 380 | vec := xVector(arg) 381 | 382 | for _, elem := range vec.val { 383 | node := newCons(elem, ec.nil_) 384 | if result == ec.nil_ { 385 | result = node 386 | } else { 387 | xSetCdr(last, node) 388 | } 389 | last = node 390 | } 391 | case stringp(arg): 392 | fallthrough 393 | default: 394 | return ec.wrongTypeArgument(ec.s.sequencep, arg) 395 | } 396 | } 397 | 398 | return result, nil 399 | } 400 | 401 | func (ec *execContext) nconc(args ...lispObject) (lispObject, error) { 402 | val := ec.nil_ 403 | 404 | for i, tem := range args { 405 | if tem == ec.nil_ { 406 | continue 407 | } 408 | 409 | if val == ec.nil_ { 410 | val = tem 411 | } 412 | 413 | if i+1 == len(args) { 414 | // Break off early in last iteration 415 | break 416 | } 417 | 418 | if !consp(tem) { 419 | return ec.wrongTypeArgument(ec.s.consp, tem) 420 | } 421 | 422 | var tail lispObject 423 | for aux := tem; consp(aux); aux = xCdr(aux) { 424 | tail = aux 425 | } 426 | 427 | tem = args[i+1] 428 | _, err := ec.setCdr(tail, tem) 429 | if err != nil { 430 | return nil, err 431 | } 432 | 433 | if tem == ec.nil_ { 434 | args[i+1] = tail 435 | } 436 | } 437 | 438 | return val, nil 439 | } 440 | 441 | func (ec *execContext) copySequence(arg lispObject) (lispObject, error) { 442 | switch { 443 | case vectorp(arg): 444 | vec := xVector(arg) 445 | return newVector(slices.Clone(vec.val)), nil 446 | case arg == ec.nil_: 447 | return arg, nil 448 | case consp(arg): 449 | val := newCons(xCar(arg), ec.nil_) 450 | prev := val 451 | tail := xCdr(arg) 452 | 453 | iter := ec.iterate(tail) 454 | for ; iter.hasNext(); tail = iter.nextCons() { 455 | c := newCons(xCar(tail), ec.nil_) 456 | xSetCdr(prev, c) 457 | prev = c 458 | } 459 | 460 | if iter.hasError() { 461 | return iter.error() 462 | } 463 | 464 | return val, nil 465 | case stringp(arg): 466 | fallthrough 467 | default: 468 | return ec.wrongTypeArgument(ec.s.sequencep, arg) 469 | } 470 | } 471 | 472 | func (ec *execContext) provide(feature, subfeatures lispObject) (lispObject, error) { 473 | if !symbolp(feature) { 474 | return ec.wrongTypeArgument(ec.s.symbolp, feature) 475 | } else if !ec.listpBool(subfeatures) { 476 | return ec.wrongTypeArgument(ec.s.listp, subfeatures) 477 | } 478 | 479 | tem, err := ec.memq(feature, ec.v.features.val) 480 | if err != nil { 481 | return nil, err 482 | } 483 | if tem == ec.nil_ { 484 | ec.v.features.val = newCons(feature, ec.v.features.val) 485 | } 486 | if subfeatures != ec.nil_ { 487 | _, err := ec.put(feature, ec.s.subfeatures, subfeatures) 488 | if err != nil { 489 | return nil, err 490 | } 491 | } 492 | 493 | return feature, nil 494 | } 495 | 496 | func (ec *execContext) nreverse(seq lispObject) (lispObject, error) { 497 | return ec.reverse(seq) 498 | } 499 | 500 | func (ec *execContext) reverse(seq lispObject) (lispObject, error) { 501 | switch seq.getType() { 502 | case lispTypeSymbol: 503 | if seq != ec.nil_ { 504 | break 505 | } 506 | fallthrough 507 | case lispTypeCons: 508 | result, err := ec.listToSlice(seq) 509 | if err != nil { 510 | return nil, err 511 | } 512 | slices.Reverse(result) 513 | return ec.makeList(result...), nil 514 | case lispTypeVector: 515 | copy := slices.Clone(xVector(seq).val) 516 | slices.Reverse(copy) 517 | return newVector(copy), nil 518 | case lispTypeString: 519 | return ec.pimacsUnimplemented(ec.s.reverse, "no reverse for string") 520 | } 521 | 522 | return ec.wrongTypeArgument(ec.s.sequencep, seq) 523 | } 524 | 525 | func (ec *execContext) nthCdr(n, list lispObject) (lispObject, error) { 526 | if !integerp(n) { 527 | return ec.wrongTypeArgument(ec.s.integerp, n) 528 | } 529 | num := xIntegerValue(n) 530 | tail := list 531 | 532 | for ; 0 < num; num, tail = num-1, xCdr(tail) { 533 | if !consp(tail) { 534 | if tail != ec.nil_ { 535 | return ec.wrongTypeArgument(ec.s.listp, list) 536 | } 537 | return ec.nil_, nil 538 | } 539 | } 540 | 541 | return tail, nil 542 | } 543 | 544 | func (ec *execContext) nth(n, list lispObject) (lispObject, error) { 545 | cdr, err := ec.nthCdr(n, list) 546 | if err != nil { 547 | return nil, err 548 | } 549 | return ec.car(cdr) 550 | } 551 | 552 | func (ec *execContext) mapCarInternal(seq lispObject, length lispObject, function lispObject) ([]lispObject, error) { 553 | if !integerp(length) { 554 | return nil, xErrOnly(ec.wrongTypeArgument(ec.s.integerp, length)) 555 | } 556 | 557 | leni := xIntegerValue(length) 558 | 559 | switch { 560 | case seq == ec.nil_: 561 | return []lispObject{}, nil 562 | case consp(seq): 563 | result := []lispObject{} 564 | tail := seq 565 | for i := lispInt(0); i < leni; i++ { 566 | if !consp(tail) { 567 | return result, nil 568 | } 569 | 570 | tmp, err := ec.funcall(function, xCar(tail)) 571 | if err != nil { 572 | return nil, err 573 | } 574 | 575 | result = append(result, tmp) 576 | tail = xCdr(tail) 577 | } 578 | 579 | return result, nil 580 | default: 581 | return nil, xErrOnly(ec.pimacsUnimplemented(ec.s.mapCar, "mapcar unimplemented for this object: '%+v'", seq)) 582 | } 583 | } 584 | 585 | func (ec *execContext) mapCar(function, sequence lispObject) (lispObject, error) { 586 | length, err := ec.length(sequence) 587 | if err != nil { 588 | return nil, err 589 | } 590 | 591 | if chartablep(sequence) { 592 | return ec.wrongTypeArgument(ec.s.listp, sequence) 593 | } 594 | 595 | result, err := ec.mapCarInternal(sequence, length, function) 596 | if err != nil { 597 | return nil, err 598 | } 599 | return ec.makeList(result...), nil 600 | } 601 | 602 | func (ec *execContext) delq(element, list lispObject) (lispObject, error) { 603 | tail := list 604 | prev := ec.nil_ 605 | 606 | iter := ec.iterate(tail) 607 | for ; iter.hasNext(); tail = iter.nextCons() { 608 | tem := xCar(tail) 609 | if element == tem { 610 | if prev == ec.nil_ { 611 | list = xCdr(tail) 612 | } else if _, err := ec.setCdr(prev, xCdr(tail)); err != nil { 613 | return nil, err 614 | } 615 | } else { 616 | prev = tail 617 | } 618 | } 619 | 620 | if iter.hasError() { 621 | return iter.error() 622 | } 623 | 624 | return list, nil 625 | } 626 | 627 | func (ec *execContext) sxHashObj(obj lispObject, depth int) lispInt { 628 | if depth > sxHashMaxDepth { 629 | return 0 630 | } 631 | 632 | switch obj.getType() { 633 | case lispTypeInteger: 634 | return xIntegerValue(obj) 635 | case lispTypeSymbol: 636 | return objAddr(obj) 637 | case lispTypeString: 638 | // TODO: Revise this - good enough? 639 | h := fnv.New64a() 640 | h.Write([]byte(xStringValue(obj))) 641 | return lispInt(h.Sum64()) 642 | case lispTypeFloat: 643 | f := float64(xFloatValue(obj)) 644 | return lispInt(math.Float64bits(f)) 645 | default: 646 | ec.warning("sxhash implementation missing for object type '%+v'", obj.getType()) 647 | return 0 648 | } 649 | } 650 | 651 | func (ec *execContext) sxHashEq(obj lispObject) (lispObject, error) { 652 | return newInteger(objAddr(obj)), nil 653 | } 654 | 655 | func (ec *execContext) sxHashEql(obj lispObject) (lispObject, error) { 656 | if numberp(obj) { 657 | return ec.sxHashEqual(obj) 658 | } 659 | return ec.sxHashEq(obj) 660 | } 661 | 662 | func (ec *execContext) sxHashEqual(obj lispObject) (lispObject, error) { 663 | return newInteger(ec.sxHashObj(obj, 0)), nil 664 | } 665 | 666 | func (ec *execContext) sxHashEqualIncludingProperties(obj lispObject) (lispObject, error) { 667 | return ec.nil_, nil 668 | } 669 | 670 | func (ec *execContext) makeHashTable(args ...lispObject) (lispObject, error) { 671 | test := ec.hashTestEql 672 | kwArgs, err := ec.kwPlistToMap(ec.makeList(args...)) 673 | if err != nil { 674 | return nil, err 675 | } 676 | key := xSymbolName(ec.s.cTest) 677 | testSym := getDefault(kwArgs, key, ec.s.eql) 678 | delete(kwArgs, key) 679 | 680 | switch testSym { 681 | case ec.s.eql: 682 | // Use default value 683 | case ec.s.eq: 684 | test = ec.hashTestEq 685 | case ec.s.equal: 686 | test = ec.hashTestEqual 687 | default: 688 | prop, err := ec.get(testSym, ec.s.hashTableTest) 689 | if err != nil { 690 | return nil, err 691 | } 692 | 693 | if !consp(prop) || !consp(xCdr(prop)) { 694 | return ec.signalError("Invalid hash table test: '%+v'", prop) 695 | } 696 | 697 | test = &lispHashTableTest{ 698 | name: testSym, 699 | compFunction: xCar(prop), 700 | hashFunction: xCar(xCdr(prop)), 701 | } 702 | } 703 | 704 | key = xSymbolName(ec.s.cWeakness) 705 | delete(kwArgs, key) 706 | 707 | if len(kwArgs) > 0 { 708 | return ec.signalError("Invalid arguments list: '%+v'", args) 709 | } 710 | 711 | return &lispHashTable{ 712 | val: make(map[lispInt][]lispHashTableEntry), 713 | test: test, 714 | }, nil 715 | } 716 | 717 | func (ec *execContext) putHash(key, value, table lispObject) (lispObject, error) { 718 | if !hashtablep(table) { 719 | return ec.wrongTypeArgument(ec.s.hashTablep, table) 720 | } 721 | 722 | ht := xHashTable(table) 723 | result := ec.hashLookup(key, ht) 724 | if result.err != nil { 725 | return nil, result.err 726 | } 727 | 728 | entry := lispHashTableEntry{key: key, val: value, code: result.code} 729 | 730 | if result.entries == nil { 731 | ht.val[result.code] = []lispHashTableEntry{entry} 732 | } else if result.i < 0 { 733 | ht.val[result.code] = append(result.entries, entry) 734 | } else { 735 | result.entries[result.i] = entry 736 | } 737 | 738 | return value, nil 739 | } 740 | 741 | func (ec *execContext) hashLookup(key lispObject, ht *lispHashTable) lispHashTableLookupResult { 742 | codeObj, err := ec.funcall(ht.test.hashFunction, key) 743 | result := lispHashTableLookupResult{i: -1} 744 | 745 | if err != nil { 746 | result.err = err 747 | return result 748 | } else if !integerp(codeObj) { 749 | result.err = xErrOnly(ec.signalError("Invalid hash code type")) 750 | return result 751 | } 752 | 753 | code := xIntegerValue(codeObj) 754 | entries := ht.val[code] 755 | 756 | result.code = code 757 | result.entries = entries 758 | 759 | for i, entry := range entries { 760 | if entry.key == key { 761 | result.i = i 762 | break 763 | } else if ht.test.compFunction != nil && 764 | ht.test.compFunction != ec.nil_ && 765 | entry.code == code { 766 | cmp, err := ec.funcall(ht.test.compFunction, key, entry.key) 767 | if err != nil { 768 | result.err = err 769 | break 770 | } 771 | 772 | if cmp != ec.nil_ { 773 | result.i = i 774 | break 775 | } 776 | } 777 | } 778 | 779 | return result 780 | } 781 | 782 | func (ec *execContext) getHash(key, table, default_ lispObject) (lispObject, error) { 783 | if !hashtablep(table) { 784 | return ec.wrongTypeArgument(ec.s.hashTablep, table) 785 | } 786 | 787 | result := ec.hashLookup(key, xHashTable(table)) 788 | if result.err != nil { 789 | return nil, result.err 790 | } 791 | 792 | if result.entries == nil || result.i < 0 { 793 | return default_, nil 794 | } 795 | 796 | return result.entries[result.i].val, nil 797 | } 798 | 799 | func (ec *execContext) remHash(key, table lispObject) (lispObject, error) { 800 | if !hashtablep(table) { 801 | return ec.wrongTypeArgument(ec.s.hashTablep, table) 802 | } 803 | 804 | ht := xHashTable(table) 805 | result := ec.hashLookup(key, xHashTable(table)) 806 | if result.err != nil { 807 | return nil, result.err 808 | } 809 | 810 | if result.entries != nil && result.i >= 0 { 811 | ht.val[result.code] = slices.Delete(result.entries, result.i, result.i+1) 812 | } 813 | 814 | return ec.nil_, nil 815 | } 816 | 817 | func (ec *execContext) clearHash(table lispObject) (lispObject, error) { 818 | if !hashtablep(table) { 819 | return ec.wrongTypeArgument(ec.s.hashTablep, table) 820 | } 821 | 822 | clear(xHashTable(table).val) 823 | return table, nil 824 | } 825 | 826 | func (ec *execContext) symbolsOfFunctions() { 827 | ec.defSym(&ec.s.cTest, ":test") 828 | ec.defSym(&ec.s.cSize, ":size") 829 | ec.defSym(&ec.s.cPureCopy, ":purecopy") 830 | ec.defSym(&ec.s.cRehashSize, ":rehash-size") 831 | ec.defSym(&ec.s.cRehashThreshold, ":rehash-threshold") 832 | ec.defSym(&ec.s.cWeakness, ":weakness") 833 | ec.defSym(&ec.s.key, "key") 834 | ec.defSym(&ec.s.value, "value") 835 | ec.defSym(&ec.s.hashTableTest, "hash-table-test") 836 | ec.defSym(&ec.s.keyOrValue, "key-or-value") 837 | ec.defSym(&ec.s.keyAndValue, "key-and-value") 838 | ec.defSym(&ec.s.subfeatures, "subfeatures") 839 | ec.defVarLisp(&ec.v.features, "features", ec.makeList(ec.s.emacs)) 840 | 841 | ec.defSubr1(nil, "length", (*execContext).length, 1) 842 | ec.defSubr2(&ec.s.equal, "equal", (*execContext).equal, 2) 843 | ec.defSubr2(&ec.s.eql, "eql", (*execContext).eql, 2) 844 | ec.defSubr2(nil, "assq", (*execContext).assq, 2) 845 | ec.defSubr3(nil, "assoc", (*execContext).assoc, 2) 846 | ec.defSubr2(nil, "memq", (*execContext).memq, 2) 847 | ec.defSubr2(nil, "get", (*execContext).get, 2) 848 | ec.defSubr3(nil, "put", (*execContext).put, 3) 849 | ec.defSubr1(&ec.s.plistp, "plistp", (*execContext).plistp, 1) 850 | ec.defSubr3(nil, "plist-get", (*execContext).plistGet, 2) 851 | ec.defSubr4(nil, "plist-put", (*execContext).plistPut, 3) 852 | ec.defSubrM(nil, "nconc", (*execContext).nconc, 0) 853 | ec.defSubrM(nil, "append", (*execContext).append_, 0) 854 | ec.defSubrM(nil, "concat", (*execContext).concat, 0) 855 | ec.defSubrM(nil, "vconcat", (*execContext).vconcat, 0) 856 | ec.defSubr1(nil, "copy-sequence", (*execContext).copySequence, 1) 857 | ec.defSubr2(nil, "provide", (*execContext).provide, 1) 858 | ec.defSubr1(nil, "nreverse", (*execContext).nreverse, 1) 859 | ec.defSubr1(&ec.s.reverse, "reverse", (*execContext).reverse, 1) 860 | ec.defSubr2(nil, "nthcdr", (*execContext).nthCdr, 2) 861 | ec.defSubr2(nil, "nth", (*execContext).nth, 2) 862 | ec.defSubr2(&ec.s.mapCar, "mapcar", (*execContext).mapCar, 2) 863 | ec.defSubrM(nil, "make-hash-table", (*execContext).makeHashTable, 0) 864 | ec.defSubr3(nil, "puthash", (*execContext).putHash, 3) 865 | ec.defSubr3(nil, "gethash", (*execContext).getHash, 2) 866 | ec.defSubr2(nil, "remhash", (*execContext).remHash, 2) 867 | ec.defSubr1(nil, "clrhash", (*execContext).clearHash, 1) 868 | ec.defSubr1(&ec.s.sxHashEq, "sxhash-eq", (*execContext).sxHashEq, 1) 869 | ec.defSubr1(&ec.s.sxHashEql, "sxhash-eql", (*execContext).sxHashEql, 1) 870 | ec.defSubr1(&ec.s.sxHashEqual, "sxhash-equal", (*execContext).sxHashEqual, 1) 871 | ec.defSubr1( 872 | &ec.s.sxHashEqualIncludingProperties, 873 | "sxhash-equal-including-properties", 874 | (*execContext).sxHashEqualIncludingProperties, 875 | 1, 876 | ) 877 | ec.defSubr2(nil, "delq", (*execContext).delq, 2) 878 | 879 | ec.hashTestEq = &lispHashTableTest{ 880 | name: ec.s.eq, 881 | hashFunction: ec.s.sxHashEq, 882 | compFunction: ec.s.eq, 883 | } 884 | ec.hashTestEql = &lispHashTableTest{ 885 | name: ec.s.eql, 886 | hashFunction: ec.s.sxHashEql, 887 | compFunction: ec.s.eql, 888 | } 889 | ec.hashTestEqual = &lispHashTableTest{ 890 | name: ec.s.equal, 891 | hashFunction: ec.s.sxHashEqual, 892 | compFunction: ec.s.equal, 893 | } 894 | } 895 | --------------------------------------------------------------------------------