work on pkgs

janet/parser.janet

@@ -843,6 +843,13 @@
  (advance parser)
  {:type :pkg-name :data (origin :lexeme) :token origin})
 
+ 
+(defn- pkg-name-only [parser]
+ (expect parser :pkg-name)
+ (def origin (current parser))
+ (advance parser)
+ {:type :pkg-name :data (origin :lexeme) :token origin})
+
 (defn- usee [parser]
  (def origin (current parser))
  (expect parser :use) (advance parser)
@@ -866,12 +873,19 @@
      (array/push (parser :errors) err)
      (error err))
     (case (-> parser current type)
+     :pkg-name (do
+      (def origin (current parser))
+      (def value (pkg-name-only parser))
+      (def key (keyword (value :data)))
+      (def pkg-kw-ast {:type :pkg-kw :data key :token origin})
+      (array/push data {:type :pkg-pair :data [pkg-kw-ast value] :token origin}))
      :keyword (do
       (def origin (current parser))
       (def key (capture kw parser))
       (def value (capture simple parser))
       (array/push data {:type :pair :data [key value] :token origin}))
      :word (do
+      (def origin (current parser))
       (def value (word-only parser))
       (def key (keyword (value :data)))
       (def kw-ast {:type :keyword :data key :token origin})
@@ -1113,19 +1127,20 @@
 )
 
 
-(do
+# (do
-# (comment
+(comment
 (def source `
-pkg Foo {foo, bar, :baz 42}
+pkg Baz {Foo, Bar}
 `)
 (def scanned (s/scan source))
 (print "\n***NEW PARSE***\n")
 (def a-parser (new-parser scanned))
-(def parsed (toplevel a-parser))
+(def parsed (script a-parser))
 
 # (print (pp-ast parsed))
 # (pp scanned)
 (pp parsed)
+(pp (a-parser :errors))
 # (def cleaned (get-in parsed [:data 2]))
 # (pp cleaned)
 )

janet/validate.janet

@@ -4,7 +4,7 @@
 
 Tracking here, before I start writing this code, the kinds of validation we're hoping to accomplish:
 
-* [ ] ensure called keywords are only called w/ one arg
+* [x] ensure called keywords are only called w/ one arg
 * [ ] first-level property access with pkg, e.g. `Foo :bar`--bar must be on Foo
  - [ ] accept pkg-kws
 * [x] validate dict patterns
@@ -25,6 +25,8 @@ Deferred until a later iteration of Ludus:
 * [ ] validate `with` forms
 )
 
+(def- package-registry @{})
+
 (try (os/cd "janet") ([_] nil))
 (import ./scanner :as s)
 (import ./parser :as p)
@@ -39,7 +41,7 @@ Deferred until a later iteration of Ludus:
 
 (var validate nil)
 
-(def terminals [:number :keyword :string :bool :nil :placeholder])
+(def terminals [:number :string :bool :nil :placeholder])
 
 (def simple-colls [:list :tuple :set :args])
 
@@ -330,16 +332,42 @@ Deferred until a later iteration of Ludus:
 
 ### TODO:
 # * [ ] ensure properties are on pkgs (if *only* pkgs from root)
-(defn- pkg-root [validator])
 
-(defn- tail-call [validator]
+(defn- pkg-root [validator]
+ (print "validating pkg-root access")
  (def ast (validator :ast))
- (when (ast :partial) (break validator))
+ (def ctx (validator :ctx))
- (def status (validator :status))
+ (def terms (ast :data))
- (when (not (status :tail)) (break validator))
+ (def pkg-name ((first terms) :data))
- (def data (ast :data))
+ (def the-pkg (resolve-name ctx pkg-name))
- (def args (last data))
+ (when (not the-pkg) 
- (set (args :tail-call) true))
+  (array/push (validator :errors)
+   {:node ast :msg "unbound pkg name"})
+  (break validator))
+ (def member (get terms 1))
+ (def accessed (case (member :type)
+  :keyword (get-in the-pkg [:pkg (member :data)])
+  :pkg-kw (get-in the-pkg [:pkg (member :data)])
+  :args (do
+   (array/push (validator :errors)
+    {:node member :msg "cannot call a pkg"}
+    (break validator)))))
+ (when (not accessed)
+  (print "no member " (member :data) " on " pkg-name)
+  (array/push (validator :errors)
+   {:node member :msg "invalid pkg access"})
+   (break validator))
+ # TODO: validate nested pkg access
+ )
+
+# (defn- tail-call [validator]
+#  (def ast (validator :ast))
+#  (when (ast :partial) (break validator))
+#  (def status (validator :status))
+#  (when (not (status :tail)) (break validator))
+#  (def data (ast :data))
+#  (def args (last data))
+#  (set (args :tail-call) true))
 
 (defn- check-arity [validator]
  (def ast (validator :ast))
@@ -386,13 +414,17 @@ Deferred until a later iteration of Ludus:
 (defn- synthetic [validator]
  (def ast (validator :ast))
  (def data (ast :data))
+ (def status (validator :status))
+ (def ftype ((first data) :type))
+ (def stype ((get data 1) :type))
+ (def ltype ((last data) :type))
+ (set (status :pkg-access?) nil)
+ (when (= ftype :pkg-name)
+  (set (status :pkg-access?) true))
  (each node data
   (set (validator :ast) node)
   (validate validator))
  (set (validator :ast) ast)
- (def ftype ((first data) :type))
- (def stype ((get data 1) :type))
- (def ltype ((last data) :type))
  (print "ftype " ftype)
  (print "stype " stype)
  (print "ltype " ltype)
@@ -468,6 +500,10 @@ Deferred until a later iteration of Ludus:
 
 (defn- pkg-entry [validator pkg]
  (def ast (validator :ast))
+ (def status (validator :status))
+ (when (= :pkg-pair (ast :type))
+  (set (status :pkg-access?) true))
+ (def data (ast :data))
  (def [key value] (ast :data))
  (print "PKG ENTRY***")
  (pp key)
@@ -476,9 +512,13 @@ Deferred until a later iteration of Ludus:
  (validate validator)
  (set (validator :ast) value)
  (validate validator)
+ (def entry (if (= :pkg-name (value :type))
+  (resolve-name (value :name) (validator :ctx))
+  value))
+ (set (status :pkg-access?) nil)
  (def kw (key :data))
  (pp kw)
- (set (pkg kw) value)
+ (set (pkg kw) entry)
  (pp pkg)
  validator)
 
@@ -605,14 +645,41 @@ Deferred until a later iteration of Ludus:
    {:node ast :msg "unbound name"}))
  validator)
 
