Merge pull request #766 from samply/501-cql-functions

Implement Functions in CQL

docs/conformance/cql.md

@@ -85,7 +85,7 @@ The section numbers refer to the documentation of the [ELM Specification](https:
 |------|---------------|------------|---------------------------------------------|-------|
 | 9.1. | ExpressionDef | ✓          |                                             |       |
 | 9.2. | ExpressionRef | !          | only inside same library                    |       |
-| 9.3. | FunctionDef   | ✗          |                                             |       |
+| 9.3. | FunctionDef   | ✓          |                                             |       |
 | 9.4. | FunctionRef   | !          | hard coded implementation of some functions |       |
 
 ### 10. Queries
@@ -322,38 +322,38 @@ The section numbers refer to the documentation of the [ELM Specification](https:
 ### 22. Type Operators
 
 | Num    | Group              | Expression | State         | Notes |
-|--------|--------------------|-----------|---------------|-------|
-| 22.1.  | As                 | !         | no strictness |       |
-| 22.2.  | CanConvert         | ✗         |               |       |
-| 22.3.  | CanConvertQuantity | ✓         |               |       |
-| 22.4.  | Children           | ✓         |               |       |
-| 22.5.  | Convert            | ✗         |               |       |
-| 22.6.  | ConvertQuantity    | ✓         |               |       |
-| 22.7.  | ConvertsToBoolean  | ✓         |               |       |
-| 22.8.  | ConvertsToDate     | ✓         |               |       |
-| 22.9.  | ConvertsToDateTime | ✓         |               |       |
-| 22.10. | ConvertsToDecimal  | ✓         |               |       |
-| 22.11. | ConvertsToLong     | ✓         |               |       |
-| 22.12. | ConvertsToInteger  | ✓         |               |       |
-| 22.13. | ConvertsToQuantity | ✓         |               |       |
-| 22.14. | ConvertsToRatio    | ✗         |               |       |
-| 22.15. | ConvertsToString   | ✓         |               |       |
-| 22.16. | ConvertsToTime     | ✓         |               |       |
-| 22.17. | Descendents        | ✓         |               |       |
-| 22.18. | Is                 | ✗         |               |       |
-| 22.19. | ToBoolean          | ✓         |               |       |
-| 22.20. | ToChars            | ✓         |               |       |
-| 22.21. | ToConcept          | ✗         |               |       |
-| 22.22. | ToDate             | ✓         |               |       |
-| 22.23. | ToDateTime         | ✓         |               |       |
-| 22.24. | ToDecimal          | ✓         |               |       |
-| 22.25. | ToInteger          | ✓         |               |       |
-| 22.26. | ToList             | ✓         |               |       |
-| 22.27. | ToLong             | ✓         |               |       |
-| 22.28. | ToQuantity         | ✓         |               |       |
-| 22.29. | ToRatio            | ✗         |               |       |
-| 22.30. | ToString           | ✓         |               |       |
-| 22.31. | ToTime             | ✓         |               |       |
+|--------|--------------------|------------|---------------|-------|
+| 22.1.  | As                 | !          | no strictness |       |
+| 22.2.  | CanConvert         | ✗          |               |       |
+| 22.3.  | CanConvertQuantity | ✓          |               |       |
+| 22.4.  | Children           | ✓          |               |       |
+| 22.5.  | Convert            | ✗          |               |       |
+| 22.6.  | ConvertQuantity    | ✓          |               |       |
+| 22.7.  | ConvertsToBoolean  | ✓          |               |       |
+| 22.8.  | ConvertsToDate     | ✓          |               |       |
+| 22.9.  | ConvertsToDateTime | ✓          |               |       |
+| 22.10. | ConvertsToDecimal  | ✓          |               |       |
+| 22.11. | ConvertsToLong     | ✓          |               |       |
+| 22.12. | ConvertsToInteger  | ✓          |               |       |
+| 22.13. | ConvertsToQuantity | ✓          |               |       |
+| 22.14. | ConvertsToRatio    | ✗          |               |       |
+| 22.15. | ConvertsToString   | ✓          |               |       |
+| 22.16. | ConvertsToTime     | ✓          |               |       |
+| 22.17. | Descendents        | ✓          |               |       |
+| 22.18. | Is                 | ✗          |               |       |
+| 22.19. | ToBoolean          | ✓          |               |       |
+| 22.20. | ToChars            | ✓          |               |       |
+| 22.21. | ToConcept          | ✗          |               |       |
+| 22.22. | ToDate             | ✓          |               |       |
+| 22.23. | ToDateTime         | ✓          |               |       |
+| 22.24. | ToDecimal          | ✓          |               |       |
+| 22.25. | ToInteger          | ✓          |               |       |
+| 22.26. | ToList             | ✓          |               |       |
+| 22.27. | ToLong             | ✓          |               |       |
+| 22.28. | ToQuantity         | ✓          |               |       |
+| 22.29. | ToRatio            | ✗          |               |       |
+| 22.30. | ToString           | ✓          |               |       |
+| 22.31. | ToTime             | ✓          |               |       |
 
 ### 23. Clinical Operators
 

modules/cql/src/blaze/elm/compiler/core.clj

@@ -41,7 +41,11 @@
 
 
 (defmulti compile*
-  "Compiles `expression` in `context`."
+  "Compiles `expression` in `context`.
+
+  Context consists of:
+  * :library - the library in it's ELM form
+  * :node - the database node"
   {:arglists '([context expression])}
   (fn [_ {:keys [type] :as expr}]
     (assert (string? type) (format "Missing :type in expression `%s`." (pr-str expr)))

modules/cql/src/blaze/elm/compiler/external_data.clj

@@ -18,7 +18,9 @@
 (defrecord CompartmentListRetrieveExpression [context data-type]
   core/Expression
   (-eval [_ {:keys [db]} {:keys [id]} _]
-    (d/list-compartment-resource-handles db context id data-type)))
+    (d/list-compartment-resource-handles db context id data-type))
+  (-form [_]
+    `(~'compartment-list-retrieve ~data-type)))
 
 
 (defrecord CompartmentQueryRetrieveExpression [query data-type clauses]
@@ -93,7 +95,9 @@
 (defrecord ResourceRetrieveExpression []
   core/Expression
   (-eval [_ _ resource _]
-    [resource]))
+    [resource])
+  (-form [_]
+    (list 'retrieve-resource)))
 
 
 (def ^:private resource-expr

modules/cql/src/blaze/elm/compiler/function.clj

@@ -0,0 +1,12 @@
+(ns blaze.elm.compiler.function
+  (:require
+    [blaze.elm.compiler.core :as core]))
+
+
+(defn arity-n [name fn-expr operand-names operands]
+  (reify core/Expression
+    (-eval [_ context resource scope]
+      (let [values (map #(core/-eval % context resource scope) operands)]
+        (core/-eval fn-expr context resource (merge scope (zipmap operand-names values)))))
+    (-form [_]
+      `(~'call ~name ~@(map core/-form operands)))))

modules/cql/src/blaze/elm/compiler/library.clj

@@ -1,39 +1,57 @@
 (ns blaze.elm.compiler.library
   (:require
-    [blaze.anomaly :as ba :refer [when-ok]]
+    [blaze.anomaly :as ba :refer [if-ok when-ok]]
     [blaze.elm.compiler :as compiler]
+    [blaze.elm.compiler.function :as function]
     [blaze.elm.deps-infer :as deps-infer]
     [blaze.elm.equiv-relationships :as equiv-relationships]
     [blaze.elm.normalizer :as normalizer]))
 
 
 (defn- compile-expression-def
-  "Compiles the expression of `expression-def` in `context` and associates the
-  resulting compiled expression under ::compiler/expression to the
-  `expression-def` which itself is returned.
-
-  Returns an anomaly on errors."
-  {:arglists '([context expression-def])}
-  [context {:keys [expression] :as expression-def}]
-  (let [context (assoc context :eval-context (:context expression-def))]
-    (-> (ba/try-anomaly
-          (assoc expression-def
-            ::compiler/expression (compiler/compile context expression)))
+  "Compiles the expression of `def` in `context` and returns a tuple of
+  `[name compiled-expression]` or an anomaly on errors."
+  [context {:keys [name expression] :as def}]
+  (let [context (assoc context :eval-context (:context def))]
+    (-> (ba/try-anomaly [name (compiler/compile context expression)])
         (ba/exceptionally
           #(assoc % :context context :elm/expression expression)))))
 
 
-(defn- expr-defs [context library]
+(defn- compile-function-def
+  "Compiles the function of `def` in `context`.
+
+  Returns the compiled function or an anomaly on errors."
+  [context {:keys [name operand] :as def}]
+  (when-ok [[_ expression] (compile-expression-def context def)]
+    (partial function/arity-n name expression (mapv :name operand))))
+
+
+(defn- compile-function-defs [context library]
   (transduce
-    (comp (map (partial compile-expression-def context))
-          (halt-when ba/anomaly?))
+    (filter (comp #{"FunctionDef"} :type))
     (completing
-      (fn [r {:keys [name] ::compiler/keys [expression]}]
-        (assoc r name expression)))
-    {}
+      (fn [context {:keys [name] :as def}]
+        (if-ok [function (compile-function-def context def)]
+          (assoc-in context [:functions name] function)
+          reduced)))
+    context
     (-> library :statements :def)))
 
 
+(defn- expression-defs [context library]
+  (when-ok [context (compile-function-defs context library)]
+    (transduce
+      (comp (filter (comp nil? :type))
+            (map (partial compile-expression-def context))
+            (halt-when ba/anomaly?))
+      (completing
+        (fn [r [name expression]]
+          (assoc r name expression)))
+      {}
+      (-> library :statements :def))))
+
+
 (defn- compile-parameter-def
   "Compiles the default value of `parameter-def` in `context` and associates the
   resulting compiled default value under :default to the `parameter-def` which
@@ -71,7 +89,7 @@
                     equiv-relationships/find-equiv-rels-library
                     deps-infer/infer-library-deps)
         context (assoc opts :node node :library library)]
-    (when-ok [expr-defs (expr-defs context library)
+    (when-ok [expression-defs (expression-defs context library)
               parameter-default-values (parameter-default-values context library)]
-      {:compiled-expression-defs expr-defs
+      {:compiled-expression-defs expression-defs
        :parameter-default-values parameter-default-values})))

modules/cql/src/blaze/elm/compiler/queries.clj

@@ -298,18 +298,6 @@
     (throw (Exception. (str "Unsupported number of " (count sources) " sources in query.")))))
 
 
-;; ?.? IdentifierRef
-;;
-;; The IdentifierRef type defines an expression that references an identifier
-;; that is either unresolved, or has been resolved to an attribute in an
-;; unambiguous iteration scope such as a sort. Implementations should attempt to
-;; resolve the identifier, only throwing an error at compile-time (or run-time
-;; for an interpretive system) if the identifier reference cannot be resolved.
-(defmethod core/compile* :elm.compiler.type/identifier-ref
-  [_ {:keys [name]}]
-  (structured-values/->SingleScopePropertyExpression (keyword name)))
-
-
 ;; 10.3. AliasRef
 ;;
 ;; The AliasRef expression allows for the reference of a specific source within
@@ -336,7 +324,13 @@
     (->AliasRefExpression name)))
 
 
-;; 10.12. With
+;; 10.7 IdentifierRef
+(defmethod core/compile* :elm.compiler.type/identifier-ref
+  [_ {:keys [name]}]
+  (structured-values/->SingleScopePropertyExpression (keyword name)))
+
+
+;; 10.14. With
 ;;
 ;; The With clause restricts the elements of a given source to only those
 ;; elements that have elements in the related source that satisfy the suchThat
@@ -386,4 +380,4 @@
         (format "Unsupported call without single query scope.")))))
 
 
-;; TODO 10.13. Without
+;; TODO 10.15. Without

modules/cql/src/blaze/elm/compiler/reusing_logic.clj

@@ -40,11 +40,17 @@
     `(~'expr-ref ~name)))
 
 
-(defn- find-expression-def
-  "Returns the expression-def with `name` from `library` or nil if not found."
+(defn- find-def
+  "Returns the def with `name` from `library` or nil if not found."
   {:arglists '([library name])}
-  [{{expr-defs :def} :statements} name]
-  (some #(when (= name (:name %)) %) expr-defs))
+  [{{defs :def} :statements} name]
+  (some #(when (= name (:name %)) %) defs))
+
+
+(defn- find-expression-def [library name]
+  (when-let [def (find-def library name)]
+    (when (nil? (:type def))
+      def)))
 
 
 (defn- expression-def-not-found-anom [context name]
@@ -157,6 +163,18 @@
     `(~'call "ToInterval" ~(core/-form operand))))
 
 
+(defn- function-def-not-found-anom [context name]
+  (ba/incorrect
+    (format "Function definition `%s` not found." name)
+    :context context))
+
+
+(defn compile-function [{:keys [functions] :as context} name operands]
+  (if-let [function (get functions name)]
+    (function operands)
+    (throw-anom (function-def-not-found-anom context name))))
+
+
 ;; 9.4. FunctionRef
 (defmethod core/compile* :elm.compiler.type/function-ref
   [context {:keys [name] operands :operand}]
@@ -184,4 +202,14 @@
       "ToInterval"
       (->ToIntervalFunctionExpression (first operands))
 
-      (throw (Exception. (str "Unsupported function `" name "` in `FunctionRef` expression."))))))
+      (compile-function context name operands))))
+
+
+;; 9.5 OperandRef
+(defmethod core/compile* :elm.compiler.type/operand-ref
+  [_ {:keys [name]}]
+  (reify core/Expression
+    (-eval [_ _ _ scope]
+      (scope name))
+    (-form [_]
+      `(~'operand-ref ~name))))

modules/cql/src/blaze/elm/compiler/spec.clj

@@ -10,5 +10,9 @@
   core/expr?)
 
 
+(s/def :blaze.elm.compiler/function
+  fn?)
+
+
 (s/def :elm/compile-context
   (s/keys :req-un [:elm/library :blaze.db/node]))

modules/cql/src/blaze/elm/spec.clj

@@ -622,8 +622,8 @@
   (s/keys :opt-un [:elm/name :elm/libraryName :elm.nary-expression/operand]))
 
 
-;; ?.? IdentifierRef
-(defmethod expression :elm.spec.type/identifier-ref [_]
+;; 9.5 OperandRef
+(defmethod expression :elm.spec.type/operand-ref [_]
   (s/keys :opt-un [:elm/name]))
 
 
@@ -669,14 +669,23 @@
      :elm.sort-by-item.by-expression/expression]))
 
 
-;; 10.9. RelationshipClause
+;; 10.7 IdentifierRef
+(defmethod expression :elm.spec.type/identifier-ref [_]
+  (s/keys :req-un [:elm/name] :opt-un [:elm/libraryName]))
+
+
+;; TODO: 10.8. LetClause
+
+;; TODO 10.9. QueryLetRef
+
+;; 10.10. RelationshipClause
 (defmulti relationship-clause :type)
 
 (s/def :elm/relationship-clause
   (s/multi-spec relationship-clause :type))
 
 
-;; 10.10. ReturnClause
+;; 10.11. ReturnClause
 (s/def :elm.return-clause/expression
   :elm/expression)
 
@@ -690,9 +699,9 @@
           :opt-un [:elm.return-clause/distinct]))
 
 
-;; TODO: 10.11. AggregateClause
+;; TODO: 10.12. AggregateClause
 
-;; 10.12. SortClause
+;; 10.13. SortClause
 (s/def :elm.sort-clause/by
   (s/coll-of :elm/sort-by-item :min-count 1))
 
@@ -701,7 +710,7 @@
   (s/keys :req-un [:elm.sort-clause/by]))
 
 
-;; 10.13. With
+;; 10.14. With
 (defmethod relationship-clause "With" [_]
   (s/keys :req-un [:elm/expression :elm/alias :elm.query/suchThat]))
 
@@ -711,7 +720,7 @@
           :opt-un [:elm.query/suchThat]))
 
 
-;; 10.14. Without
+;; 10.15. Without
 (defmethod relationship-clause "Without" [_]
   (s/keys :req-un [:elm/expression :elm/alias :elm.query/suchThat]))