Arg parsing library (#256)

* first pass at arg parser library

* fix bug with macro expansion

* add test case

* typo in error message

* go back to standard ffi opaque debug impl

* duplicate some logic for now

* remove prints

* patch warning

cogs/command-line/args.scm

@@ -1,5 +1,146 @@
+(provide ArgumentParsingResult-positional-args
+         make-command-line-arg-parser
+         get-option)
 
-;; Basic command line parsing into a hashmap, until I figure out how to
-;; dynamically deconstruct the arg list into a struct
-(define (parse-args arg-list)
-    (error "todo!"))
+;; Setup the argument parser spec
+(struct ArgumentParserSpec (docs subcommands positional-args required-args optional-args))
+
+(struct ArgumentParsingResult (spec positional-args required-args optional-args) #:transparent)
+
+;; Build up the args by crunching through, eagerly assigning
+;; to the respective fields. If there is no match for a subcommand, then we
+;; simply continue.
+(define (parse spec arg-list positional-args required-args optional-args)
+
+  (cond
+    [(empty? arg-list)
+     ;; Check that the positionl args have been fulfilled
+     (when (not (= (length (ArgumentParserSpec-positional-args spec)) (length positional-args)))
+       (displayln "getting here")
+       (error "Missing positional arguments: "
+              (drop (ArgumentParserSpec-positional-args spec) (length positional-args))))
+
+     (ArgumentParsingResult spec positional-args required-args optional-args)]
+
+    [else
+     (define next (car arg-list))
+
+     (cond
+       [(starts-with? next "--")
+        (define arg-name (trim-start-matches next "--"))
+
+        (cond
+          [(hash-contains? (ArgumentParserSpec-required-args spec) arg-name)
+           ;; Rework this so the list goes later?
+           (parse spec
+                  (cddr arg-list)
+                  positional-args
+                  (hash-insert required-args arg-name (cadr arg-list))
+                  optional-args)]
+
+          ;; Optional arguments are those where the presence of the flag
+          ;; just dictates that the flag is enabled, not that we need to
+          ;; eagerly parse the next argument.
+          [(hash-contains? (ArgumentParserSpec-optional-args spec) arg-name)
+
+           ;; The existence of the flag means its enabled. But, on the off chance
+           ;; that the flag value exists, take it.
+           (parse spec
+                  (cdr arg-list)
+                  positional-args
+                  required-args
+                  (hash-insert optional-args arg-name #t))]
+
+          [else (error "Unrecognized command line argument: " arg-name)])]
+
+       [(starts-with? next "-")
+
+        (define arg-name (trim-start-matches next "-"))
+
+        ;; TODO: Share the same logic with the above stuff
+        (cond
+          [(hash-contains? (ArgumentParserSpec-required-args spec) arg-name)
+           ;; Rework this so the list goes later?
+           (parse spec
+                  (cddr arg-list)
+                  positional-args
+                  (hash-insert required-args arg-name (cadr arg-list))
+                  optional-args)]
+
+          ;; Optional arguments are those where the presence of the flag
+          ;; just dictates that the flag is enabled, not that we need to
+          ;; eagerly parse the next argument.
+          [(hash-contains? (ArgumentParserSpec-optional-args spec) arg-name)
+
+           ;; The existence of the flag means its enabled. But, on the off chance
+           ;; that the flag value exists, take it.
+           (parse spec
+                  (cdr arg-list)
+                  positional-args
+                  required-args
+                  (hash-insert optional-args arg-name #t))]
+
+          [else (error "Unrecognized command line argument: " arg-name)])]
+
+       [else
+        ;; We've already collected all of the arguments we're expecting, so we
+        ;; should just bail out of this one
+        (when (= (length positional-args) (length (ArgumentParserSpec-positional-args spec)))
+          (error "Unexpected positional argument: " (car arg-list)))
+
+        ;; Anything else, just gets lumped in with the standard arguments
+        (parse spec
+               (cdr arg-list)
+               (cons (car arg-list) positional-args)
+               required-args
+               optional-args)])]))
+
+;; Create a command line parser, given a spec
+(define (make-command-line-arg-parser
+         #:positional [positional-args '()]
+         ;; List of pairs, argument with doc - previously a hashset
+         #:required [required-args '()]
+         ;; List of triples, argument with doc, default value - previously a hash of key -> default
+         #:optional [optional-args '()])
+
+  ;; Map from key -> doc
+  (define required-docs (transduce required-args (mapping (lambda (p) p)) (into-hashmap)))
+  (define optional-docs
+    (transduce optional-args (mapping (lambda (p) (cons (caar p) (cadr p)))) (into-hashmap)))
+
+  ;; Keep track of all of the docs
+  (define all-docs (hash-union required-docs optional-docs))
+
+  (define required-args (transduce required-args (mapping (lambda (p) (car p))) (into-hashmap)))
+  ;; Add the help options
+  (define optional-args
+    (~> (transduce optional-args (mapping (lambda (p) (car p))) (into-hashmap))
+        (hash-insert "help" #f)))
+
+  (define local-spec
+    (ArgumentParserSpec (hash-union required-args optional-args)
+                        '()
+                        positional-args
+                        required-args
+                        optional-args))
+
+  (case-lambda
+    [()
+     (when (< (length (command-line)) 2)
+       (error
+        "There aren't enough command line args to parse - was this called from an interactive session?"))
+
+     (parse local-spec (drop (command-line) 2) '() required-args optional-args)]
+    [(command-line-args) (parse local-spec command-line-args '() required-args optional-args)]))
+
+;; Check the value, otherwise
+(define (get-option spec option)
+  (define required (ArgumentParsingResult-required-args spec))
+  (define optional (ArgumentParsingResult-optional-args spec))
+  (if (hash-contains? required option) (hash-ref required option) (hash-ref optional option)))
+
+;; Example
+; (define my-options
+;   (make-command-line-arg-parser #:positional (list '("path" "The input path to read")
+;                                                    '("output" "The output path to read"))
+;                                 #:required '((("required-arg-1" #f) "Setting up the values"))))

cogs/syntax-tests.scm

@@ -258,6 +258,18 @@
                 (syntax-rules ()
                   [(_ #t ...) 1])))
 
+(define-syntax t
+  (syntax-rules ()
+    [(t a)
+     (begin
+       (define/contract (_t b)
+         (->/c number? number?)
+         (add1 b))
+
+       (_t a))]))
+
+(check-equal? "macro expansion correctly works within another syntax rules" (t 10) 11)
+
 ;; -------------- Report ------------------
 
 (define stats (get-test-stats))

crates/steel-core/src/parser/parser.rs

@@ -45,7 +45,7 @@ pub(crate) struct InterierSources {
 
 impl InterierSources {
     pub fn new() -> Self {
-        let mut sources = InterierSources {
+        let sources = InterierSources {
             paths: HashMap::new(),
             reverse: HashMap::new(),
             sources: Vec::new(),

crates/steel-core/src/parser/replace_idents.rs

@@ -163,6 +163,7 @@ impl<'a> ReplaceExpressions<'a> {
                     syn:
                         SyntaxObject {
                             ty: TokenType::Identifier(var),
+                            introduced_via_macro,
                             ..
                         },
                 }) => {
@@ -197,25 +198,25 @@ impl<'a> ReplaceExpressions<'a> {
                         res
                     };
 
-                    // Split off into small vec?
-                    // let back_chunk = vec_exprs.split_off(ellipses_pos - 1);
+                    let mut list_of_exprs = list_of_exprs.to_vec();
+
+                    for expr in list_of_exprs.iter_mut() {
+                        if let ExprKind::Atom(a) = expr {
+                            a.syn.introduced_via_macro = *introduced_via_macro;
+                            a.syn.unresolved = false;
+                        }
+                    }
 
                     let back_chunk = vec_exprs
                         .drain(ellipses_pos - 1..)
                         .collect::<SmallVec<[_; 8]>>();
 
                     vec_exprs.reserve(list_of_exprs.len() + back_chunk[2..].len());
 
-                    vec_exprs.extend_from_slice(list_of_exprs);
+                    vec_exprs.append(&mut list_of_exprs);
 
                     vec_exprs.extend_from_slice(&back_chunk[2..]);
 
-                    // let mut first_chunk = vec_exprs[0..ellipses_pos - 1].to_vec();
-                    // first_chunk.extend_from_slice(list_of_exprs);
-                    // first_chunk.extend_from_slice(&vec_exprs[(ellipses_pos + 1)..]);
-
-                    // *vec_exprs = first_chunk;
-
                     Ok(improper)
                 }
 
@@ -239,7 +240,6 @@ impl<'a> ReplaceExpressions<'a> {
                     std::mem::swap(self.fallback_bindings, &mut original_bindings);
 
                     let mut expanded_expressions = SmallVec::<[ExprKind; 6]>::with_capacity(width);
-                    // let mut expanded_expressions = Vec::with_capacity(width);
 
                     for i in 0..width {
                         let mut template = variable_to_lookup.clone();
@@ -272,24 +272,13 @@ impl<'a> ReplaceExpressions<'a> {
                         .drain(ellipses_pos - 1..)
                         .collect::<SmallVec<[_; 8]>>();
 
-                    // let back_chunk = vec_exprs.split_off(ellipses_pos - 1);
-
+                    // TODO: We might need to mimic the above, where we
+                    // set if the resulting expression was introduced via macro.
                     vec_exprs.reserve(expanded_expressions.len() + back_chunk[2..].len());
-
                     vec_exprs.extend(expanded_expressions);
                     vec_exprs.extend_from_slice(&back_chunk[2..]);
 
-                    // let mut first_chunk = vec_exprs[0..ellipses_pos - 1].to_vec();
-                    // first_chunk.extend_from_slice(&expanded_expressions);
-                    // first_chunk.extend_from_slice(&vec_exprs[(ellipses_pos + 1)..]);
-
-                    // *vec_exprs = first_chunk;
-
                     Ok(improper)
-
-                    // Ok(())
-
-                    // Ok(first_chunk)
                 }
 
                 _ => {

crates/steel-core/src/scheme/stdlib.scm

@@ -447,6 +447,21 @@
        (module gen-defines mod
          rest ...))]))
 
+(define-syntax do
+  (syntax-rules ()
+    [(do ((var init step ...) ...) (test expr ...) command ...)
+     (letrec* ([loop
+                (lambda (var ...)
+                  (if test
+                      (begin
+                        expr ...)
+                      (begin
+                        command ...
+                        (loop (do "step" var step ...) ...))))])
+              (loop init ...))]
+    [(do "step" x) x]
+    [(do "step" x y) y]))
+
 ;; TODO: Replace some of these with just list ref to abuse the underlying implementation
 (define caar (lambda (pair) (car (car pair))))
 (define cadr (lambda (pair) (car (cdr pair))))

crates/steel-core/src/steel_vm/ffi.rs

@@ -147,13 +147,12 @@ macro_rules! conversion_error {
     };
 }
 
-impl<T: IntoFFIVal, E: IntoFFIVal> IntoFFIVal for std::result::Result<T, E> {
+impl<T: IntoFFIVal, E: IntoFFIVal + std::fmt::Debug> IntoFFIVal for std::result::Result<T, E> {
     fn into_ffi_val(self) -> RResult<FFIValue, RBoxError> {
         match self {
             Ok(v) => v.into_ffi_val(),
             Err(e) => {
-                let error: Box<dyn std::error::Error + Send + Sync> =
-                    format!("{:?}", ffi_try!(e.into_ffi_val())).into();
+                let error: Box<dyn std::error::Error + Send + Sync> = format!("{:?}", e).into();
 
                 RResult::RErr(RBoxError::from_box(error))
             }

crates/steel-core/src/values/structs.rs

@@ -236,8 +236,8 @@ impl UserDefinedStruct {
                 let error_message = format!(
                     "{} expected {} arguments, found {}",
                     descriptor.name(),
+                    len,
                     args.len(),
-                    len
                 );
                 stop!(ArityMismatch => error_message);
             }

libs/steel-markdown/src/lib.rs

@@ -42,6 +42,7 @@ struct SyntaxHighlighter {
 
 impl Custom for SyntaxHighlighter {}
 
+#[derive(Debug)]
 struct SyntectError(syntect::Error);
 impl Custom for SyntectError {}
 

libs/steel-sqlite/src/lib.rs

@@ -130,6 +130,7 @@ impl Drop for SqliteTransaction {
     }
 }
 
+#[derive(Debug)]
 enum SqliteError {
     TransactionAlreadyCompleted,
     Generic(rusqlite::Error),

libs/steel-webrequests/src/lib.rs

@@ -49,6 +49,7 @@ struct BlockingResponse(Response);
 #[derive(Clone)]
 struct Client(ureq::Agent);
 
+#[derive(Debug)]
 enum BlockingError {
     Ureq(ureq::Error),
     ResponseAlreadyUsed,

libs/steel-websockets/src/lib.rs

@@ -71,6 +71,7 @@ impl WebSocketMessage {
 struct WebSocketResponse(Response);
 impl Custom for WebSocketResponse {}
 
+#[derive(Debug)]
 struct WebSocketError(tungstenite::Error);
 
 impl Custom for WebSocketError {

src/lib.rs

@@ -14,7 +14,7 @@ use clap::Parser;
 
 /// Steel Interpreter
 #[derive(Parser, Debug)]
-#[clap(author, version, about, long_about = None)]
+#[clap(author, version, about, long_about = None, trailing_var_arg = true)]
 pub struct Args {
     /// What action to perform on this file, the absence of a subcommand indicates that the given file (if any)
     /// will be run as the entrypoint