I keep working, shit's not working

janet/base.janet

@@ -46,7 +46,6 @@
       (string/join (map stringify (keys value)) ", ")
     :box (stringify (value :^value))
     :fn (string "fn " (value :name))
-    :applied (string "fn " (value :name))
     :function (string "builtin " (string value))
     :pkg (dict-str value)
   ))
@@ -72,7 +71,7 @@
     :pkg (show-pkg x)
     (stringify x)))
 
-(defn- show-patt [x]
+(defn show-patt [x]
   (case (x :type)
     :nil "nil"
     :bool (string (x :data))
@@ -87,6 +86,7 @@
     :typed (string (show-patt (get-in x [:data 1])) " as " (show-patt (get-in x [:data 0])))
     :interpolated (get-in x [:token :lexeme])
     :string (get-in x [:token :lexeme])
+    :splat (string "..." (when (x :splatted) (show-patt (x :splatted))))
     (error (string "cannot show pattern of unknown type " (x :type)))))
 
 (defn pretty-patterns [fnn]
@@ -165,7 +165,7 @@
     :set (-> x (dissoc :^type) keys)
     @[x]))
 
-(defn print! [& args]
+(defn print! [args]
   (print ;(map show args)))
 
 (defn prn [x]
@@ -178,9 +178,9 @@
     :list (array/concat @[] x y ;zs)
     :set (merge x y ;zs)))
 
-(defn unbox [x] (get x :^value))
+(defn unbox [b] (get b :^value))
 
