Commit 1b885df1 authored by remivantrijp's avatar remivantrijp

More simplifications.

parent ef1f3e1a
......@@ -59,19 +59,21 @@
(defmethod make-html ((type-hierarchy type-hierarchy) &key (weights? nil) (colored-edges-0-1 t) (render-program "dot") &allow-other-keys)
"generates html code for a type-hierarchy"
(let* ((path (type-hierarchy->image type-hierarchy :open nil :format "svg" :weights? weights? :colored-edges-0-1 colored-edges-0-1 :render-program render-program))
(svg (with-open-file (stream path :direction :input)
(let ((lines nil) (line nil))
(loop do (setf line (read-line stream nil))
;; skip stuff before <svg ...
until (and (> (length line) 3) (equal (subseq line 0 4) "<svg")))
(loop ;; skip comments
do (unless (and (> (length line) 3) (equal (subseq line 0 4) "<!--"))
(push line lines))
(setf line (if (equal line "</svg>")
nil
(read-line stream nil)))
while line)
(close stream)
(reduce #'string-append (reverse lines))))))
`((div) ,svg)))
nil)
;;; (let* ((path (type-hierarchy->image type-hierarchy :open nil :format "svg" :weights? weights? :colored-edges-0-1 colored-edges-0-1 :render-program render-program))
;;; (svg (with-open-file (stream path :direction :input)
;;; (let ((lines nil) (line nil))
;;; (loop do (setf line (read-line stream nil))
;;; ;; skip stuff before <svg ...
;;; until (and (> (length line) 3) (equal (subseq line 0 4) "<svg")))
;;; (loop ;; skip comments
;;; do (unless (and (> (length line) 3) (equal (subseq line 0 4) "<!--"))
;;; (push line lines))
;;; (setf line (if (equal line "</svg>")
;;; nil
;;; (read-line stream nil)))
;;; while line)
;;; (close stream)
;;; (reduce #'string-append (reverse lines))))))
;;; `((div) ,svg)))
......@@ -29,13 +29,9 @@
((and cxn-inventory
(type-hierarchies::get-type-hierarchy cxn-inventory)
(symbolp x) (symbolp y)
(type-hierarchies::node-p (intern (symbol-name x) :type-hierarchies)
(type-hierarchies:get-type-hierarchy cxn-inventory))
(type-hierarchies::node-p (intern (symbol-name y) :type-hierarchies)
(type-hierarchies:get-type-hierarchy cxn-inventory))
(type-hierarchies::directed-path-p (intern (symbol-name y) :type-hierarchies)
(intern (symbol-name x) :type-hierarchies)
(type-hierarchies:get-type-hierarchy cxn-inventory))
(type-hierarchies::node-p x (type-hierarchies:get-type-hierarchy cxn-inventory))
(type-hierarchies::node-p y (type-hierarchies:get-type-hierarchy cxn-inventory))
(type-hierarchies::directed-path-p y x (type-hierarchies:get-type-hierarchy cxn-inventory))
bindings))
;; unify variables
((variable-p x) (unify-variable x y bindings))
......
......@@ -48,6 +48,7 @@
&optional (cxn-inventory *fcg-constructions*))
"When the tree is translated, update the boundaries and form constraints."
(let* ((strings (fcg-extract-selected-form-constraints base-transient-structure '(string)))
;; Temporary cip-node is necessary to be able to reuse the normal fcg processing functions.
(temp-node (make-instance 'cip-node
:construction-inventory cxn-inventory
:car (make-cxn-application-result
......@@ -65,4 +66,4 @@
(fcg-get-transient-unit-structure temp-node))))
`(root
(boundaries ,new-boundaries)
(form ,(append strings new-form-constraints)))))
(form ,(append strings new-form-constraints)))))
\ No newline at end of file
......@@ -92,11 +92,10 @@
;; Lex-classes
;; ---------------------------------------------------------------
(verb ()
(syn-cat ((lex-class verb)
(agreement ?agr)
(tam ?tam)
(verb-form ?verb-form)
(finite ?finite))))
(syn-cat ((agreement ?agr))))
;(tam ?tam)
;(verb-form ?verb-form)
;(finite ?finite))))
(aux (verb)
(syn-cat ((lex-class aux))))
(auxpass (aux)
......@@ -106,18 +105,15 @@
(referent ?ref)
(args (?output ?input))
(sem-cat ((sem-class identifier)))
(syn-cat ((categories (noun))
(agreement ?agr))))
(syn-cat ((agreement ?agr))))
(common-noun (noun)
(syn-cat ((lex-class common-noun))))
(compound (noun))
(proper-noun (noun)
(syn-cat ((categories (noun proper-noun))
(lex-class proper-noun))))
(syn-cat ((lex-class proper-noun))))
(adjective ()
(referent ?ref)
(args (?output ?input))
(sem-cat ((sem-class predicate)))
(syn-cat ((lex-class adjective))))
(determiner ()
(referent ?ref)
......
......@@ -13,6 +13,7 @@
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;=========================================================================
(in-package #:asdf)
(defsystem :fcg-hybrids
......
......@@ -67,8 +67,9 @@
collect (make-unit :name (word-dependency-spec-unit-name word-spec)
:features `((parent ,parent)
(subunits ,subunits)
(form ((string ,(word-dependency-spec-unit-name word-spec)
,(word-dependency-spec-string word-spec))))
(form ((string
,(word-dependency-spec-unit-name word-spec)
,(word-dependency-spec-string word-spec))))
(dependency
((pos-tag
,(intern (upcase (word-dependency-spec-pos-tag word-spec)) :fcg))
......
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