Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Browse files

Lookup should error on failure.

  • Loading branch information...
commit 81388885737f6bac2ccdf5558ec404cb0d4f317f 1 parent 9a49db7
@Ralith Ralith authored
Showing with 11 additions and 13 deletions.
  1. +8 −7 src/environments.lisp
  2. +3 −6 src/inference.lisp
15 src/environments.lisp
@@ -26,7 +26,7 @@
(:type (type-bindings env))
(:interface (interface-bindings env))))
-(defun lookup (symbol &optional (namespace :value) (env *primitives-env*))
+(defun %lookup (symbol &optional (namespace :value) (env *primitives-env*))
(when (stringp symbol)
(setf symbol (make-bl-symbol symbol)))
(if env
@@ -34,11 +34,16 @@
(if exists
(values place t)
(loop for parent in (parents env)
- do (multiple-value-bind (place exists) (lookup symbol namespace parent)
+ do (multiple-value-bind (place exists) (%lookup symbol namespace parent)
(when exists
(return (values place t)))))))
(values nil nil)))
+(defun lookup (symbol &optional (namespace :value) (env *primitives-env*))
+ (multiple-value-bind (binding exists) (%lookup symbol namespace env)
+ (if exists binding
+ (error "~A names no ~A in ~A" symbol namespace env))))
(defun bind (env namespace symbol value)
"Associate SYMBOL with VALUE in ENV"
(etypecase symbol
@@ -56,11 +61,7 @@
"Lower code into internal representations"
(etypecase source
(null nil)
- (bl-symbol
- (multiple-value-bind (place exists) (lookup source :value env)
- (if exists
- place
- (error "~A names no binding" source))))
+ (bl-symbol (lookup source :value env))
(destructuring-bind (operator &rest args) source
(let ((op (resolve operator env)))
9 src/inference.lisp
@@ -10,17 +10,14 @@
(list (make-instance 'pred
(if (= lit 0)
- (or (lookup "abelian-group" :interface)
- (error "abelian-group undefined"))
- (or (lookup "ring" :interface)
- (error "ring undefined")))
+ (lookup "abelian-group" :interface)
+ (lookup "ring" :interface))
:args (list var))))))
(ratio (let ((var (make-instance 'tyvar :kind 1)))
(values (make-form var lit)
(list (make-instance 'pred
- (or (lookup "division-ring" :interface)
- (error "division-ring undefined"))
+ (lookup "division-ring" :interface)
:args (list var))))))))
(defun infer-expr-seq (exprs)
Please sign in to comment.
Something went wrong with that request. Please try again.