add janet functions

This commit is contained in:
Scott Richmond 2024-05-19 16:18:52 -04:00
parent a06014270f
commit 24bbef74aa

View File

@ -226,6 +226,7 @@
(print "value is a dictionary") (print "value is a dictionary")
(value :^type))) (value :^type)))
(def type (if typed? typed? (type value))) (def type (if typed? typed? (type value)))
(print "value of type " type)
(case type (case type
:nil "" :nil ""
:number (string value) :number (string value)
@ -241,6 +242,8 @@
(string/join (map stringify (keys value)) ", ") (string/join (map stringify (keys value)) ", ")
:ref (stringify (value :^value)) :ref (stringify (value :^value))
:fn (string "fn " (value :name)) :fn (string "fn " (value :name))
:function (string "builtin " (string value))
:cfunction (string "builtin " (string value))
# XXX: pkg, fn # XXX: pkg, fn
)) ))
@ -403,6 +406,7 @@
(match types (match types
[:fn :tuple] (call-fn prev curr) [:fn :tuple] (call-fn prev curr)
[:fn :partial] (partial prev curr) [:fn :partial] (partial prev curr)
[:function :tuple] (prev ;curr)
[:keyword :args] (get (first curr) prev :^nil) [:keyword :args] (get (first curr) prev :^nil)
[:dict :keyword] (get prev curr :^nil) [:dict :keyword] (get prev curr :^nil)
[:nil :keyword] :^nil [:nil :keyword] :^nil
@ -428,6 +432,18 @@
(defn- doo [ast ctx] (todo "do expressions")) (defn- doo [ast ctx] (todo "do expressions"))
(defn- pkg [ast ctx] (todo "pkgs"))
(defn- ns [ast ctx] (todo "nses"))
(defn- loopp [ast ctx] (todo "loops"))
(defn- recur [ast ctx] (todo "recur"))
(defn- repeatt [ast ctx] (todo "repeat"))
(defn - testt [ast ctx] (todo "test"))
(defn- interpret* [ast ctx] (defn- interpret* [ast ctx]
(print "interpreting node " (ast :type)) (print "interpreting node " (ast :type))
(case (ast :type) (case (ast :type)
@ -453,6 +469,11 @@
:script (script ast ctx) :script (script ast ctx)
:panic (panic ast ctx) :panic (panic ast ctx)
# looping forms
:loop (loopp ast ctx)
:recur (recur ast ctx)
:repeat (repeatt ast ctx)
# named/naming forms # named/naming forms
:word (word ast ctx) :word (word ast ctx)
:interpolated (interpolated ast ctx) :interpolated (interpolated ast ctx)
@ -463,7 +484,6 @@
# patterned forms # patterned forms
:let (lett ast ctx) :let (lett ast ctx)
:match (matchh ast ctx) :match (matchh ast ctx)
# :with (withh ast ctx)
# functions # functions
:fn (fnn ast ctx) :fn (fnn ast ctx)
@ -474,6 +494,10 @@
# do # do
:do (doo ast ctx) :do (doo ast ctx)
# deferred until after computer class
# :with (withh ast ctx)
# :import (importt ast ctx)
)) ))
(set interpret interpret*) (set interpret interpret*)
@ -488,16 +512,24 @@
(defn- has-errors? [{:errors errors}] (and errors (not (empty? errors)))) (defn- has-errors? [{:errors errors}] (and errors (not (empty? errors))))
(def base {
"ludus-type" ltype
"print" print
"add" +
"sub" -
"stringify" stringify
})
(defn run [] (defn run []
(def scanned (s/scan source)) (def scanned (s/scan source))
(when (has-errors? scanned) (break (scanned :errors))) (when (has-errors? scanned) (break (scanned :errors)))
(def parsed (p/parse scanned)) (def parsed (p/parse scanned))
(when (has-errors? parsed) (break (parsed :errors))) (when (has-errors? parsed) (break (parsed :errors)))
(def validated (v/valid parsed)) (def validated (v/valid parsed base))
(when (has-errors? validated) (break (validated :errors))) (when (has-errors? validated) (break (validated :errors)))
(def cleaned (get-in parsed [:ast :data 1])) # (def cleaned (get-in parsed [:ast :data 1]))
(pp cleaned) # (pp cleaned)
(interpret (parsed :ast) @{}) (interpret (parsed :ast) @{:^parent base})
# (try (interpret (parsed :ast) @{}) # (try (interpret (parsed :ast) @{})
# ([e] (print "Ludus panicked!: " # ([e] (print "Ludus panicked!: "
# (if (struct? e) (error (e :msg)) (error e))))) # (if (struct? e) (error (e :msg)) (error e)))))
@ -505,9 +537,11 @@
(do (do
(set source ` (set source `
#{:a 1, :b 2} print
`) `)
(def result (run)) (def result (run))
(stringify result) (stringify result)
) )
(string print)