fix a bear of a bug with accidentally persisting loop contexts

janet/errors.janet

@@ -44,8 +44,7 @@
  (print "with " (b/show value))
  (print "expecting to match one of")
  (print (b/pretty-patterns called))
- (print source-line)
+ (print source-line))
-)
 
 (defn- let-no-match [e]
  (print "Ludus panicked! no match")
@@ -63,16 +62,14 @@
  (def source-line (get-line source line-num))
  (print "Ludus panicked! " msg)
  (print "on line " line-num " in " input)
- (print source-line)
+ (print source-line))
-)
 
 (defn- unbound-name [e]
  (def {:line line-num :source source :lexeme name :input input} (get-in e [:node :token]))
  (def source-line (get-line source line-num))
  (print "Ludus panicked! unbound name " name)
  (print "on line " line-num " in " input)
- (print source-line)
+ (print source-line))
-)
 
 (defn runtime-error [e]
  (when (= :string (type e)) (print e) (break e))

janet/interpreter.janet

@@ -307,7 +307,7 @@
   (def the-set @{:^type :set})
   (each member members
     (def value (interpret member ctx))
-    (set (the-set member) true))
+    (set (the-set value) true))
   the-set)
 
 (defn- list [ast ctx]
@@ -510,13 +510,13 @@
   # (print "looping!")
   (def data (ast :data))
   (def args (interpret (data 0) ctx))
-  (when (ast :match) (break ((ast :match) 0 args)))
+  # this doesn't work: context persists between different interpretations
+  # we want functions to work this way, but not loops (I think)
+  # (when (ast :match) (break ((ast :match) 0 args)))
   (def clauses (data 1))
   (def len (length clauses))
-  (def loop-ctx @{:^parent ctx})
+  (var loop-ctx @{:^parent ctx})
   (defn match-fn [i args]
-  #   (print "calling inner loop fn")
-  #   (print "for the " i "th time")
     (when (= len i)
       (error {:node ast :value args :msg "no match: loop"}))
     (def clause (clauses i))
@@ -647,10 +647,7 @@
 # (do 
 (comment
 (set source `
-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))
 )

janet/load-prelude.janet

@@ -7,17 +7,17 @@
 (import /errors :as e)
 
 (def pkg (do 
-  (def prelude-ctx @{:^parent {"base" b/base}})
+  (def pre-ctx @{:^parent {"base" b/base}})
-  (def prelude-src (slurp "prelude.ld"))
+  (def pre-src (slurp "prelude.ld"))
-  (def prelude-scanned (s/scan prelude-src :prelude))
+  (def pre-scanned (s/scan pre-src :prelude))
-  (def prelude-parsed (p/parse prelude-scanned))
+  (def pre-parsed (p/parse pre-scanned))
-  (def parse-errors (prelude-parsed :errors))
+  (def parse-errors (pre-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 pre-validated (v/valid pre-parsed pre-ctx))
-  (def validation-errors (prelude-validated :errors))
+  (def validation-errors (pre-validated :errors))
   (when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error))
   (try 
-   (i/interpret (prelude-parsed :ast) prelude-ctx)
+   (i/interpret (pre-parsed :ast) pre-ctx)
    ([err] (e/runtime-error err) :error))))
 
 (def ctx (do
@@ -28,15 +28,16 @@
   (set (ctx "^type") nil)
   ctx))
 
-(def post/src (slurp "postlude.ld"))
+# (def post/src (slurp "postlude.ld"))
+
+# (def post/ast (do
+#   (def post-ctx @{:^parent ctx})
+#   (def post-scanned (s/scan post/src :postlude))
+#   (def post-parsed (p/parse post-scanned))
+#   (def parse-errors (post-parsed :errors))
+#   (when (any? parse-errors) (each err parse-errors (e/parse-error err)) (break :error))
+#   (def post-validated (v/valid post-parsed post-ctx))
+#   (def validation-errors (post-validated :errors))
+#   (when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error))
+#   post-parsed))
 
-(def post/ast (do
-  (def post-ctx @{:^parent ctx})
-  (def post-scanned (s/scan post/src :postlude))
-  (def post-parsed (p/parse post-scanned))
-  (def parse-errors (post-parsed :errors))
-  (when (any? parse-errors) (each err parse-errors (e/parse-error err)) (break :error))
-  (def post-validated (v/valid prelude-parsed post-ctx))
-  (def validation-errors (prelude-validated :errors))
-  (when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error))
-  post-parsed))

janet/ludus.janet

@@ -21,6 +21,7 @@ This new scene will have to return a JSON POJSO:
 )
 
 (defn run [source]
+ (when (= :error prelude/pkg) (error "could not load prelude"))
  (def ctx @{:^parent prelude/ctx})
  (def errors @[])
  (def draw @[])
@@ -40,18 +41,18 @@ This new scene will have to return a JSON POJSO:
  (when (any? (validated :errors))
   (break (each err (validated :errors)
    (e/validation-error err))))
- (setdyn :out console)
+ # (setdyn :out console)
- (print "starting ludus run")
  (try
-  (set result (b/show (i/interpret (parsed :ast) ctx)))
+  (set result (i/interpret (parsed :ast) ctx))
-  ([err] (setdyn :out stdout) (e/runtime-error err)))
+  ([err] (comment setdyn :out stdout) (e/runtime-error err)))
- (setdyn :out stdout)
+ # (setdyn :out stdout)
  (set (out :result) result)
  result)
 
 (do
 (def source `
-
+forward! (100)
+p5_calls
 `)
 
 (-> source run)
@@ -63,3 +64,4 @@ Next up:
 * testing turtle graphics
 )
 
+

janet/prelude.ld

@@ -188,7 +188,9 @@ fn set? {
 fn fold {
 	"Folds a list."
 	(f as :fn, xs as :list) -> fold (f, xs, f ())
-	(f as :fn, xs as :list, root) -> loop (root, first (xs), rest (xs)) with {
+	(f as :fn, xs as :list, root) -> {
+		base :print! (("folding ", xs, " with ", f))
+		loop (root, first (xs), rest (xs)) with {
 			(prev, curr, []) -> f (prev, curr)
 			(prev, curr, remaining) -> recur (
 				f (prev, curr)
@@ -196,6 +198,7 @@ fn fold {
 				rest (remaining)
 			)
 		}
+	}
 }
 
 & TODO: optimize these with base :conj!
@@ -237,7 +240,7 @@ fn append {
 
 fn concat {
 	"Combines two lists, strings, or sets."
-	(x as :string, y as :string) -> base :str (x, y)
+	(x as :string, y as :string) -> base :concat (x, y)
 	(xs as :list, ys as :list) -> base :concat (xs, ys)
 	(xs as :set, ys as :set) -> base :concat (xs, ys)
 	(xs, ys, ...zs) -> fold (concat, zs, concat (xs, ys))
@@ -261,7 +264,9 @@ fn add_msg! {
 	"Adds a message to the console."
 	(msg as :string) -> update! (console, append (_, msg))
 	(msgs as :list) -> {
+		base :print! (("adding msg", msgs))
 		let msg =	do msgs > map (string, _) > join 
+		base :print! (("msg: ", msg))
 		update! (console, append (_, msg))
 	}
 }
@@ -269,7 +274,7 @@ fn add_msg! {
 fn print! {
 	"Sends a text representation of Ludus values to the console."
 	(...args) -> {
-		base :print (args)
+		base :print! (args)
 		add_msg! (args)
 		:ok
 	}
@@ -1048,6 +1053,7 @@ box bgcolor = colors :black
 fn add_call! (call) -> update! (p5_calls, append (_, call))
 
 fn add_command! (command) -> {
+	print! ("adding command", command)
 	update! (turtle_commands, append (_, command))	
 	let prev = do turtle_states > unbox > last
 	let curr = apply_command (prev, command)
@@ -1070,7 +1076,7 @@ fn render_turtle! () -> {
 		then {
 			let (r, g, b, a) = turtle_color
 			add_call! ((:fill, r, g, b, a))
-			let #{heading, :position (x, y)} = state
+			let #{heading, :position (x, y), ...} = state
 			let first = mult ((0, 1), turtle_radius)
 			let (x1, y1) = first
 			let (x2, y2) = rotate (first, turtle_angle)
@@ -1224,13 +1230,13 @@ fn apply_command {
 		(:right, turns) -> update (state, :heading, add (_, turns))
 		(:left, turns) -> update (state, :heading, sub (_, turns))
 		(:forward, steps) -> {
-			let #{heading, position} = state
+			let #{heading, position, ...} = state
 			let unit = heading/vector (heading)
 			let vect = mult (steps, unit)
 			update (state, :position, add (vect, _))
 		}
 		(:back, steps) -> {
-			let #{heading, position} = state
+			let #{heading, position, ...} = state
 			let unit = heading/vector (heading)
 			let vect = mult (steps, unit)
 			update (state, :position, sub (_, vect))