-(defn store! [x] (set (x :^value) x))
+(defn store! [b x] (set (b :^value) x))
 
 (def ctx {
   "print!" print!

janet/errors.janet

@@ -47,8 +47,20 @@
  (print "with " (b/show value))
  (print "expecting to match one of")
  (print (b/pretty-patterns called))
+ (print source-line)
 )
 
+(defn- let-no-match [e]
+ (print "Ludus panicked! no match")
+ (def line-num (get-in e [:node :token :line]))
+ (def source (get-in e [:node :token :source]))
+ (def source-line (get-line source line-num))
+ (print "on line " line-num)
+ (print "binding " (b/show (e :value)))
+ (def pattern (get-in e [:node :data 0]))
+ (print "to " (b/show-patt pattern))
+ (print source-line))
+
 (defn- generic-panic [e]
  (def msg (e :msg))
  (def line-num (get-in e [:node :token :line]))
@@ -59,10 +71,20 @@
  (print source-line)
 )
 
+(defn- unbound-name [e]
+ (def {:line line-num :source source :lexeme name} (get-in e [:node :token]))
+ (def source-line (get-line source line-num))
+ (print "Ludus panicked! unbound name " name)
+ (print "on line " line-num)
+ (print source-line)
+)
+
 (defn runtime-error [e]
- (pp e)
+ (when (= :string (type e)) (print e) (break e))
  (def msg (e :msg))
  (case msg
   "no match: function call" (fn-no-match e)
-  (generic-panic e)
+  "no match: let binding" (let-no-match e)
+  "unbound name" (unbound-name e)
+  (generic-panic e))
  e)

janet/interpreter.janet

@@ -370,7 +370,7 @@
 (defn- fnn [ast ctx]
   (def {:name name :data clauses :doc doc} ast)
   # (print "defining fn " name)
-  (def closure (table/to-struct ctx))
+  (def closure (merge ctx))
   (def the-fn @{:name name :^type :fn :body clauses :ctx closure :doc doc})
   (when (not= :^not-found (resolve-name name ctx))
   #   (print "fn "name" was forward declared")
@@ -382,6 +382,7 @@
   #   (pp fwd)
     (break fwd))
   # (pp the-fn)
+  (set (closure name) the-fn)
   (set (ctx name) the-fn)
   the-fn)
 
@@ -389,10 +390,10 @@
 
 (var call-fn nil)
 
-(def name "foo")
-(eval ~(fn ,(symbol name) [] :foo))
-
-(defn- partial [the-fn partial-args] 
+(defn- partial [root-ast the-fn partial-args] 
+  (when (the-fn :applied)
+    (error {:msg "cannot partially apply a partially applied function"
+      :node root-ast :called the-fn :args partial-args}))
   # (print "calling partially applied function")
   (def args (partial-args :args))
   # (pp args)
@@ -405,7 +406,7 @@
     (set (full-args pos) missing)
   #   (print "all args: " (b/show full-args))
     (call-fn root-ast the-fn [;full-args]))
-  {:^type :applied :name name :body partial-fn})
+  {:^type :fn :applied true :name name :body partial-fn})
 
 (defn- call-fn* [root-ast the-fn args]
    # (print "on line " (get-in root-ast [:token :line]))
@@ -456,9 +457,9 @@
   # (pp types)
   (match types
     [:fn :tuple] (call-fn root-ast prev curr)
-    [:fn :partial] (partial prev curr)
+    [:fn :partial] (partial root-ast prev curr)
     [:function :tuple] (call-fn root-ast prev curr)
-    [:applied :tuple] (call-partial root-ast prev curr)
+    # [:applied :tuple] (call-partial root-ast prev curr)
     [:keyword :args] (get (first curr) prev :^nil)
     [:dict :keyword] (get prev curr :^nil)
     [:nil :keyword] :^nil
@@ -643,11 +644,14 @@
   (try (interpret (parsed :ast) @{:^parent b/ctx})
     ([e] (if (struct? e) (error (e :msg)) (error e)))))
 
-(do 
+# (do 
+(comment
 (set source `
-box foo = :bar
+fn call_unary (f, arg) -> f (arg)
+fn my_add (x, y) -> add (x, y)
+let add5 = my_add (5, _)
+call_unary (add5, 10)
 `)
 (def result (run))
-(b/show result)
 )
 

janet/load-prelude.janet

@@ -0,0 +1,29 @@
+(try (os/cd "janet") ([_] nil))
+(import /base :as b)
+(import /scanner :as s)
+(import /parser :as p)
+(import /validate :as v)
+(import /interpreter :as i)
+(import /errors :as e)
+
+(def pkg (do 
+  (def prelude-ctx @{:^parent {"base" b/base}})
+  (def prelude-src (slurp "prelude.ld"))
+  (def prelude-scanned (s/scan prelude-src))
+  (def prelude-parsed (p/parse prelude-scanned))
+  (def parse-errors (prelude-parsed :errors))
+  (when (any? parse-errors) (each err parse-errors (e/parse-error err)) (break :error))
+  (def prelude-validated (v/valid prelude-parsed prelude-ctx))
+  (def validation-errors (prelude-validated :errors))
+  (when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error))
+  (try 
+   (i/interpret (prelude-parsed :ast) prelude-ctx)
+   ([err] (e/runtime-error err) :error))))
+
+(def ctx (do
+  (def ctx @{})
+  (each [k v] (pairs pkg)
+    (set (ctx (string k)) v))
+  (set (ctx "^name") nil)
+  (set (ctx "^type") nil)
+  ctx))

janet/ludus.janet

@@ -6,6 +6,7 @@
 (import /interpreter :as i)
 (import /errors :as e)
 (import /base :as b)
+(import /load-prelude :as prelude)
 (import spork/json :as j)
 
 (comment
@@ -19,30 +20,8 @@ This new scene will have to return a JSON POJSO:
 {:console "..." :result "..." :draw [...] :errors [...]}
 )
 
-(def prelude-ctx @{:^parent {"base" b/base}})
-
-# (comment
-# (do
-(def prelude-ctx @{:^parent {"base" b/base}})
-(def prelude-src (slurp "prelude.ld"))
-(def prelude-scanned (s/scan prelude-src))
-(def prelude-parsed (p/parse prelude-scanned))
-(def parse-errors (prelude-parsed :errors))
-(when (any? parse-errors) (each err parse-errors (e/parse-error err)))
-(def prelude-validated (v/valid prelude-parsed prelude-ctx))
-(def validation-errors (prelude-validated :errors))
-(when (any? validation-errors) (each err validation-errors (e/validation-error err)))
-(def prelude-pkg (try 
- (i/interpret (prelude-parsed :ast) prelude-ctx)
- ([e] e)))
-
-(keys prelude-pkg)
-(prelude-pkg :msg)
-(e/runtime-error prelude-pkg)
-# )
-
-
 (defn run [source]
+ (def ctx @{:^parent prelude/ctx})
  (def errors @[])
  (def draw @[])
  (var result @"")
@@ -57,30 +36,24 @@ This new scene will have to return a JSON POJSO:
  (when (any? (parsed :errors))
   (break (each err (parsed :errors)
    (e/parse-error err))))
- (def validated (v/valid parsed prelude-ctx))
+ (def validated (v/valid parsed ctx))
  (when (any? (validated :errors))
   (break (each err (validated :errors)
    (e/validation-error err))))
  (setdyn :out console)
+ (print "starting ludus run")
  (try
-  (set result (b/show (i/interpret (parsed :ast) prelude-ctx)))
+  (set result (b/show (i/interpret (parsed :ast) ctx)))
   ([err] (setdyn :out stdout) (e/runtime-error err)))
  (setdyn :out stdout)
  (set (out :result) result)
- (j/encode out))
-
-(defn test [source])
-
-(defn run-script [filename]
- (def source (slurp filename))
- (run source))
+ result)
 
