Haschoo 0.0 → 0.1

raw patch · 5 files changed

+127/−7 lines, 5 files

Files

• Haschoo.cabal +5/−1
• Haschoo/Stdlib.hs +5/−2
• README.txt +0/−4
• std-func.scm +11/−0
• std-prim.scm +106/−0

@@ -1,7 +1,7 @@ Cabal-Version: >= 1.6  Name:        Haschoo-Version:     0.0+Version:     0.1 Homepage:    http://iki.fi/matti.niemenmaa/misc-projects.html#haschoo Synopsis:    Minimalist R5RS Scheme interpreter Category:    Compilers/Interpreters@@ -23,6 +23,9 @@                     tests/macros/r5rs/4.3.2.scm                     tests/macros/xfail/*.scm +Data-Files: std-func.scm+            std-prim.scm+ Executable haschoo    Main-Is: Haschoo/Main.hs @@ -56,3 +59,4 @@                   Haschoo.Stdlib                   Haschoo.Types                   Haschoo.Utils+                  Paths_Haschoo

@@ -8,6 +8,8 @@ import Data.IORef        (IORef, newIORef, readIORef) import System.Exit       (exitFailure) +import Paths_Haschoo (getDataFileName) -- Thanks to Cabal+ import Haschoo.Running         (runFile) import Haschoo.Types           (Context, addToContext, ScmValue(..)) import Haschoo.Utils           (errPut, errPutLn, errPrint, ErrOr)@@ -19,11 +21,12 @@ toplevelContext, primitiveContext :: IO [IORef Context] toplevelContext = do    pc <- primitiveContext-   load pc std "std-func.scm"+   load pc std =<< getDataFileName "std-func.scm"  where    std = foldr (uncurry addToContext) Standard.context envFuncs -primitiveContext = load [] Primitives.context "std-prim.scm"+primitiveContext =+	load [] Primitives.context =<< getDataFileName "std-prim.scm"  load :: [IORef Context] -> Context -> FilePath -> IO [IORef Context] load ctx new path = (do

@@ -45,10 +45,6 @@ runhaskell Setup.hs build runhaskell Setup.hs install -As a last resort:--ghc --make Haschoo/Main.hs -o haschoo -O2- Goal ---- 

@@ -0,0 +1,11 @@+; (R5RS 6.3.2)+(define list-tail+  (lambda (x k)+    (if (zero? k)+        x+        (list-tail (cdr x) (- k 1)))))++; (R5RS 6.4)+(define force+  (lambda (object)+      (object)))

@@ -0,0 +1,106 @@+; (R5RS 7.3)+(define-syntax cond+  (syntax-rules (else =>)+    ((cond (else result1 result2 ...))+     (begin result1 result2 ...))+    ((cond (test => result))+     (let ((temp test))+       (if temp (result temp))))+    ((cond (test => result) clause1 clause2 ...)+     (let ((temp test))+       (if temp+           (result temp)+           (cond clause1 clause2 ...))))+    ((cond (test)) test)+    ((cond (test) clause1 clause2 ...)+     (let ((temp test))+       (if temp+           temp+           (cond clause1 clause2 ...))))+    ((cond (test result1 result2 ...))+     (if test (begin result1 result2 ...)))+    ((cond (test result1 result2 ...)+           clause1 clause2 ...)+     (if test+         (begin result1 result2 ...)+         (cond clause1 clause2 ...)))))++(define-syntax case+  (syntax-rules (else)+    ((case (key ...)+       clauses ...)+     (let ((atom-key (key ...)))+       (case atom-key clauses ...)))+    ((case key+       (else result1 result2 ...))+     (begin result1 result2 ...))+    ((case key+       ((atoms ...) result1 result2 ...))+     (if (memv key '(atoms ...))+         (begin result1 result2 ...)))+    ((case key+       ((atoms ...) result1 result2 ...)+       clause clauses ...)+     (if (memv key '(atoms ...))+         (begin result1 result2 ...)+         (case key clause clauses ...)))))++(define-syntax and+  (syntax-rules ()+    ((and) #t)+    ((and test) test)+    ((and test1 test2 ...)+     (if test1 (and test2 ...) #f))))++(define-syntax or+  (syntax-rules ()+    ((or) #f)+    ((or test) test)+    ((or test1 test2 ...)+     (let ((x test1))+       (if x x (or test2 ...))))))++(define-syntax let+  (syntax-rules ()+    ((let ((name val) ...) body1 body2 ...)+     ((lambda (name ...) body1 body2 ...)+      val ...))+    ((let tag ((name val) ...) body1 body2 ...)+     ((letrec ((tag (lambda (name ...)+                      body1 body2 ...)))+        tag)+      val ...))))++(define-syntax let*+  (syntax-rules ()+    ((let* () body1 body2 ...)+     (let () body1 body2 ...))+    ((let* ((name1 val1) (name2 val2) ...)+       body1 body2 ...)+     (let ((name1 val1))+       (let* ((name2 val2) ...)+         body1 body2 ...)))))++(define-syntax begin+  (syntax-rules ()+    ((begin exp ...)+     ((lambda () exp ...)))))++; (R5RS 6.4)+(define-syntax delay+  (syntax-rules ()+      ((delay expression)+           (make-promise (lambda () expression)))))+(define make-promise+  (lambda (proc)+    (let ((result-ready? #f)+          (result #f))+      (lambda ()+        (if result-ready?+            result+            (let ((x (proc)))+              (if result-ready?+                  result+                  (begin (set! result-ready? #t)+                         (set! result x)+                         result))))))))