提交: 3ee4ecc4571ee60e563341963a49c9a7f8c64652 - cammy (git)

A categorical programming language

Commit MetaInfo

• 修订版: 3ee4ecc4571ee60e563341963a49c9a7f8c64652 (tree)
• 时间: 2021-08-11 02:02:54
• 作者: Corbin <cds@corb...>
• Commiter: Corbin

Log Message

Redo and simplify argument handling.

Lists of lists should no longer be off the menu.

更改概述

• modified: finish.py
• modified: stub.scm

差异

--- a/finish.py
+++ b/finish.py
@@ -2,18 +2,17 @@
 
 import sys
 
-parsers = {
-    "unit": "string->unit",
-    "bool": "string->boolean",
-    "nat": "string->nat",
-    "nat * nat": "string->int",
+aliases = {
+    "nat * nat": "int",
 }
 
 def get_parser(ty):
     if ty.endswith(" list"):
-        return "(string->listof {})".format(get_parser(ty[:-5]))
+        return "(arg-list {})".format(get_parser(ty[:-5]))
+    elif ty in aliases:
+        return get_parser(aliases[ty])
     else:
-        return parsers[ty]
+        return "arg-" + ty
 
 with open(sys.argv[-1], "r", encoding="utf-8") as handle:
     line = handle.readlines()[-2]
@@ -32,7 +31,9 @@ with open(sys.argv[-2], "r", encoding="utf-8") as handle:
 print("""
 (import (chicken process-context))
 (define parsers (list {}))
-(define parsed-args (zip-app parsers (command-line-arguments)))
+(define parsed-args
+    (map (lambda (arg p) (p (read-string arg)))
+        (command-line-arguments) parsers))
 (begin
     (display (fold-left program (lambda (x f) (f x)) parsed-args))
     (newline))

--- a/stub.scm
+++ b/stub.scm
@@ -1,4 +1,6 @@
+(import (srfi 6))
 (import (chicken condition))
+(import (chicken format))
 (import (chicken string))
 
 (define id (lambda (x) x))
@@ -31,24 +33,14 @@
 (define (fold x f)
   (lambda (l) (if (null? l) (x '()) (f (cons (car l) ((fold x f) (cdr l)))))))
 
-(define (parse-error message) (signal (condition (list 'exn 'message message))))
-(define (string->unit s) '())
-(define (string->boolean s) (equal? s "true"))
-(define (string->nat s)
-  (let ((i (string->number s)))
-    (if (< i 0) (parse-error "nats must be positive")
-      i)))
-(define (string->int s)
-  (let ((i (string->number s))) (if (< i 0) (cons 0 (abs i)) (cons i 0))))
-(define (string->listof p) (lambda (s)
-  (let ((len (string-length s)))
-    (if (not (equal? #\( (string-ref s 0)))
-      (parse-error "list must start with ("))
-    (if (not (equal? #\) (string-ref s (- len 1))))
-      (parse-error "list must end with )"))
-    (map p (string-split (substring s 1 (- len 1)))))))
+(define (read-string s) (read (open-input-string s)))
+(define (arg-error arg why)
+  (signal (condition (list 'exn 'message (sprintf "Invalid argument ~A: ~A" arg why)))))
+(define (arg-unit x) '())
+(define (arg-bool x) (if (boolean? x) x (arg-error x "not bool")))
+(define (arg-nat x) (if (> x 0) x (arg-error x "not a natural number")))
+(define (arg-int x)
+  (if (number? x) (if (> x 0) (cons x 0) (cons 0 (abs x))) (arg-error x "not an integer")))
+(define (arg-list p) (lambda (x) (map p x)))
 
 (define (fold-left kn kc l) (if (null? l) kn (kc (car l) (fold-left kn kc (cdr l)))))
-(define (zip-app fs xs)
-  (if (null? fs) '()
-    (cons ((car fs) (car xs)) (zip-app (cdr fs) (cdr xs)))))