├── .gitignore ├── COPYING ├── LISP1 ├── 5 │ ├── axioms.scm │ ├── memory.scm │ ├── mexpr.scm │ └── runtime.scm └── 5.scm ├── Makefile.in ├── README.adoc ├── configure ├── lisp └── .keep ├── mx ├── eval.mx ├── extended-cond.mx ├── funarg-lambda.mx ├── funarg.mx ├── genv.mx └── mapcar.mx ├── package.scm ├── test-basic.scm ├── test-genv.scm └── tools ├── mexpr-env.scm └── trace.scm /.gitignore: -------------------------------------------------------------------------------- 1 | /*.gpd 2 | /Makefile 3 | /VERSION 4 | /*.log 5 | /lisp/*.lisp 6 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | Copyright 2019 Shiro Kawai 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be 12 | included in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /LISP1/5.scm: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; LISP1.5 3 | ;;; 4 | 5 | (define-module LISP1.5 6 | (use LISP1.5.runtime) 7 | (export prog :=) 8 | ) 9 | (select-module LISP1.5) 10 | 11 | ;; temporary - minimal emulation so that we can load m-expr source 12 | (define-syntax prog begin) 13 | (define-syntax := define) 14 | -------------------------------------------------------------------------------- /LISP1/5/axioms.scm: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Miminal primitives to run EVAL 3 | ;;; 4 | 5 | (define-module LISP1.5.axioms 6 | (export CAR CDR CONS COND EQ ATOM QUOTE $TOPLEVELS)) 7 | (select-module LISP1.5.axioms) 8 | 9 | (define (CAR x) (if (null? (car x)) 'NIL (car x))) 10 | (define (CDR x) (if (null? (cdr x)) 'NIL (cdr x))) 11 | (define (CONS x y) (cons x (if (eq? y 'NIL) '() y))) 12 | (define (ATOM x) (if (pair? x) 'F 'T)) 13 | (define (EQ a b) (if (eq? a b) 'T 'F)) 14 | 15 | (define-syntax QUOTE quote) 16 | (define-syntax COND 17 | (syntax-rules (=>) 18 | [(_) 'NIL] 19 | [(_ (test expr) . more) 20 | (let ([t test]) 21 | (if (or (eq? t 'NIL) (eq? t 'F)) 22 | (COND . more) 23 | expr))] 24 | [(_ (test => expr) . more) ; extension 25 | (let ([t test]) 26 | (if (or (eq? t 'NIL) (eq? t 'F)) 27 | (COND . more) 28 | (expr t)))])) 29 | 30 | ;; $TOPLEVELS is not an axiom, but more like a directive to set up 31 | ;; the toplevel environment. We translate 32 | (define-syntax $TOPLEVELS 33 | (syntax-rules ($=) 34 | [(_ ($= (name arg ...) expr) ...) 35 | (begin (define (name arg ...) expr) ...)])) 36 | -------------------------------------------------------------------------------- /LISP1/5/memory.scm: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; LISP1.5 Memory model 3 | ;;; 4 | 5 | (define-module LISP1.5.memory 6 | (use gauche.uvector) 7 | (use gauche.parameter) 8 | (use srfi-42) 9 | (export make-memory the-mem 10 | *NIL* *PNAME* *APVAL* *EXPR* *FEXPR* *SUBR* *FSUBR* *T* *F* 11 | *OBLIST* *OBLIST-SIZE* 12 | 13 | ;;$full-word? 14 | ;;$cons? $symbol? $fixnum? $flonum? 15 | )) 16 | (select-module LISP1.5.memory) 17 | 18 | ;; We don't really emulate IBM70x, but define a similar memory structure 19 | ;; so that we can get the feeling of those days. 20 | 21 | (define-constant *MEMORY-SIZE* 65536) ;Number of words. Data layout heavily 22 | ;depends on this, so can't be change 23 | ;casually. 24 | (define-constant *NATIVE-SIZE* 2048) ;Native vector size. 25 | 26 | (define-class () 27 | (;; Main memory is 65536 32-bit words. Lower half is used for 28 | ;; cons cells, upper half for full words. 29 | (cells :init-value (make-u32vector *MEMORY-SIZE*)) 30 | 31 | ;; Mark bits 32 | (mark-bits :init-value (make-u8vector (/ *MEMORY-SIZE* 8))) 33 | 34 | ;; Native object vector 35 | (natives :init-value (make-vector *NATIVE-SIZE*)) 36 | )) 37 | 38 | ;; Atoms are represented as cells with special tag in its CAR. 39 | (define-constant *TAG-SYMBOL* #xffff) 40 | (define-constant *TAG-NATIVE* #xfffe) 41 | (define-constant *TAG-FIXNUM* #xfffd) 42 | (define-constant *TAG-FLONUM* #xfffc) 43 | 44 | ;; The last part of full words area is reserved by the system, so that 45 | ;; above tags would never be a valid pointer. We use two of reserved words 46 | ;; for the anchors of freelists: 47 | (define-constant *FREELIST-CONS* #xffff) 48 | (define-constant *FREELIST-FULL* #xfffe) 49 | 50 | (define-constant *FULL-WORD-BASE* #x8000) 51 | (define-constant *FULL-WORD-CEIL* #xfffc) 52 | 53 | ;; First several cells are pre-allocated for important symbols. 54 | (define-constant *NIL* 0) 55 | (define-constant *PNAME* 1) 56 | (define-constant *APVAL* 2) 57 | (define-constant *EXPR* 3) 58 | (define-constant *FEXPR* 4) 59 | (define-constant *SUBR* 5) 60 | (define-constant *FSUBR* 6) 61 | (define-constant *T* 7) 62 | (define-constant *F* 8) 63 | (define-constant *NUM-RESERVERD-SYMBOLS* 9) 64 | 65 | ;; Followed by pre-allocated cells are a list of symbols, customarily 66 | ;; called oblist. It is actually a list of lists; we hash the symbol 67 | ;; name and chains the symbol in the corresponding sublist (bucket). 68 | ;; We guarantee that the spine of oblist is allocated contiguously, 69 | ;; thus we can directly pick the bucket from the hash value. 70 | (define-constant *OBLIST-SIZE* 211) 71 | (define-constant *OBLIST* *NUM-RESERVERD-SYMBOLS*) 72 | (define-constant *NUM-RESERVED-CELLS* (+ *OBLIST* *OBLIST-SIZE*)) 73 | 74 | ;; Create a new memory. Only freelists and OBLIST are initialized; the 75 | ;; predefined symbols must be initialized in symbol.scm 76 | (define (make-memory) 77 | (rlet1 mem (make ) 78 | (do-ec (:range i *NUM-RESERVED-CELLS* *FULL-WORD-BASE*) 79 | (set! (~ mem'cells i) (+ i 1))) 80 | (set! (~ mem'cells (- *FULL-WORD-BASE* 1)) *NIL*) 81 | (set! (~ mem'cells *FREELIST-CONS*) *NUM-RESERVED-CELLS*) 82 | 83 | (do-ec (:range i *FULL-WORD-BASE* *FULL-WORD-CEIL*) 84 | (set! (~ mem'cells i) (+ i 1))) 85 | (set! (~ mem'cells (- *FULL-WORD-CEIL* 1)) *NIL*) 86 | (set! (~ mem'cells *FREELIST-FULL*) *FULL-WORD-BASE*))) 87 | 88 | 89 | ;; Our memory 90 | (define the-mem (make-parameter (make-memory))) 91 | 92 | ;; Basic accessors 93 | (define ($get-word ptr) (~ (the-mem)'cells ptr)) 94 | (define ($put-word! ptr w) (set! (~ (the-mem)'cells ptr) w)) 95 | 96 | (define ($car ptr) (logand (~ (the-mem)'cells ptr) #xffff)) 97 | (define ($cdr ptr) (ash (~ (the-mem)'cells ptr) -16)) 98 | (define ($set-car! ptr val) 99 | (update! (~ (the-mem)'cells ptr) (^c (copy-bit-field c val 16 32)))) 100 | (define ($set-cdr! ptr val) 101 | (update! (~ (the-mem)'cells ptr) (^c (copy-bit-field c val 0 16)))) 102 | 103 | ;; A basic type predicates 104 | (define ($full-word? ptr) (>= ptr *FULL-WORD-BASE*)) 105 | 106 | (define ($cell? ptr) (and (not ($full-word? ptr)) 107 | (not ($full-word? ($car ptr))))) 108 | (define ($atom? ptr) (and (not ($full-word? ptr)) 109 | ($full-word? ($car ptr)))) 110 | 111 | (define ($symbol? ptr) (and (not ($full-word? ptr)) 112 | (eqv? ($car ptr) *TAG-SYMBOL*))) 113 | (define ($native? ptr) (and (not ($full-word? ptr)) 114 | (eqv? ($car ptr) *TAG-NATIVE*))) 115 | (define ($fixnum? ptr) (and (not ($full-word? ptr)) 116 | (eqv? ($car ptr) *TAG-FIXNUM*))) 117 | (define ($flonum? ptr) (and (not ($full-word? ptr)) 118 | (eqv? ($car ptr) *TAG-FLONUM*))) 119 | 120 | #| 121 | ;; 122 | ;; Fixnum 123 | ;; 124 | 125 | (define ($fixnum n) ;n is Scheme integer 126 | (logior (logand n *VALUE-MASK*) *FIXNUM-PAGE*)) 127 | (define ($fixnum-value ind) ;returns Scheme integer 128 | (let1 v (logand ind *VALUE-MASK*) 129 | (if (> v #x2000_0000) 130 | (- v #x4000_0000) 131 | v))) 132 | (define ($fixnum? ind) 133 | (= (logand ind *PAGE-MASK*) *FIXNUM-PAGE*)) 134 | 135 | 136 | 137 | (define ($cons ca cd) 138 | (rlet1 ind (~ (the-mem) 'freecell) 139 | (when (= ($cdr ind) *ATOM*) 140 | (error "Cell exhausted")) 141 | (set! (~ (the-mem)'freecell) ($cdr ind)) 142 | (set! (~ (the-mem)'cells ind) (logior (ash ca 32) cd)))) 143 | 144 | ;; A cell can be a pair or an atom 145 | (define ($atom? ind) 146 | (and ($cell? ind) 147 | (= ($car ind) *ATOM*))) 148 | (define ($pair? ind) 149 | (and ($cell? ind) 150 | (not ($atom? ind)))) 151 | 152 | ;; let's define this here for we'll define list functions. 153 | (define ($null? ind) 154 | (eqv? ind *NIL*)) 155 | 156 | (define ($list . elts) 157 | (if (null? elts) 158 | *NIL* 159 | ($cons (car elts) (apply $list (cdr elts))))) 160 | 161 | (define ($get-prop plist key) 162 | (cond [($null? plist) *NIL*] 163 | [(eqv? ($car plist) key) ($car ($cdr plist))] 164 | [else ($get-prop ($cdr ($cdr plist)) key)])) 165 | 166 | ;; Bytes area is used to store variable-length strings. In LISP1.5, strings 167 | ;; are stored as a linked list of "full word"s, where each full word is 36bit 168 | ;; work that can hold up to 6 characters. We use byte-addressable memory 169 | ;; for the characters, and use one cell for a string header, whose car points 170 | ;; to the byte area (character array) and whose cdr holds fixnum of character 171 | ;; count. 172 | 173 | ;; Allocate num-bytes from bytes area and returns its tagged index. 174 | ;; NB: bytes and strings are "under the hood" in LISP1.5---they can't be 175 | ;; manipulated directly from LISP code. 176 | (define ($new-bytes num-bytes) 177 | (unless (< (+ (~ (the-mem)'freebyte) num-bytes) (~ (the-mem)'num-bytes)) 178 | (error "Bytes exhausted.")) 179 | (rlet1 ind (logior (~ (the-mem)'freebyte) *BYTE-PAGE*) 180 | (inc! (~ (the-mem)'freebyte) num-bytes))) 181 | 182 | (define ($bytes? ind) 183 | (= (logand ind *PAGE-MASK*) *BYTE-PAGE*)) 184 | 185 | (define ($put-bytes! ind str) ;str is Scheme string 186 | (let1 start (logand ind *VALUE-MASK*) 187 | (u8vector-copy! (~ (the-mem)'bytes) start (string->u8vector str)))) 188 | 189 | (define ($get-bytes ind len) ;returns Scheme string 190 | (let1 start (logand ind *VALUE-MASK*) 191 | (u8vector->string (u8vector-copy (~ (the-mem)'bytes) start (+ start len))))) 192 | 193 | (define ($new-string str) ;str is Scheme string 194 | (let* ([len (string-size str)] 195 | [ind ($new-bytes len)]) 196 | ($put-bytes! ind str) 197 | ($cons ind ($fixnum len)))) 198 | 199 | (define ($string? ind) 200 | (and ($pair? ind) 201 | ($bytes? ($car ind)))) 202 | 203 | (define ($get-string ind) 204 | (assume ($string? ind)) 205 | ($get-bytes ($car ind) ($fixnum-value ($cdr ind)))) 206 | 207 | ;; Symbol construction 208 | 209 | ;; Initialize a symbol of index sym with NAME (Scheme string) 210 | ;; and plist (Scheme list) 211 | (define ($init-symbol sym name plist) 212 | (let1 name-str ($new-string name) 213 | ($set-car! sym *ATOM*) 214 | ($set-cdr! sym (apply $list *PNAME* name-str plist)) 215 | (hash-table-put! (~ (the-mem)'obtable) name sym))) 216 | 217 | ;; bootstrap - called from make-memory 218 | (define (init-predefined-symbols mem) 219 | (parameterize ((the-mem mem)) 220 | ($init-symbol *NIL* "NIL" `(,*APVAL* ,*NIL*)) 221 | ($init-symbol *PNAME* "PNAME" '()) 222 | ($init-symbol *APVAL* "APVAL" '()) 223 | ($init-symbol *EXPR* "EXPR" '()) 224 | ($init-symbol *FEXPR* "FEXPR" '()) 225 | ($init-symbol *SUBR* "SUBR" '()) 226 | ($init-symbol *FSUBR* "FSUBR" '()) 227 | ($init-symbol *T* "T" `(,*APVAL* ,*T*)) 228 | ($init-symbol *F* "F" `(,*APVAL* ,*NIL*)))) 229 | 230 | (define ($symbol name) 231 | (or (hash-table-get (~(the-mem)'obtable) name #f) 232 | (rlet1 sym ($cons *ATOM* *NIL*) 233 | ($init-symbol sym name '())))) 234 | 235 | (define ($symbol-plist sym) 236 | ($cdr sym)) 237 | 238 | (define ($symbol-pname sym) ; returns Scheme string 239 | ($get-string ($get-prop ($symbol-plist sym) *PNAME*))) 240 | 241 | (define ($symbol-apval sym) 242 | ($get-prop ($symbol-plist sym) *APVAL*)) 243 | 244 | ;; 245 | ;; For ease of debugging 246 | ;; 247 | 248 | (define ($lisp->scheme ind) 249 | (cond [($fixnum? ind) ($fixnum-value ind)] 250 | [($atom? ind) (string->symbol ($symbol-pname ind))] 251 | [($cell? ind) 252 | (if ($null? ($cdr ind)) 253 | (list ($lisp->scheme ($car ind))) 254 | (cons ($lisp->scheme ($car ind)) 255 | ($lisp->scheme ($cdr ind))))] 256 | [else "#"])) 257 | 258 | (define ($scheme->lisp obj) 259 | (cond [(fixnum? obj) ($fixnum obj)] 260 | [(symbol? obj) ($symbol (symbol->string obj))] 261 | [(null? obj) *NIL*] 262 | [(eq? obj #t) *T*] 263 | [(eq? obj #f) *F*] 264 | [(pair? obj) ($cons ($scheme->lisp (car obj)) 265 | ($scheme->lisp (cdr obj)))] 266 | [else (error "Can't convert ~s to LISP object" obj)])) 267 | 268 | |# 269 | -------------------------------------------------------------------------------- /LISP1/5/mexpr.scm: -------------------------------------------------------------------------------- 1 | ;; -*- coding:utf-8 -*- 2 | ;;; 3 | ;;; LISP1.5.mexpr - M-expression parser 4 | ;;; 5 | 6 | ;; NB: We make this module independent from memory and runtime, so that 7 | ;; it can be tested independently. 8 | 9 | (define-module LISP1.5.mexpr 10 | (use parser.peg) 11 | (use parser.peg.deprecated) 12 | (use util.match) 13 | (use gauche.parameter) 14 | (use gauche.unicode) 15 | (export parse-mexpr parse-mexprs 16 | trace-mexpr-parser)) 17 | (select-module LISP1.5.mexpr) 18 | 19 | ;; 20 | ;; Tokenizer 21 | ;; 22 | 23 | ;; API: tokenize INPUT 24 | ;; Returns an lseq of tokens. A token can be: 25 | ;; (number ) 26 | ;; (atom ) ; atomic symbol; is all uppercase 27 | ;; (ident ) ; identifier; is all uppercase 28 | ;; LAMBDA ; λ is also recognized. 29 | ;; LABEL 30 | ;; -> ; → is also recognized. 31 | ;; => ; cond extension. ⇒ is also recognized 32 | ;; = ; definition 33 | ;; := ; used in PROG 34 | ;; #\[ 35 | ;; #\] 36 | ;; #\( 37 | ;; #\) 38 | ;; #\. 39 | ;; #\; 40 | ;; 41 | ;; Whitespaces and comments are consumed and discarded. 42 | 43 | ;; NB: LISP1.5 mexpr doesn't have comment syntax. We don't want to use ';', 44 | ;; for it is used as an argument delimiter. We use '#' instead. 45 | (define %ws ($skip-many ($or ($. #[ \t\r\n]) 46 | ($seq ($. #\#) ($skip-many ($. #[^\n])))))) 47 | 48 | (define (make-word chars) 49 | (let1 s (list->string chars) 50 | (if-let1 n (string->number s) 51 | `(number ,n) 52 | (cond [(#/^[A-Z][A-Z0-9]*$/ s) `(atom ,(string->symbol s))] 53 | [(#/^[a-z][a-z0-9]*$/ s) `(ident ,(string->symbol (string-upcase s)))] 54 | [else (error "Invalid word: " s)])))) 55 | 56 | (define %word ($lift make-word ($many ($. #[0-9a-zA-Z]) 1))) 57 | 58 | ;; A few reserved word 59 | (define %lambda ($seq ($or ($."lambda") ($. #\λ)) ($return 'LAMBDA))) 60 | (define %label ($seq ($."label") ($return 'LABEL))) 61 | (define %-> ($seq ($or ($."->") ($. #\→)) ($return '->))) 62 | (define %=> ($seq ($or ($."=>") ($. #\⇒)) ($return '=>))) 63 | (define %:= ($seq ($.":=") ($return '|:=|))) 64 | (define %= ($seq ($. #\=) ($return '=))) 65 | 66 | (define %token 67 | ($between %ws 68 | ($or %-> %=> %:= %= %lambda %label %word ($. #[\[\]\(\).\;])) 69 | %ws)) 70 | 71 | (define (tokenize input) 72 | (generator->lseq (peg-parser->generator %token input))) 73 | 74 | ;; 75 | ;; Parser 76 | ;; 77 | 78 | ;; API: parse-mexpr INPUT 79 | ;; Parse single M-expr from INPUT and returns S-expr. 80 | ;; API: parse-mexprs INPUT 81 | ;; Returns a lseq of parsed S-exprs from INPUT. 82 | ;; API: trace-mexpr-parser 83 | ;; A parameter. If true, parsers emits debug output. 84 | 85 | (define (snd x y) y) 86 | (define (tok-atom? x) (match x [('atom x) x] [_ #f])) 87 | (define (tok-number? x) (match x [('number x) x] [_ #f])) 88 | (define (tok-identifier? x) (match x [('ident x) x] [_ #f])) 89 | 90 | (define %atom ($satisfy tok-atom? 'atom snd)) 91 | (define %number ($satisfy tok-number? 'number snd)) 92 | (define %identifier ($satisfy tok-identifier? 'identifier snd)) 93 | 94 | (define %datum ($lazy ($or %atom %number %list))) 95 | 96 | (define %list-tail 97 | ($lazy ($or ($seq ($. #\)) ($return '())) 98 | ($between ($. #\.) %datum ($. #\))) 99 | ($lift cons %datum %list-tail)))) 100 | 101 | (define %list 102 | ($seq ($. #\() 103 | ($or ($seq ($. #\)) ($return '())) 104 | ($lift cons %datum %list-tail)))) 105 | 106 | (define %form 107 | ($lazy ($or ($lift (cut list 'QUOTE <>) %datum) 108 | %conditional 109 | %funcall-or-variable 110 | ($eos)))) 111 | 112 | (define %conditional-clause 113 | ($do [test %form] 114 | [arrow ($satisfy (cut memq <> '(-> =>)) '(-> =>))] 115 | [expr %form] 116 | ($return (if (eq? arrow '->) 117 | (list test expr) 118 | (list test '=> expr))))) 119 | 120 | (define %conditional 121 | ($do [clauses ($between ($. #\[) 122 | ($sep-by %conditional-clause ($. #\;)) 123 | ($. #\]))] 124 | ($return `(COND ,@clauses)))) 125 | 126 | (define %function ($lazy ($or %lambda-form %label-form %identifier))) 127 | 128 | (define %lambda-form 129 | ($do [($satisfy (cut eq? 'LAMBDA <>) 'lambda)] 130 | [($. #\[)] 131 | [args ($between ($. #\[) 132 | ($sep-by %identifier ($. #\;)) 133 | ($. #\]))] 134 | [($. #\;)] 135 | [body %form] 136 | [($. #\])] 137 | ($return `(LAMBDA ,args ,body)))) 138 | 139 | (define %label-form 140 | ($do [($satisfy (cut eq? 'LABEL <>) 'label)] 141 | [($. #\[)] 142 | [id %identifier] 143 | [($. #\;)] 144 | [f %function] 145 | [($. #\])] 146 | ($return `(LABEL ,id ,f)))) 147 | 148 | ;; We parse the definition form 149 | ;; 150 | ;; fn[arg;...] = expr 151 | ;; 152 | ;; as: 153 | ;; 154 | ;; ($= (FN ARG ...) EXPR) 155 | ;; 156 | 157 | (define %def ($satisfy (cut eq? '= <>) '=)) 158 | 159 | (define %funcall-or-variable 160 | ($do [head %function] 161 | [args ($optional ($between ($. #\[) 162 | ($sep-by %form ($. #\;)) 163 | ($. #\])))] 164 | [follow ($optional ($seq %def %form))] 165 | ($return (let1 pre (if args (cons head args) head) 166 | (if follow 167 | `($= ,pre ,follow) 168 | pre))))) 169 | 170 | (define trace-mexpr-parser (make-parameter #f)) 171 | 172 | (define (%toplevel) 173 | (if (trace-mexpr-parser) 174 | ($debug "toplevel" %form) 175 | %form)) 176 | 177 | ;; API 178 | (define (parse-mexpr input) 179 | (values-ref (peg-run-parser (%toplevel) (tokenize input)) 0)) 180 | 181 | ;; API 182 | (define (parse-mexprs input) 183 | (generator->lseq (peg-parser->generator (%toplevel) (tokenize input)))) 184 | 185 | ;; To embed M-expr within Scheme, use #,(m-expr "M-expr") 186 | (define-reader-ctor 'm-expr (^s (parse-mexpr s))) 187 | 188 | ;;; 189 | ;;; The m-expr reader directive 190 | ;;; 191 | 192 | ;; This allows source file to be written in M-expression 193 | ;; 194 | ;; (use LISP1.5.mexpr) 195 | ;; #!m-expr 196 | ;; ... code written in M-expression ... 197 | ;; 198 | ;; NB: This module does not defines any LISP1.5 primitive syntax. 199 | ;; To load m-expr that uses LISP1.5 syntax, you want to use other 200 | ;; modules such as LISP1.5.axiom. 201 | 202 | ;; LISP1.5 employs special treatment on toplevel forms, and it's not 203 | ;; convenient for us to deal with parsed result in the later stage. 204 | ;; (See README.adoc for more discussion). 205 | ;; 206 | ;; So, m-expr parser just collect all the toplevel forms 207 | ;; under (TOPLEVELS ...) form. Interpretation of $TOPLEVELS form 208 | ;; depends on the later stage. 209 | 210 | (define-reader-directive 'm-expr 211 | (^[sym port ctx] 212 | `($TOPLEVELS ,@(parse-mexprs port)))) 213 | -------------------------------------------------------------------------------- /LISP1/5/runtime.scm: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; LISP1.5.runtime 3 | ;;; 4 | 5 | ;; This module adds enough support to run LISP1.5 evaluator shown in 6 | ;; Appendix B. 7 | 8 | (define-module LISP1.5.runtime 9 | (use util.match) 10 | (export $TOPLEVELS 11 | CAR CDR CONS ATOM EQ QUOTE COND CALLSUBR 12 | T F NIL ERROR LAMBDA 13 | $scheme->lisp $lisp->scheme) 14 | ) 15 | (select-module LISP1.5.runtime) 16 | 17 | ;; 18 | ;; LISP symbols 19 | ;; 20 | ;; LISP symbols are Gauche pairs whose car is 'ATOM. Their cdr is a 21 | ;; property list. 22 | 23 | (define *PNAME* '#0=(ATOM #0# "PNAME")) 24 | (define *APVAL* `(ATOM ,*PNAME* "APVAL")) 25 | (define *SUBR* `(ATOM ,*PNAME* "SUBR")) 26 | (define *NIL* (rlet1 nil (list 'ATOM *PNAME* "NIL" *APVAL*) 27 | (set! (cdr (last-pair nil)) `((,nil))))) 28 | (define *F* `(ATOM ,*PNAME* "F" ,*APVAL* (,*NIL*))) 29 | (define *T* (rlet1 t (list 'ATOM *PNAME* "T" *APVAL*) 30 | (set! (cdr (last-pair t)) `((,t))))) 31 | 32 | ;; 33 | ;; Helper functions 34 | ;; 35 | 36 | (define ($atom? obj) (and (pair? obj) (eq? (car obj) 'ATOM))) 37 | (define ($cons? obj) (and (pair? obj) (not (eq? (car obj) 'ATOM)))) 38 | 39 | (define ($lisp->scheme obj) 40 | (define (rec obj) 41 | (cond [(eq? obj *NIL*) '()] 42 | [($atom? obj) (string->symbol (cadr (member *PNAME* (cdr obj))))] 43 | [(pair? obj) (cons (rec (car obj)) (rec (cdr obj)))] 44 | [(null? obj) '()] 45 | [else (format "#[~s]" obj)])) 46 | (if (eq? obj *NIL*) 47 | 'NIL 48 | (rec obj))) 49 | 50 | (define *obtable* (hash-table-r7 eq-comparator 51 | 'NIL *NIL* 52 | 'PNAME *PNAME* 53 | 'APVAL *APVAL* 54 | 'SUBR *SUBR* 55 | 'F *F* 56 | 'T *T*)) 57 | 58 | (define ($scheme->lisp obj) 59 | (cond [(null? obj) *NIL*] 60 | [(symbol? obj) (or (hash-table-get *obtable* obj #f) 61 | (rlet1 s (list 'ATOM *PNAME* (symbol->string obj)) 62 | (hash-table-put! *obtable* obj s)))] 63 | [(pair? obj) (cons ($scheme->lisp (car obj)) 64 | ($scheme->lisp (cdr obj)))] 65 | [else (errorf "Cannot convert ~s to LISP" obj)])) 66 | 67 | ;;; 68 | ;;; The "basement"---primitives that are used to run eval in the ground floor 69 | ;;; 70 | 71 | ;; We don't check whether the argument is an atom--thus we allow them 72 | ;; to go through symbol's property list. 73 | (define (CAR x) (if (null? (car x)) *NIL* (car x))) 74 | (define (CDR x) (if (null? (cdr x)) *NIL* (cdr x))) 75 | (define (CONS x y) (cons x (if (eq? y *NIL*) '() y))) 76 | (define (ATOM x) (if ($atom? x) *T* *F*)) 77 | (define (EQ x y) (if (eq? x y) *T* *F*)) 78 | (define (CALLSUBR subr args) (apply subr args)) 79 | (define (ERROR obj) (error "Meta*LISP Error:" ($lisp->scheme obj))) 80 | (define T *T*) 81 | (define F *NIL*) 82 | (define NIL *NIL*) 83 | 84 | (define-syntax LAMBDA lambda) 85 | (define-syntax QUOTE 86 | (syntax-rules () 87 | [(_ x) ($scheme->lisp 'x)])) 88 | (define-syntax COND 89 | (syntax-rules (=>) 90 | [(_) *NIL*] 91 | [(_ (test expr) . more) 92 | (let ([t test]) 93 | (if (or (eq? t *NIL*) (eq? t *F*)) 94 | (COND . more) 95 | expr))] 96 | [(_ (test => proc) . more) ; extension 97 | (let ([t test]) 98 | (if (or (eq? t *NIL*) (eq? t *F*)) 99 | (COND . more) 100 | (proc t)))])) 101 | 102 | (define-syntax $TOPLEVELS 103 | (syntax-rules ($=) 104 | [(_ ($= (name args ...) expr) ...) 105 | (begin (define name 106 | (let ([lsym ($scheme->lisp 'name)] 107 | [lfn ($scheme->lisp '(LAMBDA (args ...) expr))]) 108 | (set! (cdr lsym) `(,($scheme->lisp 'EXPR) ,lfn ,@(cdr lsym))) 109 | (lambda (args ...) expr))) 110 | ...)])) 111 | 112 | ;;; 113 | ;;; The "ground floor"---these are used to evaluate the second-level code 114 | ;;; 115 | 116 | (define-syntax defglobal 117 | (syntax-rules () 118 | [(_ var key val) 119 | (let1 lsym ($scheme->lisp 'var) 120 | (set! (cdr lsym) `(,($scheme->lisp key) ,val ,@(cdr lsym))))])) 121 | 122 | (defglobal CAR 'SUBR CAR) 123 | (defglobal CDR 'SUBR CDR) 124 | (defglobal CONS 'SUBR CONS) 125 | (defglobal ATOM 'SUBR ATOM) 126 | (defglobal EQ 'SUBR EQ) 127 | (defglobal ERROR 'SUBR ERROR) 128 | (defglobal CALLSUBR 'SUBR CALLSUBR) 129 | -------------------------------------------------------------------------------- /Makefile.in: -------------------------------------------------------------------------------- 1 | # General info 2 | SHELL = @SHELL@ 3 | prefix = @prefix@ 4 | exec_prefix = @exec_prefix@ 5 | bindir = @bindir@ 6 | libdir = @libdir@ 7 | datadir = @datadir@ 8 | datarootdir = @datarootdir@ 9 | srcdir = @srcdir@ 10 | VPATH = $(srcdir) 11 | 12 | # These may be overridden by make invocators 13 | DESTDIR = 14 | GOSH = "@GOSH@" 15 | GAUCHE_CONFIG = "@GAUCHE_CONFIG@" 16 | GAUCHE_PACKAGE = "@GAUCHE_PACKAGE@" 17 | INSTALL = "@GAUCHE_INSTALL@" -C 18 | 19 | # Other parameters 20 | SOEXT = @SOEXT@ 21 | OBJEXT = @OBJEXT@ 22 | EXEEXT = @EXEEXT@ 23 | LOCAL_PATHS = "@LOCAL_PATHS@" 24 | 25 | # Module-specific stuff 26 | PACKAGE = Gauche-lisp15 27 | 28 | ARCHFILES = 29 | SCMFILES = $(srcdir)/LISP1/5.scm 30 | HEADERS = 31 | 32 | TARGET = lisp/eval.lisp lisp/mapcar.lisp 33 | GENERATED = 34 | CONFIG_GENERATED = Makefile config.cache config.log config.status \ 35 | configure.lineno autom4te*.cache $(PACKAGE).gpd 36 | 37 | GAUCHE_PKGINCDIR = "$(DESTDIR)@GAUCHE_PKGINCDIR@" 38 | GAUCHE_PKGLIBDIR = "$(DESTDIR)@GAUCHE_PKGLIBDIR@" 39 | GAUCHE_PKGARCHDIR = "$(DESTDIR)@GAUCHE_PKGARCHDIR@" 40 | 41 | all : $(TARGET) 42 | 43 | lisp/eval.lisp : mx/eval.mx 44 | $(GOSH) tools/mexpr-env.scm -e mx/eval.mx > lisp/eval.lisp 45 | 46 | lisp/mapcar.lisp : mx/eval.mx mx/mapcar.mx 47 | $(GOSH) tools/mexpr-env.scm -e mx/eval.mx mx/mapcar.mx \ 48 | > lisp/mapcar.lisp 49 | 50 | check : all 51 | @rm -f test.log 52 | $(GOSH) -I. -I$(srcdir) $(srcdir)/test-basic.scm > test.log 53 | $(GOSH) -I. -I$(srcdir) $(srcdir)/test-genv.scm >> test.log 54 | 55 | install : all 56 | $(INSTALL) -m 444 -T $(GAUCHE_PKGINCDIR) $(HEADERS) 57 | $(INSTALL) -m 444 -T $(GAUCHE_PKGLIBDIR) $(SCMFILES) 58 | $(INSTALL) -m 555 -T $(GAUCHE_PKGARCHDIR) $(ARCHFILES) 59 | $(INSTALL) -m 444 -T $(GAUCHE_PKGLIBDIR)/.packages $(PACKAGE).gpd 60 | 61 | uninstall : 62 | $(INSTALL) -U $(GAUCHE_PKGINCDIR) $(HEADERS) 63 | $(INSTALL) -U $(GAUCHE_PKGLIBDIR) $(SCMFILES) 64 | $(INSTALL) -U $(GAUCHE_PKGARCHDIR) $(ARCHFILES) 65 | $(INSTALL) -U $(GAUCHE_PKGLIBDIR)/.packages $(PACKAGE).gpd 66 | 67 | clean : 68 | $(GAUCHE_PACKAGE) compile --clean lisp15 $(lisp15_SRCS) 69 | rm -rf core $(TARGET) $(GENERATED) *~ test.log so_locations 70 | 71 | distclean : clean 72 | rm -rf $(CONFIG_GENERATED) 73 | 74 | maintainer-clean : clean 75 | rm -rf $(CONFIG_GENERATED) VERSION 76 | -------------------------------------------------------------------------------- /README.adoc: -------------------------------------------------------------------------------- 1 | // -*- coding: utf-8 -*- 2 | = LISP1.5 implementation on Gauche 3 | :sectnums: 4 | :toc: 5 | :toc-placement!: 6 | ifdef::env-github[] 7 | :tip-caption: :bulb: 8 | :note-caption: :information_source: 9 | :important-caption: :heavy_exclamation_mark: 10 | :caution-caption: :fire: 11 | :warning-caption: :warning: 12 | endif::[] 13 | 14 | This is a fun project to implement LISP 1.5 as described in 15 | "LISP 1.5 Programmer's Manual". It's not a complete LISP 1.5 environment 16 | emulator; instead, it is to get a glimpse of how it is constructed. 17 | 18 | toc::[] 19 | 20 | 21 | == M-expressions 22 | 23 | When LISP was in its infancy, it wasn't wrapped with so many parentheses 24 | which would later become its most memorable characteristic. 25 | At least in front of people's eyes. 26 | 27 | An early LISP program looked like this: 28 | 29 | ---- 30 | member[a;l] = [null[l] → NIL; 31 | eq[a;car[l]] → l; 32 | T → member[a;cdr[l]]] 33 | ---- 34 | 35 | S-expressions were also used, but only to denote _data_. 36 | 37 | ---- 38 | member[C;(A B C D E)] 39 | ---- 40 | 41 | LISP programmers back then read and wrote programs in this form, 42 | _on paper_. Yes, program sources were meant to be read by humans. 43 | In order for computers to understand programs, one must have prepared 44 | a deck of cards with holes punched according to 45 | link:https://en.wikipedia.org/wiki/BCD_(character_encoding)[BCD character code]. 46 | The character set didn't have many punctuations and it was impossible 47 | to punch M-expressions directly. Instead, people translated 48 | M-expressions into S-expressions, which was already used 49 | to describe nested list structures. In other words, people 50 | fed the machine the internal representation of syntax tree 51 | directly. 52 | 53 | Eventually, people got used to write programs in S-expresions directly, 54 | and M-expressions were faded into oblivion. 55 | 56 | However, when we read papers of that era, we see M-expressions 57 | everywhere. Now that we can write M-expressions in a text file, 58 | let's make the computer understand it directly! 59 | 60 | === M-expression syntax 61 | 62 | Here's a summary of M-expression sytnax: 63 | 64 | - Identifiers are in all lowercase. Literal symbols are in all uppercase. 65 | No `quote` in M-expression. Literal list can be written using parentheses, 66 | e.g. `(A B (C D . E))`, without a quote. 67 | - Function call is written as `fn[arg1;arg2;...]` 68 | - Conditional is `[test1 \-> expr1; test2 \-> expr2;...]`. It works just like 69 | `cond`. Unicode arrow character `->` (U+2192) can be used in place of `\->`. 70 | - Symbol `NIL` is used for list terminator. Hence `cons[A;NIL]` yields 71 | `(A)`. 72 | - Literal function is written as `lambda[[arg;..];expr]`. This lambda form 73 | itself doesn't have a value -- it must be called with arguments to take effect. 74 | - Local recursive function can be written as `label[name;lambda[[arg;...];expr]]`, 75 | where you can use `name` in the `expr` to refer to itself. 76 | - In toplevel, you can define a function by `name[arg;...] = expr`. 77 | 78 | An M-expression can be translated into an S-expression as follows: 79 | 80 | - Literal data (symbols and lists) are embedded in the output 81 | by `(QUOTE )`. 82 | - Function call `fn[arg1;arg2;...]` becomes (FN ARG1 ARG2 ...)`. 83 | We didn't have lower case characters on computers back then. 84 | - Conditional `[test1 \-> expr1; test2 \-> expr2;...]` becomes 85 | `(COND (TEST1 EXPR1) (TEST2 EXPR2) ...)`. 86 | - Literal function `lambda[[arg;..];expr]` 87 | becomes `(LAMBDA (ARG ...) EXPR)`. 88 | - Local recursive function `label[name;lambda[[arg;...];expr]]` 89 | becomes `(LABEL NAME (LAMBDA (ARG ...) EXPR))`. 90 | 91 | === Parsing a single M-expression 92 | 93 | Module `LISP1.5.mexpr` implements parsers. A procedure 94 | `parse-mexpr` takes a string or an input port, and parses one M-expression 95 | and returns an S-expression. 96 | 97 | ---- 98 | gosh> ,u LISP1.5.mexpr 99 | gosh> (parse-mexpr "cons[(A . B);C]") 100 | (CONS (QUOTE (A . B)) (QUOTE C)) 101 | gosh> (parse-mexpr "lambda[[x];[eq[NIL;x]→T; T→F]]") 102 | (LAMBDA (X) (COND ((EQ (QUOTE NIL) X) (QUOTE T)) ((QUOTE T) (QUOTE F)))) 103 | ---- 104 | 105 | See how liteals (upper-case names and lists) are `QUOTE`{nbsp}-d 106 | once parsed. 107 | 108 | [TIP] 109 | ====================================================== 110 | If you try the above example on your REPL, make sure 111 | your terminal character encoding matches your Gauche setting 112 | (it's utf-8 by default). 113 | ====================================================== 114 | 115 | Interestingly, there seemed no direct translation of definition 116 | syntax `name[arg;...] = expr` into an S-expression. 117 | When a user translates a prorgam in M-expressions into S-expressions 118 | to punch the cards, 119 | she gathers all the definitions into a call of `DEFINE` pseudo function 120 | (see the note below). 121 | 122 | For our purpose, we want the parser to yield a single S-expression 123 | from one M-expression. So, we return `($= ...)` form 124 | as the result of parsing a defintion: 125 | 126 | ---- 127 | gosh> (parse-mexpr "null[x] = [eq[NIL;x]→T; T→F]]") 128 | ($= (NULL X) (COND ((EQ (QUOTE NIL) X) (QUOTE T)) ((QUOTE T) (QUOTE F)))) 129 | ---- 130 | 131 | (The preceding `$` of `$=` indicates it is an internal or 132 | implementation-dependent feature.) 133 | 134 | The `parse-mexpr` function only parses one M-expression. 135 | If the input may contain more than one M-expression, use `parse-mexprs` 136 | instead, which reads input up to EOF and returns an lseq of result 137 | S-expressions. 138 | 139 | === Comments and other exhancements 140 | 141 | We also add these extensions, for the convenience. 142 | 143 | ==== Comments 144 | 145 | There's no comment syntax defined in M-expressions. Since 146 | it's for humans to read, you could freely intermix code 147 | and natural language descriptions. For our purpose, 148 | we make a hash sign `#` to the end of line is a comment. 149 | (We avoid `;`, for it is used as a separator.) 150 | 151 | ==== Extended `COND` form 152 | 153 | In Appendix B of LISP 1.5 Programmer's Manual, they use 154 | a pseudo extension of conditional expression for concise 155 | explanation, in which you can access the result of test expression 156 | from the expression in that branch. 157 | Such extension wasn't formalized and the actual 158 | code is written in assembly language instead of M-expressions. 159 | But for our purpose it'll be convnient to support such extension. 160 | 161 | It is to allow a conditional expression to have the following clause: 162 | 163 | ---- 164 | test => fun 165 | ---- 166 | 167 | Here, `fun` must be a LAMBDA form that takes one argument, 168 | or an expression that yield a function. 169 | First, `test` is evaluated, and if it yiels a true value 170 | (a value neither `NIL` nor `F`), the value is passed 171 | to the function. It's the same as Scheme's `cond` feature with `\=>`. 172 | 173 | We'll explain the actual use case and implementation of this extension 174 | when we get to the full toplevel environment support. 175 | 176 | === Writing source in M-expression: 177 | 178 | With Gauche's reader directive feature, you can write source 179 | in M-expressions, as follows: 180 | 181 | ---- 182 | ;; 183 | ;; Scheme comments 184 | ;; 185 | (use LISP1.5.mexpr) 186 | #!m-expr 187 | 188 | # M-expression function definitions 189 | function1[arg;...] = expression1 190 | function2[arg;...] = expression2 191 | ... 192 | ---- 193 | 194 | For our purpose, we want to treat M-expressions as our source code, 195 | and the parser returns a single S-expression as a result. 196 | So we introduce our own extension. 197 | 198 | ---- 199 | ($TOPLEVEL ...) 200 | 201 | : ($= []) 202 | | 203 | ---- 204 | 205 | When read, the entire source is wrapped in `$TOPLEVEL` form. 206 | Inside it, each toplevel form becomes either 207 | `($= )` (in case of definition) or just an `` 208 | in case of toplevel function call. This `$TOPLEVEL` form is 209 | merely our parser's way to wrap the result, and its interpretation 210 | depends on the caller of the parser; it doesn't mean we'll have 211 | a special form called `$TOPLEVEL`. 212 | 213 | [NOTE] 214 | ================================================================ 215 | In the actual use case, all definitions in a program were 216 | gathered and translated into the following form to be punched: 217 | 218 | ---- 219 | DEFINE (( 220 | (NAME (LAMBDA (ARG ...) EXPR)) 221 | (NAME (LAMBDA (ARG ...) EXPR)) 222 | ... 223 | )) 224 | ---- 225 | 226 | This is actially a special syntax to execute a function call on toplevel. 227 | It takes a form `FUNC (ARG ...)`, where `ARG`{nbsp}s are implicitly 228 | quoted. The function `DEFINE` takes one argument, which is 229 | a form of `((NAME LAMBDA-EXPR) ...)`. 230 | 231 | If you want to perform some calculation, you list the call of 232 | the function after the `DEFINE` form, as follows: 233 | 234 | ---- 235 | DEFINE (( 236 | ... definitions .. 237 | (DOSOMETHING (LABMDA (ARG ...) EXPR)) 238 | )) 239 | 240 | DOSOMETHING (ARG ...) 241 | ---- 242 | 243 | Examples are shown in p.15 and pp.48-51 of LISP1.5 Programmer's 244 | Manual. 245 | ================================================================ 246 | 247 | The `#!m-expr` directive translates those M-expressions into 248 | a LISP1.5 `DEFINE` form: 249 | 250 | ---- 251 | ($TOPLEVEL 252 | ($= (FUNCTION1 ARG ...) EXPRESSION1) 253 | ($= (FUNCTION2 ARG ...) EXPRESSION2) 254 | ...) 255 | ---- 256 | 257 | Note that you have to have definitions of `$TOPLEVEL` and other primitive 258 | LISP1.5 forms before loading the source file; The `LISP1.5.mexpr` module 259 | only handles parsing. 260 | 261 | We provide several implementations of those LISP1.5 primitives, 262 | which we'll show you in the following chapters. 263 | 264 | 265 | == A Universal LISP Function 266 | 267 | === Running EVAL with minimal axioms 268 | 269 | Section 1.6 of "LISP 1.5 Programmer's Manual" is one of the pinnacles 270 | of the document. They show how to implement Lisp interpreter 271 | on top of Lisp systems. They call it "a Universal LISP function". 272 | 273 | We write out their code in link:mx/eval.mx[]. 274 | 275 | What's interesting about it is that you only need a handful of 276 | functions and syntaxes to run the interpreter. We define those 277 | minimal set of primitives in link:LISP1/5/axioms.scm[]. 278 | It provides the definition of the following primitives: 279 | `CAR`, `CDR`, `CONS`, `ATOM`, `EQ`, `QUOTE`, and `COND`, as well as 280 | a definition of `$TOPLEVEL` to handle toplevel forms. 281 | 282 | To try the eval function, first `use` the axioms module, then 283 | load the `eval.mx` file. Assuming you have 284 | load path set to the top directory of LISP1.5 source, 285 | you can say the following in the gosh REPL: 286 | 287 | ---- 288 | gosh> ,u LISP1.5.axioms 289 | gosh> ,l mx/eval.mx 290 | #t 291 | ---- 292 | 293 | Or, you can start gosh with loading necessary modules 294 | (this assumes you're in the top directory of LISP1.5 source): 295 | 296 | ---- 297 | $ gosh -I. -u LISP1.5.axioms -l mx/eval.mx 298 | ---- 299 | 300 | On the gosh prompt, you can call `EVAL`. The first argument 301 | is the S-expression to evaluate, and the second argument 302 | is the environment (assoc list of symbols and values): 303 | 304 | ---- 305 | gosh> (EVAL '(CONS (CAR (QUOTE (X . Y))) (QUOTE Z)) 'NIL) 306 | (X . Z) 307 | ---- 308 | 309 | Be aware of the difference of `'` (`quote`) and `QUOTE`. 310 | The former one is recognized by Gauche. The latter one is recognized by 311 | `EVAL`. 312 | 313 | If you prefer, you can write M-expressions using 314 | read-time constructor `#,(m-expr "...")`: 315 | 316 | ---- 317 | gosh> (EVAL '#,(m-expr "cons[car[(X . Y)];Z]") 'NIL) 318 | (X . Z) 319 | ---- 320 | 321 | Following is a bit more convoluted example. It defines `append` 322 | as a recursive funciton using `LABEL`, and calls it with 323 | two arguments, `(A B C)` and `(X Y Z)`: 324 | 325 | 326 | ---- 327 | gosh> (EVAL '#,(m-expr "label[append;lambda[[xs;r];\ 328 | [eq[xs;NIL] -> r;\ 329 | T -> cons[car[xs];append[cdr[xs];r]]]]]\ 330 | [(A B C);(X Y Z)]") 331 | 'NIL) 332 | (A B C X Y Z) 333 | ---- 334 | 335 | This interpreter only _knows_ the minimal 7 primitives: 336 | `CAR`, `CDR`, `CONS`, `ATOM`, `EQ`, `QUOTE`, and `COND`. 337 | To refer to anything other than that, 338 | you have to pass them in the environment argument. 339 | 340 | The following example reverses a list, using the 341 | definition of `NULL`, `APPEND` and `REVERSE` given to the environment: 342 | 343 | ---- 344 | gosh> (EVAL '#,(m-expr "reverse[(A B C D E F G)]") 345 | '((NULL . #,(m-expr "lambda[[x];[eq[x;NIL] -> T; T -> F]]")) 346 | (APPEND . #,(m-expr "lambda[[xs;r];\ 347 | [eq[xs;NIL] -> r;\ 348 | T -> cons[car[xs];append[cdr[xs];r]]]]")) 349 | (REVERSE . #,(m-expr "lambda[[xs];\ 350 | [null[xs] -> NIL;\ 351 | T -> append[reverse[cdr[xs]];cons[car[xs];NIL]]]]")) 352 | )) 353 | (G F D C B A) 354 | ---- 355 | 356 | [NOTE] 357 | ================================================================ 358 | We need to provide the function `NULL` in the environment, 359 | since the one defined in `eval.mx` exists in the world of Gauche, and is 360 | not visible from the world of `EVAL`. 361 | ================================================================ 362 | 363 | [TIP] 364 | ================================================================ 365 | When you refer to an identifier that's neither one of the built-in 366 | primitive nor the one given in the environment, you'll get an error 367 | like the following: 368 | 369 | ---- 370 | *** ERROR: pair required, but got NIL 371 | Stack Trace: 372 | _______________________________________ 373 | 0 (car x) 374 | at "./LISP1/5/axioms.scm":9 375 | 1 (CAR X) 376 | [unknown location] 377 | 2 (CAAR A) 378 | [unknown location] 379 | 3 (EQUAL (CAAR A) X) 380 | [unknown location] 381 | 4 (ASSOC E A) 382 | [unknown location] 383 | 5 (EVAL FN A) 384 | [unknown location] 385 | ... 386 | ---- 387 | 388 | The code searches the environment alist by `ASSOC`, hits the end of 389 | the alist without finding it and complains. Remember, we have minimal 390 | interpreter and there's no fancy error handling mechanism. 391 | ================================================================ 392 | 393 | 394 | === Going Metacircular 395 | 396 | Since the universal LISP function defined in `eval.mx` understands 397 | the primitives required to interpret functions in `eval.mx`, you can use 398 | our `EVAL` to evaluate `eval.mx` to run `EVAL` on top of 399 | `EVAL` -- now you're running a metacircular interpreter! 400 | 401 | You might have noticed though, that `axioms.scm` provides `$TOPLEVELS`, 402 | which is missing in `eval.mx`. In our context of discussing 403 | metacircular interpreter, `$TOPLEVELS` appears as a result of 404 | parsing M-expression definitions, and should be understood 405 | as a meta-language to direct the set-up, rather than an integrated 406 | part of the language (one way to think of it is that if other primitives 407 | are C built-ins then `$TOPLEVELS` is `#pragma` or `Makefile` -- they belong 408 | to a different layer.) 409 | 410 | Of course, it is more convenient to have an ability in the core language 411 | to add new toplevel definitions, 412 | and we'll deal with it later. For now, let's stick to the 7 primitives. 413 | 414 | In order to run `EVAL` inside `EVAL`, we need to prepare the definitions 415 | in `eval.mx` as an environment alist passed to outer `EVAL`. 416 | Run the following command in the toplevel source directory: 417 | 418 | ---- 419 | $ gosh tools/mexpr-env.scm mx/eval.mx 420 | ---- 421 | 422 | It reads `eval.mx` and prints the definitions in an alist. Copy the output, 423 | then start `gosh` again, read `axioms` and load `eval.mx`, and evaluate 424 | the `EVAL` expression, passing the copied alist as the environment 425 | (don't forget the quote before the alist!): 426 | 427 | 428 | ---- 429 | gosh> ,u LISP1.5.axioms 430 | gosh> ,l mx/eval.mx 431 | #t 432 | gosh> (EVAL '(EVAL (QUOTE (CAR (QUOTE (X . Y)))) (QUOTE NIL)) 433 | '...<>) 434 | X 435 | ---- 436 | 437 | The result `X` is the result of `(CAR (QUOTE (X . Y)))`, computed 438 | by the `EVAL` function implemented in LISP1.5, not the underlying Gauche. 439 | 440 | If cut&pasting the environment alist is too tedious, `mexpr-env.scm` can 441 | create a definition of an auxiliary function `EVAL*`, which calls `EVAL` 442 | with the environment that has all the definitions in the given source file. 443 | Run `mexpr-env.scm` with `-e` option, and save the result in `lisp/eval.lisp`: 444 | 445 | ---- 446 | $ gosh tools/mexpr-env.scm -e mx/eval.mx > lisp/eval.lisp 447 | ---- 448 | 449 | [TIP] 450 | ================================================================== 451 | Instead of manually executing `tools/mexpr-env.scm`, you can 452 | run the standard build process (`./configur && make`) and 453 | all the converted files are placed under `lisp/`. 454 | ================================================================== 455 | 456 | 457 | We use suffix `lisp` to indicate it is not a Scheme code (even though 458 | Gauche can understand it after using `LISP1.5.axioms`). 459 | The created `lisp/eval.lisp` looks as follows: 460 | 461 | ---- 462 | ($TOPLEVELS ($= (EVAL* X) (EVAL X '...<>... 463 | ))) 464 | ---- 465 | 466 | That is, it defines `EVAL*` which takes one LISP1.5 expression and 467 | evaluates it under the enviornment where all the definitions in `eval.mx` 468 | is visible. 469 | 470 | The created `eval.lisp` can be loaded to `gosh` after using `LISP1.5.axioms`. 471 | Together with `mx/eval.mx`, you can run `EVAL` on top of `EVAL`: 472 | 473 | ---- 474 | $ gosh -I. -uLISP1.5.axioms -lmx/eval.mx -leval-star.lisp 475 | gosh> (EVAL* '#,(m-expr"eval[(CONS (QUOTE X) (QUOTE Y));NIL]")) 476 | (X . Y) 477 | ---- 478 | 479 | This time we used M-expression in the inner call. It's the same 480 | as writing `'(EVAL (QUOTE (CONS (QUOTE X) (QUOTE Y))) (QUOTE NIL))`. 481 | 482 | Let's recap what's happening. The outer `EVAL` (via `EVAL*`) is 483 | executed by Gauche, using the initially loaded `eval.mx`. The 484 | inner `EVAL` is interpreted by the outer `EVAL`, using the 485 | enviornment created by `mexpr-env.scm`. 486 | And the expression `(CONS (QUOTE X) (QUOTE Y))` is interpreted by 487 | the inner `EVAL`: 488 | 489 | ---- 490 | +----------------------------+ 491 | | (CONS (QUOTE X) (QUOTE Y)) | 492 | +----------------------------+ 493 | | EVAL | ; inner EVAL 494 | +----------------------------+ 495 | | EVAL | ; outer EVAL 496 | +----------------------------+ 497 | | Gauche | 498 | +----------------------------+ 499 | ---- 500 | 501 | If it is not obvious, try it with an altered environment. 502 | For example, edit the `eval.lisp` created above 503 | to change the inner `EVAL` recognizes `KWOTE` instead of `QUOTE`. 504 | There's only one place to change: 505 | 506 | ---- 507 | (EVAL 508 | LAMBDA 509 | (E A) 510 | (COND 511 | ((ATOM E) (CDR (ASSOC E A))) 512 | ((ATOM (CAR E)) 513 | (COND ((EQ (CAR E) (QUOTE KWOTE)) (CADR E)) 514 | ^^^^^ 515 | ((EQ (CAR E) (QUOTE COND)) (EVCON (CDR E) A)) 516 | ((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A)))) 517 | ((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A)))) 518 | ---- 519 | 520 | (Leave other `QUOTE` intact, for they are recognized by the outer `EVAL`). 521 | 522 | Now, try it: 523 | 524 | ---- 525 | (EVAL* '(EVAL (QUOTE (CONS (KWOTE X) (KWOTE Y))) (QUOTE NIL))) 526 | => (X . Y) 527 | ---- 528 | 529 | The two `QUOTE`{nbsp}s are recognized by the outer `EVAL`, and the two 530 | `KWOTE`{nbsp}s are recognized by the inner `EVAL`. Furthermore, 531 | the `'` (`quote`) is recognized by Gauche. 532 | 533 | 534 | === Having FUN with ARG 535 | 536 | (If you know what we'll talk about from the section title, you can 537 | skip this section. Yes, it's just about _that_.) 538 | 539 | One advantage of having a simple language with a concise interpreter is 540 | that we can tweak it easily. 541 | 542 | In the universal `EVAL`, a function is represented as a literal list 543 | whose car is `LAMBDA`. It is a powerful idea--now you can have 544 | a function as a first-class citizen of the language, that you can 545 | construct it, pass it to another function, and return it from another 546 | funciton. However, it has a flaw. 547 | 548 | Let's try a failure case and see if we can fix it. 549 | 550 | Consider `MAPCAR` function, which takes a function and a list, and 551 | returns a list of results of the function applied to each element of the 552 | given list (that is, Scheme's `map` function): 553 | 554 | ---- 555 | mapcar[fn;x] = [null[x] -> NIL; 556 | T -> cons[fn[car[x]];mapcar[fn;cdr[x]]]] 557 | ---- 558 | 559 | It is in link:mx/mapcar.mx[]. You can't load it directly 560 | into Gauche, however. Treating a list starting with `LAMBDA` as 561 | a function is a feature of `EVAL`, not Gauche. 562 | We have to make `EVAL` understand the above definition. 563 | 564 | We can use the same technique we used in the metacircular interpreter -- 565 | that is, translate the definition of `MAPCAR` above into an enviroment 566 | alist. We also need the definition of `NULL`, so let's combine 567 | `eval.mx` together with `mapcar.mx`. It can be done with the following 568 | command line: 569 | 570 | ---- 571 | $ gosh tools/mexpr-env.scm -e mx/eval.mx mx/mapcar.mx > lisp/mapcar.lisp 572 | ---- 573 | 574 | Alternatively, run `./configure` then `make` in the toplevel source directory. 575 | 576 | Once you have `lisp/mapcar.lisp`, you can load it (after `mx/eval.mx`) 577 | and you can call `MAPCAR` inside `EVAL*`: 578 | 579 | ---- 580 | $ gosh -I. -uLISP1.5.axioms 581 | gosh> ,l mx/eval.mx 582 | #t 583 | gosh> ,l lisp/mapcar.lisp 584 | #t 585 | gosh> (EVAL* '(MAPCAR (QUOTE (LAMBDA (X) (CONS X (QUOTE Y)))) (QUOTE (A B C)))) 586 | ((A . Y) (B . Y) (C . Y)) 587 | gosh> (EVAL* '#,(m-expr "mapcar[(LAMBDA (X) (CONS X (QUOTE Y)));(A B C)]")) 588 | ((A . Y) (B . Y) (C . Y)) 589 | ---- 590 | 591 | So far, so good. 592 | 593 | Now, Let's try nesting `MAPCAR`. We'll do equivalent to the following 594 | Scheme code: 595 | 596 | ---- 597 | (map (lambda (x) (map (lambda (y) (cons x y)) '(p q r))) '(a b c)) 598 | => (((a . p) (a . q) (a . r)) ((b . p) (b . q) (b . r)) ((c . p) (c . q) (c . r))) 599 | ---- 600 | 601 | Here's LISP1.5 version: 602 | 603 | ---- 604 | (EVAL* '(MAPCAR (QUOTE (LAMBDA (X) 605 | (MAPCAR (QUOTE (LAMBDA (Y) (CONS X Y))) 606 | (QUOTE (P Q R))))) 607 | (QUOTE (A B C)))) 608 | => ((((P Q R) . P) ((Q R) . Q) ((R) . R)) (((P Q R) . P) ((Q R) . Q) ((R) . R)) (((P Q R) . P) ((Q R) . Q) ((R) . R))) 609 | ---- 610 | 611 | Oops, what happened? Let's examine the details. 612 | Outer `MAPCAR` receives two actual parameters, `(LAMBDA (X) ...)` and `(A B C)` 613 | (`QUOTE`{nbsp}s are stripped when arguments are evaluated 614 | by `evlis` before calling the function). They are bound to the 615 | local parameters, `FN` and `X`, respectively. In other words, 616 | the body of `MAPCAR`: 617 | 618 | ---- 619 | [null[x] -> NIL; 620 | T -> cons[fn[car[x]];mapcar[fn;cdr[x]]]] 621 | ---- 622 | 623 | is evaluated with the following environment: 624 | 625 | ---- 626 | ((FN . (LAMBDA (X) 627 | (MAPCAR (QUOTE (LAMBDA (Y) (CONS X Y))) 628 | (QUOTE (P Q R))))) 629 | (X . (A B C))) 630 | ---- 631 | 632 | Since `X` is not `NIL`, evaluation goes to `cons[...]` branch. 633 | The first argument is `fn[car[x]]`, so first `car[x]` is evaluated 634 | and yields `A`, `fn` evaluated to the outer `LAMBDA` form 635 | and we call it with `A`. The body of inner `LAMBDA` form, which 636 | is the inner `MAPCAR` call, is evaluated with the following environment 637 | (Keep in mind that the new local bindings are inserted in front of 638 | outer environment): 639 | 640 | ---- 641 | ((X . A) 642 | (FN . (LAMBDA (X) 643 | (MAPCAR (QUOTE (LAMBDA (Y) (CONS X Y))) 644 | (QUOTE (P Q R))))) 645 | (X . (A B C))) 646 | ---- 647 | 648 | Inner `MAPCAR` gets `(LAMBDA (Y) (CONS X Y))` and `(P Q R)` as two 649 | actual parameters, which are bound to `MAPCAR`{nbsp}'s formal paramter 650 | `FN` and `X` again, and the environment under which innter `MAPCAR`{nbsp}'s 651 | body is evaluated looks like this: 652 | 653 | ---- 654 | ((FN . (LAMBDA (Y) (CONS X Y))) 655 | (X . (P Q R)) 656 | (X . A) 657 | (FN . (LAMBDA (X) 658 | (MAPCAR (QUOTE (LAMBDA (Y) (CONS X Y))) 659 | (QUOTE (P Q R))))) 660 | (X . (A B C))) 661 | ---- 662 | 663 | Finally, innter `LAMBDA` is called -- first, `P` as the 664 | actual parameter, which is bound to `Y`. Hence the body 665 | of the inner `LAMBDA`, which is `(CONS X Y)`, is evaluated 666 | under the following environment: 667 | 668 | ---- 669 | ((Y . P) 670 | (FN . (LAMBDA (Y) (CONS X Y))) 671 | (X . (P Q R)) <1> 672 | (X . A) <2> 673 | (FN . (LAMBDA (X) 674 | (MAPCAR (QUOTE (LAMBDA (Y) (CONS X Y))) 675 | (QUOTE (P Q R))))) 676 | (X . (A B C))) <3> 677 | ---- 678 | 679 | 1. Argument for the inner `MAPCAR` 680 | 2. Argument for the outer `LAMBDA` 681 | 3. Argument for the outer `MAPCAR` 682 | 683 | Now it is clear why it didn't work. When we write the 684 | initial nested `MAPCAR` form, we expect that `X` in the 685 | innermost expression `(CONS X Y)` refer to the formal parameter of the 686 | outer `LAMBDA`. But it is shadowed by the formal parameter of the 687 | `MAPCAR`. 688 | 689 | This is a well-known problem, and in lambda calculus it is avoided 690 | by _renaming_ the parameter names to avoid conflict. In our case, 691 | if we rename the formal parameter of inner `LAMBDA` to something 692 | different from the formal parameter of `MAPCAR`, it works as expected: 693 | 694 | ---- 695 | (EVAL* '(MAPCAR (QUOTE (LAMBDA (Z) <1> 696 | (MAPCAR (QUOTE (LAMBDA (Y) (CONS Z Y))) 697 | (QUOTE (P Q R))))) 698 | (QUOTE (A B C)))) 699 | => (((A . P) (A . Q) (A . R)) ((B . P) (B . Q) (B . R)) ((C . P) (C . Q) (C . R))) 700 | ---- 701 | 702 | 1. We use `Z` to avoid confclit with `MAPCAR`{nbsp}'s `X`. 703 | 704 | However, we can't possibly avoid all potential conflict manually, 705 | and renaming all formal parameters programatically to unique ones can be costly. 706 | 707 | LISP1.5 employed another way to solve this problem. Instead of passing 708 | `LAMBDA` form quoted, it introduced another form, called `FUNCTION`. 709 | The rule is that whenever you pass a function as an argument, 710 | you wrap it with `FUNCTION` instead of `QUOTE`. With this rule, 711 | our call of nested `MAPCAR` would look like this: 712 | 713 | ---- 714 | (EVAL* '(MAPCAR (FUNCTION (LAMBDA (X) 715 | (MAPCAR (FUNCTION (LAMBDA (Y) (CONS X Y))) 716 | (QUOTE (P Q R))))) 717 | (QUOTE (A B C)))) 718 | ---- 719 | 720 | Now we modify our universal LISP function to deal with `FUNCTION`. 721 | We only need to change two lines. First, make `EVAL` understand 722 | `(FUNCTION )` form. Whenver it sees the form, it just 723 | returns a list `(FUNARG )`, where `` is the evaluation 724 | enviornment: 725 | 726 | ---- 727 | eval[e;a] = 728 | [atom[e] -> cdr[assoc[e;a]]; 729 | atom[car[e]] -> [eq[car[e];QUOTE] -> cadr[e]; 730 | eq[car[e];FUNCTION] -> cons[FUNARG;cons[cadr[e];cons[a;NIL]]]; <1> 731 | eq[car[e];COND] -> evcon[cdr[e];a]; 732 | T -> apply[car[e];evlis[cdr[e];a];a]]; 733 | T -> apply[car[e];evlis[cdr[e];a];a]] 734 | ---- 735 | 736 | 1. If we see `(FUNCTION )` form, wrap the function and the current environment in `FUNARG` form, as `(FUNARG )`. 737 | 738 | 739 | Then, in `APPLY`, we call `` with the rememberd `` instead of 740 | the passed environment: 741 | 742 | ---- 743 | apply[fn;x;a] = 744 | [atom[fn] -> [eq[fn;CAR] -> caar[x]; 745 | eq[fn;CDR] -> cdar[x]; 746 | eq[fn;CONS] -> cons[car[x];cadr[x]]; 747 | eq[fn;ATOM] -> atom[car[x]]; 748 | eq[fn;EQ] -> eq[car[x];cadr[x]]; 749 | T -> apply[eval[fn;a];x;a]]; 750 | eq[car[fn];FUNARG] -> apply[cadr[fn];x;caddr[fn]]; <1> 751 | eq[car[fn];LAMBDA] -> eval[caddr[fn];pairlis[cadr[fn];x;a]]; 752 | eq[car[fn];LABEL] -> apply[caddr[fn];x;cons[cons[cadr[fn];caddr[fn]];a]]] 753 | ---- 754 | 755 | 1. Apply the wrapped function in the rememberd environment 756 | 757 | 758 | The changed definitions are in link:mx/funarg.mx[]. You can load it 759 | and see it addresses the issue (which has been called FUNARG problem). 760 | 761 | ---- 762 | $ gosh -I. -u LISP1.5.axioms -l mx/funarg.mx 763 | gosh> ,l lisp/mapcar.lisp 764 | #t 765 | gosh> (EVAL* '(MAPCAR (FUNCTION (LAMBDA (X) 766 | (MAPCAR (FUNCTION (LAMBDA (Y) (CONS X Y))) 767 | (QUOTE (P Q R))))) 768 | (QUOTE (A B C)))) 769 | (((A . P) (A . Q) (A . R)) ((B . P) (B . Q) (B . R)) ((C . P) (C . Q) (C . R))) 770 | ---- 771 | 772 | [NOTE] 773 | ========================================================== 774 | Did you notice that you actually did't need `FUNCTION`? Instead 775 | of introducing another form, you can let `EVAL` create `FUNARG` 776 | when it sees a bare `LAMBDA` form. The definition will look like this: 777 | 778 | ---- 779 | eval[e;a] = 780 | [atom[e] -> cdr[assoc[e;a]]; 781 | atom[car[e]] -> [eq[car[e];QUOTE] -> cadr[e]; 782 | eq[car[e];LAMBDA] -> cons[FUNARG;cons[e;cons[a;NIL]]]; 783 | eq[car[e];COND] -> evcon[cdr[e];a]; 784 | T -> apply[car[e];evlis[cdr[e];a];a]]; 785 | T -> apply[car[e];evlis[cdr[e];a];a]] 786 | ---- 787 | 788 | The updated definition is in link:mx/funarg-lambda.mx[]. Using it, 789 | calling `MAPCAR` becomes quite simpler: 790 | 791 | ---- 792 | $ gosh -I. -u LISP1.5.axioms -l mx/funarg-lambda.mx 793 | gosh> ,l lisp/mapcar.lisp 794 | #t 795 | gosh> (EVAL* '(MAPCAR (LAMBDA (X) 796 | (MAPCAR (LAMBDA (Y) (CONS X Y)) 797 | (QUOTE (P Q R)))) 798 | (QUOTE (A B C)))) 799 | (((A . P) (A . Q) (A . R)) ((B . P) (B . Q) (B . R)) ((C . P) (C . Q) (C . R))) 800 | ---- 801 | 802 | This idea was realized by Sussman and Steele in 1975, as a dialect 803 | Scheme. The first paper of Scheme stated it at the beginning: 804 | 805 | [quote, Gerald Jay Sussman and Guy Lewis Steele Jr., 'SCHEME: An Interpreter For Extended Lambda Calculus'] 806 | ---- 807 | SCHEME is essentially a full-funarg LISP. LAMBDA expressions need 808 | not be QUOTEd, FUNCTIONed, or *FUNCTIONed when passed as arguments or 809 | returned as values; they will evaluate to closures themselves. 810 | ---- 811 | 812 | ========================================================== 813 | 814 | 815 | === Symbols and toplevel environment 816 | 817 | So far, our `EVAL` requires any bindings to be provided 818 | via the environment argument. Preprocessing the source with `mexpr-env.scm` 819 | was a remedy, but it's still troublesome. So our next step is to 820 | add a toplevel environment, that keeps global bindings of symbols. 821 | 822 | The easiest way is to keep a global table, and when we search 823 | a variable binding via `ASSOC` (in the first branch of `EVAL`), 824 | we also look up the table when we didn't find any local bindings. 825 | 826 | However, LISP1.5 took a bit different approach. Since its symbol had 827 | a property list, or _plist_, which could hold arbitrary key-value 828 | pairs, so I suspect it was natural to store the global value 829 | of the symbol in its plist. In fact, even the name of a symbol 830 | was merely one of its properties. In LISP1.5, a symbol was just 831 | another type of list where the car of its head was marked 832 | with a special value (-1). 833 | 834 | [NOTE] 835 | ==== 836 | A property list (plist) associates keys to values, much like 837 | an associative list (alist), 838 | but its structure alternates keys and values. For example, if 839 | key `A` has value `APPLE` and key `B` has a value `BANANA`, it can 840 | be represented with the following alist and plist, respectively: 841 | 842 | ---- 843 | ;; alist 844 | ((A . APPLE) (B . BANANA)) 845 | 846 | ;; plist 847 | (A APPLE B BANANA) 848 | ---- 849 | 850 | The number of cons cells used are the same. We're not sure why LISP1.5 851 | creators used plist for symbol properties, while they used 852 | alist for environment in `EVAL`. 853 | ==== 854 | 855 | In our minimal infrastructure (link:LISP1/5/axioms.scm[]) we just 856 | used Gauche symbols for LISP symbols. It might be interesting, 857 | though, to reproduce what LISP1.5 did -- using a list to implement 858 | symbols! 859 | 860 | That is, from now on, our LISP symbol is a pair whose car is 861 | a special marker. We use Gauche symbol `ATOM`. From LISP world, 862 | a LISP symbol is an unbreakable unit (hence it is called _atom_), so 863 | the marker is never be visible. Under the hood, in Gauche level, 864 | we can break an atom to access its internal structure. It is as 865 | if LISP world deals with chemical reactions and Gauche world deals 866 | with nuclear reactions. 867 | 868 | In LISP symbols, its name is stored as a value of the property 869 | `PNAME`. Since the property list is scanned by LISP function, 870 | we have to use LISP symbols as the property key. For the name itself, 871 | we use a Scheme string; in real LISP1.5, the name is stored 872 | in a special way and treated specially (there wasn't a string type). 873 | 874 | Thus, LISP symbol `PNAME` has the following structure in Gauche: 875 | 876 | [source, scheme] 877 | ---- 878 | (define *PNAME* '#0=(ATOM #0# "PNAME")) 879 | ---- 880 | 881 | The `#0=` notation is a Scheme way to write a circular structure. 882 | The symbol `PNAME` has a propoerty list, in which the key `PNAME` 883 | is associated to the name `"PNAME"`. Note that they LISP symbol 884 | `PNAME` itself doesn't have a global value. 885 | 886 | The global value of symbols is stored as a propery value with 887 | the key `APVAL`. So we need the LISP symbol `APVAL`, which looks 888 | like the following in Gauche. `APVAL` itself doesn't have a global 889 | value either: 890 | 891 | [source, scheme] 892 | ---- 893 | (define *APVAL* `(ATOM ,*PNAME* "APVAL")) 894 | ---- 895 | 896 | Once we have `PNAME` and `APVAL`, we can define `NIL`, whose name 897 | is `"NIL"` and value is itself. We can't use `#0=` notation this time, 898 | since we have to construct the list using values of `\*PNAME\*` etc. 899 | 900 | [source, scheme] 901 | ---- 902 | (define *NIL* (rlet1 nil (list 'ATOM *PNAME* "NIL" *APVAL*) 903 | (set! (cddddr nil) (list nil)))) 904 | ---- 905 | 906 | Here's how `\*NIL*` looks like in Gauche world. 907 | `#1=(ATOM #1# "PNAME")` is LISP symbol `PNAME`, and 908 | `(ATOM #1# "APVAL")` is LISP symbol `APVAL`. Remember we're looking 909 | at the internal of atoms -- from LISP world, this is just a symbol 910 | `NIL`. 911 | 912 | ---- 913 | gosh> *NIL* 914 | #0=(ATOM #1=(ATOM #1# "PNAME") "NIL" (ATOM #1# "APVAL") #0#) 915 | ---- 916 | 917 | We can define several symbols in this way. See link:LISP1/5/runtime.scm[] 918 | for all the predefined symbols. 919 | 920 | Let's start building infrastructure. Our LISP world only have symbols 921 | and cons cells so far (we'll add numbers later). We can define `$atom?` 922 | and `$cons?` as follows (The `$` indicates it deals with LISP objects): 923 | 924 | [source, scheme] 925 | ---- 926 | (define ($atom? obj) (and (pair? obj) (eq? (car obj) 'ATOM))) 927 | (define ($cons? obj) (and (pair? obj) (not (eq? (car obj) 'ATOM)))) 928 | ---- 929 | 930 | Then we can define `$lisp\->scheme`, which converts LISP data structure 931 | into Scheme data structure, handy for debugging. 932 | We map `NIL` inside the structure into Scheme empty list, so that 933 | list structure can be printed naturally (instead of having `. NIL)` 934 | at the end.) We also convert non-LISP object into a string `#[...]`. 935 | 936 | [source, scheme] 937 | ---- 938 | (define ($lisp->scheme obj) 939 | (define (rec obj) 940 | (cond [(eq? obj *NIL*) '()] 941 | [($atom? obj) (string->symbol (cadr (member *PNAME* (cdr obj))))] 942 | [(pair? obj) (cons (rec (car obj)) (rec (cdr obj)))] 943 | [else (format "#[~s]" obj)])) 944 | (if (eq? obj *NIL*) 945 | 'NIL 946 | (rec obj))) 947 | ---- 948 | 949 | It's also handy to have `$scheme\->lisp`, which converts Scheme 950 | structure into LISP structure. One important point: We want to keep 951 | symbol's `eq`{nbsp}-ness, that is, LISP symbols with the same name 952 | can be compared with `eq`. So we keep a hashtable to map Scheme 953 | symbol to LISP symbols. 954 | 955 | [source, scheme] 956 | ---- 957 | (define *obtable* (hash-table-r7 eq-comparator 958 | 'NIL *NIL* 959 | 'PNAME *PNAME* 960 | 'APVAL *APVAL*)) 961 | 962 | (define ($scheme->lisp obj) 963 | (cond [(null? obj) *NIL*] 964 | [(symbol? obj) (or (hash-table-get *obtable* obj #f) 965 | (rlet1 s (list 'ATOM *PNAME* (symbol->string obj)) 966 | (hash-table-put! *obtable* obj s)))] 967 | [(pair? obj) (cons ($scheme->lisp (car obj)) 968 | ($scheme->lisp (cdr obj)))] 969 | [else (errorf "Cannot convert ~s to LISP" obj)])) 970 | ---- 971 | 972 | Let's try them. Converting Scheme `(A B C D E)` into LISP results 973 | somewhat scary structure, but converting it back shows it's nothing 974 | to be afraid of: 975 | 976 | ---- 977 | gosh> ($scheme->lisp '(A B C D E)) 978 | ((ATOM #0=(ATOM #0# "PNAME") "A") (ATOM #0# "B") (ATOM #0# "C") 979 | (ATOM #0# "D") (ATOM #0# "E") . #1=(ATOM #0# "NIL" (ATOM #0# "APVAL") #1#)) 980 | gosh> ($lisp->scheme *1) 981 | (A B C D E) 982 | ---- 983 | 984 | Not all global values are stored in `APVAL` property. LISP1.5 uses 985 | several different keys, depending on the type of the value. `APVAL` 986 | is used when a symbol is used as a variable, and other keys are 987 | used when a symbol is used in the function position of the function call. 988 | 989 | [%header,cols=2*] 990 | |=== 991 | | Key 992 | | Value 993 | 994 | |`APVAL` 995 | |The value is a LISP object. 996 | 997 | |`EXPR` 998 | |The value is a LISP-defined function (LAMBDA or FUNARG form). The arguments 999 | are evaluated before passed to it. 1000 | 1001 | |`FEXPR` 1002 | |The value is a LISP-defined function (LAMBDA or FUNARG form). The arguments 1003 | are not evaluated, and passed as a single list. 1004 | 1005 | |`SUBR` 1006 | |The value is a native function (written in assembly in the acutal LISP1.5, 1007 | written in Gauche in our case). The arguments are evaluated before 1008 | passed it. 1009 | 1010 | |`FSUBR` 1011 | |The value is a native function (written in assembly in the acutal LISP1.5, 1012 | written in Gauche in our case). The arguments 1013 | are not evaluated, and passed as a single list. 1014 | |=== 1015 | 1016 | It is worth to mention that EXPR form receives fixed-number of arguments. 1017 | If you want to write a function in LISP that takes variable number 1018 | of arguments, you have to make it FEXPR, and evaluate the given list 1019 | of arguments by yourself. 1020 | 1021 | [NOTE] 1022 | ============================================================ 1023 | Lisp dialects can be categorized to either Lisp-1 or Lisp-2. 1024 | They are not versions, but about namespaces. 1025 | 1026 | Lisp-1 unifies function and variable namespaces, so in the 1027 | function call syntax, the function name is looked up the same 1028 | way as variable look-up. Scheme is Lisp-1. 1029 | 1030 | Lisp-2 have separate namespaces for functions and variables. 1031 | You can use the argument named `list`, and it is treated separately 1032 | from the function `list`. When you need to call a function stored 1033 | in a variable, you need to use an extra function, `funcall`. 1034 | Common Lisp is Lisp-2. 1035 | 1036 | This design of having different keys for function call and 1037 | variable makes LISP1.5 a Lisp-2. However, interestingly, 1038 | to call a function stored in a variable you can place the variable 1039 | in the function position, without `funcall`, just like Scheme. 1040 | So, coincidentally, we can say LISP1.5 is somewhat between Lisp-1 and Lisp-2. 1041 | ============================================================ 1042 | 1043 | 1044 | === Enhancement of M-expressions 1045 | 1046 | The `EVAL` procedure that uses symbol's property lists are 1047 | shown in Appending B of "LISP1.5 Programmer's Manual". However, 1048 | it contains some pseudo code which were actually implemented 1049 | in the assembly. Although we can rewrite the code in pure 1050 | LISP1.5, it would be pretty verbose; instead, we enhance our M-expressions 1051 | a bit so that the pseudo code in Appendix B can be written naturally 1052 | in our implementation. 1053 | 1054 | Specifically, we allow this clause in the `cond` form: 1055 | 1056 | ---- 1057 | test => proc 1058 | ---- 1059 | 1060 | The `test` expression is evaluated, and if it yields neither `NIL` nor `F`, 1061 | the procedure `proc` is called with the result of `test` as the sole 1062 | argument. It is the same as Scheme's `cond`. You can also 1063 | use Unicode character `⇒` (U+21d2) in place of `=>`. 1064 | 1065 | We also allow `λ` (U+03bb) in place of `lambda`, for conciseness 1066 | and similarity to the listing in "LISP1.5 Programmer's Manual". 1067 | 1068 | Here's a Scheme's `filter-map` written in our M-expression: 1069 | 1070 | ---- 1071 | filtermap[pred;lis] = 1072 | [null[lis] → NIL; 1073 | pred[car[lis]] ⇒ λ[[x];cons[x;filtermap[pred;cdr[lis]]]]; 1074 | T → filtermap[pred;cdr[lis]]] 1075 | ---- 1076 | 1077 | It works as follows: 1078 | 1079 | ---- 1080 | filtermap[atom;(A (B) C (D) E)] 1081 | ⇒ (A C E) 1082 | ---- 1083 | 1084 | 1085 | === Bridging worlds 1086 | 1087 | As we did in our first version with link:LISP1/5/axioms.scm[axioms.scm] and 1088 | link:mx/eval.mx[eval.mx], we want to keep Scheme code minimal 1089 | and write the rest of the system in LISP itself. We also want to 1090 | write so-called standard libraries in LISP, too. 1091 | 1092 | When you write language X in the language X itself, you have to be 1093 | epecially careful which _world_ you're dealing with. Before proceeding, 1094 | let's recap the layered structure we saw in the previous sections. 1095 | 1096 | * In `axioms.scm`, we defined minimal operators in Scheme to run LISP 1.5. 1097 | It is the bottom world, or the Basement. We can see all the mechanics 1098 | that runs the LISP system from the Basenment. 1099 | 1100 | * Then we loaded `eval.mx`, which is written in LISP 1.5 itself. At this 1101 | time though, the functions in `eval.mx`, such as `NULL`, `ASSOC` or 1102 | `EVAL`, are actually Gauche variables, bound to Gauche procedures; 1103 | The `DEFINE` macro in `axioms.scm` translates LISP 1.5 definitions 1104 | into Gauche definitons. The functions in `eval.mx` doesn't know 1105 | about Gauche, even though they themselves are running as Gauche procedures. 1106 | We're in the Ground Floor. 1107 | 1108 | * Then we processed `eval.mx` with `mexpr-env.scm` to produce `eval.lisp`. 1109 | It has `EVAL*`, which is still Ground Floor function. It takes a LISP1.5 1110 | expression and evaluates it. The expression passed to `EVAL*` lives 1111 | in the First Floor, above the Ground Floor. As we've seen, 1112 | the habitants in the First Floor knows nothing about the Ground Floor 1113 | or the Basement, except the bindings passed as the environment. 1114 | 1115 | Now, in our revised runtime, difference between the Basement 1116 | and the Ground Floor becomes wider: A LISP symbol is an unbreakable 1117 | atom in the Ground Floor, but it's just a pair in the Basement. 1118 | 1119 | We do need a few conduits between the floors, so that the upper floor 1120 | can access the functionality of lower floor: 1121 | 1122 | * `SUBR` and `FSUBR` are functions implemented in the basement. In 1123 | the original LISP1.5, they were implemented in assembly language. 1124 | In our case, they are written in Gauche. In order to invoke those 1125 | functions from the ground floor, we need an additional primitive, 1126 | `CALLSUBR`, which takes the instance of `SUBR` or `FSUBR` and 1127 | arguments, to call it. 1128 | 1129 | * Atoms in LISP world now has structure---somewhat like that an atom in 1130 | original sense was the minimal unbreakable building block of the universe, 1131 | then mankind found it has electrons and nucleus in it. We do want 1132 | to treat LISP atoms as unbreakable entity for most of the time, except 1133 | when we want to access its property list. 1134 | 1135 | * The previous version of `EVAL` doesn't have error handling mechanism. 1136 | For usability, we need some minimal mechanism to signal an error. 1137 | Theoretically, a sophisticated error handling mechanism can be implemented 1138 | fully in LISP layer---e.g. we can define a special "error" value, and 1139 | whenever something yields an error value, we let all the expressions 1140 | that got the error value just returns it, so that the error value 1141 | propagates to the final result. 1142 | However, it is convenient to stop and examine the evaluator at the moment 1143 | when error occurs, and such a mechanism needs access to the basement. 1144 | For now, we provide `ERROR` procedure as another primitive. 1145 | 1146 | * The previous version of `EVAL` didn't have literal fuction (lambda form) 1147 | in `EVAL` code itself---the lambda form is dealt by `EVAL`, but 1148 | the Basement that executes `EVAL` doesn't need to know that. Now that, 1149 | for our convenience, we use several lambda forms in the definition of `EVAL`, 1150 | so the Basement needs to deal with them, too. 1151 | 1152 | The revised runtime Basement routines---replacing `axioms.scm` is 1153 | in `LISP1/5/runtime.scm`: 1154 | 1155 | ---- 1156 | (define (CAR x) (if (null? (car x)) *NIL* (car x))) 1157 | (define (CDR x) (if (null? (cdr x)) *NIL* (cdr x))) 1158 | (define (CONS x y) (cons x (if (eq? y *NIL*) '() y))) 1159 | (define (ATOM x) (if ($atom? x) *T* *F*)) 1160 | (define (EQ x y) (if (eq? x y) *T* *F*)) 1161 | (define (CALLSUBR subr args) (apply subr args)) 1162 | (define (ERROR obj) (error "Meta*LISP Error:" ($lisp->scheme obj))) 1163 | (define T *T*) 1164 | (define F *NIL*) 1165 | (define NIL *NIL*) 1166 | 1167 | (define-syntax LAMBDA lambda) 1168 | (define-syntax QUOTE 1169 | (syntax-rules () 1170 | [(_ x) ($scheme->lisp 'x)])) 1171 | (define-syntax COND 1172 | (syntax-rules (=>) 1173 | [(_) *NIL*] 1174 | [(_ (test expr) . more) 1175 | (let ([t test]) 1176 | (if (or (eq? t *NIL*) (eq? t *F*)) 1177 | (COND . more) 1178 | expr))] 1179 | [(_ (test => proc) . more) ; extension 1180 | (let ([t test]) 1181 | (if (or (eq? t *NIL*) (eq? t *F*)) 1182 | (COND . more) 1183 | (proc t)))])) 1184 | 1185 | (define-syntax $TOPLEVELS 1186 | (syntax-rules ($=) 1187 | [(_ ($= (name args ...) expr) ...) 1188 | (begin (define name 1189 | (let ([lsym ($scheme->lisp 'name)] 1190 | [lfn ($scheme->lisp '(LAMBDA (args ...) expr))]) 1191 | (set! (cdr lsym) `(,($scheme->lisp 'EXPR) ,lfn ,@(cdr lsym))) 1192 | (lambda (args ...) expr))) 1193 | ...)])) 1194 | ---- 1195 | 1196 | When we read the definition of new `EVAL` in Gauche, the literals 1197 | are passed as Gauche's liteals. We treat it as LISP1.5 literals, 1198 | hence our `QUOTE` form in the basement translates Gauche literals 1199 | to LISP1.5 literals by `$scheme->lisp`. 1200 | 1201 | The `COND` is also enhanced to handle our extension. 1202 | 1203 | The `$TOPLEVELS` now not only defines Gauche procedures, 1204 | but also registers the defined form to the LISP1.5 symbol's `EXPR` 1205 | property. That is, if we load this M-expression on top of the 1206 | Basement: 1207 | 1208 | ---- 1209 | caar[x] = car[car[x]] 1210 | ---- 1211 | 1212 | It defines (1) a Gauche procedure `CAAR`, and (2) it registers `EXPR` 1213 | property of LISP1.5 symbol `CAAR` with S-expression 1214 | `(LAMBDA (X) (CAR (CAR X)))`. 1215 | 1216 | The `runtime.scm` also defines `SUBR` property of 1217 | several symbols that are used as primitives: 1218 | 1219 | ---- 1220 | (define-syntax defglobal 1221 | (syntax-rules () 1222 | [(_ var key val) 1223 | (let1 lsym ($scheme->lisp 'var) 1224 | (set! (cdr lsym) `(,($scheme->lisp key) ,val ,@(cdr lsym))))])) 1225 | 1226 | (defglobal CAR 'SUBR CAR) 1227 | (defglobal CDR 'SUBR CDR) 1228 | (defglobal CONS 'SUBR CONS) 1229 | (defglobal ATOM 'SUBR ATOM) 1230 | (defglobal EQ 'SUBR EQ) 1231 | (defglobal ERROR 'SUBR ERROR) 1232 | (defglobal CALLSUBR 'SUBR CALLSUBR) 1233 | ---- 1234 | 1235 | 1236 | === Revised `EVAL` with global environment: 1237 | 1238 | Now we write `EVAL` that understands the global environment. 1239 | First we need a couple of auxiliary procedures. 1240 | 1241 | Previously, we used `assoc` to search local bindings in the 1242 | local environment. We didn't consider an error there, so if you 1243 | use undefined variable it yielded Gauche error. The following `sassoc` 1244 | takes an extra thunk (a procedure with no arguments) and invokes it 1245 | when the item `x` isn't found in an associative list `a`: 1246 | 1247 | ---- 1248 | sassoc[x;a;thunk] = 1249 | [null[a] → thunk[]; 1250 | equal[caar[a];x] → car[a]; 1251 | T → sassoc[x;cdr[a];thunk]] 1252 | ---- 1253 | 1254 | Another function is to get the property value with the key `y` in 1255 | the symbol `x`. As we explained above, we access symbol's property list 1256 | just using `car` and `cdr`: 1257 | 1258 | ---- 1259 | get[x;y] = 1260 | [null[x] → NIL; 1261 | eq[car[x];y] → cadr[x]; 1262 | T → get[cdr[x];y]] 1263 | ---- 1264 | 1265 | Note: Since a property list alternates keys and values, it must loop 1266 | with `cddr`---skipping a value. However, LISP1.5 Programmer's Manual 1267 | lists the above code, just looping with `cdr`. I don't know if it 1268 | was just an overlook or they just reused exisitng `get` procedure. 1269 | 1270 | One consequence of that choice is that we can't simply store the 1271 | symbol's global value as `APVAL`'s value, since if that value happens 1272 | to be a symbol such as `EXPR`, it'll confuse `get` procedure. 1273 | So the `APVAL`'s value is wrapped with a list. 1274 | 1275 | Now, we can write revised `APPLY` and `EVAL` that maintaines 1276 | the global environment in symbols' propetry lists: 1277 | 1278 | ---- 1279 | apply[fn;args;a] = 1280 | [null[fn] → NIL; 1281 | atom[fn] → [get[fn;EXPR] ⇒ λ[[e];apply[e;args;a]]; 1282 | get[fn;SUBR] ⇒ λ[[s];callsubr[s;args]]; 1283 | T → apply[cdr[sassoc[fn;a;λ[[];error[A2]]]];args;a]]; 1284 | eq[car[fn];LABEL] → apply[caddr[fn];args;cons[cons[cadr[fn];caddr[fn]];a]]; 1285 | eq[car[fn];FUNARG] → apply[cadr[fn];args;caddr[fn]]; 1286 | eq[car[fn];LAMBDA] → eval[caddr[fn];pairlis[cadr[fn];args;a]]; 1287 | T → apply[eval[fn;a];args;a]] 1288 | 1289 | eval[form;a] = 1290 | [null[form] → NIL; 1291 | atom[form] → [get[form;APVAL] ⇒ λ[[v];car[v]]; 1292 | T → cdr[sassoc[form;a;λ[[];error[A8]]]]]; 1293 | eq[car[form];QUOTE] → cadr[form]; 1294 | eq[car[form];FUNCTION] → cons[FUNARG;cons[cadr[form];cons[a;NIL]]]; 1295 | eq[car[form];COND] → evcon[cdr[form];a]; 1296 | atom[car[form]] → [get[car[form];EXPR] 1297 | ⇒ λ[[e];apply[e;evlis[cdr[form];a];a]]; 1298 | get[car[form];FEXPR] 1299 | ⇒ λ[[f];apply[f;cons[cdr[form];cons[a;NIL]];a]]; 1300 | get[car[form];SUBR] 1301 | ⇒ λ[[s];callsubr[s;evlis[cdr[form];a]]]; 1302 | get[car[form];FSUBR] 1303 | ⇒ λ[[f];callsubr[f;cons[cdr[form];cons[a;NIL]]]]; 1304 | T → eval[cons[cdr[sassoc[car[form];a;λ[[];error[A9]]]]; 1305 | cdr[form]]; 1306 | a]]; 1307 | T → apply[car[form];evlis[cdr[form];a];a]] 1308 | ---- 1309 | 1310 | This is pretty close to what is shown in the Appendix B of 1311 | "LISP1.5 Programmer's Manual". 1312 | 1313 | Note that We have a couple of calls of `ERROR`. The argument is an 1314 | error code. 1315 | 1316 | * `error[A2]` : A symbol is used as a procedure but doesn't have a binding. 1317 | * `error[A8]` : A symbol is used as a variable but doesn't have a binding. 1318 | * `error[A9]` : A symbol is used as a procedure or syntax but doesn't have a binding. 1319 | 1320 | Another curious point. Check the `atom` branch of `eval`: 1321 | 1322 | ---- 1323 | atom[form] → [get[form;APVAL] ⇒ λ[[v];car[v]]; 1324 | T → cdr[sassoc[form;a;λ[[];error[A8]]]]]; 1325 | ---- 1326 | 1327 | It first accesses symbol's `APVAL` property, then 1328 | searches the environment. That is, symbol's global value takes 1329 | precedence from local values. 1330 | 1331 | You can run this version of `EVAL` by loading 1332 | `mx/genv.mx` into Gauche. 1333 | Note that `EVAL` now accepts LISP1.5 data, and returns 1334 | LISP1.5 data. You have to convert them to Gauche's data back and forth. 1335 | 1336 | Here, we just evaluate the global variable `F`, whose value is 1337 | `NIL`: 1338 | 1339 | ---- 1340 | gosh> ($lisp->scheme (EVAL ($scheme->lisp 'F) ($scheme->lisp '()))) 1341 | NIL 1342 | ---- 1343 | 1344 | The following code defines `REVERSE` function locally and calls it. 1345 | Note that `null` and `append` are already stored as `EXPR` property 1346 | of those symbols when we loaded `genv.mx`, so we don't need 1347 | to provide them in the environment: 1348 | 1349 | ---- 1350 | gosh> ($lisp->scheme 1351 | (EVAL ($scheme->lisp '#,(m-expr "reverse[(A B C D E F G)]")) 1352 | ($scheme->lisp 1353 | '((REVERSE . #,(m-expr "lambda[[xs];\ 1354 | [null[xs] -> NIL;\ 1355 | T -> append[reverse[cdr[xs]];cons[car[xs];NIL]]]]")))))) 1356 | 1357 | (G F E D C B A) 1358 | ---- 1359 | -------------------------------------------------------------------------------- /configure: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env gosh 2 | ;; Configuring Gauche-lisp15 3 | ;; Run ./configure (or gosh ./configure) to generate Makefiles. 4 | 5 | (use gauche.configure) 6 | 7 | ;; Here you can define handlers of configure arguments by cf-arg-enable 8 | ;; and cf-arg-with. Note that --with-local is handled implicitly if you use 9 | ;; cf-init-gauche-extension. 10 | 11 | 12 | ;; Initialize configure. This creates the global context, parses 13 | ;; command-line args and sets up default values. 14 | (cf-init-gauche-extension) 15 | 16 | ;; Here you can add feature tests and other cf-define's. 17 | 18 | ;; Output 19 | (cf-output-default) 20 | 21 | ;; Local variables: 22 | ;; mode: scheme 23 | ;; end: 24 | -------------------------------------------------------------------------------- /lisp/.keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shirok/Gauche-lisp15/9e171cc80a987e21e237e0a1ac654a9c7dba2c03/lisp/.keep -------------------------------------------------------------------------------- /mx/eval.mx: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Section 1.6 - A Universal LISP Function 3 | ;;; 4 | 5 | (use LISP1.5.mexpr) 6 | 7 | ;; NB: Before loading this file, you also need to have LISP1.5 8 | ;; enviornment so that special forms (COND, QUOTE, DEFINE) are 9 | ;; recognized. 10 | 11 | #!m-expr 12 | 13 | # Primitives (Axioms): 14 | # car, cdr, cons, eq, atom (and cond and quote, implicitly) 15 | 16 | # Convenience functions 17 | 18 | null[x] = [eq[x;NIL] -> T; T -> F] 19 | caar[x] = car[car[x]] 20 | cadr[x] = car[cdr[x]] 21 | cdar[x] = cdr[car[x]] 22 | caddr[x] = cadr[cdr[x]] 23 | cadar[x] = cadr[car[x]] 24 | 25 | equal[x;y] = 26 | [atom[x] -> [atom[y] -> eq[x;y]; T -> F]; 27 | equal[car[x]; car[y]] -> equal[cdr[x]; cdr[y]]; 28 | T -> F] 29 | 30 | subst[x;y;z] = 31 | [equal[y;z] -> x; 32 | atom[z] -> z; 33 | T -> cons[subst[x;y;car[z]];subst[x;y;cdr[z]]]] 34 | 35 | append[x;y] = 36 | [null[x] -> y; 37 | T -> cons[car[x];append[cdr[x];y]]] 38 | 39 | # Building blocks 40 | 41 | pairlis[x;y;a] = 42 | [null[x] -> a; 43 | T -> cons[cons[car[x];car[y]]; pairlis[cdr[x];cdr[y];a]]] 44 | 45 | assoc[x;a] = 46 | [equal[caar[a];x] -> car[a]; 47 | T -> assoc[x;cdr[a]]] 48 | 49 | 50 | # Evaluator 51 | 52 | apply[fn;x;a] = 53 | [atom[fn] -> [eq[fn;CAR] -> caar[x]; 54 | eq[fn;CDR] -> cdar[x]; 55 | eq[fn;CONS] -> cons[car[x];cadr[x]]; 56 | eq[fn;ATOM] -> atom[car[x]]; 57 | eq[fn;EQ] -> eq[car[x];cadr[x]]; 58 | T -> apply[eval[fn;a];x;a]]; 59 | eq[car[fn];LAMBDA] -> eval[caddr[fn];pairlis[cadr[fn];x;a]]; 60 | eq[car[fn];LABEL] -> apply[caddr[fn];x;cons[cons[cadr[fn];caddr[fn]];a]]] 61 | 62 | eval[e;a] = 63 | [atom[e] -> cdr[assoc[e;a]]; 64 | atom[car[e]] -> [eq[car[e];QUOTE] -> cadr[e]; 65 | eq[car[e];COND] -> evcon[cdr[e];a]; 66 | T -> apply[car[e];evlis[cdr[e];a];a]]; 67 | T -> apply[car[e];evlis[cdr[e];a];a]] 68 | 69 | evcon[c;a] = 70 | [eval[caar[c];a] -> eval[cadar[c];a]; 71 | T -> evcon[cdr[c];a]] 72 | 73 | evlis[m;a] = 74 | [null[m] -> NIL; 75 | T -> cons[eval[car[m];a];evlis[cdr[m];a]]] 76 | 77 | evalquote[fn;args] = apply[fn;args;NIL] 78 | -------------------------------------------------------------------------------- /mx/extended-cond.mx: -------------------------------------------------------------------------------- 1 | ;; -*- coding:utf-8 -*- 2 | ;; An example of using extended cond 3 | 4 | (use LISP1.5.mexpr) 5 | 6 | #!m-expr 7 | 8 | filtermap[pred;lis] = 9 | [null[lis] → NIL; 10 | pred[car[lis]] ⇒ lambda[[x];cons[x;filtermap[pred;cdr[lis]]]]; 11 | T → filtermap[pred;cdr[lis]]] 12 | 13 | # filtermap[atom;(A (B) C (D) E)] => (A C E) 14 | -------------------------------------------------------------------------------- /mx/funarg-lambda.mx: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Auto-FUNARG, like Scheme 3 | ;;; 4 | 5 | (use LISP1.5.mexpr) 6 | 7 | ;; We load funarg.mx, then overwrite eval. 8 | (load "examples/funarg.mx") 9 | 10 | #!m-expr 11 | 12 | eval[e;a] = 13 | [atom[e] -> cdr[assoc[e;a]]; 14 | atom[car[e]] -> [eq[car[e];QUOTE] -> cadr[e]; 15 | eq[car[e];LAMBDA] -> cons[FUNARG;cons[e;cons[a;NIL]]]; 16 | eq[car[e];COND] -> evcon[cdr[e];a]; 17 | T -> apply[car[e];evlis[cdr[e];a];a]]; 18 | T -> apply[car[e];evlis[cdr[e];a];a]] 19 | -------------------------------------------------------------------------------- /mx/funarg.mx: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Implement FUNCTION and FUNARG 3 | ;;; 4 | 5 | (use LISP1.5.mexpr) 6 | 7 | ;; We load eval.mx first, then overwrite apply and eval. 8 | (load "mx/eval.mx") 9 | 10 | #!m-expr 11 | 12 | apply[fn;x;a] = 13 | [atom[fn] -> [eq[fn;CAR] -> caar[x]; 14 | eq[fn;CDR] -> cdar[x]; 15 | eq[fn;CONS] -> cons[car[x];cadr[x]]; 16 | eq[fn;ATOM] -> atom[car[x]]; 17 | eq[fn;EQ] -> eq[car[x];cadr[x]]; 18 | T -> apply[eval[fn;a];x;a]]; 19 | eq[car[fn];FUNARG] -> apply[cadr[fn];x;caddr[fn]]; 20 | eq[car[fn];LAMBDA] -> eval[caddr[fn];pairlis[cadr[fn];x;a]]; 21 | eq[car[fn];LABEL] -> apply[caddr[fn];x;cons[cons[cadr[fn];caddr[fn]];a]]] 22 | 23 | eval[e;a] = 24 | [atom[e] -> cdr[assoc[e;a]]; 25 | atom[car[e]] -> [eq[car[e];QUOTE] -> cadr[e]; 26 | eq[car[e];FUNCTION] -> cons[FUNARG;cons[cadr[e];cons[a;NIL]]]; 27 | eq[car[e];COND] -> evcon[cdr[e];a]; 28 | T -> apply[car[e];evlis[cdr[e];a];a]]; 29 | T -> apply[car[e];evlis[cdr[e];a];a]] 30 | -------------------------------------------------------------------------------- /mx/genv.mx: -------------------------------------------------------------------------------- 1 | ;; -*- coding:utf-8 -*- 2 | ;;; 3 | ;;; EVAL with global envirnoment and LISP1.5 symbols 4 | ;;; 5 | 6 | (use LISP1.5.mexpr) 7 | (use LISP1.5.runtime) 8 | 9 | ;; We load eval.mx first, then overwrite apply and eval. 10 | (load "mx/eval.mx") 11 | 12 | #!m-expr 13 | 14 | # assoc with error check 15 | sassoc[x;a;thunk] = 16 | [null[a] → thunk[]; 17 | equal[caar[a];x] → car[a]; 18 | T → sassoc[x;cdr[a];thunk]] 19 | 20 | # Search a key Y in plist X and returns the corresponding value 21 | # If not found, returns NIL. 22 | get[x;y] = 23 | [null[x] → NIL; 24 | eq[car[x];y] → cadr[x]; 25 | T → get[cdr[x];y]] 26 | 27 | # 28 | # Apply and Eval 29 | # 30 | 31 | apply[fn;args;a] = 32 | [null[fn] → NIL; 33 | atom[fn] → [get[fn;EXPR] ⇒ λ[[e];apply[e;args;a]]; 34 | get[fn;SUBR] ⇒ λ[[s];callsubr[s;args]]; 35 | T → apply[cdr[sassoc[fn;a;λ[[];error[A2]]]];args;a]]; 36 | eq[car[fn];LABEL] → apply[caddr[fn];args;cons[cons[cadr[fn];caddr[fn]];a]]; 37 | eq[car[fn];FUNARG] → apply[cadr[fn];args;caddr[fn]]; 38 | eq[car[fn];LAMBDA] → eval[caddr[fn];pairlis[cadr[fn];args;a]]; 39 | T → apply[eval[fn;a];args;a]] 40 | 41 | eval[form;a] = 42 | [null[form] → NIL; 43 | atom[form] → [get[form;APVAL] ⇒ λ[[v];car[v]]; 44 | T → cdr[sassoc[form;a;λ[[];error[A8]]]]]; 45 | eq[car[form];QUOTE] → cadr[form]; 46 | eq[car[form];FUNCTION] → cons[FUNARG;cons[cadr[form];cons[a;NIL]]]; 47 | eq[car[form];COND] → evcon[cdr[form];a]; 48 | atom[car[form]] → [get[car[form];EXPR] 49 | ⇒ λ[[e];apply[e;evlis[cdr[form];a];a]]; 50 | get[car[form];FEXPR] 51 | ⇒ λ[[f];apply[f;cons[cdr[form];cons[a;NIL]];a]]; 52 | get[car[form];SUBR] 53 | ⇒ λ[[s];callsubr[s;evlis[cdr[form];a]]]; 54 | get[car[form];FSUBR] 55 | ⇒ λ[[f];callsubr[f;cons[cdr[form];cons[a;NIL]]]]; 56 | T → eval[cons[cdr[sassoc[car[form];a;λ[[];error[A9]]]]; 57 | cdr[form]]; 58 | a]]; 59 | T → apply[car[form];evlis[cdr[form];a];a]] 60 | -------------------------------------------------------------------------------- /mx/mapcar.mx: -------------------------------------------------------------------------------- 1 | (use LISP1.5.mexpr) 2 | 3 | #!m-expr 4 | 5 | mapcar[fn;x] = [null[x] -> NIL; 6 | T -> cons[fn[car[x]];mapcar[fn;cdr[x]]]] 7 | -------------------------------------------------------------------------------- /package.scm: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; Package Gauche-lisp15 3 | ;; 4 | 5 | (define-gauche-package "Gauche-lisp15" 6 | ;; 7 | :version "1.0" 8 | 9 | ;; Description of the package. The first line is used as a short 10 | ;; summary. 11 | :description "LISP1.5 implementation on Gauche" 12 | 13 | ;; List of dependencies. 14 | ;; Example: 15 | ;; :require (("Gauche" (>= "0.9.5")) ; requires Gauche 0.9.5 or later 16 | ;; ("Gauche-gl" "0.6")) ; and Gauche-gl 0.6 17 | :require (("Gauche" (>= "0.9.10"))) 18 | 19 | ;; List of providing modules 20 | ;; NB: This will be recognized >= Gauche 0.9.7. 21 | ;; Example: 22 | ;; :providing-modules (util.algorithm1 util.algorithm1.option) 23 | :providing-modules (LISP1.5) 24 | 25 | ;; List name and contact info of authors. 26 | ;; e.g. ("Eva Lu Ator " 27 | ;; "Alyssa P. Hacker ") 28 | :authors ("Shiro Kawai ") 29 | 30 | ;; List name and contact info of package maintainers, if they differ 31 | ;; from authors. 32 | ;; e.g. ("Cy D. Fect ") 33 | :maintainers () 34 | 35 | ;; List licenses 36 | ;; e.g. ("BSD") 37 | :licenses ("MIT") 38 | 39 | ;; Homepage URL, if any. 40 | 41 | ;; Repository URL, e.g. github 42 | :repository "https://github.com/shirok/Gauche-lisp15.git" 43 | ) 44 | -------------------------------------------------------------------------------- /test-basic.scm: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Test LISP1.5 3 | ;;; 4 | 5 | (use gauche.test) 6 | (use gauche.parameter) 7 | (use file.util) 8 | (test-start "LISP1.5") 9 | 10 | (test-section "Basic modules") 11 | 12 | (use LISP1.5.axioms) 13 | (test-module 'LISP1.5.axioms) 14 | 15 | (use LISP1.5.memory) 16 | (test-module 'LISP1.5.memory) 17 | 18 | (use LISP1.5.mexpr) 19 | (test-module 'LISP1.5.mexpr) 20 | 21 | (define (test-m mexpr expected) 22 | (test* mexpr expected (parse-mexpr mexpr))) 23 | 24 | (test-m "123" '(QUOTE 123)) 25 | (test-m "ABC123" '(QUOTE ABC123)) 26 | (test-m "blurb" 'BLURB) 27 | (test-m "list[]" '(LIST)) 28 | (test-m "cons[A;B]" '(CONS (QUOTE A) (QUOTE B))) 29 | (test-m "cons[(A . B);C]" '(CONS (QUOTE (A . B)) (QUOTE C))) 30 | (test-m "cons[cons[A;B]; C]" '(CONS (CONS (QUOTE A) (QUOTE B)) (QUOTE C))) 31 | (test-m "car[(A . (B1 . B2))]" '(CAR (QUOTE (A . (B1 . B2))))) 32 | 33 | (test-m "#comment\ncons[A;\nB #comment\n]" '(CONS (QUOTE A) (QUOTE B))) 34 | 35 | (test-m "[eq[car[x];A] -> cons[B;cdr[x]]; T -> x]" 36 | '(COND ((EQ (CAR X) (QUOTE A)) (CONS (QUOTE B) (CDR X))) 37 | ((QUOTE T) X))) 38 | 39 | (test-m "label[ff;lambda[[x];[atom[x]->x; T->ff[car[x]]]]]" 40 | '(LABEL FF (LAMBDA (X) 41 | (COND ((ATOM X) X) 42 | ((QUOTE T) (FF (CAR X))))))) 43 | 44 | (test-m "equal[x;y] = [atom[x] -> [atom[y] -> eq[x;y]; T -> F];\ 45 | equal[car[x]; car[y]] -> equal[cdr[x]; cdr[y]];\ 46 | T -> F]" 47 | '($= (EQUAL X Y) 48 | (COND ((ATOM X) (COND ((ATOM Y) (EQ X Y)) 49 | ((QUOTE T) (QUOTE F)))) 50 | ((EQUAL (CAR X) (CAR Y)) (EQUAL (CDR X) (CDR Y))) 51 | ((QUOTE T) (QUOTE F))))) 52 | 53 | (use LISP1.5) 54 | (test-module 'LISP1.5) 55 | 56 | (test-section "Eval") 57 | 58 | (test* "Loading eval.mx" #t 59 | (load "mx/eval.mx")) 60 | (test* "Calling APPLY" '(A B C X Y Z) 61 | (APPLY '#,(m-expr "label[apnd;lambda[[xs;r];\ 62 | [eq[xs;NIL] -> r;\ 63 | T -> cons[car[xs];apnd[cdr[xs];r]]]]]") 64 | '((A B C) (X Y Z)) 65 | 'NIL)) 66 | (test* "Calling EVAL" '(G F E D C B A) 67 | (EVAL '#,(m-expr "reverse[(A B C D E F G)]") 68 | '((NULL . #,(m-expr "lambda[[x];[eq[x;NIL] -> T; T -> F]]")) 69 | (APPEND . #,(m-expr "lambda[[xs;r];\ 70 | [null[xs] -> r;\ 71 | T -> cons[car[xs];append[cdr[xs];r]]]]")) 72 | (REVERSE . #,(m-expr "lambda[[xs];\ 73 | [null[xs] -> NIL;\ 74 | T -> append[reverse[cdr[xs]];cons[car[xs];NIL]]]]")) 75 | ))) 76 | 77 | (define-module metacircular-test1 78 | (use LISP1.5.axioms) 79 | (load "mx/eval.mx" :environment (current-module)) 80 | (load "lisp/eval.lisp" :environment (current-module))) 81 | (test* "Metacircular (axioms)" '(X . Y) 82 | (with-module metacircular-test1 83 | (EVAL* '#,(m-expr"eval[(CONS (QUOTE X) (QUOTE Y));NIL]")))) 84 | 85 | (define-module metacircular-test2 86 | (use LISP1.5.axioms) 87 | (load "mx/eval.mx" :environment (current-module)) 88 | (load "lisp/mapcar.lisp" :environment (current-module))) 89 | (test* "Metacircular (mapcar, no function)" '((A . Y) (B . Y) (C . Y)) 90 | (with-module metacircular-test2 91 | (EVAL* '(MAPCAR (QUOTE (LAMBDA (X) (CONS X (QUOTE Y)))) 92 | (QUOTE (A B C)))))) 93 | (test* "Metacircular (mapcar, no function, nested)" 94 | '((((P Q R) . P) ((Q R) . Q) ((R) . R)) 95 | (((P Q R) . P) ((Q R) . Q) ((R) . R)) 96 | (((P Q R) . P) ((Q R) . Q) ((R) . R))) 97 | (with-module metacircular-test2 98 | (EVAL* '(MAPCAR (QUOTE (LAMBDA (X) 99 | (MAPCAR (QUOTE (LAMBDA (Y) (CONS X Y))) 100 | (QUOTE (P Q R))))) 101 | (QUOTE (A B C)))))) 102 | 103 | (define-module metacircular-test3 104 | (use LISP1.5.axioms) 105 | (load "mx/funarg.mx" :environment (current-module)) 106 | (load "lisp/mapcar.lisp" :environment (current-module))) 107 | (test* "Metacircular (mapcar, with function)" 108 | '(((A . P) (A . Q) (A . R)) 109 | ((B . P) (B . Q) (B . R)) 110 | ((C . P) (C . Q) (C . R))) 111 | (with-module metacircular-test3 112 | (EVAL* '(MAPCAR (FUNCTION 113 | (LAMBDA (X) 114 | (MAPCAR (FUNCTION (LAMBDA (Y) (CONS X Y))) 115 | (QUOTE (P Q R))))) 116 | (QUOTE (A B C)))))) 117 | 118 | ;; If you don't want `gosh' to exit with nonzero status even if 119 | ;; the test fails, pass #f to :exit-on-failure. 120 | (test-end :exit-on-failure #t) 121 | -------------------------------------------------------------------------------- /test-genv.scm: -------------------------------------------------------------------------------- 1 | (use gauche.test) 2 | (use gauche.parameter) 3 | (use file.util) 4 | (test-start "genv") 5 | 6 | (test-section "LISP1.5.runtime") 7 | 8 | (use LISP1.5.runtime) 9 | (test-module 'LISP1.5.runtime) 10 | 11 | (test* "Loading genv" #t (load "mx/genv.mx")) 12 | 13 | (define-syntax evaltest 14 | (syntax-rules () 15 | [(evaltest output input env) 16 | (test* (x->string input) output 17 | ($lisp->scheme (EVAL ($scheme->lisp input) 18 | ($scheme->lisp env))))])) 19 | 20 | (evaltest 'A '(QUOTE A) '()) 21 | (evaltest '(X . Y) '(CONS (QUOTE X) (QUOTE Y)) '()) 22 | (evaltest 'NIL 'NIL '()) 23 | (evaltest 'NIL 'F '()) 24 | (evaltest 'T 'T '()) 25 | 26 | (evaltest 'ORANGE 'APPLE '((APPLE . ORANGE))) 27 | (evaltest '(G F E D C B A) 28 | '(REVERSE (QUOTE (A B C D E F G))) 29 | '((REVERSE . (LAMBDA (XS) 30 | (COND ((NULL XS) NIL) 31 | (T (APPEND (REVERSE (CDR XS)) 32 | (CONS (CAR XS) NIL)))))))) 33 | 34 | (evaltest '(G F E D C B A) 35 | '#,(m-expr "reverse[(A B C D E F G)]") 36 | '((REVERSE . #,(m-expr "lambda[[xs];\ 37 | [null[xs] -> NIL;\ 38 | T -> append[reverse[cdr[xs]];cons[car[xs];NIL]]]]")))) 39 | 40 | 41 | (test-end) 42 | -------------------------------------------------------------------------------- /tools/mexpr-env.scm: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; A helper tool to convert definitions M-expr source into an assoc list. 3 | ;; 4 | 5 | (use gauche.parseopt) 6 | (add-load-path ".." :relative) 7 | 8 | (define (usage) 9 | (print "Usage: gosh tools/axiom-env [-e] MEXPR-SOURCE ...") 10 | (print " Read MEXPR-SOURCE and writes out the definitions in an assoc list") 11 | (print " that can be passed to EVAL as an environment.") 12 | (print " With -e option, generate a definition of EVAL*, which calls EVAL") 13 | (print " with the given environment.") 14 | (print " If more than one MEXPR-SOURCE is given, definitions are concatenated") 15 | (print " in reverse order, so if there're definitions of the same name, the latter") 16 | (print " one takes precedence.") 17 | (exit 1)) 18 | 19 | (define *defs* '()) 20 | 21 | (define-syntax $TOPLEVELS 22 | (syntax-rules ($=) 23 | [(_ ($= (name arg ...) expr) ...) 24 | (begin (push! *defs* '((name . (LAMBDA (arg ...) expr)) ...)) 25 | (undefined))])) 26 | 27 | (define (main args) 28 | (let-args (cdr args) ([emit-eval* "e"] 29 | [else => (^ _ (usage))] 30 | . files) 31 | (when (null? files) (usage)) 32 | (dolist [file files] 33 | (load file :paths '("."))) 34 | (when emit-eval* (display "($TOPLEVELS ($= (EVAL* X) (EVAL X (QUOTE ")) 35 | (pprint (concatenate *defs*)) 36 | (when emit-eval* (print "))))")) 37 | 0)) 38 | -------------------------------------------------------------------------------- /tools/trace.scm: -------------------------------------------------------------------------------- 1 | (use srfi-42) 2 | (use gauche.parameter) 3 | 4 | (define-class () 5 | ((orig-proc :init-keyword :orig-proc) 6 | (name :init-keyword :name))) 7 | 8 | (define nesting (make-parameter 0)) 9 | 10 | (define (indent) (make-string (* (nesting) 2))) 11 | 12 | (define-method object-apply ((t ) . args) 13 | (print #"~(indent)Calling ~(~ t'name) with args:") 14 | (do-ec [: arg (index i) args] 15 | (begin 16 | (format (current-output-port) "~a~2d: " (indent) i) 17 | (pprint ($lisp->scheme arg) :length 6 :level 4))) 18 | (rlet1 r (parameterize ((nesting (+ (nesting) 1))) 19 | (apply (~ t'orig-proc) args)) 20 | (display #"~(indent)Result of ~(~ t'name): ") 21 | (pprint ($lisp->scheme r) :length 6 :level 4))) 22 | 23 | (define-syntax trace 24 | (syntax-rules () 25 | [(_ X) (set! X (%make-trace X 'X))])) 26 | 27 | (define (%make-trace proc name) 28 | (when (is-a? proc ) 29 | (error "Already traced:" name)) 30 | (make :orig-proc proc :name name)) 31 | --------------------------------------------------------------------------------