Commit e45f64c8 authored by Christophe Rhodes's avatar Christophe Rhodes

Restore prolog2paiprolog

The source isn't clean, but its primary use right now is to check that
prolog syntax is vaguely working (since we don't have prolog syntax
parent b79fb695
......@@ -35,7 +35,7 @@
;; (:file "cl-syntax" :depends-on ("packages"))
;; (:file "html-syntax" :depends-on ("packages"))
(:file "prolog-syntax" :depends-on ("packages"))
;; (:file "prolog2paiprolog" :depends-on ("prolog-syntax"))
(:file "prolog2paiprolog" :depends-on ("prolog-syntax"))
;; (:file "ttcn3-syntax" :depends-on ("packages"))
(:file "climacs-lisp-syntax" :depends-on ("core" "groups"))
(:file "climacs-lisp-syntax-commands" :depends-on ("climacs-lisp-syntax" "misc-commands"))
......@@ -26,13 +26,16 @@
(defclass prolog-parse-tree (parse-tree)
(define-syntax-command-table prolog-table :errorp nil)
(define-syntax prolog-syntax (fundamental-syntax)
((lexer :reader lexer)
(valid-parse :initform 1)
(operator-directives :initform nil :accessor operator-directives))
(:name "Prolog")
(:pathname-types "pl"))
(:pathname-types "pl")
(:command-table prolog-table))
(defparameter *prolog-grammar* (grammar))
......@@ -20,6 +20,8 @@
(in-package #:climacs-prolog-syntax)
(defclass prolog-buffer (standard-buffer)
((filepath :initform nil :accessor filepath)
(syntax :accessor syntax)))
......@@ -28,9 +30,12 @@
(declare (ignore args))
(with-slots (syntax) buffer
(setf syntax (make-instance 'prolog-syntax :buffer buffer))))
(defvar *loaded-files* nil "List of files loaded by ensure_loaded directive.")
(defun eval-prolog-file (filepath)
(setf *loaded-files* nil)
(let ((*package*
......@@ -51,10 +56,12 @@
(update-syntax-for-display buffer (syntax buffer) (low-mark buffer)
(high-mark buffer))
(defun buffer->paiprolog (buffer)
(let ((lexemes (drei-syntax::lexemes (lexer (syntax buffer))))
(defun view->paiprolog (view)
(let ((lexemes (drei-syntax::lexemes (lexer (syntax view))))
(expressions '()))
(update-parse (syntax view))
(dotimes (i (flexichain:nb-elements lexemes) (nreverse expressions))
(let ((lexeme (flexichain:element* lexemes i)))
(when (typep lexeme 'end-lexeme)
......@@ -76,12 +83,12 @@
(unless (member (cadr dexpr) *loaded-files*
:test #'string=)
(dolist (e (buffer->paiprolog
(dolist (e (view->paiprolog
(find-prolog-file (cadr dexpr))))
(push e expressions))
(push (cadr dexpr) *loaded-files*)))
(dolist (e (buffer->paiprolog
(dolist (e (view->paiprolog
(find-prolog-file (cadr dexpr))))
(push e expressions)))))
......@@ -403,3 +410,10 @@ returns a symbol designating a paiprolog functor."
(defun intern-paiprolog (name)
(intern (string-upcase name) :paiprolog))
(define-command (com-export-paiprolog :name t :command-table prolog-table)
((pathname 'pathname))
(let ((expressions (view->paiprolog (current-view))))
(with-open-file (s pathname :direction :output :if-exists :supersede)
(dolist (e expressions)
(prin1 e s)))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment