Skip to content
This repository
Browse code

Lookup should error on failure.

  • Loading branch information...
commit 81388885737f6bac2ccdf5558ec404cb0d4f317f 1 parent 9a49db7
Benjamin Saunders Ralith authored

Showing 2 changed files with 11 additions and 13 deletions. Show diff stats Hide diff stats

  1. +8 7 src/environments.lisp
  2. +3 6 src/inference.lisp
15 src/environments.lisp
@@ -26,7 +26,7 @@
26 26 (:type (type-bindings env))
27 27 (:interface (interface-bindings env))))
28 28
29   -(defun lookup (symbol &optional (namespace :value) (env *primitives-env*))
  29 +(defun %lookup (symbol &optional (namespace :value) (env *primitives-env*))
30 30 (when (stringp symbol)
31 31 (setf symbol (make-bl-symbol symbol)))
32 32 (if env
@@ -34,11 +34,16 @@
34 34 (if exists
35 35 (values place t)
36 36 (loop for parent in (parents env)
37   - do (multiple-value-bind (place exists) (lookup symbol namespace parent)
  37 + do (multiple-value-bind (place exists) (%lookup symbol namespace parent)
38 38 (when exists
39 39 (return (values place t)))))))
40 40 (values nil nil)))
41 41
  42 +(defun lookup (symbol &optional (namespace :value) (env *primitives-env*))
  43 + (multiple-value-bind (binding exists) (%lookup symbol namespace env)
  44 + (if exists binding
  45 + (error "~A names no ~A in ~A" symbol namespace env))))
  46 +
42 47 (defun bind (env namespace symbol value)
43 48 "Associate SYMBOL with VALUE in ENV"
44 49 (etypecase symbol
@@ -56,11 +61,7 @@
56 61 "Lower code into internal representations"
57 62 (etypecase source
58 63 (null nil)
59   - (bl-symbol
60   - (multiple-value-bind (place exists) (lookup source :value env)
61   - (if exists
62   - place
63   - (error "~A names no binding" source))))
  64 + (bl-symbol (lookup source :value env))
64 65 (list
65 66 (destructuring-bind (operator &rest args) source
66 67 (let ((op (resolve operator env)))
9 src/inference.lisp
@@ -10,17 +10,14 @@
10 10 (list (make-instance 'pred
11 11 :interface
12 12 (if (= lit 0)
13   - (or (lookup "abelian-group" :interface)
14   - (error "abelian-group undefined"))
15   - (or (lookup "ring" :interface)
16   - (error "ring undefined")))
  13 + (lookup "abelian-group" :interface)
  14 + (lookup "ring" :interface))
17 15 :args (list var))))))
18 16 (ratio (let ((var (make-instance 'tyvar :kind 1)))
19 17 (values (make-form var lit)
20 18 (list (make-instance 'pred
21 19 :interface
22   - (or (lookup "division-ring" :interface)
23   - (error "division-ring undefined"))
  20 + (lookup "division-ring" :interface)
24 21 :args (list var))))))))
25 22
26 23 (defun infer-expr-seq (exprs)

0 comments on commit 8138888

Please sign in to comment.
Something went wrong with that request. Please try again.