+(do
 (def source `
-let pi = base :pi
-pi
+print! ("hello")
 `)
 
-b/base
-
-(-> source run j/decode)
+(-> source run)
+)
 

janet/parser.janet

@@ -1117,10 +1117,10 @@
 
 # (do
 (comment
-(def source `fn () -> 42
+(def source `...
 `)
 (def scanned (s/scan source))
 # (print "\n***NEW PARSE***\n")
 (def a-parser (new-parser scanned))
-(def parsed (fnn a-parser))
+(def parsed (splat a-parser))
 )

janet/prelude.ld

@@ -282,7 +282,11 @@ fn show {
 
 fn prn! {
 	"Prints the underlying Clojure data structure of a Ludus value."
-	(x) -> base :prn (x)
+	(x) -> {
+		base :prn (x)
+		add_msg! (x)
+		:ok
+	}
 }
 
 fn report! {
@@ -352,7 +356,10 @@ fn unbox {
 
 fn store! {
 	"Stores a value in a box, replacing the value that was previously there. Returns the value."
-	(b as :box, value) -> base :set! (b, value)
+	(b as :box, value) -> {
+		base :store! (b, value)
+		value
+	}
 }
 
 fn update! {
@@ -566,12 +573,12 @@ fn at {
 	(xs as :list, n as :number) -> when {
 		neg? (n) -> nil
 		gte? (n, count (xs)) -> nil
-		true -> base :nth (xs, inc (n))
+		true -> base :nth (n, xs)
 	}
 	(xs as :tuple, n as :number) -> when {
 		neg? (n) -> nil
 		gte? (n, count (xs)) -> nil
-		true -> base :nth (xs, inc (n))
+		true -> base :nth (n, xs)
 	}
 	(_) -> nil
 }
@@ -792,9 +799,6 @@ fn each! {
 
 let pi = base :pi
 
-print! (base :pi)
-print! (pi)
-
 let tau = mult (2, pi)
 
 fn sin {
@@ -1270,136 +1274,154 @@ fn penwidth {
 }
 
 pkg Prelude {
-	type
-	eq?
-	neq?
-	tuple?
-	fn?
-	empty?
-	any?
-	first
-	second
-	rest
-	at
-	last
-	butlast
-	slice
-	count
-	append
-	fold
-	map
-	filter
-	keep
-	list
-	set
-	set?
-	inc
-	dec
-	print!
-	flush!
-	console
-	show
-	prn!
-	report!
-	doc!
-	concat
-	box?
-	unbox
-	store!
-	update!
-	string
-	string?
-	join
+	abs
 	add
-	sub
-	mult
+	and
+	angle
+	any?
+	append
+	assert!
+	assoc
+	assoc?
+	at
+	atan/2
+	back!
+	background!
+	between?
+	bg!
+	bgcolor
+	bk!
+	bool
+	bool?
+	box?
+	butlast
+	ceil
+	clear!
+	coll?
+	colors
+	concat
+	console
+	cos
+	count
+	dec
+	deg/rad
+	deg/turn
+	dict
+	dict?
+	diff
+	dissoc
+	dist
 	div
 	div/0
 	div/safe
-	inv
-	inv/0
-	angle
-	abs
-	neg
-	zero?
-	neg?
-	pos?
-	even?
-	odd?
-	gt?
-	gte?
-	lt?
-	lte?
-	min
-	max
-	between?
-	keyword?
-	nil?
-	some?
-	some
-	bool?
-	false?
-	bool
-	not
-	and
-	or
-	coll?
-	ordered?
-	assoc?
-	assoc
-	dissoc
-	update
-	get
-	dict
-	dict?
-	keys
-	values
-	diff
+	doc!
 	each!
-	sin
-	cos
-	tan
-	turn/rad
-	rad/turn
-	turn/deg
-	deg/turn
-	rad/deg
-	deg/rad
-	atan/2
-	mod
-	square
-	sum_of_squares
-	dist
-	random
-	random_int
-	pi
-	tau
-	floor
-	ceil
-	round
-	range
-	ok
-	ok?
+	empty?
+	eq?
 	err
 	err?
+	even?
+	false?
+	fd!
+	filter
+	first
+	floor
+	flush!
+	fn?
+	fold
+	forward!
+	get
+	goto!
+	gt?
+	gte?
+	heading
+	heading/vector
+	home!
+	inc
+	inv
+	inv/0
+	join
+	keep
+	keys
+	keyword?
+	last
+	left!
+	list
+	lt!
+	lt?
+	lte?
+	map
+	max
+	min
+	mod
+	mult
+	neg
+	neg?
+	neq?
+	nil?
+	not
+	odd?
+	ok
+	ok?
+	or
+	ordered?
+	p5_calls
+	pc!
+	pd!
+	pencolor
+	pencolor!
+	pendown!
+	pendown?
+	penup!
+	penwidth
+	penwidth!
+	pi
+	pos?
+	position
+	print!
+	prn!
+	pu!
+	pw!
+	rad/deg
+	rad/turn
+	random
+	random_int
+	range
+	render_turtle!
+	report!
+	reset_turtle!
+	rest
+	right!
+	round
+	rt!
+	second
+	set
+	set?
+	show
+	sin
+	slice
+	some
+	some?
+	square
+	store!
+	string
+	string?
+	sub
+	sum_of_squares
+	tan
+	tau
+	tuple?
+	turn/deg
+	turn/rad
+	turtle_commands
+	turtle_state
+	turtle_states
+	type
+	unbox
 	unwrap!
 	unwrap_or
-	assert!
-	colors
-	forward!, fd!
-	back!, bk!
-	right!, rt!
-	left!, lt!
-	penup!, pu!
-	pendown!, pd!
-	pencolor!, pc!
-	background!, bg!
-	penwidth!, pw!
-	home!, clear!, goto!,
-	heading, position, pendown?
-	pencolor, penwidth
-	heading/vector
-	turtle_state
-	p5_calls, turtle_states, turtle_commands, bgcolor
-	render_turtle!, reset_turtle!
+	update
+	update!
+	values
+	zero?
 }

janet/validate.janet

@@ -296,7 +296,7 @@ Deferred until a later iteration of Ludus:
 (defn- fnn [validator]
  (def ast (validator :ast))
  (def name (ast :name))
- (print "function name: " name)
+ # (print "function name: " name)
  (def status (validator :status))
  (def tail? (status :tail))
  (set (status :tail) true)