Commit 1b885df1 authored by remivantrijp's avatar remivantrijp

More simplifications.

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