+(defn- pkg-kw [validator]
+ (print "validating pkg-kw")
+ (def ast (validator :ast))
+ (def pkg-access? (get-in validator [:status :pkg-access?]))
+ (print "pkg-access? " pkg-access?)
+ (when (not pkg-access?)
+  (array/push (validator :errors)
+   {:node ast :msg "cannot use pkg-kw here"}))
+ validator)
+
+(defn- pkg-pair [validator]
+ (print "validating pkg-pair")
+ (def ast (validator :ast))
+ (def status (validator :status))
+ (def [_ pkg] (ast :data))
+ (set (status :pkg-access?) true)
+ (set (validator :ast) pkg)
+ (validate validator)
+ (set (status :pkg-access?) nil)
+ validator)
+
+(defn- kw [validator]
+ (def status (validator :status))
+ (set (status :pkg-access?) nil)
+ validator)
+
 (defn- validate* [validator]
  (def ast (validator :ast))
  (def type (ast :type))
  (print "validating node " type)
  (cond
-  (has-value? terminals type) true
+  (has-value? terminals type) validator
   (has-value? simple-colls type) (simple-coll validator)
   (case type
+   :keyword (kw validator)
    :if (iff validator) 
    :let (lett validator)
    :script (script validator)
@@ -630,9 +697,11 @@ Deferred until a later iteration of Ludus:
    :when (whenn validator)
    :splat (splat validator)
    :pair (pair validator)
+   :pkg-pair (pkg-pair validator)
    :ns (ns validator)
    :pkg (pkg validator)
    :pkg-name (pkg-name validator)
+   :pkg-kw (pkg-kw validator)
    :use (usee validator)
    :loop (loopp validator)
    :recur (recur validator)
@@ -650,12 +719,15 @@ Deferred until a later iteration of Ludus:
 
 (import ./base :as b)
 
-# (do
+(do
-(comment
+# (comment
 (def source `
-:foo (1, 2)
+let foo = 1
+pkg Foo {foo}
+pkg Baz {Foo}
+Foo :Baz
 `)
 (def scanned (s/scan source))
 (def parsed (p/parse scanned))
-(valid parsed b/ctx)
+(def validated (valid parsed b/ctx))
 )