Uncomment remaining testsmerge-parsing-stages

3 files changed, 37 insertions, 34 deletions

diff --git a/compiler/passes/parse-policy.scm b/compiler/passes/parse-policy.scm
index 840460b..28a7925 100644
--- a/compiler/passes/parse-policy.scm
+++ b/compiler/passes/parse-policy.scm
@@ -106,7 +106,6 @@
   ;; No individual rule should have failed to extract.
   (assert (every identity result))
 
-  (pretty-print (to-pretty-sexp result))
   result)
 
 (define (determine-head-kind head-obj)
@@ -126,17 +125,17 @@ field-eqv: assignment to a reference   (varname[field] IS value IF condition)
 (define (preprocess-head head-obj)
   ;; Head rules will sometimes have an "assign" key, but this is only when the
   ;; right-hand side is a scalar value.
-  (define lhs (preprocess-body (array->list (assoc-ref head-obj "ref"))))
+  (define lhs (make <reference>
+                #:parts (preprocess-body (array->list (assoc-ref head-obj "ref")))))
   (define rhs (preprocess-body
                (if (eqv? 'set-memq (determine-head-kind head-obj))
                    (assoc-ref head-obj "key")
                    (assoc-ref head-obj "value"))))
-  (assert (= 1 (length lhs)))
   (let ((kind (determine-head-kind head-obj)))
     (make <head>
       #:name (assoc-ref head-obj "name")
       #:kind kind
-      #:lhs (first lhs)
+      #:lhs lhs
       #:rhs rhs)))
 
 (define (preprocess-body body-obj)
@@ -183,27 +182,27 @@ field-eqv: assignment to a reference   (varname[field] IS value IF condition)
                  (string? value)) value)
             ((string= "array" type)  (if (null? value)
                                          #()
-                                         (list->vector (map parse-literal (array->list value)))))
+                                         (list->vector value)))
             ((string= "set" type)    (make <set-literal>
-                                       #:elems (map parse-literal (array->list value))))
+                                       #:elems value))
             ((string= "object" type) (pairs->object-literal value))
             ((string= "arraycomprehension" type)
              (make <comprehension>
                #:kind 'array
-               #:key (parse-literal (assoc-ref value "term"))
+               #:key (assoc-ref value "term")
                #:value #f
                #:body (extract-conjunction (preprocess-body (assoc-ref value "body")))))
             ((string= "setcomprehension" type)
              (make <comprehension>
                #:kind 'set
-               #:key (parse-literal (assoc-ref value "term"))
+               #:key (assoc-ref value "term")
                #:value #f
                #:body (extract-conjunction (preprocess-body (assoc-ref value "body")))))
             ((string= "objectcomprehension" type)
              (make <comprehension>
               #:kind 'object
-              #:key (parse-literal (assoc-ref value "key"))
-              #:value (parse-literal (assoc-ref value "value"))
+              #:key (assoc-ref value "key")
+              #:value (assoc-ref value "value")
               #:body (extract-conjunction (preprocess-body (assoc-ref value "body")))))
             (else (error "unidentified type" type))))))
 
diff --git a/compiler/test.scm b/compiler/test.scm
index 53b51b7..23b6898 100644
--- a/compiler/test.scm
+++ b/compiler/test.scm
@@ -30,7 +30,6 @@
   #:use-module (compiler types)
   #:use-module (compiler utilities)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 pretty-print)
   #:use-module (oop goops)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
@@ -416,31 +415,31 @@ Error if POLICY has more than one rule."
 ;;
 ;; ↔
 ;;
-;; #<<object-literal> pairs: ...>
+;; #<<constant> value: #<<object-literal> pairs: ...>>
 
-;; (let ((parse-result (template-and-parse "naturals := { \"first\": 1, \"second\": 2 }")))
-;;   (pretty-print (to-pretty-sexp parse-result))
-;;   (match (select-rule parse-result)
-;;     (($ <rule>
-;;         _default
-;;         ($ <head> _name _kind _lhs
-;;            ($ <object-literal>
-;;               ((($ <constant> "first") ($ <constant> 1))
-;;                (($ <constant> "second") ($ <constant> 2)))))
-;;         _body)
-;;      (test-assert #t))))
+(let ((parse-result (template-and-parse "naturals := { \"first\": 1, \"second\": 2 }")))
+  (match (select-rule parse-result)
+    (($ <rule>
+        _default
+        ($ <head> _name _kind _lhs
+           ($ <constant>
+              ($ <object-literal>
+                 ((($ <constant> "first") ($ <constant> 1))
+                  (($ <constant> "second") ($ <constant> 2))))))
+        _body)
+     (test-assert #t))))
 
-;; (let ((parse-result (template-and-parse "naturals := { first: 1, second: 2 }")))
-;;   (pretty-print (to-pretty-sexp parse-result))
-;;   (match (select-rule parse-result)
-;;     (($ <rule>
-;;         _default
-;;         ($ <head> _name _kind _lhs
-;;            ($ <object-literal>
-;;               ((($ <constant> "first") ($ <constant> 1))
-;;                (($ <constant> "second") ($ <constant> 2)))))
-;;         _body)
-;;      (test-assert #t))))
+(let ((parse-result (template-and-parse "naturals := { first: 1, second: 2 }")))
+  (match (select-rule parse-result)
+    (($ <rule>
+        _default
+        ($ <head> _name _kind _lhs
+           ($ <constant>
+              ($ <object-literal>
+                 ((($ <variable-ref> "first") ($ <constant> 1))
+                  (($ <variable-ref> "second") ($ <constant> 2))))))
+        _body)
+     (test-assert #t))))
 
 ;; set             = empty-set | non-empty-set
 ;; non-empty-set   = "{" term { "," term } "}"
diff --git a/examples/13-else-keyword.rego b/examples/13-else-keyword.rego
new file mode 100644
index 0000000..f04887a
--- /dev/null
+++ b/examples/13-else-keyword.rego
@@ -0,0 +1,5 @@
+package examples.set_defined_by_predicate
+
+import future.keywords.if
+
+phi := 3.14159 if False else := 1.61803