aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/bootlex.lisp100
-rw-r--r--src/interp/lexing.boot20
-rw-r--r--src/interp/parsing.lisp17
-rw-r--r--src/interp/spad.lisp82
4 files changed, 102 insertions, 117 deletions
diff --git a/src/interp/bootlex.lisp b/src/interp/bootlex.lisp
index 93d6b997..0f8768b7 100644
--- a/src/interp/bootlex.lisp
+++ b/src/interp/bootlex.lisp
@@ -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-2012, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -49,25 +49,8 @@
(IMPORT-MODULE "nlib")
(in-package "BOOT")
-; *** 0. Global parameters
-
; *** 1. BOOT file handling
-(defun init-boot/spad-reader ()
- (setq $SPAD_ERRORS (VECTOR 0 0 0))
- (setq SPADERRORSTREAM |$OutputStream|)
- (setq File-Closed nil)
- (Next-Lines-Clear)
- (setq |$lineStack| nil)
- (ioclear))
-
-(defmacro test (x &rest y)
- `(progn
- (setq spaderrorstream t)
- (in-boot)
- (initialize-preparse |$InputStream|)
- (,(intern (strconc "PARSE-" x)) . ,y)))
-
(defun print-defun (name body)
(let* ((sp (assoc 'compiler-output-stream optionlist))
(st (if sp (cdr sp) |$OutputStream|)))
@@ -77,90 +60,9 @@
(when (or |$PrettyPrint| (not (is-console st)))
(print-full body st) (force-output st))))
-(defun spad (&optional
- (*spad-input-file* nil)
- (*spad-output-file* nil)
- &aux
- ;; (*comp370-apply* (function print-and-eval-defun))
- (*comp370-apply* (function print-defun))
- (*fileactq-apply* (function print-defun))
- ($SPAD T)
- (OPTIONLIST nil)
- (*EOF* NIL)
- (File-Closed NIL)
- (/editfile *spad-input-file*)
- in-stream out-stream)
- (declare (special |$Echo| /editfile *comp370-apply* *EOF*
- File-Closed Xcape))
- (setq |$InteractiveMode| nil)
- ;; only rebind |$InteractiveFrame| if compiling
- (progv (if (not |$InteractiveMode|) '(|$InteractiveFrame|))
- (if (not |$InteractiveMode|)
- (list (|addBinding|
- '|$DomainsInScope|
- `((FLUID . |true|)
- (|special| . ,(COPY-TREE |$InitialDomainsInScope|)))
- (|addBinding| '|$Information| NIL (|makeInitialModemapFrame|)))))
- (init-boot/spad-reader)
- (unwind-protect
- (progn
- (setq in-stream (if *spad-input-file*
- (open *spad-input-file* :direction :input)
- |$InputStream|))
- (initialize-preparse in-stream)
- (setq out-stream (if *spad-output-file*
- (open *spad-output-file* :direction :output)
- |$OutputStream|))
- (when *spad-output-file*
- (format out-stream "~&;;; -*- Mode:Lisp; Package:Boot -*-~%~%")
- (print-package "BOOT"))
- (setq |$OutputStream| out-stream)
- (loop
- (if (or *eof* file-closed) (return nil))
- (catch 'SPAD_READER
- (if (setq |$lineStack| (PREPARSE in-stream))
- (let ((LINE (cdar |$lineStack|)))
- (declare (special LINE))
- (|parseNewExpr|)
- (let ((parseout (|popStack1|)) )
- (when parseout
- (let ((|$OutputStream| out-stream))
- (S-PROCESS parseout))
- (format out-stream "~&")))
- ;(IOClear in-stream out-stream)
- )))
- (IOClear in-stream out-stream)))
- (if *spad-input-file* (shut in-stream))
- (if *spad-output-file* (shut out-stream)))
- T))
-
-(defun READ-SPAD1 (FN FT FM TO)
- (LET ((STRM IN-STREAM))
- (SETQ $MAXLINENUMBER 0)
- (SETQ $SPAD_ERRORS (VECTOR 0 0 0))
- (SETQ IN-STREAM (open (strconc fm ">" fn "." ft) :direction :input))
- ($ERASE (LIST FN 'ERROR 'A))
- (SETQ OUT-STREAM (if TO (open to :direction :output) OUT-STREAM))
- (SETQ SPADERRORSTREAM (open (strconc "a>" fn ".error") :direction :output))
- (READ-SPAD-1)
- (close SPADERRORSTREAM)
- (SETQ IN-STREAM STRM)
- (OR (EQUAL #(0 0 0) $SPAD_ERRORS)
- (|sayBrightly| (LIST '|%b| (ELT $SPAD_ERRORS 0) '|%d| '|syntax errors|
- '|%l| '|%b| (ELT $SPAD_ERRORS 1) '|%d| '|precompilation errors|
- '|%l| '|%b| (ELT $SPAD_ERRORS 2) '|%d| '|semantic errors| '|%l|)))
- (+ (ELT $SPAD_ERRORS 0) (ELT $SPAD_ERRORS 1) (ELT $SPAD_ERRORS 2))))
-
; *** 3. BOOT Token Handling ***
-(defun get-argument-designator-token (token)
- (|advanceChar!|)
- (get-number-token token)
- (|tokenInstall| (intern (strconc "#" (format nil "~D" (|tokenSymbol| token))))
- 'argument-designator token |$nonblank|))
-
-
;; -*- Parse an integer number -*-
;; The number may be written in plain format, where the radix
;; is implicitly taken to be 10. Or the spelling can explicitly
diff --git a/src/interp/lexing.boot b/src/interp/lexing.boot
index 8b0e1b7e..e63a13cb 100644
--- a/src/interp/lexing.boot
+++ b/src/interp/lexing.boot
@@ -1,4 +1,4 @@
--- Copyright (C) 2011, Gabriel Dos Reis.
+-- Copyright (C) 2011-2012, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -188,6 +188,22 @@ tokenInstall(sym,typ,tok,nonblank == true) ==
tokenNonblank?(tok) := nonblank
tok
+getNumberToken tok ==
+ buf := nil
+ repeat
+ buf := [currentChar(),:buf]
+ digit? nextChar() => advanceChar!()
+ leave nil
+ advanceChar!()
+ sz := #buf -- keep track of digit count
+ tokenInstall(readIntegerIfCan listToString reverse! buf,'NUMBER,tok,sz)
+
+getArgumentDesignator tok ==
+ advanceChar!()
+ getNumberToken tok
+ tokenInstall(makeSymbol strconc('"#",formatToString('"~D",tokenSymbol tok)),
+ 'ARGUMENT_-DESIGNATOR,tok,$nonblank)
+
getToken tok ==
not skipBlankChars() => nil
tt := tokenLookaheadType currentChar()
@@ -195,7 +211,7 @@ getToken tok ==
tt is 'ESCAPE =>
advanceChar!()
getIdentifier(tok,true)
- tt is 'ARGUMENT_-DESIGNATOR => GET_-ARGUMENT_-DESIGNATOR_-TOKEN tok
+ tt is 'ARGUMENT_-DESIGNATOR => getArgumentDesignator tok
tt is 'ID => getIdentifier(tok,false)
tt is 'NUM => GET_-SPAD_-INTEGER_-TOKEN tok
tt is 'STRING => getSpadString tok
diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp
index 509c6a14..a8bf8ea3 100644
--- a/src/interp/parsing.lisp
+++ b/src/interp/parsing.lisp
@@ -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-2012, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -189,21 +189,6 @@ Symbolics read-line returns embedded newlines in a c-m-Y.")
(defun make-adjustable-string (n)
(make-array (list n) :element-type 'character :adjustable t))
-(defun get-number-token (token)
- "Take a number off the input stream."
- (prog ((buf (make-adjustable-string 0)))
- nu1
- (suffix (|currentChar|) buf) ; Integer part
- (let ((next-chr (|nextChar|)))
- (cond ((digitp next-chr)
- (|advanceChar!|)
- (go nu1))))
- (|advanceChar!|)
- (return (|tokenInstall| (read-from-string buf)
- 'number token
- (size buf) ;used to keep track of digit count
- ))))
-
; *** 5. META Error Handling
(defparameter $num_of_meta_errors 0)
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index 1fcca89d..5311f73f 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -75,6 +75,88 @@
(defvar |InteractiveMode|)
(defvar |uc| 'UC)
+(defun init-boot/spad-reader ()
+ (setq $SPAD_ERRORS (VECTOR 0 0 0))
+ (setq SPADERRORSTREAM |$OutputStream|)
+ (setq File-Closed nil)
+ (Next-Lines-Clear)
+ (setq |$lineStack| nil)
+ (ioclear))
+
+(defun spad (&optional
+ (*spad-input-file* nil)
+ (*spad-output-file* nil)
+ &aux
+ ;; (*comp370-apply* (function print-and-eval-defun))
+ (*comp370-apply* (function print-defun))
+ (*fileactq-apply* (function print-defun))
+ ($SPAD T)
+ (OPTIONLIST nil)
+ (*EOF* NIL)
+ (File-Closed NIL)
+ (/editfile *spad-input-file*)
+ in-stream out-stream)
+ (declare (special |$Echo| /editfile *comp370-apply* *EOF*
+ File-Closed Xcape))
+ (setq |$InteractiveMode| nil)
+ ;; only rebind |$InteractiveFrame| if compiling
+ (progv (if (not |$InteractiveMode|) '(|$InteractiveFrame|))
+ (if (not |$InteractiveMode|)
+ (list (|addBinding|
+ '|$DomainsInScope|
+ `((FLUID . |true|)
+ (|special| . ,(COPY-TREE |$InitialDomainsInScope|)))
+ (|addBinding| '|$Information| NIL (|makeInitialModemapFrame|)))))
+ (init-boot/spad-reader)
+ (unwind-protect
+ (progn
+ (setq in-stream (if *spad-input-file*
+ (open *spad-input-file* :direction :input)
+ |$InputStream|))
+ (initialize-preparse in-stream)
+ (setq out-stream (if *spad-output-file*
+ (open *spad-output-file* :direction :output)
+ |$OutputStream|))
+ (when *spad-output-file*
+ (format out-stream "~&;;; -*- Mode:Lisp; Package:Boot -*-~%~%")
+ (print-package "BOOT"))
+ (setq |$OutputStream| out-stream)
+ (loop
+ (if (or *eof* file-closed) (return nil))
+ (catch 'SPAD_READER
+ (if (setq |$lineStack| (PREPARSE in-stream))
+ (let ((LINE (cdar |$lineStack|)))
+ (declare (special LINE))
+ (|parseNewExpr|)
+ (let ((parseout (|popStack1|)) )
+ (when parseout
+ (let ((|$OutputStream| out-stream))
+ (S-PROCESS parseout))
+ (format out-stream "~&")))
+ ;(IOClear in-stream out-stream)
+ )))
+ (IOClear in-stream out-stream)))
+ (if *spad-input-file* (shut in-stream))
+ (if *spad-output-file* (shut out-stream)))
+ T))
+
+(defun READ-SPAD1 (FN FT FM TO)
+ (LET ((STRM IN-STREAM))
+ (SETQ $MAXLINENUMBER 0)
+ (SETQ $SPAD_ERRORS (VECTOR 0 0 0))
+ (SETQ IN-STREAM (open (strconc fm ">" fn "." ft) :direction :input))
+ ($ERASE (LIST FN 'ERROR 'A))
+ (SETQ OUT-STREAM (if TO (open to :direction :output) OUT-STREAM))
+ (SETQ SPADERRORSTREAM (open (strconc "a>" fn ".error") :direction :output))
+ (READ-SPAD-1)
+ (close SPADERRORSTREAM)
+ (SETQ IN-STREAM STRM)
+ (OR (EQUAL #(0 0 0) $SPAD_ERRORS)
+ (|sayBrightly| (LIST '|%b| (ELT $SPAD_ERRORS 0) '|%d| '|syntax errors|
+ '|%l| '|%b| (ELT $SPAD_ERRORS 1) '|%d| '|precompilation errors|
+ '|%l| '|%b| (ELT $SPAD_ERRORS 2) '|%d| '|semantic errors| '|%l|)))
+ (+ (ELT $SPAD_ERRORS 0) (ELT $SPAD_ERRORS 1) (ELT $SPAD_ERRORS 2))))
+
(DEFUN INTEGER-BIT (N I) (LOGBITP I N))
(DEFUN /TRANSPAD (X)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-03 17:37:08 +0000