about summary refs log tree commit diff
path: root/src/stklos/resolve.stk
diff options
context:
space:
mode:
authorLudovic Court`es2005-11-02 10:08:38 +0000
committerLudovic Court`es2005-11-02 10:08:38 +0000
commitb76d5e1b252967521f210eac10ddbf089dde8c6a (patch)
tree00fc81c51256991c04799d79a749bbdd5b9fad30 /src/stklos/resolve.stk
parentba63b8d4780428d9f63f6ace7f49361b77401112 (diff)
parentf553cb65b157b6df9563cefa593902d59301461b (diff)
downloadskribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.tar.gz
skribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.tar.lz
skribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.zip
Cleaned up the source tree and the installation process.
Patches applied:

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-6
   Cosmetic changes.

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-7
   Removed useless files, integrated packages.

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-8
   Removed useless files, integrated packages.

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-9
   Moved the STkLos and Bigloo code to `legacy'.

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-10
   Installed Autoconf/Automake machinery.  Fixed a few things.

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-11
   Changes related to source-highlighting and to the manual.


git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-10
Diffstat (limited to 'src/stklos/resolve.stk')
-rw-r--r--src/stklos/resolve.stk255
1 files changed, 0 insertions, 255 deletions
diff --git a/src/stklos/resolve.stk b/src/stklos/resolve.stk
deleted file mode 100644
index 91dc965..0000000
--- a/src/stklos/resolve.stk
+++ /dev/null
@@ -1,255 +0,0 @@
-;;;;
-;;;; resolve.stk	-- Skribe Resolve Stage
-;;;; 
-;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
-;;;; 
-;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2 of the License, or
-;;;; (at your option) any later version.
-;;;; 
-;;;; This program is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this program; if not, write to the Free Software
-;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 
-;;;; USA.
-;;;; 
-;;;;           Author: Erick Gallesio [eg@essi.fr]
-;;;;    Creation date: 13-Aug-2003 18:39 (eg)
-;;;; Last file update: 17-Feb-2004 14:43 (eg)
-;;;;
-
-(define-module SKRIBE-RESOLVE-MODULE
-  (import SKRIBE-DEBUG-MODULE  SKRIBE-RUNTIME-MODULE)
-  (export resolve! resolve-search-parent resolve-children resolve-children*
-	  find1 resolve-counter resolve-parent resolve-ident)
-
-(define *unresolved* #f)
-(define-generic do-resolve!)
-
-
-;;;; ======================================================================
-;;;;
-;;;; RESOLVE!
-;;;;
-;;;; This function iterates over an ast until all unresolved  references
-;;;; are resolved.
-;;;;
-;;;; ======================================================================
-(define (resolve! ast engine env)
-  (with-debug 3 'resolve
-     (debug-item "ast=" ast)
-     (fluid-let ((*unresolved* #f))
-       (let Loop ((ast ast))
-	 (set! *unresolved* #f)
-	 (let ((ast (do-resolve! ast engine env)))
-	   (if *unresolved*
-	       (Loop ast)
-	       ast))))))
-
-;;;; ======================================================================
-;;;;
-;;;; 				D O - R E S O L V E !
-;;;;
-;;;; ======================================================================
-
-(define-method do-resolve! (ast engine env)
-  ast)
-
-
-(define-method do-resolve! ((ast <pair>) engine env)
-  (let Loop ((n* ast))
-    (cond
-      ((pair? n*)
-       (set-car! n* (do-resolve! (car n*) engine env))
-       (Loop (cdr n*)))
-      ((not (null? n*))
-       (error 'do-resolve "Illegal argument" n*))
-      (else
-       ast))))
-
-
-(define-method do-resolve! ((node <node>) engine env)
-  (let ((body    (slot-ref node 'body))
-	(options (slot-ref node 'options))
-	(parent  (slot-ref node 'parent)))
-    (with-debug 5 'do-resolve<body>
-       (debug-item "body=" body)
-       (when (eq? parent 'unspecified)
-	 (let ((p (assq 'parent env)))
-	   (slot-set! node 'parent (and (pair? p) (pair? (cdr p)) (cadr p)))
-	   (when (pair? options)
-	     (debug-item "unresolved options=" options)
-	     (for-each (lambda (o)
-			 (set-car! (cdr o)
-				   (do-resolve! (cadr o) engine env)))
-		       options)
-	     (debug-item "resolved options=" options))))
-       (slot-set! node 'body (do-resolve! body engine env))
-       node)))
-
-
-
-(define-method do-resolve! ((node <container>) engine env0)
-  (let ((body     (slot-ref node 'body))
-	(options  (slot-ref node 'options))
-	(env      (slot-ref node 'env))
-	(parent   (slot-ref node 'parent)))
-    (with-debug 5 'do-resolve<container>
-       (debug-item "markup=" (markup-markup node))
-       (debug-item "body=" body)
-       (debug-item "env0=" env0)
-       (debug-item "env=" env)
-       (when (eq? parent 'unspecified)
-	 (let ((p (assq 'parent env0)))
-	   (slot-set! node 'parent (and (pair? p) (pair? (cdr p)) (cadr p)))
-	   (when (pair? options)
-	     (let ((e (append `((parent ,node)) env0)))
-	       (debug-item "unresolved options=" options)
-	       (for-each (lambda (o)
-			   (set-car! (cdr o)
-				     (do-resolve! (cadr o) engine e)))
-			 options)
-	       (debug-item "resolved options=" options)))
-	   (let ((e `((parent ,node) ,@env ,@env0)))
-	     (slot-set! node 'body (do-resolve! body engine e)))))
-       node)))
-
-
-(define-method do-resolve! ((node <document>) engine env0)
-  (next-method)
-  ;; resolve the engine custom
-  (let ((env (append `((parent ,node)) env0)))
-    (for-each (lambda (c)
-		(let ((i (car c))
-		      (a (cadr c)))
-		  (debug-item "custom=" i " " a)
-		  (set-car! (cdr c) (do-resolve! a engine env))))
-	      (slot-ref engine 'customs)))
-  node)
-
-
-(define-method do-resolve! ((node <unresolved>) engine env)
-  (with-debug 5 'do-resolve<unresolved>
-     (debug-item "node=" node)
-     (let ((p (assq 'parent env)))
-       (slot-set! node 'parent (and (pair? p) (pair? (cdr p)) (cadr p))))
-
-     (let* ((proc (slot-ref node 'proc))
-	    (res  (resolve! (proc node engine env) engine env))
-	    (loc  (ast-loc node)))
-       (when (ast? res)
-	 (ast-loc-set! res loc))
-       (debug-item "res=" res)
-       (set! *unresolved* #t)
-       res)))
-
-
-(define-method do-resolve! ((node <handle>) engine env)
-  node)
-
-
-;;;; ======================================================================
-;;;;
-;;;; RESOLVE-PARENT
-;;;;
-;;;; ======================================================================
-(define (resolve-parent n e)
-  (with-debug 5 'resolve-parent
-     (debug-item "n=" n)
-     (cond
-       ((not (is-a? n <ast>))
-	(let ((c (assq 'parent e)))
-	  (if (pair? c)
-	      (cadr c)
-	      n)))
-       ((eq? (slot-ref n 'parent) 'unspecified)
-	(skribe-error 'resolve-parent "Orphan node" n))
-       (else
-	(slot-ref n 'parent)))))
-
-
-;;;; ======================================================================
-;;;;
-;;;; RESOLVE-SEARCH-PARENT
-;;;;
-;;;; ======================================================================
-(define (resolve-search-parent n e pred)
-  (with-debug 5 'resolve-search-parent
-     (debug-item "node=" n)
-     (debug-item "searching=" pred)
-     (let ((p (resolve-parent n e)))
-       (debug-item "parent=" p " "
-		   (if (is-a? p 'markup) (slot-ref p 'markup) "???"))
-       (cond
-	 ((pred p)	 	 p)				
-	 ((is-a? p <unresolved>) p)
-	 ((not p)		 #f)
-	 (else 			 (resolve-search-parent p e pred))))))
-
-;;;; ======================================================================
-;;;;
-;;;; RESOLVE-COUNTER
-;;;;
-;;;; ======================================================================
-;;FIXME: factoriser
-(define (resolve-counter n e cnt val . opt)
-  (let ((c (assq (symbol-append cnt '-counter) e)))
-    (if (not (pair? c))
-	(if (or (null? opt) (not (car opt)) (null? e))
-	    (skribe-error cnt "Orphan node" n)
-	    (begin
-	      (set-cdr! (last-pair e)
-			(list (list (symbol-append cnt '-counter) 0)
-			      (list (symbol-append cnt '-env) '())))
-	      (resolve-counter n e cnt val)))
-	(let* ((num (cadr c))
-	       (nval (if (integer? val)
-			 val
-			 (+ 1 num))))
-	  (let ((c2 (assq (symbol-append cnt '-env) e)))
-	    (set-car! (cdr c2) (cons (resolve-parent n e) (cadr c2))))
-	  (cond
-	    ((integer? val)
-	     (set-car! (cdr c) val)
-	     (car val))
-	    ((not val)
-	     val)
-	    (else
-	     (set-car! (cdr c) (+ 1 num))
-	     (+ 1 num)))))))
-  
-;;;; ======================================================================
-;;;;
-;;;; RESOLVE-IDENT
-;;;;
-;;;; ======================================================================
-(define (resolve-ident ident markup n e)
-  (with-debug 4 'resolve-ident
-     (debug-item "ident=" ident)
-     (debug-item "markup=" markup)
-     (debug-item "n=" (if (markup? n) (markup-markup n) n))
-     (if (not (string? ident))
-	 (skribe-type-error 'resolve-ident
-			    "Illegal ident"
-			    ident
-			    "string")
-	 (let ((mks (find-markups ident)))
-	   (and mks
-		(if (not markup)
-		    (car mks)
-		    (let loop ((mks mks))
-		      (cond
-			((null? mks)
-			 #f)
-			((is-markup? (car mks) markup)
-			 (car mks))
-			(else
-			 (loop (cdr mks)))))))))))
-
-)
generated by cgit-pink 1.4.1 (git 2.36.1) at 2025-09-18 00:03:24 +0000