aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog5
-rw-r--r--src/boot/ast.boot1
-rw-r--r--src/boot/strap/ast.clisp1
-rw-r--r--src/boot/strap/tokens.clisp14
-rw-r--r--src/boot/tokens.boot1
-rw-r--r--src/interp/cparse.boot4
-rw-r--r--src/interp/database.boot2
-rw-r--r--src/interp/debug.lisp8
-rw-r--r--src/interp/i-syscmd.boot12
-rw-r--r--src/interp/i-toplev.boot4
-rw-r--r--src/interp/lisplib.boot2
-rw-r--r--src/interp/nlib.lisp24
-rw-r--r--src/interp/pathname.boot8
-rw-r--r--src/interp/sys-os.boot5
-rw-r--r--src/interp/sys-utility.boot11
-rw-r--r--src/interp/vmlisp.lisp6
16 files changed, 57 insertions, 51 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index ea72ec70..f3578ea3 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,8 @@
+2013-05-27 Gabriel Dos Reis <gdr@integrable-solutions.net>
+
+ * interp/nlib.lisp (MAKE-INPUT-FILENAME): Move to sys-utility.boot.
+ * boot/ast.boot (bfIS1): Handle Lisp keywords.
+
2013-05-26 Gabriel Dos Reis <gdr@integrable-solutions.net>
* interp/nlib.lisp (GET-DIRECTORY-LIST): Move to sys-utility.boot.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 6410b524..dfffa58a 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -761,6 +761,7 @@ bfIS1(tu,lhs,rhs) ==
rhs = true => ['EQ,lhs,rhs]
bfString? rhs => bfAND [['STRINGP,lhs],["STRING=",lhs,rhs]]
bfChar? rhs or integer? rhs => ['EQL,lhs,rhs]
+ inert? rhs => ['EQ,lhs,rhs]
rhs isnt [.,:.] => ['PROGN,bfLetForm(rhs,lhs),'T]
rhs.op is 'QUOTE =>
[.,a] := rhs
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 94f3cce2..a51ee1c2 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -1124,6 +1124,7 @@
((|bfString?| |rhs|)
(|bfAND| (LIST (LIST 'STRINGP |lhs|) (LIST 'STRING= |lhs| |rhs|))))
((OR (|bfChar?| |rhs|) (INTEGERP |rhs|)) (LIST 'EQL |lhs| |rhs|))
+ ((KEYWORDP |rhs|) (LIST 'EQ |lhs| |rhs|))
((NOT (CONSP |rhs|)) (LIST 'PROGN (|bfLetForm| |rhs| |lhs|) 'T))
((EQ (CAR |rhs|) 'QUOTE) (SETQ |a| (CADR |rhs|))
(COND ((SYMBOLP |a|) (LIST 'EQ |lhs| |rhs|))
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index b606644b..3c0dd848 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -225,14 +225,16 @@
(LIST '|flushOutput| 'FORCE-OUTPUT) (LIST '|fourth| 'CADDDR)
(LIST '|freshLine| 'FRESH-LINE) (LIST '|function?| 'FUNCTIONP)
(LIST '|functionSymbol?| 'FBOUNDP) (LIST '|gensym| 'GENSYM)
- (LIST '|genvar| 'GENVAR) (LIST '|integer?| 'INTEGERP)
- (LIST 'LAST '|last|) (LIST '|list| 'LIST) (LIST '|listEq?| 'EQUAL)
+ (LIST '|genvar| 'GENVAR) (LIST '|inert?| 'KEYWORDP)
+ (LIST '|integer?| 'INTEGERP) (LIST 'LAST '|last|)
+ (LIST '|list| 'LIST) (LIST '|listEq?| 'EQUAL)
(LIST '|lowerCase?| 'LOWER-CASE-P)
(LIST '|makeFilePath| 'MAKE-PATHNAME) (LIST '|makeSymbol| 'INTERN)
- (LIST '|mkpf| 'MKPF) (LIST '|newVector| 'MAKE-ARRAY)
- (LIST '|nil| NIL) (LIST '|not| 'NOT) (LIST '|null| 'NULL)
- (LIST '|odd?| 'ODDP) (LIST '|or| 'OR) (LIST '|otherwise| 'T)
- (LIST '|property| 'GET) (LIST '|readInteger| 'PARSE-INTEGER)
+ (LIST '|mergeFilePaths| 'MERGE-PATHNAMES) (LIST '|mkpf| 'MKPF)
+ (LIST '|newVector| 'MAKE-ARRAY) (LIST '|nil| NIL)
+ (LIST '|not| 'NOT) (LIST '|null| 'NULL) (LIST '|odd?| 'ODDP)
+ (LIST '|or| 'OR) (LIST '|otherwise| 'T) (LIST '|property| 'GET)
+ (LIST '|readInteger| 'PARSE-INTEGER)
(LIST '|readLispFromString| 'READ-FROM-STRING)
(LIST '|readOnly?| 'CONSTANTP) (LIST '|removeDuplicates| 'REMDUP)
(LIST '|rest| 'CDR) (LIST '|sameObject?| 'EQ)
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index c8b29ebb..fa340275 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -298,6 +298,7 @@ for i in [ _
["functionSymbol?", "FBOUNDP"] , _
["gensym", "GENSYM"] , _
["genvar", "GENVAR"] , _
+ ["inert?", "KEYWORDP"] , _
["integer?","INTEGERP"] , _
["LAST", "last"] , _
["list", "LIST"] , _
diff --git a/src/interp/cparse.boot b/src/interp/cparse.boot
index be4fcd06..eaa43873 100644
--- a/src/interp/cparse.boot
+++ b/src/interp/cparse.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2013, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -1104,7 +1104,7 @@ _/RQ_,LIB(:x) ==
_/RF_-1 x ==
- ifile := MAKE_-INPUT_-FILENAME $editFile
+ ifile := makeInputFilename $editFile
lfile := nil
type := PATHNAME_-TYPE ifile
type = '"boot" =>
diff --git a/src/interp/database.boot b/src/interp/database.boot
index fc13f773..d63d0f44 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -709,7 +709,7 @@ dropPrefix(fn) ==
--moved to util.lisp
--++loadExposureGroupData() ==
--++ egFile := ['INTERP,'EXPOSED]
---++-- null MAKE_-INPUT_-FILENAME(egFile) =>
+--++-- null makeInputFilename(egFile) =>
--++-- throwKeyedMsg("S2IL0003",[namestring egFile])
--++ stream:= DEFIOSTREAM(['(MODE . INPUT),['FILE,:egFile]],80,0)
--++ $globalExposureGroupAlist := nil
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index 057caf98..e97cc1fc 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
;; All rights reserved.
-;; Copyright (C) 2007-2012, Gabriel Dos Reis.
+;; Copyright (C) 2007-2013, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -209,7 +209,7 @@
;;%% next form is used because $FINDFILE seems to screw up
;;%% sometimes. The stream is opened and closed several times
;;%% in case the filemode has changed during editing.
- (SETQ EDINFILE (make-input-filename INFILE))
+ (SETQ EDINFILE (|makeInputFilename| INFILE))
(SETQ INPUTSTREAM (DEFSTREAM EDINFILE 'INPUT))
(|sayBrightly|
(LIST " editing file" '|%b| (|namestring| EDINFILE) '|%d|))
@@ -233,7 +233,7 @@
(RETURN NIL)))
;; next is done in case the diskmode changed
(SHUT INPUTSTREAM) ))
- (SETQ INFILE (make-input-filename INFILE))
+ (SETQ INFILE (|makeInputFilename| INFILE))
(MAKEPROP /FN 'DEFLOC
(CONS RECNO INFILE))
(SETQ oft (|object2Identifier| (UPCASE (|pathnameType| INFILE))))
@@ -311,7 +311,7 @@
(DEFUN /LOCATE (FN KEY INFILE INITRECNO)
(PROG (FT RECNO KEYLENGTH LN)
(if (AND (NOT (eq 'FROMWRITEUPDATE (|pathnameName| INFILE)))
- (NOT (make-input-filename INFILE)))
+ (NOT (|makeInputFilename| INFILE)))
(RETURN NIL))
(SETQ FT (UPCASE (|object2Identifier| (|pathnameType| INFILE))))
(SETQ KEYLENGTH (LENGTH KEY))
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index ebd70a47..46e817cb 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2012, Gabriel Dos Reis.
+-- Copyright (C) 2007-2013, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -1016,7 +1016,7 @@ newHelpSpad2Cmd args ==
-- see if new help file exists
narg := PNAME arg
- null (helpFile := MAKE_-INPUT_-FILENAME [narg,'HELPSPAD,'_*]) => nil
+ null (helpFile := makeInputFilename [narg,'HELPSPAD,'_*]) => nil
$useFullScreenHelp =>
editFile helpFile
@@ -1280,7 +1280,7 @@ initHist() ==
newFile := histFileName()
-- see if history directory is writable
histFileErase oldFile
- if MAKE_-INPUT_-FILENAME newFile then $REPLACE(oldFile,newFile)
+ if makeInputFilename newFile then $REPLACE(oldFile,newFile)
$HiFiAccess:= true
initHistList()
@@ -1528,7 +1528,7 @@ saveHistory(fn) ==
$seen: local := hashTable 'EQ
not $HiFiAccess => sayKeyedMsg("S2IH0016",nil)
not $useInternalHistoryTable and
- null MAKE_-INPUT_-FILENAME histFileName() => sayKeyedMsg("S2IH0022",nil)
+ null makeInputFilename histFileName() => sayKeyedMsg("S2IH0022",nil)
null fn =>
throwKeyedMsg("S2IH0037", nil)
savefile := makeHistFileName(fn)
@@ -1554,7 +1554,7 @@ restoreHistory(fn) ==
else if fn is [fn'] and ident?(fn') then fn' := fn'
else throwKeyedMsg("S2IH0023",[fn'])
restfile := makeHistFileName(fn')
- null MAKE_-INPUT_-FILENAME restfile =>
+ null makeInputFilename restfile =>
sayKeyedMsg("S2IH0024",[namestring(restfile)]) -- no history file
-- if clear is changed to be undoable, this should be a reset-clear
@@ -2664,7 +2664,7 @@ workfilesSpad2Cmd args ==
for file in flist repeat
fl := pathname [file,type1,'"*"]
deleteFlag => SETQ($sourceFiles,remove($sourceFiles,fl))
- null (MAKE_-INPUT_-FILENAME fl) => sayKeyedMsg("S2IZ0035",[namestring fl])
+ null (makeInputFilename fl) => sayKeyedMsg("S2IZ0035",[namestring fl])
updateSourceFiles fl
SAY " "
centerAndHighlight(" User-specified work files ",$LINELENGTH,specialChar 'hbar)
diff --git a/src/interp/i-toplev.boot b/src/interp/i-toplev.boot
index a1982eb9..081826ac 100644
--- a/src/interp/i-toplev.boot
+++ b/src/interp/i-toplev.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2011, Gabriel Dos Reis.
+-- Copyright (C) 2007-2013, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -113,7 +113,7 @@ start(:l) ==
readSpadProfileIfThere() ==
-- reads SPADPROF INPUT if it exists
file := ['_.axiom,'input]
- MAKE_-INPUT_-FILENAME file =>
+ makeInputFilename file =>
$editFile := file
_/RQ ()
nil
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index b2bbffe2..feaa8cef 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -453,7 +453,7 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,fal,fn) ==
res
compileDocumentation(ctor,libName) ==
- filename := MAKE_-INPUT_-FILENAME(libName,$spadLibFT)
+ filename := makeInputFilename(libName,$spadLibFT)
$FCOPY(filename,[libName,'DOCLB])
stream := RDEFIOSTREAM [['FILE,libName,'DOCLB],['MODE, :'O]]
lisplibWrite('"documentation",finalizeDocumentation ctor,stream)
diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp
index 8a9a2e99..6122111a 100644
--- a/src/interp/nlib.lisp
+++ b/src/interp/nlib.lisp
@@ -44,8 +44,7 @@
(fullname nil)
(indextable nil))
(cond ((equal (elt (string mode) 0) #\I)
- ;;(setq fullname (make-input-filename (cdr file) 'LISPLIB))
- (setq fullname (make-input-filename (cdr file) 'NIL))
+ (setq fullname (|makeInputFilename| (cdr file) 'NIL))
(setq stream (|openIndexFileIfPresent| fullname))
(if (null stream)
(if missing-file-error-flag
@@ -133,10 +132,7 @@
;; (RKEYIDS filearg) -- interned version of keys
(defun rkeyids (&rest filearg)
(mapcar #'intern (mapcar #'car (|getIndexTable|
- (make-input-filename filearg 'NIL)))))
-;;(defun rkeyids (&rest filearg)
-;; (mapcar #'intern (mapcar #'car (|getIndexTable|
-;; (make-input-filename filearg 'LISPLIB)))))
+ (|makeInputFilename| filearg 'NIL)))))
;; (RWRITE cvec item rstream)
(defun rwrite (key item rstream)
@@ -241,25 +237,11 @@
(putindextable ctable filearg))
-(defun make-input-filename (filearg &optional (filetype nil))
- (let*
- ((filename (|makeFilename| filearg filetype))
- (dirname (pathname-directory filename))
- (ft (pathname-type filename))
- (dirs (|getDirectoryList| ft))
- (newfn nil))
- (if (or (null dirname) (eqcar dirname :relative))
- (dolist (dir dirs (|probeReadableFile| filename))
- (setq newfn (concatenate 'string dir filename))
- (when (|probeReadableFile| newfn)
- (return newfn)))
- (|probeReadableFile| filename))))
-
(defun $findfile (filespec filetypelist)
(let ((file-name (if (consp filespec) (car filespec) filespec))
(file-type (if (consp filespec) (cadr filespec) nil)))
(if file-type (push file-type filetypelist))
- (some #'(lambda (ft) (make-input-filename file-name ft))
+ (some #'(lambda (ft) (|makeInputFilename| file-name ft))
filetypelist)))
;;(defun move-file (namestring1 namestring2)
diff --git a/src/interp/pathname.boot b/src/interp/pathname.boot
index 1a3bc6b3..15a8d88f 100644
--- a/src/interp/pathname.boot
+++ b/src/interp/pathname.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2013, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -76,7 +76,7 @@ pathnameDirectory p ==
isExistingFile f ==
-- p := pathname f
--member(p,$existingFiles) => true
- if MAKE_-INPUT_-FILENAME f
+ if makeInputFilename f
then
--$existingFiles := [p,:$existingFiles]
true
@@ -130,7 +130,7 @@ newMKINFILENAM(infile) ==
getFunctionSourceFile fun ==
null (f := getFunctionSourceFile1 fun) => nil
- if MAKE_-INPUT_-FILENAME(f) then updateSourceFiles f
+ if makeInputFilename(f) then updateSourceFiles f
f
getFunctionSourceFile1 fun ==
@@ -149,6 +149,6 @@ getFunctionSourceFile1 fun ==
updateSourceFiles p ==
p := pathname p
p := pathname [pathnameName p, pathnameType p, '"*"]
- if MAKE_-INPUT_-FILENAME p and pathnameTypeId p in '(BOOT LISP META) then
+ if makeInputFilename p and pathnameTypeId p in '(BOOT LISP META) then
$sourceFiles := insert(p, $sourceFiles)
p
diff --git a/src/interp/sys-os.boot b/src/interp/sys-os.boot
index a9a54d17..b79eff84 100644
--- a/src/interp/sys-os.boot
+++ b/src/interp/sys-os.boot
@@ -50,7 +50,10 @@ loadSystemRuntimeCore()
--% File System Support
++ Current working directory
-import oa__getcwd: () -> string for getWorkingDirectory
+import oa__getcwd: () -> string for doGetWorkingDirectory
+
+getWorkingDirectory() ==
+ ensureTrailingSlash doGetWorkingDirectory()
++ change current working directory.
import oa__chdir: string -> int for changeDirectory
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index a29779e9..e0cece17 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -1,3 +1,5 @@
+)eval TRACE bfIS1
+
-- Copyright (C) 2007-2013 Gabriel Dos Reis.
-- All rights reserved.
--
@@ -460,3 +462,12 @@ getDirectoryList ft ==
[home,:$DIRECTORY_-LIST]
stringMember?(here,dirs) => dirs
[here,:dirs]
+
+makeInputFilename(filearg,filetype == nil) ==
+ filename := makeFilename(filearg,filetype)
+ dirname := filePathDirectory filename
+ dirname = nil or dirname is [KEYWORD::RELATIVE,:.] =>
+ or/[probeReadableFile strconc(dir,filename)
+ for dir in getDirectoryList filePathType filename]
+ or probeReadableFile filename
+ probeReadableFile filename
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 28602764..40bd2bd5 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
;; All rights reserved.
-;; Copyright (C) 2007-2012, Gabriel Dos Reis.
+;; Copyright (C) 2007-2013, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -925,7 +925,7 @@
(declare (ignore recnum))
(cond ((numberp filespec) (make-synonym-stream '*standard-input*))
((null filespec) (error "not handled yet"))
- (t (open (make-input-filename filespec)
+ (t (open (|makeInputFilename| filespec)
:direction :input :if-does-not-exist nil))))
(defun MAKE-OUTSTREAM (filespec &optional (width nil) (recnum 0))
@@ -956,7 +956,7 @@
(let ((strm (case mode
((OUTPUT O) (open (|makeFilename| filename)
:direction :output))
- ((INPUT I) (open (make-input-filename filename)
+ ((INPUT I) (open (|makeInputFilename| filename)
:direction :input)))))
(if (and (numberp char-position) (> char-position 0))
(file-position strm char-position))
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-29 15:37:14 +0000