diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 12 | ||||
| -rw-r--r-- | src/interp/bootlex.lisp | 100 | ||||
| -rw-r--r-- | src/interp/lexing.boot | 20 | ||||
| -rw-r--r-- | src/interp/parsing.lisp | 17 | ||||
| -rw-r--r-- | src/interp/spad.lisp | 82 |
5 files changed, 114 insertions, 117 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 32ed8418..d2d9985d 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,15 @@ +2012-02-19 Gabriel Dos Reis <gdr@cse.tamu.edu> + + * interp/lexing.boot (getNumberToken): New. + (getArgumentDesignator): Likewise. + (getToken): Use it. + * interp/parsing.lisp (GET-NUMBER-TOKEN): Remove. + * interp/bootlex.lisp (INIT-BOOT/SPAD-READER): Move to spad.lisp. + (SPAD): Likewise. + (READ-SPAD1): Likewise. + (TEST): Remove. + (GET-ARGUMENT-DESIGNATOR-TOKEN): Likewise. + 2012-02-19 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/compiler.boot (compBuiltinDomain): Compute the exports 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) |