Initial work

CS1032/practical-2023-09-27/challenges-1.janet

@@ -0,0 +1,4 @@
+(def names ["Monkey" "Rooster" "Dog" "Pig" "Rat" "Ox" "Tiger" "Hare" "Dragon" "Snake" "Horse" "Sheep"])
+
+
+(defn main [_ arg] (print (names (% (scan-number arg) 12))))

CS1032/practical-2023-09-27/challenges-2.janet

@@ -0,0 +1,15 @@
+(def grades {
+    "A+" "4.0"
+    "A"  "4.0"
+    "A-" "3.7"
+    "B+" "3.3"
+    "B" "3.0"
+    "B-" "2.7"
+    "C+" "2.3"
+    "C" "2.0"
+    "C-" "1.7"
+    "D+" "1.3"
+    "D" "1.0"
+})
+
+(defn main [_ arg] (print (or (grades arg) "Not a grade")))

CS1032/practical-2023-09-27/challenges-5.janet

@@ -0,0 +1,8 @@
+(def old (peg/compile ~(* (repeat 3 (range "AZ")) " " (repeat 3 (range "09")) -1)))
+(def new (peg/compile ~(* (repeat 4 (range "09")) " " (repeat 3 (range "AZ")) -1)))
+
+(defn main [_ arg] (print (cond
+	(peg/match old arg) "Old"
+	(peg/match new arg) "New"
+	true "Not a license plate"
+)))

CS1032/practical-2023-09-27/forth.janet

@@ -0,0 +1,117 @@
+(def grammar (peg/compile ~{
+  :main (* :tok (any (* :s+ :tok)) -1)
+  :tok (+ (<- :word) (number (some (+ (range "09") "."))))
+  :word (* :init-char (any :rest-char))
+  :init-char (+ (range "AZ") (range "az") (set ":/{}><,.[]+=-_*&^%$#@!;()"))
+  :rest-char (+ :init-char (range "09"))
+}))
+
+# State @{ :dictionary @{ word { :definition [word] :immediate } } :stack @[] :mode fn }
+(defn immediate [state word]
+  (cond
+    (or (number? word) (array? word) (tuple? word)) (array/push (state :stack) word)
+    (let
+      (word (or ((state :dictionary) word) (error (string "No such word defined: " word))))
+      ((word :definition) state)
+)))
+
+(defn deferred [state word] (let
+ (definition ((state :dictionary) word)) (if (and definition (definition :immediate))
+  (immediate state word)
+  (array/push (array/peek (state :stack)) word)
+)))
+
+(defmacro fixed-word [args ret] ~{
+  :definition (fn [state]
+    (do 
+      ,;(map (fn [name] ~(def ,name (,array/pop (state :stack)))) (reverse args))
+      (array/concat (state :stack) ,ret)
+    )
+  )
+})
+
+(defn run-state [state words]
+    (loop [word :in words] (:mode state word))
+)
+
+(defn word-as [& words] { :definition (fn [state] (run-state state words)) })
+
+(defn truthy [a] (and a (not (= a 0))))
+
+(def std-dict @{
+  "pick" (fixed-word [a b] [a b a])
+  "drop" (fixed-word [a] [])
+  "swap" (fixed-word [a b] [b a])
+  "dup" (fixed-word [a] [a a])
+  "-" (fixed-word [a b] (- a b))
+  "+" (fixed-word [a b] (+ a b))
+  "*" (fixed-word [a b] (* a b))
+  "/" (fixed-word [a b] (/ a b))
+  "=" (fixed-word [a b] (= a b))
+  ">" (fixed-word [a b] (> a b))
+  "<" (fixed-word [a b] (< a b))
+  "len" (fixed-word [a] (length a))
+  "true" (fixed-word [] true)
+  "false" (fixed-word [] false)
+  "dec" (word-as 1 "-")
+  "inc" (word-as 1 "+")
+  "negate" (word-as 0 "swap" "-")
+  "." (fixed-word [a] (do (print a) []))
+  ".s" { :definition (fn [state] (pp (state :stack)))}
+  "{" { :definition (fn [state] 
+    (array/push (state :stack) @[])
+    (set (state :mode) deferred)
+  )}
+  "}" { :definition (fn [state]
+    (def words (array/peek (state :stack)))
+    (if (> (count |(= $ "{") words) (count |(= $ "}") words))
+      (array/push words "}")
+      (do
+        (def dictionary (table/clone (state :dictionary)))
+        (array/pop (state :stack)) # Remove wordlist that's on stack top
+        (array/push (state :stack) (fn [state &opt recur]
+          (when recur (set (dictionary "recur") { :definition recur }))
+          (def state @{ :dictionary dictionary :stack (state :stack) :mode immediate })
+          (run-state state words)
+        ))
+        (set (state :mode) immediate)
+      )
+    )
+  ) :immediate true }
+  "()" { :definition (fn [state] ((array/pop (state :stack)) state)) }
+  ":" { :definition (fn [state] 
+    (set (state :mode) (fn [state word]
+      (def exec (array/pop (state :stack)))
+      (set ((state :dictionary) word) { :definition (fn [state] (exec state exec)) })
+      (set (state :mode) immediate)
+    ))
+  )}
+  "if" (fixed-word [cond when-true when-false] (do ((if (truthy cond) when-true when-false) state) []))
+  "loop" { :definition (fn [state]
+    (def body (array/pop (state :stack)))
+    (body state)
+    (while (truthy (array/pop (state :stack))) (body state))
+  )}
+  "while" { :definition (fn [state]
+    (def body (array/pop (state :stack)))
+    (while (truthy (array/pop (state :stack))) (body state))
+  )}
+  "repeat" (fixed-word [count body] (for x 0 count (body state)))
+  "[" { :immediate true :definition (fn [state] 
+    (set (state :mode) immediate)
+  )}
+  "]" { :definition (fn [state]
+    (def val (array/pop (state :stack)))
+    (array/push (array/peek (state :stack)) val)
+    (set (state :mode) deferred)
+  )}
+})
+
+
+
+(defn main [_ arg] (let (
+    words (peg/match grammar arg)
+    state @{ :dictionary (table/clone std-dict) :stack @[] :mode immediate }
+  )
+    (run-state state words)
+))