mirror of
https://github.com/kanaka/mal.git
synced 2024-09-20 01:57:09 +03:00
8a19f60386
- Reorder README to have implementation list after "learning tool" bullet. - This also moves tests/ and libs/ into impls. It would be preferrable to have these directories at the top level. However, this causes difficulties with the wasm implementations which need pre-open directories and have trouble with paths starting with "../../". So in lieu of that, symlink those directories to the top-level. - Move the run_argv_test.sh script into the tests directory for general hygiene.
65 lines
2.2 KiB
Scheme
65 lines
2.2 KiB
Scheme
;; Copyright (C) 2015
|
|
;; "Mu Lei" known as "NalaGinrut" <NalaGinrut@gmail.com>
|
|
;; This file is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This file is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
(library (env)
|
|
(export make-Env env-has env-check)
|
|
(import (guile) (types)))
|
|
|
|
(define (env-check sym env)
|
|
(env-has sym env (lambda _ #f)))
|
|
|
|
(define (sym-err-throw sym)
|
|
(throw 'mal-error (format #f "'~a' not found" sym)))
|
|
|
|
(define* (env-has sym env #:optional (err sym-err-throw))
|
|
(let ((v ((env 'get) sym)))
|
|
(if (equal? v '*mal-null*)
|
|
(err sym)
|
|
v)))
|
|
|
|
(define* (make-Env #:key (outer nil) (binds '()) (exprs '()))
|
|
(define _env (make-hash-table))
|
|
(define (_set k v) (hash-set! _env k v))
|
|
(define (_get k)
|
|
(let ((v (hash-ref _env k '*mal-null*)))
|
|
(if (equal? v '*mal-null*)
|
|
(if (_nil? outer)
|
|
'*mal-null*
|
|
((outer 'get) k))
|
|
v)))
|
|
(define (_find k) (_get k))
|
|
(define (_show)
|
|
(hash-for-each (lambda (k v) (format #t "~a : ~a~%" k v)) _env)
|
|
(display "outer:\n")
|
|
(and (not (_nil? outer)) ((outer 'show))))
|
|
(let lp((b binds) (e exprs))
|
|
(cond
|
|
((null? b) #t)
|
|
((eq? (car b) '&) (hash-set! _env (cadr b) e)) ; handle varglist
|
|
(else ; normal binding
|
|
(when (not (symbol? (car b)))
|
|
(throw 'mal-error (format #f "Invalid binding key! '~a'" (car b))))
|
|
(when (null? e)
|
|
(throw 'mal-error "Invalid pattern for this macro"))
|
|
(hash-set! _env (car b) (car e))
|
|
(lp (cdr b) (cdr e)))))
|
|
(lambda (cmd)
|
|
(case cmd
|
|
((set) _set)
|
|
((find) _find)
|
|
((get) _get)
|
|
((show) _show)
|
|
(else (throw 'mal-error (format #f "BUG: Invalid cmd '~a'" cmd))))))
|