(SETQQCHECK NIL
ORDINAL
'(RESTRICTIONS: DIRECTION: DIMENSION:)
'MEASURE)
(RETURN (LIST '/#MORE
DIMENSION:
(PLNR-VAR (COND (DIRECTION: NEWVAR) (VAR)))
(PLNR-VAR (COND (DIRECTION: VAR)
(NEWVAR)))))))
;;;=============================================================
(DEFUN EXPAND (EXP EVENT)
;;THE HEART OF THE PLANNER BUILDER. EXPANDS AN EXPRESSION
;;WORRYING ABOUT THE QUANTIFIERS AND CONNECTIVES OF ITS
;;CONSTITUENTS. IT DOESN/"T REALLY HANDLE EXPRESSIONS WITH
;;MORE THAN ONE QUANTIFIED SS UNLESS ONE OF THEM IS THE REL.
;;THE EVENT IS NON-NIL ONLY IF THE EVENT-NAME IS TO BE
;;INCLUDED IN THE EXPANSION OF THE EXPRESSION.
(COND
((RSS? EXP)
(COND ((AND? EXP)
(PLNR-PROGIFY NIL
(MAPCAR '(LAMBDA (X) (EXPAND X NIL))
(AND? EXP))))
((OR? EXP)
(PLNR-ORIFY (MAPCAR '(LAMBDA (X) (EXPAND X NIL))
(OR? EXP))))
((PLNR-NOTIFY (NEGATIVE? EXP)
(PLNR-DESCRIBE (RELATIONS? EXP)
(VARIABLE? EXP)
(CONS (VARIABLE? EXP)
FREEVARS))))))
((ATOM EXP) (BUG EXPAND - ATOMIC MODIFIER))
((EQ (CAR EXP) '*ORDINAL*)
(COND (ORDINAL (GLOBAL-ERR '(I CAN/"T
HANDLE
TWO
ORDINALS
OR
SUPERLATIVES
AT
ONCE)))
((SETQ ORDINAL (CADR EXP)) '*ORDINAL*)))
((EQ (CAR EXP) '/#SUBST)
(ERT EXPAND - IS /#SUBST BEING HANDLED BY SOMEONE ELSE?)
EXP)
((PROG (BODY QUANTIFIER CHOICE VAR MULTIPLE)
(SETQ MULTIPLE (EVAL (GET (CAR EXP) 'MULTIPLE)))
(SETQ
EXP
(MAPCAR
'(LAMBDA (X)
(COND
((OR (NOT (ATOM X)) (NOT (OR (RSS? X) (OSS? X))))
X)
((REFER? X)
(COND ((CDR (REFER? X))
(COND (MULTIPLE (ERQSET 'AND)
(SETQ CHOICE (REFER? X))
'*AND*)
((REFER? X))))
((CAR (REFER? X)))))
((MEMQ (VARIABLE? X) FREEVARS)
(AND (RSSVAR? (VARIABLE? X))
(PUTPROP (VARIABLE? X) T 'USED))
(PLNR-VAR (VARIABLE? X)))
((SETQ CHOICE (AND? X))
(ERQSET 'AND)
(AND MULTIPLE
(REFER? X)
(SETQ CHOICE (REFER? X)))
'*AND*)
((SETQ CHOICE (OR? X))
(ERQSET 'OR)
'*OR*)
((COND ((RSS? X)
(ERQSET 'EVENT)
(PUTPROP (VARIABLE? X) T 'USED))
((MEMQ (QUANTIFIER? X) '(ALL NO))
(ERQSET (QUANTIFIER? X))
T)
((MEMQ (QUANTIFIER? X)
'(NDET INDEF))
(COND ((MEMQ (NUMBER? X)
'(NS SG-PL))
(ERQSET 'INDEF))
((SETQ CHOICE
(PLNR-FINDSPEC (NUMBER? X)))
(ERQSET 'FIND)))
T))
(SETQ BODY
(PLNR-DESCRIBE (RELATIONS? X)
(VARIABLE? X)
(CONS (VARIABLE? X)
FREEVARS)))
(PLNR-VAR (SETQ VAR (VARIABLE? X))))
((ERTERR EXPAND - STRANGE QUANTIFIER))))
(COND (EVENT (CONS (CAR EXP) (CONS EVENT (CDR EXP))))
(T EXP))))
;THE EVENT NAME IS STUCK INTO THE SECOND
(RETURN
;POSITION IF THERE IS ONE.
(COND
((NULL QUANTIFIER) (PLNR-GOALIFY EXP))
((EQ QUANTIFIER 'AND)
(PLNR-PROGIFY NIL
(MAPCAR '(LAMBDA (X)
(EXPAND (SUBST X
'*AND*
EXP)
NIL))
CHOICE)))
((EQ QUANTIFIER 'OR)
(PLNR-ORIFY (MAPCAR '(LAMBDA (X)
(EXPAND (SUBST X
'*OR*
EXP)
NIL))
CHOICE)))
((EQ QUANTIFIER 'FIND)
(PLNR-FINDIFY
CHOICE
VAR
(LIST VAR)
(PLNR-PROGIFY NIL
(CONS BODY
(LIST (PLNR-GOALIFY EXP))))))
(T
(PLNR-NOTIFY
(MEMQ QUANTIFIER '(ALL NO))
(PLNR-PROGIFY
(AND VAR (LIST VAR))
(CONS
BODY
(LIST (PLNR-NOTIFY (EQ QUANTIFIER 'ALL)
(PLNR-GOALIFY EXP)))))))))))))
;;;=============================================================
(DEFUN ERQSET (X)
;;USED BY EXPAND TO MAKE SURE IT ISN/"T GETTING CONFUSED BY TOO
;;MANY CONNECTIVES AND QUANTIFIERS IN THE SAME EXPRESSION
(COND (QUANTIFIER (GLOBAL-ERR '(I CAN/"T
HANDLE
COMBINATIONS
OF
QUANTIFIERS
AND
CONNECTIVES
WHICH
ARE
SO
COMPLICATED)))
((SETQ QUANTIFIER X))))
;;;============================================================
(DEFUN SETQQCHECK (%EVALFLAG %LIST %CHECKLIST %NAME)
;;SETQQCHECK IS LIKE SETQQ (OR LIKE SETQ DEPENDING ON
;;EVALFLAG) BUT IT CHECKS TO MAKE SURE THE VARIABLE NAME IS A
;;MEMBER OF THE %CHECKLIST, AND IF NOT PRINTS AN ERROR
;;MESSAGE.
(PROG (%X)
GO (COND ((NULL %LIST) (RETURN T))
((MEMQ (CAR %LIST) %CHECKLIST)
(SET (CAR %LIST)
(COND (%EVALFLAG (EVAL (CADR %LIST)))
(ELSE (CADR %LIST))))
(SETQ %LIST (CDDR %LIST))
(GO GO))
(T (SETQ %X
(APPLY 'ERT
(CONS (CAR %LIST)
(APPEND '(IS NOT
A
LEGAL
SPECIFICATION
FOR)
(LIST %NAME)))))))
UP (COND ((EQ %X '?)
(PRINT %CHECKLIST)
(SETQ %X (ERT foo: setqqcheck ????))
(GO UP))
;A QUESTION MARK GETS THE LIST OF POSSIBILITIES
;PRINTED OUT, THEN LETS YOU TRY AGAIN. TO DO
;THIS YOU MUST TYPE (RETURN '?) AT THE ERT. IF
;YOU RETURN ANY OTHER VALUE, IT ASSUMES THIS IS
((SETQ %LIST (CONS %X (CDR %LIST))) (GO GO)))))
;THE VARIABLE NAME INTENDED, OTHERWISE IT JUST
;CAUSES AN ERROR.
;;;============================================================
(DEFUN THVAL2 (WHO AA)
(PROG (RESULT X mplnr-ttime m-gc)
(SETQ THLEVEL '(T))
(SETQ X (SETQ RESULT '(NIL)))
(AND PLANNERSEE
(DISP AA)
PLNRSEE-PAUSE
(ERT FOR PLANNER))
(and (not (eq result x))
(return result))
(setq mplnr-ttime (runtime) m-gc (status gctime) )
(setq result (thval aa '((ev command)) ))
(setq mplnr-time (timer mplnr-ttime (runtime)))
(or (= m-gc (status gctime))
(setq mplnr-time (difference mplnr-time (timer m-gc (status gctime)))
gc (status gctime)) )
(return result)
))
;;;============================================================
(DEFUN WHO (X)
(COND ((NULL WHO))
((ATOM X))
((NOT (SETQ X (GET X 'WHO))) NIL)
((EQ WHO 'HE))
((LESSP (CAR WHO) X LASTSENTNO))))
(DEFUN CHECK (NEW-MARKERS MARKERS SYSTEMS)
;;;
;; TAKES A LIST OF NEW MARKERS AND CHECKS FOR COMPATIBILITY
;;WITH THE EXISTING MARKERS AND SYSTEMS (AS GIVEN BY ARGS
;;MARKERS AND SYSTEMS). IF COMPATIBLE, RETURNS A TWO-LIST OF
;;THE NEW MARKERS AND SYSTEMS, ELSE RETURNS NIL
;;;
(PROG NIL
LOOP (COND ((NULL NEW-MARKERS)
(RETURN (LIST MARKERS SYSTEMS)))
((CHECKAMARKER (CAR NEW-MARKERS))
(SETQ NEW-MARKERS (CDR NEW-MARKERS))
(GO LOOP))
(T (RETURN NIL)))))
; FAIL IF CHECKAMARKER FAILS
;;;=========================================================================
====
(DEFUN CHECKAMARKER (MARKER)
;;;
;;; CHECKS A SINGLE MARKER FOR COMPATIBILITY
;;; USES FREE VARIABLES:
;;; SYSTEMS - THE SYSTEM LIST SO FAR
;;; MARKERS - THE MARKER LIST SO FAR
;;; IF SUCCESSFULL, THE MARKER AND ITS SYSTEM(S) ARE APPENDED
;;; TO THESE FREE VARIBLES
;;;
(PROG (NEW-SYSTEMS)
(COND ((MEMQ MARKER MARKERS) (RETURN T)))
;IF MARKER ALREADY THERE, FINE
(SETQ MARKERS (CONS MARKER MARKERS))
; ADD NEW MARKER TO LIST
(SETQ NEW-SYSTEMS (GET MARKER 'SYS))
;GET THE SYSTEMS OF THE NEW MARKER
SYS (COND ((NULL NEW-SYSTEMS) (RETURN T))
((MEMQ (CAR NEW-SYSTEMS) SYSTEMS) (RETURN NIL))
;FAIL IF SYSTEM THERE BY ANOTHER PATH
((CHECKAMARKER (CAR NEW-SYSTEMS))
(SETQ SYSTEMS (CONS (CAR NEW-SYSTEMS) SYSTEMS))
(SETQ NEW-SYSTEMS (CDR NEW-SYSTEMS))
(GO SYS))
(T (RETURN NIL)))))
(DEFUN FINDEVENTS (RSS)
;;FINDS ALL THE EVENTS FITTING THE RSS DESCRIPTION
(PUTPROP (VARIABLE? RSS) T 'USED)
(THVAL2 NIL
(PLNR-FINDIFY 'ALL
(VARIABLE? RSS)
(LIST (VARIABLE? RSS))
(PLNR-DESCRIBE (RELATIONS? RSS)
(VARIABLE? RSS)
(LIST (VARIABLE? RSS))))))
(DEFUN CHECKREL (OSS)
;;CHECKS FOR POSSIBLE RELATIVE, EITHER BECAUSE OSS IS ON THE
;;RELLIST, OR BECUASE RSS INVOLVES INSIDE IT AN OSS ON THE
;;RELLIST
(COND ((OSS? OSS) (MEMQ OSS RELLIST))
;IT RETURNS EITHER NIL OR A LIST OF WHICH THE
((RSS? OSS)
;FIRST ELEMENT IS THE REAL RELATIVE. IT USES
(MAPCAN
'(LAMBDA (RELATION)
;THIS FACT TO CHEAT ON RECURSION BY USING
(COND ((ATOM RELATION) NIL)
;MAPCAN.
((MAPCAN 'CHECKREL RELATION))))
(RELATIONS? OSS)))))
-----------------------------------------------
Why is that?
Mike Speed wrote:
> I give up - I can't find a ^[^;]*[.] or anything even remote to this in
> this code.
Presumably you'd get a different error message if you truncated the file
before the place where the problem lies. This suggests binary division
to narrow it down to a specific line.
--
Cameron MacKinnon
Toronto, Canada
From: Kent M Pitman
Subject: Re: SMUTIL - What is a Dot Context Error [2/2]
Date:
Message-ID: <u1x5eoxso.fsf@nhplace.com>
Cameron MacKinnon <··········@clearspot.net> writes:
> Mike Speed wrote:
> > I give up - I can't find a ^[^;]*[.] or anything even remote to this in
> > this code.
>
> Presumably you'd get a different error message if you truncated the
> file before the place where the problem lies. This suggests binary
> division to narrow it down to a specific line.
Good suggestion.
Another thing he might do is to write a program that opens the file
and then successively reads and evaluates the forms, noting in each
case what the file position is before each time it calls READ so that
you can find the position of the start position of the errant form...
(In Maclisp you can call FILEPOS on an open stream to get the file
position.)
>>I give up - I can't find a ^[^;]*[.] or anything even remote to this in
>> this code.
>You do know that's a regular expression, right?
Yeah.
Divide and conquer - okay.
>Another thing he might do is to write a program that opens the file
>and then successively reads and evaluates the forms, noting in each
>case what the file position is before each time it calls READ so that
>you can find the position of the start position of the errant form...
>(In Maclisp you can call FILEPOS on an open stream to get the file
>position.)
Whaaa? *Way* over my head.
"Mike Speed" <·······@yahoo.com> writes:
>>>I give up - I can't find a ^[^;]*[.] or anything even remote to this in
>>> this code.
>
>>You do know that's a regular expression, right?
>
> Yeah.
>
> Divide and conquer - okay.
>
>>Another thing he might do is to write a program that opens the file
>>and then successively reads and evaluates the forms, noting in each
>>case what the file position is before each time it calls READ so that
>>you can find the position of the start position of the errant form...
>>(In Maclisp you can call FILEPOS on an open stream to get the file
>>position.)
>
> Whaaa? *Way* over my head.
What are you saying? It's basic lisp:
(defun trace-load (path &key (print *load-print*) (verbose *load-verbose*))
(with-open-file (src path)
(when verbose (format t "~&;; Loading ~A~%" path))
(unwind-protect
(loop
(let ((pos (file-position src))
(sexp (read src nil src)))
(if (eq sexp src)
(progn
(when print
(format t ";; at ~A: successfull EOF~%" pos))
(return-from trace-load))
(progn
(handler-case
(let ((result (eval sexp)))
(when print
(format t ";; at ~A: ~A~%" pos result)))
(simple-warning
(ERR)
(format *error-output* "~&~A: ~%"
(class-name (class-of err)))
(apply (function format) *error-output*
(simple-condition-format-control err)
(simple-condition-format-arguments err))
(format *error-output*
"~& while reading ~S~% at position ~D~2%"
sexp pos))
(simple-condition
(ERR)
(format *error-output* "~&~A: ~%"
(class-name (class-of err)))
(apply (function format) *error-output*
(simple-condition-format-control err)
(simple-condition-format-arguments err))
(format *error-output*
"~& while reading ~S~% at position ~D~2%"
sexp pos)
(return-from trace-load))
(condition
(ERR)
(format *error-output* "~&~A: ~% ~S~%"
(class-name (class-of err)) err)
(format *error-output*
"~& while reading ~S~% at position ~D~2%"
sexp pos)
(return-from trace-load)))))))
(when verbose (format t "~&;; Loaded ~A~%" path)))))
--
__Pascal Bourguignon__ http://www.informatimago.com/
There is no worse tyranny than to force a man to pay for what he does not
want merely because you think it would be good for him. -- Robert Heinlein
Kent M Pitman <······@nhplace.com> writes:
> Cameron MacKinnon <··········@clearspot.net> writes:
>
>> Mike Speed wrote:
>> > I give up - I can't find a ^[^;]*[.] or anything even remote to this in
>> > this code.
>>
>> Presumably you'd get a different error message if you truncated the
>> file before the place where the problem lies. This suggests binary
>> division to narrow it down to a specific line.
>
> Good suggestion.
>
> Another thing he might do is to write a program that opens the file
> and then successively reads and evaluates the forms, noting in each
> case what the file position is before each time it calls READ so that
> you can find the position of the start position of the errant form...
> (In Maclisp you can call FILEPOS on an open stream to get the file
> position.)
Some implementations have an implementation specific flag to print the
expression between the read and the eval.
For example, in clisp, you can (setf custom:*load-echo* t)
--
__Pascal Bourguignon__ http://www.informatimago.com/
There is no worse tyranny than to force a man to pay for what he does not
want merely because you think it would be good for him. -- Robert Heinlein
From: Kent M Pitman
Subject: Re: SMUTIL - What is a Dot Context Error [2/2]
Date:
Message-ID: <u4qa9oc4f.fsf@nhplace.com>
Pascal Bourguignon <····@mouse-potato.com> writes:
> Some implementations have an implementation specific flag to print the
> expression between the read and the eval.
> For example, in clisp, you can (setf custom:*load-echo* t)
He's using Maclisp (a pre-CL Lisp dialect) under a PDP10 emulator.
From: Kent M Pitman
Subject: Re: SMUTIL - What is a Dot Context Error [2/2]
Date:
Message-ID: <u64uqe25c.fsf@nhplace.com>
"Mike Speed" <·······@yahoo.com> writes:
> I give up - I can't find a ^[^;]*[.] or anything even remote to this in
> this code.
You do know that's a regular expression, right?