Skip to content


Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base fork: bitlisp/bitlisp
base: 9a49db76d0
head fork: bitlisp/bitlisp
compare: f50ebd679c
Checking mergeability… Don't worry, you can still create the pull request.
  • 2 commits
  • 2 files changed
  • 0 commit comments
  • 1 contributor
Showing with 15 additions and 13 deletions.
  1. +12 −7 src/environments.lisp
  2. +3 −6 src/inference.lisp
19 src/environments.lisp
@@ -11,6 +11,10 @@
(module :initform nil :initarg :module :accessor module)
(toplevel? :initarg :toplevel? :accessor toplevel?)))
+(defmethod print-object ((env environment) stream)
+ (print-unreadable-object (env stream :type t)
+ (princ (module-fqn (module env)) stream)))
(defun make-subenv (parent)
(make-instance 'environment
:parents (list parent)
@@ -26,7 +30,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 +38,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 +65,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)

No commit comments for this range

Something went wrong with that request. Please try again.