jirkamarsik

module Main where

import Prelude
import Data.DOM.Simple.Document
import Data.DOM.Simple.Element
import Data.DOM.Simple.Window
import qualified VirtualDOM as VD
import qualified VirtualDOM.VTree as VT

foreign import isoTS :: DOM.Node -> Data.DOM.Simple.Types.HTMLElement

jirkamarsik

(defn simple-rule [in-tree]
  (if-let [res (seq (run 1 [out-tree]
                      (fresh [X Y Z W]
                        (== in-tree ['VP X Y ['PP Z W]])
                        (== out-tree ['VP ['VP X Y] ['PP Z W]]))))]
    (first res)
    in-tree))
;=> #'user/simple-rule

(simple-rule '[VP [VB plays] [NP piano] [PP [IN for] [NP fun]]])

jirkamarsik

(defn poly-appendo
  "Like clojure.core.logic/appendo, but works with arbitrary number of
  args, like clojure.core/concat."
  ([x y]
     (== x y))
  ([x y & more]
     (fresh [z]
       (apply poly-appendo z more)
       (appendo x y z))))

jirkamarsik

(defn ^::rule fix-adjunctiono
  "A rule which takes a left-most or right-most child A, which is an
  adjunct, and puts the A on a separate level from the other children,
  i.e. (R A ...) -> (R A (R ...)) or (R ... A) -> (R (R ...) A).

  This solves the general case when modifiers and adjuncts end up as
  children of the consituent they modify (e.g. in VPs)."
  [in-tree out-tree]
  (fresh [root children other-children adjunct head-child]
    (conso root children in-tree)

jirkamarsik

(defmacro transformo
  "Is satisfied when out-tree is a normalized version of the in-tree
  node. Tries to use any goal annotated with ::rule."
  [in-tree out-tree]
  `(conde ~@(for [[sym var] (ns-interns *ns*)
                  :when (::rule (meta var))]
              [(list sym in-tree out-tree)])))

jirkamarsik

(defn record-adjunct
  "Records an adjunction performed by our rules."
  [phrase adjunct]
  (swap! adjunctions conj {:name name
                           :phrase phrase
                           :adjunct adjunct}))

(def fixed-trees
  "A map from tree filenames to their fixed versions."
  (into {} (for [[name tree] trees]

jirkamarsik

(def ^:dynamic *current-tree-name*)

(defn record-adjunct
  "Records an adjunction performed by our rules."
  [phrase adjunct]
  (swap! adjunctions conj {:name *current-tree-name*
                           :phrase phrase
                           :adjunct adjunct}))

(def fixed-trees

jirkamarsik

(def ^:dynamic *fix-tree-adjunctions*)

(defn record-adjunct
  "Records an adjunction performed within fix-tree."
  [phrase adjunct]
  (if (thread-bound? #'*fix-tree-adjunctions*)
    (set! *fix-tree-adjunctions* (conj *fix-tree-adjunctions*
                                       {:phrase phrase
                                        :adjunct adjunct}))))

jirkamarsik

(def ^:dynamic *fix-tree-adjunctions*)
(def ^:dynamic *fix-tree-current-name*)

(defn record-adjunct
  "Records an adjunction performed within fix-tree."
  [phrase adjunct]
  (if (thread-bound? #'*fix-tree-adjunctions*)
    (let [record {:phrase phrase
                  :adjunct adjunct}
          record (if (thread-bound? #'*fix-tree-current-name*)

jirkamarsik

-- HUMAN RESOURCE MACHINE PROGRAM --

    COMMENT  4
    COPYFROM 24
    COPYTO   19
    BUMPUP   19
    BUMPUP   19
    COMMENT  3
a:
    COPYFROM 24