summaryrefslogtreecommitdiff
path: root/src/guile/silex/main.scm
diff options
context:
space:
mode:
authorLudovic Courtès2008-01-18 12:36:59 +0100
committerLudovic Courtès2008-01-18 12:36:59 +0100
commit7efd05778cddec0293e0d48199f3aeee2aad6178 (patch)
tree806be6fc0190c511374f15332c4465e27048b111 /src/guile/silex/main.scm
parenta3b7dfffbda5fe148920c7556244ab35b99109a5 (diff)
downloadskribilo-7efd05778cddec0293e0d48199f3aeee2aad6178.tar.gz
skribilo-7efd05778cddec0293e0d48199f3aeee2aad6178.tar.lz
skribilo-7efd05778cddec0293e0d48199f3aeee2aad6178.zip
Add SILex, for simplicity.
Diffstat (limited to 'src/guile/silex/main.scm')
-rw-r--r--src/guile/silex/main.scm226
1 files changed, 226 insertions, 0 deletions
diff --git a/src/guile/silex/main.scm b/src/guile/silex/main.scm
new file mode 100644
index 0000000..f157334
--- /dev/null
+++ b/src/guile/silex/main.scm
@@ -0,0 +1,226 @@
+; SILex - Scheme Implementation of Lex
+; Copyright (C) 2001 Danny Dube'
+;
+; 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.
+
+;
+; Gestion d'erreurs
+;
+
+(define lex-exit-continuation #f)
+(define lex-unwind-protect-list '())
+(define lex-error-filename #f)
+
+(define lex-unwind-protect
+ (lambda (proc)
+ (set! lex-unwind-protect-list (cons proc lex-unwind-protect-list))))
+
+(define lex-error
+ (lambda (line column . l)
+ (let* ((linestr (if line (number->string line) #f))
+ (colstr (if column (number->string column) #f))
+ (namelen (string-length lex-error-filename))
+ (linelen (if line (string-length linestr) -1))
+ (collen (if column (string-length colstr) -1))
+ (totallen (+ namelen 1 linelen 1 collen 2)))
+ (display "Lex error:")
+ (newline)
+ (display lex-error-filename)
+ (if line
+ (begin
+ (display ":")
+ (display linestr)))
+ (if column
+ (begin
+ (display ":")
+ (display colstr)))
+ (display ": ")
+ (let loop ((l l))
+ (if (null? l)
+ (newline)
+ (let ((item (car l)))
+ (display item)
+ (if (equal? '#\newline item)
+ (let loop2 ((i totallen))
+ (if (> i 0)
+ (begin
+ (display #\space)
+ (loop2 (- i 1))))))
+ (loop (cdr l)))))
+ (newline)
+ (let loop ((l lex-unwind-protect-list))
+ (if (pair? l)
+ (begin
+ ((car l))
+ (loop (cdr l)))))
+ (lex-exit-continuation #f))))
+
+
+
+
+;
+; Decoupage des arguments
+;
+
+(define lex-recognized-args
+ '(complete-driver?
+ filein
+ table-name
+ fileout
+ counters
+ portable
+ code
+ pp))
+
+(define lex-valued-args
+ '(complete-driver?
+ filein
+ table-name
+ fileout
+ counters))
+
+(define lex-parse-args
+ (lambda (args)
+ (let loop ((args args))
+ (if (null? args)
+ '()
+ (let ((sym (car args)))
+ (cond ((not (symbol? sym))
+ (lex-error #f #f "bad option list."))
+ ((not (memq sym lex-recognized-args))
+ (lex-error #f #f "unrecognized option \"" sym "\"."))
+ ((not (memq sym lex-valued-args))
+ (cons (cons sym '()) (loop (cdr args))))
+ ((null? (cdr args))
+ (lex-error #f #f "the value of \"" sym "\" not specified."))
+ (else
+ (cons (cons sym (cadr args)) (loop (cddr args))))))))))
+
+
+
+
+;
+; Differentes etapes de la fabrication de l'automate
+;
+
+(define lex1
+ (lambda (filein)
+; (display "lex1: ") (write (get-internal-run-time)) (newline)
+ (parser filein)))
+
+(define lex2
+ (lambda (filein)
+ (let* ((result (lex1 filein))
+ (<<EOF>>-action (car result))
+ (<<ERROR>>-action (cadr result))
+ (rules (cddr result)))
+; (display "lex2: ") (write (get-internal-run-time)) (newline)
+ (append (list <<EOF>>-action <<ERROR>>-action rules)
+ (re2nfa rules)))))
+
+(define lex3
+ (lambda (filein)
+ (let* ((result (lex2 filein))
+ (<<EOF>>-action (list-ref result 0))
+ (<<ERROR>>-action (list-ref result 1))
+ (rules (list-ref result 2))
+ (nl-start (list-ref result 3))
+ (no-nl-start (list-ref result 4))
+ (arcs (list-ref result 5))
+ (acc (list-ref result 6)))
+; (display "lex3: ") (write (get-internal-run-time)) (newline)
+ (append (list <<EOF>>-action <<ERROR>>-action rules)
+ (noeps nl-start no-nl-start arcs acc)))))
+
+(define lex4
+ (lambda (filein)
+ (let* ((result (lex3 filein))
+ (<<EOF>>-action (list-ref result 0))
+ (<<ERROR>>-action (list-ref result 1))
+ (rules (list-ref result 2))
+ (nl-start (list-ref result 3))
+ (no-nl-start (list-ref result 4))
+ (arcs (list-ref result 5))
+ (acc (list-ref result 6)))
+; (display "lex4: ") (write (get-internal-run-time)) (newline)
+ (append (list <<EOF>>-action <<ERROR>>-action rules)
+ (sweep nl-start no-nl-start arcs acc)))))
+
+(define lex5
+ (lambda (filein)
+ (let* ((result (lex4 filein))
+ (<<EOF>>-action (list-ref result 0))
+ (<<ERROR>>-action (list-ref result 1))
+ (rules (list-ref result 2))
+ (nl-start (list-ref result 3))
+ (no-nl-start (list-ref result 4))
+ (arcs (list-ref result 5))
+ (acc (list-ref result 6)))
+; (display "lex5: ") (write (get-internal-run-time)) (newline)
+ (append (list <<EOF>>-action <<ERROR>>-action rules)
+ (nfa2dfa nl-start no-nl-start arcs acc)))))
+
+(define lex6
+ (lambda (args-alist)
+ (let* ((filein (cdr (assq 'filein args-alist)))
+ (result (lex5 filein))
+ (<<EOF>>-action (list-ref result 0))
+ (<<ERROR>>-action (list-ref result 1))
+ (rules (list-ref result 2))
+ (nl-start (list-ref result 3))
+ (no-nl-start (list-ref result 4))
+ (arcs (list-ref result 5))
+ (acc (list-ref result 6)))
+; (display "lex6: ") (write (get-internal-run-time)) (newline)
+ (prep-set-rules-yytext? rules)
+ (output args-alist
+ <<EOF>>-action <<ERROR>>-action
+ rules nl-start no-nl-start arcs acc)
+ #t)))
+
+(define lex7
+ (lambda (args)
+ (call-with-current-continuation
+ (lambda (exit)
+ (set! lex-exit-continuation exit)
+ (set! lex-unwind-protect-list '())
+ (set! lex-error-filename (cadr (memq 'filein args)))
+ (let* ((args-alist (lex-parse-args args))
+ (result (lex6 args-alist)))
+; (display "lex7: ") (write (get-internal-run-time)) (newline)
+ result)))))
+
+
+
+
+;
+; Fonctions principales
+;
+
+(define lex
+ (lambda (filein fileout . options)
+ (lex7 (append (list 'complete-driver? #t
+ 'filein filein
+ 'table-name "lexer-default-table"
+ 'fileout fileout)
+ options))))
+
+(define lex-tables
+ (lambda (filein table-name fileout . options)
+ (lex7 (append (list 'complete-driver? #f
+ 'filein filein
+ 'table-name table-name
+ 'fileout fileout)
+ options))))