Merge pull request #212 from calcit-lang/tuple-with-class

new function &tuple:with-class

Cargo.toml

@@ -1,6 +1,6 @@
 [package]
 name = "calcit"
-version = "0.7.0"
+version = "0.7.2"
 authors = ["jiyinyiyong <[email protected]>"]
 edition = "2021"
 license = "MIT"

calcit/test.cirru

@@ -296,6 +296,13 @@
               :: :t 1
               :: :t 1 2
 
+            let
+                a $ :: :a 1
+                %r $ defrecord! %demo
+                  :get $ fn (self) 1
+                b $ &tuple:with-class a %r
+              assert= %r $ &tuple:class b
+
         |test-effect $ quote
           fn ()
             log-title "|Testing effect"

package.json

@@ -1,6 +1,6 @@
 {
   "name": "@calcit/procs",
-  "version": "0.7.0",
+  "version": "0.7.2",
   "main": "./lib/calcit.procs.mjs",
   "devDependencies": {
     "@types/node": "^20.2.5",

src/builtins.rs

@@ -78,6 +78,7 @@ fn handle_proc_internal(name: CalcitProc, args: &CalcitItems, call_stack: &CallS
     CalcitProc::NativeTupleAssoc => meta::assoc(args),
     CalcitProc::NativeTupleCount => meta::tuple_count(args),
     CalcitProc::NativeTupleClass => meta::tuple_class(args),
+    CalcitProc::NativeTupleWithClass => meta::tuple_with_class(args),
     // effects
     CalcitProc::NativeDisplayStack => meta::display_stack(args, call_stack),
     CalcitProc::Raise => effects::raise(args),

src/builtins/meta.rs

@@ -466,6 +466,20 @@ pub fn tuple_class(xs: &CalcitItems) -> Result<Calcit, CalcitErr> {
   }
 }
 
+pub fn tuple_with_class(xs: &CalcitItems) -> Result<Calcit, CalcitErr> {
+  if xs.len() != 2 {
+    return CalcitErr::err_str(format!("tuple:with-class expected 2 arguments, got: {xs:?}"));
+  }
+  match (&xs[0], &xs[1]) {
+    (Calcit::Tuple(tag, extra, _), b @ Calcit::Record(..)) => {
+      Ok(Calcit::Tuple(tag.to_owned(), extra.to_owned(), Arc::new(b.to_owned())))
+    }
+    (a, Calcit::Record(..)) => CalcitErr::err_str(format!("&tuple:with-class expected a tuple, got: {a}")),
+    (Calcit::Tuple(..), b) => CalcitErr::err_str(format!("&tuple:with-class expected second argument in record, got: {b}")),
+    (a, b) => CalcitErr::err_str(format!("&tuple:with-class expected a tuple and a record, got: {a} {b}")),
+  }
+}
+
 pub fn no_op() -> Result<Calcit, CalcitErr> {
   Ok(Calcit::Nil)
 }

src/cirru/calcit-core.cirru

@@ -1817,3 +1817,10 @@
             if (some? y)
               range (inc (&- (&+ x x) y)) y
               range (inc (negate x)) x
+
+        |: $ quote
+          defmacro : (tag & args)
+            quasiquote
+              ::
+                ~ $ turn-tag tag
+                ~@ args

src/data/cirru.rs

@@ -27,7 +27,7 @@ pub fn code_to_calcit(xs: &Cirru, ns: Arc<str>, def: Arc<str>, coord: &[u8]) ->
         location: Some(coord.to_vec()),
       }),
       _ => match s.chars().next().expect("load first char") {
-        ':' => Ok(Calcit::tag(&s[1..])),
+        ':' if s.len() > 1 && s.chars().nth(1) != Some(':') => Ok(Calcit::tag(&s[1..])),
         '.' => {
           if let Some(stripped) = s.strip_prefix(".-") {
             Ok(Calcit::Method(stripped.into(), MethodKind::Access))

src/primes.rs

@@ -187,12 +187,10 @@ impl fmt::Display for Calcit {
       Calcit::Tuple(tag, extra, _class) => {
         let mut extra_str = String::from("");
         for item in extra {
-          if !extra_str.is_empty() {
-            extra_str.push(' ');
-          }
+          extra_str.push(' ');
           extra_str.push_str(&item.to_string())
         }
-        f.write_str(&format!("(:: {tag} {extra_str})"))
+        f.write_str(&format!("(:: {tag}{extra_str})"))
       }
       Calcit::Buffer(buf) => {
         f.write_str("(&buffer")?;

src/primes/proc_name.rs

@@ -30,6 +30,7 @@ pub enum CalcitProc {
   NativeTupleAssoc,
   NativeTupleCount,
   NativeTupleClass,
+  NativeTupleWithClass,
   NativeDisplayStack,
   Raise,
   Quit,
@@ -207,6 +208,7 @@ impl FromStr for CalcitProc {
       "&tuple:assoc" => Ok(Self::NativeTupleAssoc),
       "&tuple:count" => Ok(Self::NativeTupleCount),
       "&tuple:class" => Ok(Self::NativeTupleClass),
+      "&tuple:with-class" => Ok(Self::NativeTupleWithClass),
       // effects
       "&display-stack" => Ok(Self::NativeDisplayStack),
       "raise" => Ok(Self::Raise),
@@ -388,6 +390,7 @@ impl Display for CalcitProc {
       Self::NativeTupleAssoc => write!(f, "&tuple:assoc"),
       Self::NativeTupleCount => write!(f, "&tuple:count"),
       Self::NativeTupleClass => write!(f, "&tuple:class"),
+      Self::NativeTupleWithClass => write!(f, "&tuple:with-class"),
       Self::NativeDisplayStack => write!(f, "&display-stack"),
       Self::Raise => write!(f, "raise"),
       Self::Quit => write!(f, "quit!"),

src/runner.rs

@@ -61,7 +61,7 @@ pub fn evaluate_expr(expr: &Calcit, scope: &CalcitScope, file_ns: Arc<str>, call
     Calcit::Buffer(..) => Ok(expr.to_owned()),
     Calcit::CirruQuote(..) => Ok(expr.to_owned()),
     Calcit::Recur(_) => unreachable!("recur not expected to be from symbol"),
-    Calcit::RawCode(_, code) => unreachable!("native code {} not expected to be evaluated", code),
+    Calcit::RawCode(_, code) => unreachable!("raw code `{}` cannot be called", code),
     Calcit::List(xs) => match xs.get(0) {
       None => Err(CalcitErr::use_msg_stack(format!("cannot evaluate empty expr: {expr}"), call_stack)),
       Some(x) => {

ts-src/calcit.procs.mts

@@ -1,5 +1,5 @@
 // CALCIT VERSION
-export const calcit_version = "0.7.0";
+export const calcit_version = "0.7.2";
 
 import { parse, ICirruNode } from "@cirru/parser.ts";
 import { writeCirruCode } from "@cirru/writer.ts";
@@ -299,10 +299,17 @@ export let _$n_tuple_$o_count = function (xs: CalcitValue) {
 };
 
 export let _$n_tuple_$o_class = function (x: CalcitTuple) {
-  if (arguments.length !== 1) throw new Error("&tuple:class takes 1 arguments");
+  if (arguments.length !== 1) throw new Error("&tuple:class takes 1 argument");
   return x.klass;
 };
 
+export let _$n_tuple_$o_with_class = function (x: CalcitTuple, y: CalcitRecord) {
+  if (arguments.length !== 2) throw new Error("&tuple:with-class takes 2 arguments");
+  if (!(x instanceof CalcitTuple)) throw new Error("&tuple:with-class expects a tuple");
+  if (!(y instanceof CalcitRecord)) throw new Error("&tuple:with-class expects second argument in record");
+  return new CalcitTuple(x.tag, x.extra, y);
+};
+
 export let _$n_record_$o_get = function (xs: CalcitValue, k: CalcitTag) {
   if (arguments.length !== 2) {
     throw new Error("record &get takes 2 arguments");