aboutsummaryrefslogtreecommitdiff
path: root/legacy/bigloo/eval.scm
diff options
context:
space:
mode:
Diffstat (limited to 'legacy/bigloo/eval.scm')
-rw-r--r--legacy/bigloo/eval.scm335
1 files changed, 0 insertions, 335 deletions
diff --git a/legacy/bigloo/eval.scm b/legacy/bigloo/eval.scm
deleted file mode 100644
index b5c6548..0000000
--- a/legacy/bigloo/eval.scm
+++ /dev/null
@@ -1,335 +0,0 @@
-;*=====================================================================*/
-;* serrano/prgm/project/skribe/src/bigloo/eval.scm */
-;* ------------------------------------------------------------- */
-;* Author : Manuel Serrano */
-;* Creation : Wed Jul 23 12:48:11 2003 */
-;* Last change : Wed May 18 15:52:01 2005 (serrano) */
-;* Copyright : 2003-05 Manuel Serrano */
-;* ------------------------------------------------------------- */
-;* The Skribe evaluator */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;* The module */
-;*---------------------------------------------------------------------*/
-(module skribe_eval
-
- (option (set! dsssl-symbol->keyword
- (lambda (s)
- (string->keyword
- (string-append ":" (symbol->string s))))))
-
- (include "debug.sch")
-
- (import skribe_param
- skribe_types
- skribe_resolve
- skribe_verify
- skribe_output
- skribe_read
- skribe_lib
- skribe_engine)
-
- (export (skribe-eval-location)
- (skribe-error ::obj ::obj ::obj)
- (skribe-type-error ::obj ::obj ::obj ::bstring)
- (skribe-warning ::int . obj)
- (skribe-warning/ast ::int ::%ast . obj)
- (skribe-message ::bstring . obj)
- (skribe-load ::bstring #!rest opt #!key engine path)
- (skribe-load-options)
- (skribe-include ::bstring . rest)
- (skribe-open-bib-file ::bstring ::obj)
- (skribe-eval-port ::input-port ::obj #!key env)
- (skribe-eval ::obj ::%engine #!key env)
- (skribe-path::pair-nil)
- (skribe-path-set! ::obj)
- (skribe-image-path::pair-nil)
- (skribe-image-path-set! ::obj)
- (skribe-bib-path::pair-nil)
- (skribe-bib-path-set! ::obj)
- (skribe-source-path::pair-nil)
- (skribe-source-path-set! ::obj)))
-
-;*---------------------------------------------------------------------*/
-;* skribe-eval-location ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-eval-location)
- (evmeaning-location))
-
-;*---------------------------------------------------------------------*/
-;* skribe-error ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-error proc msg obj)
- (if (ast? obj)
- (skribe-ast-error proc msg obj)
- (error/evloc proc msg obj)))
-
-;*---------------------------------------------------------------------*/
-;* skribe-type-error ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-type-error proc msg obj etype)
- (let ((ty (if (%markup? obj)
- (format "~a#~a" (markup-markup obj) (markup-ident obj))
- (find-runtime-type obj))))
- (skribe-error proc
- (bigloo-type-error-msg msg etype ty)
- obj)))
-
-;*---------------------------------------------------------------------*/
-;* skribe-ast-error ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-ast-error proc msg obj)
- (let ((l (ast-loc obj))
- (shape (if (%markup? obj)
- (%markup-markup obj)
- (find-runtime-type obj))))
- (if (location? l)
- (error/location proc msg shape (location-file l) (location-pos l))
- (error/evloc proc msg shape))))
-
-;*---------------------------------------------------------------------*/
-;* error/evloc ... */
-;*---------------------------------------------------------------------*/
-(define (error/evloc proc msg obj)
- (let ((l (evmeaning-location)))
- (if (location? l)
- (error/location proc msg obj (location-file l) (location-pos l))
- ((begin error) proc msg obj))))
-
-;*---------------------------------------------------------------------*/
-;* skribe-warning ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-warning level . obj)
- (if (>= *skribe-warning* level)
- (let ((l (evmeaning-location)))
- (if (location? l)
- (apply warning/location (location-file l) (location-pos l) obj)
- (apply warning obj)))))
-
-;*---------------------------------------------------------------------*/
-;* skribe-warning/ast ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-warning/ast level ast . obj)
- (if (>= *skribe-warning* level)
- (let ((l (%ast-loc ast)))
- (if (location? l)
- (apply warning/location (location-file l) (location-pos l) obj)
- (apply skribe-warning level obj)))))
-
-;*---------------------------------------------------------------------*/
-;* skribe-message ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-message fmt . obj)
- (if (> *skribe-verbose* 0)
- (apply fprintf (current-error-port) fmt obj)))
-
-;*---------------------------------------------------------------------*/
-;* *skribe-loaded* ... */
-;* ------------------------------------------------------------- */
-;* This hash table stores the list of loaded files in order */
-;* to avoid one file to be loaded twice. */
-;*---------------------------------------------------------------------*/
-(define *skribe-loaded* (make-hashtable))
-
-;*---------------------------------------------------------------------*/
-;* *skribe-load-options* ... */
-;*---------------------------------------------------------------------*/
-(define *skribe-load-options* '())
-
-;*---------------------------------------------------------------------*/
-;* skribe-load ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-load file #!rest opt #!key engine path)
- (with-debug 4 'skribe-load
- (debug-item " engine=" engine)
- (debug-item " path=" path)
- (debug-item " opt" opt)
- (let* ((ei (cond
- ((not engine)
- *skribe-engine*)
- ((engine? engine)
- engine)
- ((not (symbol? engine))
- (skribe-error 'skribe-load "Illegal engine" engine))
- (else
- engine)))
- (path (cond
- ((not path)
- (skribe-path))
- ((string? path)
- (list path))
- ((not (and (list? path) (every? string? path)))
- (skribe-error 'skribe-load "Illegal path" path))
- (else
- path)))
- (filep (find-file/path file path)))
- (set! *skribe-load-options* opt)
- (if (and (string? filep) (file-exists? filep))
- (if (not (hashtable-get *skribe-loaded* filep))
- (begin
- (hashtable-put! *skribe-loaded* filep #t)
- (cond
- ((>fx *skribe-verbose* 1)
- (fprint (current-error-port)
- " [loading file: " filep " " opt "]"))
- ((>fx *skribe-verbose* 0)
- (fprint (current-error-port)
- " [loading file: " filep "]")))
- (with-input-from-file filep
- (lambda ()
- (skribe-eval-port (current-input-port) ei)))))
- (skribe-error 'skribe-load
- (format "Can't find file `~a' in path" file)
- path)))))
-
-;*---------------------------------------------------------------------*/
-;* skribe-load-options ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-load-options)
- *skribe-load-options*)
-
-;*---------------------------------------------------------------------*/
-;* evaluate ... */
-;*---------------------------------------------------------------------*/
-(define (evaluate exp)
- (try (eval exp)
- (lambda (a p m o)
- (evmeaning-notify-error p m o)
- (flush-output-port (current-error-port)))))
-
-;*---------------------------------------------------------------------*/
-;* skribe-include ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-include file . rest)
- (let* ((path (cond
- ((or (null? rest) (null? (cdr rest)))
- (skribe-path))
- ((not (every? string? (cdr rest)))
- (skribe-error 'skribe-include "Illegal path" (cdr rest)))
- (else
- (cdr rest))))
- (filep (find-file/path file (if (null? path) (skribe-path) path))))
- (if (and (string? filep) (file-exists? filep))
- (begin
- (if (>fx *skribe-verbose* 0)
- (fprint (current-error-port)
- " [including file: " filep "]"))
- (with-input-from-file filep
- (lambda ()
- (let loop ((exp (skribe-read (current-input-port)))
- (res '()))
- (if (eof-object? exp)
- (if (and (pair? res) (null? (cdr res)))
- (car res)
- (reverse! res))
- (loop (skribe-read (current-input-port))
- (cons (evaluate exp) res)))))))
- (skribe-error 'skribe-include
- (format "Can't find file `~a 'in path" file)
- path))))
-
-;*---------------------------------------------------------------------*/
-;* skribe-open-bib-file ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-open-bib-file file command)
- (let ((filep (find-file/path file *skribe-bib-path*)))
- (if (string? filep)
- (begin
- (if (>fx *skribe-verbose* 0)
- (fprint (current-error-port) " [loading bib: " filep "]"))
- (open-input-file (if (string? command)
- (string-append "| "
- (format command filep))
- filep)))
- (begin
- (skribe-warning 1
- 'bibliography
- "Can't find bibliography -- " file)
- #f))))
-
-;*---------------------------------------------------------------------*/
-;* skribe-eval-port ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-eval-port port ei #!key (env '()))
- (with-debug 2 'skribe-eval-port
- (debug-item "ei=" ei)
- (let ((e (if (symbol? ei) (find-engine ei) ei)))
- (debug-item "e=" e)
- (if (not (%engine? e))
- (skribe-error 'find-engine "Can't find engine" ei)
- (let loop ((exp (skribe-read port)))
- (with-debug 10 'skribe-eval-port
- (debug-item "exp=" exp))
- (if (not (eof-object? exp))
- (begin
- (skribe-eval (evaluate exp) e :env env)
- (loop (skribe-read port)))))))))
-
-;*---------------------------------------------------------------------*/
-;* skribe-eval ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-eval a e #!key (env '()))
- (with-debug 2 'skribe-eval
- (debug-item "a=" a " e=" (%engine-ident e))
- (let ((a2 (resolve! a e env)))
- (debug-item "resolved a=" a)
- (let ((a3 (verify a2 e)))
- (debug-item "verified a=" a3)
- (output a3 e)))))
-
-;*---------------------------------------------------------------------*/
-;* skribe-path ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-path)
- *skribe-path*)
-
-;*---------------------------------------------------------------------*/
-;* skribe-path-set! ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-path-set! path)
- (if (not (and (list? path) (every? string? path)))
- (skribe-error 'skribe-path-set! "Illegal path" path)
- (set! *skribe-path* path)))
-
-;*---------------------------------------------------------------------*/
-;* skribe-image-path ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-image-path)
- *skribe-image-path*)
-
-;*---------------------------------------------------------------------*/
-;* skribe-image-path-set! ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-image-path-set! path)
- (if (not (and (list? path) (every? string? path)))
- (skribe-error 'skribe-image-path-set! "Illegal path" path)
- (set! *skribe-image-path* path)))
-
-;*---------------------------------------------------------------------*/
-;* skribe-bib-path ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-bib-path)
- *skribe-bib-path*)
-
-;*---------------------------------------------------------------------*/
-;* skribe-bib-path-set! ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-bib-path-set! path)
- (if (not (and (list? path) (every? string? path)))
- (skribe-error 'skribe-bib-path-set! "Illegal path" path)
- (set! *skribe-bib-path* path)))
-
-;*---------------------------------------------------------------------*/
-;* skribe-source-path ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-source-path)
- *skribe-source-path*)
-
-;*---------------------------------------------------------------------*/
-;* skribe-source-path-set! ... */
-;*---------------------------------------------------------------------*/
-(define (skribe-source-path-set! path)
- (if (not (and (list? path) (every? string? path)))
- (skribe-error 'skribe-source-path-set! "Illegal path" path)
- (set! *skribe-source-path* path)))
generated by cgit v1.2.3 (git 2.44.0) at 2024-06-01 11:00:30 +0000