├── LICENSE ├── README.md ├── compile ├── compile.go ├── env.go ├── infer.go └── validate.go ├── dump.go ├── examples ├── adventure │ ├── engine.fn │ ├── main.fn │ └── story.fn ├── guessing-game.fn ├── hello-world.fn ├── shell-simulator │ ├── commands.fn │ ├── file-system.fn │ └── main.fn └── simple-chess │ ├── board.fn │ ├── main.fn │ └── rules.fn ├── expr ├── expr.go └── string.go ├── interpreters └── funkycmd │ ├── funkycmd │ ├── funkycmd.exe │ └── main.go ├── parse ├── definitions.go ├── expr.go ├── parseinfo │ └── parseinfo.go ├── tokenize.go ├── tree.go └── type.go ├── run.go ├── runtime └── value.go ├── stdlib ├── array.fn ├── bool.fn ├── cmd │ └── io.fn ├── common.fn ├── complex.fn ├── field.fn ├── list-dict.fn ├── list-set.fn ├── list.fn ├── math.fn ├── maybe.fn ├── pair.fn ├── proc.fn ├── result.fn ├── slots.fn └── string.fn ├── types-sandbox.go └── types ├── name.go ├── string.go ├── typecheck ├── infer.go ├── spec.go ├── subst.go └── unify.go └── types.go /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018 Michal Štrba 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Funky 2 | 3 | The best functional language ever. 4 | 5 | ## Work in progress tour [here](https://faiface.github.io/funky-tour/). 6 | 7 | _More extensive overview in [my thesis](http://www.dcs.fmph.uniba.sk/bakalarky/registracia/getfile.php/funky.pdf?id=363&fid=712&type=application%2Fpdf)._ -------------------------------------------------------------------------------- /compile/compile.go: -------------------------------------------------------------------------------- 1 | package compile 2 | 3 | import ( 4 | "github.com/faiface/crux" 5 | "github.com/faiface/crux/runtime" 6 | "github.com/faiface/funky/expr" 7 | "github.com/faiface/funky/types/typecheck" 8 | ) 9 | 10 | func (env *Env) Compile(main string) ( 11 | globalIndices map[string][]int32, 12 | globalValues []runtime.Value, 13 | codeIndices map[string][]int32, 14 | codes []runtime.Code, 15 | ) { 16 | env.lazyInit() 17 | 18 | globals := make(map[string][]crux.Expr) 19 | 20 | for name, impls := range env.funcs { 21 | for i := range impls { 22 | switch impl := impls[i].(type) { 23 | case *internal: 24 | globals[name] = append(globals[name], impl.Expr) 25 | case *function: 26 | globals[name] = append(globals[name], compress(lift(nil, compress(env.translate(nil, impl.Expr))))) 27 | } 28 | } 29 | } 30 | 31 | return crux.Compile(globals) 32 | } 33 | 34 | func (env *Env) translate(locals []string, e expr.Expr) crux.Expr { 35 | switch e := e.(type) { 36 | case *expr.Char: 37 | return &crux.Char{Value: e.Value} 38 | 39 | case *expr.Int: 40 | var i crux.Int 41 | i.Value.Set(e.Value) 42 | return &i 43 | 44 | case *expr.Float: 45 | return &crux.Float{Value: e.Value} 46 | 47 | case *expr.Var: 48 | for _, local := range locals { 49 | if local == e.Name { 50 | return &crux.Var{Name: e.Name, Index: -1} 51 | } 52 | } 53 | for i, impl := range env.funcs[e.Name] { 54 | if typecheck.CheckIfUnify(env.names, e.TypeInfo(), impl.TypeInfo()) { 55 | return &crux.Var{ 56 | Name: e.Name, 57 | Index: int32(i), 58 | } 59 | } 60 | } 61 | panic("unknown variable") 62 | 63 | case *expr.Abst: 64 | return &crux.Abst{ 65 | Bound: []string{e.Bound.Name}, 66 | Body: env.translate(append(locals, e.Bound.Name), e.Body), 67 | } 68 | 69 | case *expr.Appl: 70 | return &crux.Appl{ 71 | Rator: env.translate(locals, e.Left), 72 | Rands: []crux.Expr{env.translate(locals, e.Right)}, 73 | } 74 | 75 | case *expr.Strict: 76 | return &crux.Strict{Expr: env.translate(locals, e.Expr)} 77 | 78 | case *expr.Switch: 79 | cases := make([]crux.Expr, len(e.Cases)) 80 | for i := range cases { 81 | cases[i] = env.translate(locals, e.Cases[i].Body) 82 | } 83 | return &crux.Switch{ 84 | Expr: env.translate(locals, e.Expr), 85 | Cases: cases, 86 | } 87 | 88 | default: 89 | panic("unreachable") 90 | } 91 | } 92 | 93 | func compress(e crux.Expr) crux.Expr { 94 | switch e := e.(type) { 95 | case *crux.Char, *crux.Int, *crux.Float, *crux.Operator, *crux.Make, *crux.Field, *crux.Var: 96 | return e 97 | 98 | case *crux.Abst: 99 | compressedBody := compress(e.Body) 100 | if abst, ok := compressedBody.(*crux.Abst); ok { 101 | return &crux.Abst{Bound: append(e.Bound, abst.Bound...), Body: abst.Body} 102 | } 103 | return &crux.Abst{Bound: e.Bound, Body: compressedBody} 104 | 105 | case *crux.Appl: 106 | compressedRator := compress(e.Rator) 107 | compressedRands := make([]crux.Expr, len(e.Rands)) 108 | for i := range compressedRands { 109 | compressedRands[i] = compress(e.Rands[i]) 110 | } 111 | if appl, ok := compressedRator.(*crux.Appl); ok { 112 | return &crux.Appl{Rator: appl.Rator, Rands: append(appl.Rands, compressedRands...)} 113 | } 114 | return &crux.Appl{Rator: compressedRator, Rands: compressedRands} 115 | 116 | case *crux.Strict: 117 | return &crux.Strict{Expr: compress(e.Expr)} 118 | 119 | case *crux.Switch: 120 | compressedExpr := compress(e.Expr) 121 | compressedCases := make([]crux.Expr, len(e.Cases)) 122 | for i := range compressedCases { 123 | compressedCases[i] = compress(e.Cases[i]) 124 | } 125 | return &crux.Switch{Expr: compressedExpr, Cases: compressedCases} 126 | 127 | default: 128 | panic("unreachable") 129 | } 130 | } 131 | 132 | func lift(locals []string, e crux.Expr) crux.Expr { 133 | switch e := e.(type) { 134 | case *crux.Char, *crux.Int, *crux.Float, *crux.Operator, *crux.Make, *crux.Field, *crux.Var: 135 | return e 136 | 137 | case *crux.Abst: 138 | var ( 139 | toBind []string 140 | toApply []crux.Expr 141 | ) 142 | for _, local := range locals { 143 | if isFree(local, e) { 144 | toBind = append(toBind, local) 145 | toApply = append(toApply, &crux.Var{Name: local, Index: -1}) 146 | } 147 | } 148 | if len(toBind) == 0 { 149 | return &crux.Abst{Bound: e.Bound, Body: lift(e.Bound, e.Body)} 150 | } 151 | newLocals := append(toBind, e.Bound...) 152 | return &crux.Appl{ 153 | Rator: &crux.Abst{Bound: newLocals, Body: lift(newLocals, e.Body)}, 154 | Rands: toApply, 155 | } 156 | 157 | case *crux.Appl: 158 | liftedRator := lift(locals, e.Rator) 159 | liftedRands := make([]crux.Expr, len(e.Rands)) 160 | for i := range liftedRands { 161 | liftedRands[i] = lift(locals, e.Rands[i]) 162 | } 163 | return &crux.Appl{Rator: liftedRator, Rands: liftedRands} 164 | 165 | case *crux.Strict: 166 | return &crux.Strict{Expr: lift(locals, e.Expr)} 167 | 168 | case *crux.Switch: 169 | liftedExpr := lift(locals, e.Expr) 170 | liftedCases := make([]crux.Expr, len(e.Cases)) 171 | for i := range liftedCases { 172 | liftedCases[i] = lift(locals, e.Cases[i]) 173 | } 174 | return &crux.Switch{Expr: liftedExpr, Cases: liftedCases} 175 | 176 | default: 177 | panic("unreachable") 178 | } 179 | } 180 | 181 | func isFree(local string, e crux.Expr) bool { 182 | switch e := e.(type) { 183 | case *crux.Char, *crux.Int, *crux.Float, *crux.Operator, *crux.Make, *crux.Field: 184 | return false 185 | case *crux.Var: 186 | return e.Index < 0 && local == e.Name 187 | case *crux.Abst: 188 | for _, bound := range e.Bound { 189 | if local == bound { 190 | return false 191 | } 192 | } 193 | return isFree(local, e.Body) 194 | case *crux.Appl: 195 | for _, rand := range e.Rands { 196 | if isFree(local, rand) { 197 | return true 198 | } 199 | } 200 | return isFree(local, e.Rator) 201 | case *crux.Strict: 202 | return isFree(local, e.Expr) 203 | case *crux.Switch: 204 | for _, cas := range e.Cases { 205 | if isFree(local, cas) { 206 | return true 207 | } 208 | } 209 | return isFree(local, e.Expr) 210 | default: 211 | panic("unreachable") 212 | } 213 | } 214 | -------------------------------------------------------------------------------- /compile/env.go: -------------------------------------------------------------------------------- 1 | package compile 2 | 3 | import ( 4 | "fmt" 5 | "math" 6 | 7 | "github.com/faiface/crux" 8 | "github.com/faiface/crux/mk" 9 | "github.com/faiface/crux/runtime" 10 | "github.com/faiface/funky/expr" 11 | "github.com/faiface/funky/parse" 12 | "github.com/faiface/funky/parse/parseinfo" 13 | "github.com/faiface/funky/types" 14 | ) 15 | 16 | type Error struct { 17 | SourceInfo *parseinfo.Source 18 | Msg string 19 | } 20 | 21 | func (err *Error) Error() string { 22 | return fmt.Sprintf("%v: %s", err.SourceInfo, err.Msg) 23 | } 24 | 25 | type Env struct { 26 | inited bool 27 | names map[string]types.Name 28 | funcs map[string][]funcImpl 29 | } 30 | 31 | type funcImpl interface { 32 | SourceInfo() *parseinfo.Source 33 | TypeInfo() types.Type 34 | } 35 | 36 | type ( 37 | internal struct { 38 | SI *parseinfo.Source 39 | Type types.Type 40 | Expr crux.Expr 41 | } 42 | 43 | function struct { 44 | Expr expr.Expr 45 | } 46 | ) 47 | 48 | func (i *internal) SourceInfo() *parseinfo.Source { return i.SI } 49 | func (f *function) SourceInfo() *parseinfo.Source { return f.Expr.SourceInfo() } 50 | func (i *internal) TypeInfo() types.Type { return i.Type } 51 | func (f *function) TypeInfo() types.Type { return f.Expr.TypeInfo() } 52 | 53 | func parseType(s string) types.Type { 54 | tokens, err := parse.Tokenize("", s) 55 | if err != nil { 56 | panic(err) 57 | } 58 | typ, err := parse.Type(tokens) 59 | if err != nil { 60 | panic(err) 61 | } 62 | return typ 63 | } 64 | 65 | func (env *Env) lazyInit() { 66 | if env.inited { 67 | return 68 | } 69 | env.inited = true 70 | 71 | // built-in types 72 | env.names = map[string]types.Name{ 73 | "Char": &types.Builtin{NumArgs: 0}, 74 | "Int": &types.Builtin{NumArgs: 0}, 75 | "Float": &types.Builtin{NumArgs: 0}, 76 | } 77 | 78 | env.funcs = make(map[string][]funcImpl) 79 | 80 | // built-in operator functions 81 | 82 | // Char 83 | env.addFunc("int", &internal{Type: parseType("Char -> Int"), Expr: mk.Op(runtime.OpCharInt)}) 84 | env.addFunc("inc", &internal{Type: parseType("Char -> Char"), Expr: mk.Op(runtime.OpCharInc)}) 85 | env.addFunc("dec", &internal{Type: parseType("Char -> Char"), Expr: mk.Op(runtime.OpCharDec)}) 86 | env.addFunc("+", &internal{Type: parseType("Char -> Int -> Char"), Expr: mk.Op(runtime.OpCharAdd)}) 87 | env.addFunc("-", &internal{Type: parseType("Char -> Int -> Char"), Expr: mk.Op(runtime.OpCharSub)}) 88 | env.addFunc("==", &internal{Type: parseType("Char -> Char -> Bool"), Expr: mk.Op(runtime.OpCharEq)}) 89 | env.addFunc("!=", &internal{Type: parseType("Char -> Char -> Bool"), Expr: mk.Op(runtime.OpCharNeq)}) 90 | env.addFunc("<", &internal{Type: parseType("Char -> Char -> Bool"), Expr: mk.Op(runtime.OpCharLess)}) 91 | env.addFunc("<=", &internal{Type: parseType("Char -> Char -> Bool"), Expr: mk.Op(runtime.OpCharLessEq)}) 92 | env.addFunc(">", &internal{Type: parseType("Char -> Char -> Bool"), Expr: mk.Op(runtime.OpCharMore)}) 93 | env.addFunc(">=", &internal{Type: parseType("Char -> Char -> Bool"), Expr: mk.Op(runtime.OpCharMoreEq)}) 94 | env.addFunc("upper", &internal{Type: parseType("Char -> Char"), Expr: mk.Op(runtime.OpCharToUpper)}) 95 | env.addFunc("lower", &internal{Type: parseType("Char -> Char"), Expr: mk.Op(runtime.OpCharToLower)}) 96 | env.addFunc("whitespace?", &internal{Type: parseType("Char -> Bool"), Expr: mk.Op(runtime.OpCharIsWhitespace)}) 97 | env.addFunc("letter?", &internal{Type: parseType("Char -> Bool"), Expr: mk.Op(runtime.OpCharIsLetter)}) 98 | env.addFunc("digit?", &internal{Type: parseType("Char -> Bool"), Expr: mk.Op(runtime.OpCharIsDigit)}) 99 | env.addFunc("upper?", &internal{Type: parseType("Char -> Bool"), Expr: mk.Op(runtime.OpCharIsUpper)}) 100 | env.addFunc("lower?", &internal{Type: parseType("Char -> Bool"), Expr: mk.Op(runtime.OpCharIsLower)}) 101 | env.addFunc("ascii?", &internal{Type: parseType("Char -> Bool"), Expr: mk.Op(runtime.OpCharIsASCII)}) 102 | 103 | // Int 104 | env.addFunc("char", &internal{Type: parseType("Int -> Char"), Expr: mk.Op(runtime.OpIntChar)}) 105 | env.addFunc("float", &internal{Type: parseType("Int -> Float"), Expr: mk.Op(runtime.OpIntFloat)}) 106 | env.addFunc("string", &internal{Type: parseType("Int -> String"), Expr: mk.Op(runtime.OpIntString)}) 107 | env.addFunc("neg", &internal{Type: parseType("Int -> Int"), Expr: mk.Op(runtime.OpIntNeg)}) 108 | env.addFunc("abs", &internal{Type: parseType("Int -> Int"), Expr: mk.Op(runtime.OpIntAbs)}) 109 | env.addFunc("inc", &internal{Type: parseType("Int -> Int"), Expr: mk.Op(runtime.OpIntInc)}) 110 | env.addFunc("dec", &internal{Type: parseType("Int -> Int"), Expr: mk.Op(runtime.OpIntDec)}) 111 | env.addFunc("+", &internal{Type: parseType("Int -> Int -> Int"), Expr: mk.Op(runtime.OpIntAdd)}) 112 | env.addFunc("-", &internal{Type: parseType("Int -> Int -> Int"), Expr: mk.Op(runtime.OpIntSub)}) 113 | env.addFunc("*", &internal{Type: parseType("Int -> Int -> Int"), Expr: mk.Op(runtime.OpIntMul)}) 114 | env.addFunc("/", &internal{Type: parseType("Int -> Int -> Int"), Expr: mk.Op(runtime.OpIntDiv)}) 115 | env.addFunc("%", &internal{Type: parseType("Int -> Int -> Int"), Expr: mk.Op(runtime.OpIntMod)}) 116 | env.addFunc("^", &internal{Type: parseType("Int -> Int -> Int"), Expr: mk.Op(runtime.OpIntExp)}) 117 | env.addFunc("==", &internal{Type: parseType("Int -> Int -> Bool"), Expr: mk.Op(runtime.OpIntEq)}) 118 | env.addFunc("!=", &internal{Type: parseType("Int -> Int -> Bool"), Expr: mk.Op(runtime.OpIntNeq)}) 119 | env.addFunc("<", &internal{Type: parseType("Int -> Int -> Bool"), Expr: mk.Op(runtime.OpIntLess)}) 120 | env.addFunc("<=", &internal{Type: parseType("Int -> Int -> Bool"), Expr: mk.Op(runtime.OpIntLessEq)}) 121 | env.addFunc(">", &internal{Type: parseType("Int -> Int -> Bool"), Expr: mk.Op(runtime.OpIntMore)}) 122 | env.addFunc(">=", &internal{Type: parseType("Int -> Int -> Bool"), Expr: mk.Op(runtime.OpIntMoreEq)}) 123 | env.addFunc("zero?", &internal{Type: parseType("Int -> Bool"), Expr: mk.Op(runtime.OpIntIsZero)}) 124 | 125 | // Float 126 | env.addFunc("int", &internal{Type: parseType("Float -> Int"), Expr: mk.Op(runtime.OpFloatInt)}) 127 | env.addFunc("string", &internal{Type: parseType("Float -> String"), Expr: mk.Op(runtime.OpFloatString)}) 128 | env.addFunc("neg", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatNeg)}) 129 | env.addFunc("abs", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatAbs)}) 130 | env.addFunc("inc", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatInc)}) 131 | env.addFunc("dec", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatDec)}) 132 | env.addFunc("+", &internal{Type: parseType("Float -> Float -> Float"), Expr: mk.Op(runtime.OpFloatAdd)}) 133 | env.addFunc("-", &internal{Type: parseType("Float -> Float -> Float"), Expr: mk.Op(runtime.OpFloatSub)}) 134 | env.addFunc("*", &internal{Type: parseType("Float -> Float -> Float"), Expr: mk.Op(runtime.OpFloatMul)}) 135 | env.addFunc("/", &internal{Type: parseType("Float -> Float -> Float"), Expr: mk.Op(runtime.OpFloatDiv)}) 136 | env.addFunc("%", &internal{Type: parseType("Float -> Float -> Float"), Expr: mk.Op(runtime.OpFloatMod)}) 137 | env.addFunc("^", &internal{Type: parseType("Float -> Float -> Float"), Expr: mk.Op(runtime.OpFloatExp)}) 138 | env.addFunc("==", &internal{Type: parseType("Float -> Float -> Bool"), Expr: mk.Op(runtime.OpFloatEq)}) 139 | env.addFunc("!=", &internal{Type: parseType("Float -> Float -> Bool"), Expr: mk.Op(runtime.OpFloatNeq)}) 140 | env.addFunc("<", &internal{Type: parseType("Float -> Float -> Bool"), Expr: mk.Op(runtime.OpFloatLess)}) 141 | env.addFunc("<=", &internal{Type: parseType("Float -> Float -> Bool"), Expr: mk.Op(runtime.OpFloatLessEq)}) 142 | env.addFunc(">", &internal{Type: parseType("Float -> Float -> Bool"), Expr: mk.Op(runtime.OpFloatMore)}) 143 | env.addFunc(">=", &internal{Type: parseType("Float -> Float -> Bool"), Expr: mk.Op(runtime.OpFloatMoreEq)}) 144 | env.addFunc("+inf", &internal{Type: parseType("Float"), Expr: mk.Float(math.Inf(+1))}) 145 | env.addFunc("-inf", &internal{Type: parseType("Float"), Expr: mk.Float(math.Inf(-1))}) 146 | env.addFunc("nan", &internal{Type: parseType("Float"), Expr: mk.Float(math.NaN())}) 147 | env.addFunc("e", &internal{Type: parseType("Float"), Expr: mk.Float(math.E)}) 148 | env.addFunc("pi", &internal{Type: parseType("Float"), Expr: mk.Float(math.Pi)}) 149 | env.addFunc("phi", &internal{Type: parseType("Float"), Expr: mk.Float(math.Phi)}) 150 | env.addFunc("+inf?", &internal{Type: parseType("Float -> Bool"), Expr: mk.Op(runtime.OpFloatIsPlusInf)}) 151 | env.addFunc("-inf?", &internal{Type: parseType("Float -> Bool"), Expr: mk.Op(runtime.OpFloatIsMinusInf)}) 152 | env.addFunc("inf?", &internal{Type: parseType("Float -> Bool"), Expr: mk.Op(runtime.OpFloatIsInf)}) 153 | env.addFunc("nan?", &internal{Type: parseType("Float -> Bool"), Expr: mk.Op(runtime.OpFloatIsNan)}) 154 | env.addFunc("sin", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatSin)}) 155 | env.addFunc("cos", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatCos)}) 156 | env.addFunc("tan", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatTan)}) 157 | env.addFunc("asin", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatAsin)}) 158 | env.addFunc("acos", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatAcos)}) 159 | env.addFunc("atan", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatAtan)}) 160 | env.addFunc("atan2", &internal{Type: parseType("Float -> Float -> Float"), Expr: mk.Op(runtime.OpFloatAtan2)}) 161 | env.addFunc("sinh", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatSinh)}) 162 | env.addFunc("cosh", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatCosh)}) 163 | env.addFunc("tanh", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatTanh)}) 164 | env.addFunc("asinh", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatAsinh)}) 165 | env.addFunc("acosh", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatAcosh)}) 166 | env.addFunc("atanh", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatAtanh)}) 167 | env.addFunc("ceil", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatCeil)}) 168 | env.addFunc("floor", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatFloor)}) 169 | env.addFunc("sqrt", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatSqrt)}) 170 | env.addFunc("cbrt", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatCbrt)}) 171 | env.addFunc("log", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatLog)}) 172 | env.addFunc("hypot", &internal{Type: parseType("Float -> Float -> Float"), Expr: mk.Op(runtime.OpFloatHypot)}) 173 | env.addFunc("gamma", &internal{Type: parseType("Float -> Float"), Expr: mk.Op(runtime.OpFloatGamma)}) 174 | 175 | // String 176 | env.addFunc("int", &internal{Type: parseType("String -> Int"), Expr: mk.Op(runtime.OpStringInt)}) 177 | env.addFunc("float", &internal{Type: parseType("String -> Float"), Expr: mk.Op(runtime.OpStringFloat)}) 178 | 179 | // miscellaneous 180 | env.addFunc("panic", &internal{Type: parseType("String -> a"), Expr: mk.Op(runtime.OpError)}) 181 | env.addFunc("dump", &internal{Type: parseType("String -> a -> a"), Expr: mk.Op(runtime.OpDump)}) 182 | } 183 | 184 | func (env *Env) Add(d parse.Definition) error { 185 | env.lazyInit() 186 | 187 | switch value := d.Value.(type) { 188 | case *types.Record: 189 | return env.addRecord(d.Name, value) 190 | case *types.Union: 191 | return env.addUnion(d.Name, value) 192 | case *types.Alias: 193 | return env.addAlias(d.Name, value) 194 | case expr.Expr: 195 | return env.addFunc(d.Name, &function{value}) 196 | } 197 | 198 | panic("unreachable") 199 | } 200 | 201 | func (env *Env) SourceInfo(name string, index int) *parseinfo.Source { 202 | if len(env.funcs[name]) <= index { 203 | return nil 204 | } 205 | return env.funcs[name][index].SourceInfo() 206 | } 207 | 208 | func (env *Env) TypeInfo(name string, index int) types.Type { 209 | if len(env.funcs[name]) <= index { 210 | return nil 211 | } 212 | return env.funcs[name][index].TypeInfo() 213 | } 214 | 215 | func (env *Env) addRecord(name string, record *types.Record) error { 216 | if env.names[name] != nil { 217 | return &Error{ 218 | record.SourceInfo(), 219 | fmt.Sprintf("type name %s already defined: %v", name, env.names[name].SourceInfo()), 220 | } 221 | } 222 | env.names[name] = record 223 | 224 | var args []types.Type 225 | for _, arg := range record.Args { 226 | args = append(args, &types.Var{Name: arg}) 227 | } 228 | recordType := &types.Appl{ 229 | SI: record.SourceInfo(), 230 | Name: name, 231 | Args: args, 232 | } 233 | 234 | // add record constructor 235 | var constructorType types.Type = recordType 236 | for i := len(record.Fields) - 1; i >= 0; i-- { 237 | constructorType = &types.Func{ 238 | From: record.Fields[i].Type, 239 | To: constructorType, 240 | } 241 | } 242 | err := env.addFunc( 243 | name, 244 | &internal{ 245 | SI: record.SourceInfo(), 246 | Type: constructorType, 247 | Expr: mk.Make(0), 248 | }, 249 | ) 250 | if err != nil { 251 | return err 252 | } 253 | 254 | // add record field getters 255 | // RecordType -> FieldType 256 | for i, field := range record.Fields { 257 | err := env.addFunc(field.Name, &internal{ 258 | SI: field.SI, 259 | Type: &types.Func{From: recordType, To: field.Type}, 260 | Expr: mk.Field(int32(i)), 261 | }) 262 | if err != nil { 263 | return err 264 | } 265 | } 266 | 267 | // add record field setters 268 | // (FieldType -> FieldType) -> RecordType -> RecordType 269 | fieldVars := make([]string, len(record.Fields)) 270 | for i := range fieldVars { 271 | fieldVars[i] = fmt.Sprintf("x%d", i) 272 | } 273 | switchArgs := append([]string{"f"}, fieldVars...) 274 | for i, field := range record.Fields { 275 | switchResult := mk.Appl(mk.Make(0), make([]crux.Expr, len(fieldVars))...) 276 | for j := range switchResult.Rands { 277 | switchResult.Rands[j] = mk.Var(fieldVars[j], -1) 278 | } 279 | switchResult.Rands[i] = mk.Appl(mk.Var("f", -1), mk.Var(fieldVars[i], -1)) 280 | err := env.addFunc(field.Name, &internal{ 281 | SI: field.SI, 282 | Type: &types.Func{ 283 | From: &types.Func{From: field.Type, To: field.Type}, 284 | To: &types.Func{From: recordType, To: recordType}, 285 | }, 286 | Expr: mk.Abst("f", "r")(mk.Switch(mk.Var("r", -1), 287 | mk.Appl(mk.Abst(switchArgs...)(switchResult), mk.Var("f", -1)), 288 | )), 289 | }) 290 | if err != nil { 291 | return err 292 | } 293 | } 294 | 295 | return nil 296 | } 297 | 298 | func (env *Env) addUnion(name string, union *types.Union) error { 299 | if env.names[name] != nil { 300 | return &Error{ 301 | union.SourceInfo(), 302 | fmt.Sprintf("type name %s already defined: %v", name, env.names[name].SourceInfo()), 303 | } 304 | } 305 | env.names[name] = union 306 | 307 | var args []types.Type 308 | for _, arg := range union.Args { 309 | args = append(args, &types.Var{Name: arg}) 310 | } 311 | unionType := &types.Appl{ 312 | SI: union.SourceInfo(), 313 | Name: name, 314 | Args: args, 315 | } 316 | 317 | // add union alternative constructors 318 | for i, alt := range union.Alts { 319 | alternative := int32(i) 320 | var altType types.Type = unionType 321 | for i := len(alt.Fields) - 1; i >= 0; i-- { 322 | altType = &types.Func{ 323 | From: alt.Fields[i], 324 | To: altType, 325 | } 326 | } 327 | err := env.addFunc( 328 | alt.Name, 329 | &internal{ 330 | SI: alt.SI, 331 | Type: altType, 332 | Expr: mk.Make(alternative), 333 | }, 334 | ) 335 | if err != nil { 336 | return err 337 | } 338 | } 339 | 340 | return nil 341 | } 342 | 343 | func (env *Env) addAlias(name string, alias *types.Alias) error { 344 | if env.names[name] != nil { 345 | return &Error{ 346 | alias.SourceInfo(), 347 | fmt.Sprintf("type name %s already defined: %v", name, env.names[name].SourceInfo()), 348 | } 349 | } 350 | env.names[name] = alias 351 | return nil 352 | } 353 | 354 | func (env *Env) addFunc(name string, imp funcImpl) error { 355 | env.funcs[name] = append(env.funcs[name], imp) 356 | return nil 357 | } 358 | -------------------------------------------------------------------------------- /compile/infer.go: -------------------------------------------------------------------------------- 1 | package compile 2 | 3 | import ( 4 | "github.com/faiface/funky/expr" 5 | "github.com/faiface/funky/types" 6 | "github.com/faiface/funky/types/typecheck" 7 | ) 8 | 9 | func (env *Env) TypeInferExpr(e expr.Expr) ([]typecheck.InferResult, error) { 10 | env.lazyInit() 11 | 12 | global := make(map[string][]types.Type) 13 | for name, impls := range env.funcs { 14 | for _, imp := range impls { 15 | global[name] = append(global[name], imp.TypeInfo()) 16 | } 17 | } 18 | 19 | return typecheck.Infer(env.names, global, e) 20 | } 21 | 22 | func (env *Env) TypeInfer() []error { 23 | env.lazyInit() 24 | 25 | var errs []error 26 | 27 | global := make(map[string][]types.Type) 28 | for name, impls := range env.funcs { 29 | for _, imp := range impls { 30 | global[name] = append(global[name], imp.TypeInfo()) 31 | } 32 | } 33 | 34 | for _, impls := range env.funcs { 35 | for _, imp := range impls { 36 | function, ok := imp.(*function) 37 | if !ok { 38 | continue 39 | } 40 | results, err := typecheck.Infer(env.names, global, function.Expr) 41 | if err != nil { 42 | errs = append(errs, err) 43 | continue 44 | } 45 | // there's exactly one result 46 | function.Expr = results[0].Expr 47 | } 48 | } 49 | 50 | return errs 51 | } 52 | -------------------------------------------------------------------------------- /compile/validate.go: -------------------------------------------------------------------------------- 1 | package compile 2 | 3 | import ( 4 | "fmt" 5 | 6 | "github.com/faiface/funky/parse/parseinfo" 7 | "github.com/faiface/funky/types" 8 | "github.com/faiface/funky/types/typecheck" 9 | ) 10 | 11 | func (env *Env) Validate() []error { 12 | env.lazyInit() 13 | 14 | var errs []error 15 | 16 | for _, definition := range env.names { 17 | var err error 18 | switch definition := definition.(type) { 19 | case *types.Builtin: 20 | case *types.Record: 21 | err = env.validateRecord(definition) 22 | case *types.Union: 23 | err = env.validateUnion(definition) 24 | case *types.Alias: 25 | err = env.validateAlias(definition) 26 | default: 27 | panic("unreachable") 28 | } 29 | if err != nil { 30 | errs = append(errs, err) 31 | } 32 | } 33 | 34 | for name, impls := range env.funcs { 35 | implsLoop: 36 | for i, imp := range impls { 37 | // check function type 38 | free := freeVars(imp.TypeInfo()) 39 | err := env.validateType(free, imp.TypeInfo()) 40 | if err != nil { 41 | errs = append(errs, err) 42 | continue 43 | } 44 | 45 | // check other functions for type collisions 46 | for _, another := range impls[:i] { 47 | if typecheck.CheckIfUnify(env.names, imp.TypeInfo(), another.TypeInfo()) { 48 | errs = append(errs, &Error{ 49 | imp.SourceInfo(), 50 | fmt.Sprintf( 51 | "function %s with colliding type exists: %v", 52 | name, 53 | another.SourceInfo(), 54 | ), 55 | }) 56 | continue implsLoop 57 | } 58 | } 59 | } 60 | } 61 | 62 | return errs 63 | } 64 | 65 | func (env *Env) validateType(boundVars []string, typ types.Type) error { 66 | switch typ := typ.(type) { 67 | case *types.Var: 68 | for _, bound := range boundVars { 69 | if typ.Name == bound { 70 | return nil 71 | } 72 | } 73 | return &Error{typ.SourceInfo(), fmt.Sprintf("type variable not bound: %s", typ.Name)} 74 | 75 | case *types.Appl: 76 | if env.names[typ.Name] == nil { 77 | return &Error{typ.SourceInfo(), fmt.Sprintf("type name does not exist: %s", typ.Name)} 78 | } 79 | numArgs := len(typ.Args) 80 | arity := env.names[typ.Name].Arity() 81 | if numArgs != arity { 82 | return &Error{ 83 | typ.SourceInfo(), 84 | fmt.Sprintf("type %s requires %d arguments, %d given", typ.Name, arity, numArgs), 85 | } 86 | } 87 | for _, arg := range typ.Args { 88 | err := env.validateType(boundVars, arg) 89 | if err != nil { 90 | return err 91 | } 92 | } 93 | return nil 94 | 95 | case *types.Func: 96 | err := env.validateType(boundVars, typ.From) 97 | if err != nil { 98 | return err 99 | } 100 | err = env.validateType(boundVars, typ.To) 101 | if err != nil { 102 | return err 103 | } 104 | return nil 105 | } 106 | 107 | panic("unreachable") 108 | } 109 | 110 | func (env *Env) validateRecord(record *types.Record) error { 111 | err := validateArgs(record.SourceInfo(), record.Args) 112 | if err != nil { 113 | return err 114 | } 115 | 116 | // check if all fields have distinct names 117 | for i, field1 := range record.Fields { 118 | for _, field2 := range record.Fields[:i] { 119 | if field1.Name == field2.Name { 120 | return &Error{ 121 | field1.SI, 122 | fmt.Sprintf("another record field has the same name: %v", field2.SI), 123 | } 124 | } 125 | } 126 | } 127 | 128 | // validate field types 129 | for _, field := range record.Fields { 130 | err := env.validateType(record.Args, field.Type) 131 | if err != nil { 132 | return err 133 | } 134 | } 135 | 136 | return nil 137 | } 138 | 139 | func (env *Env) validateUnion(union *types.Union) error { 140 | err := validateArgs(union.SourceInfo(), union.Args) 141 | if err != nil { 142 | return err 143 | } 144 | 145 | // check if all alternatives have distinct names 146 | for i, alt1 := range union.Alts { 147 | for _, alt2 := range union.Alts[:i] { 148 | if alt1.Name == alt2.Name { 149 | return &Error{ 150 | alt1.SI, 151 | fmt.Sprintf("another union alternative has the same name: %v", alt2.SI), 152 | } 153 | } 154 | } 155 | } 156 | 157 | // validate alternative types 158 | for _, alt := range union.Alts { 159 | for _, field := range alt.Fields { 160 | err := env.validateType(union.Args, field) 161 | if err != nil { 162 | return err 163 | } 164 | } 165 | } 166 | 167 | return nil 168 | } 169 | 170 | func (env *Env) validateAlias(alias *types.Alias) error { 171 | err := validateArgs(alias.SourceInfo(), alias.Args) 172 | if err != nil { 173 | return err 174 | } 175 | err = env.validateType(alias.Args, alias.Type) 176 | if err != nil { 177 | return err 178 | } 179 | return nil 180 | } 181 | 182 | func validateArgs(si *parseinfo.Source, args []string) error { 183 | for i := range args { 184 | for j := range args[:i] { 185 | if args[i] == args[j] { 186 | return &Error{ 187 | si, 188 | fmt.Sprintf("duplicate type argument: %v", args[i]), 189 | } 190 | } 191 | } 192 | } 193 | return nil 194 | } 195 | 196 | func freeVars(t types.Type) []string { 197 | seen := make(map[string]bool) 198 | t.Map(func(t types.Type) types.Type { 199 | if v, ok := t.(*types.Var); ok { 200 | seen[v.Name] = true 201 | } 202 | return t 203 | }) 204 | var names []string 205 | for name := range seen { 206 | names = append(names, name) 207 | } 208 | return names 209 | } 210 | -------------------------------------------------------------------------------- /dump.go: -------------------------------------------------------------------------------- 1 | package funky 2 | 3 | import ( 4 | "fmt" 5 | "io" 6 | 7 | "github.com/faiface/crux/runtime" 8 | ) 9 | 10 | func dumpCodes(w io.Writer, globalIndices map[string][]int32, code *runtime.Code) { 11 | indicesToGlobals := make(map[int32]struct { 12 | Name string 13 | Index int32 14 | }) 15 | for name := range globalIndices { 16 | for i := range globalIndices[name] { 17 | indicesToGlobals[globalIndices[name][i]] = struct { 18 | Name string 19 | Index int32 20 | }{name, int32(i)} 21 | } 22 | } 23 | 24 | var dumpIndented func(int, *runtime.Code) 25 | dumpIndented = func(indentation int, code *runtime.Code) { 26 | for i := 0; i < indentation; i++ { 27 | fmt.Fprintf(w, " ") 28 | } 29 | 30 | switch code.Kind { 31 | case runtime.CodeValue: 32 | fmt.Fprintf(w, "VALUE %v\n", code.Value) 33 | case runtime.CodeOperator: 34 | fmt.Fprintf(w, "OPERATOR %s\n", runtime.OperatorString[code.X]) 35 | case runtime.CodeMake: 36 | fmt.Fprintf(w, "MAKE %d\n", code.X) 37 | case runtime.CodeField: 38 | fmt.Fprintf(w, "FIELD %d\n", code.X) 39 | case runtime.CodeVar: 40 | fmt.Fprintf(w, "VAR %d\n", code.X) 41 | case runtime.CodeGlobal: 42 | global := indicesToGlobals[code.X] 43 | fmt.Fprintf(w, "GLOBAL %s/%d\n", global.Name, global.Index) 44 | case runtime.CodeAbst: 45 | fmt.Fprintf(w, "ABST %d\n", code.X) 46 | case runtime.CodeFastAbst: 47 | fmt.Fprintf(w, "FASTABST %d\n", code.X) 48 | case runtime.CodeAppl: 49 | fmt.Fprintf(w, "APPL\n") 50 | case runtime.CodeStrict: 51 | fmt.Fprintf(w, "STRICT\n") 52 | case runtime.CodeSwitch: 53 | fmt.Fprintf(w, "SWITCH\n") 54 | default: 55 | panic("invalid code") 56 | } 57 | 58 | for i := range code.Table { 59 | dumpIndented(indentation+1, &code.Table[i]) 60 | } 61 | } 62 | 63 | dumpIndented(1, code) 64 | } 65 | -------------------------------------------------------------------------------- /examples/adventure/engine.fn: -------------------------------------------------------------------------------- 1 | # Records 2 | 3 | record Adventure = 4 | inventory : List-Set Item, 5 | current-place-name : String, 6 | places : List-Dict String Place, 7 | combinations : List Combination, 8 | 9 | record Place = 10 | description : String, 11 | objects : List-Set Object, 12 | items : List-Set Item, 13 | directions : List-Set Direction, 14 | 15 | record Direction = 16 | names : List-Set String, 17 | description : String, 18 | go-description : String, 19 | destination : String, 20 | 21 | record Object = 22 | names : List-Set String, 23 | short-description : String, 24 | long-description : String, 25 | actions : List Action, 26 | 27 | record Item = 28 | name : String, 29 | short-description : String, 30 | long-description : String, 31 | 32 | record Action = 33 | names : List-Set String, 34 | description : String, 35 | items : List-Set Item, 36 | outcome : Adventure -> Adventure, 37 | 38 | record Combination = 39 | name : String, 40 | description : String, 41 | use-items : List-Set Item, 42 | new-items : List-Set Item, 43 | 44 | record Command = 45 | description : String, 46 | change : Adventure -> Adventure, 47 | 48 | # Constructors 49 | 50 | func adventure : String -> List (Pair String Place) -> List Combination -> Adventure = 51 | \current-place-name \places \combinations 52 | Adventure 53 | (list-set (==) []) 54 | current-place-name 55 | (list-dict (==) invalid-place places) 56 | combinations 57 | 58 | func place : String -> List Object -> List Item -> List Direction -> Place = 59 | \description \objects \items \directions 60 | Place 61 | description 62 | (list-set (==) objects) 63 | (list-set (==) items) 64 | (list-set (==) directions) 65 | 66 | func invalid-place : Place = place "Invalid place. Reaching this place is a bug." [] [] [] 67 | 68 | func direction : List String -> String -> String -> String -> Direction = 69 | \names \description \go-description \destination 70 | Direction 71 | (list-set (==) names) 72 | description 73 | go-description 74 | destination 75 | 76 | func object : List String -> String -> String -> List Action -> Object = 77 | \names \short-description \long-description \actions 78 | Object 79 | (list-set (==) names) 80 | short-description 81 | long-description 82 | actions 83 | 84 | func item : String -> String -> String -> Item = Item 85 | 86 | func action : List String -> String -> List Item -> (Adventure -> Adventure) -> Action = 87 | \names \description \items \outcome 88 | Action 89 | (list-set (==) names) 90 | description 91 | (list-set (==) items) 92 | outcome 93 | 94 | func combo : String -> String -> List Item -> List Item -> Combination = 95 | \name \description \use-items \new-items 96 | Combination 97 | name 98 | description 99 | (list-set (==) use-items) 100 | (list-set (==) new-items) 101 | 102 | # Adventure functions 103 | 104 | func current-place : Adventure -> Place = 105 | \adv 106 | (at (current-place-name adv) . places) adv 107 | 108 | func current-place : (Place -> Place) -> Adventure -> Adventure = 109 | \f \adv 110 | (places . at (current-place-name adv)) f adv 111 | 112 | func show-inventory : Adventure -> String = 113 | \adv 114 | if (empty? (inventory adv)) "(empty)"; 115 | (join " " . map name . values . inventory) adv 116 | 117 | # Place functions 118 | 119 | func full-description : Place -> String = 120 | \place 121 | yield-all (description place); 122 | for (values; objects place) 123 | (yield-all . (" " ++) . short-description); 124 | for (values; items place) 125 | (yield-all . (" " ++) . short-description); 126 | for (values; directions place) 127 | (yield-all . (" " ++) . description); 128 | empty 129 | 130 | # Direction functions 131 | 132 | func == : Direction -> Direction -> Bool = 133 | \dir1 \dir2 134 | names dir1 == names dir2 135 | 136 | func != : Direction -> Direction -> Bool = 137 | not (==) 138 | 139 | # Object functions 140 | 141 | func == : Object -> Object -> Bool = 142 | \object1 \object2 143 | names object1 == names object2 144 | 145 | func != : Object -> Object -> Bool = 146 | not (==) 147 | 148 | # Item functions 149 | 150 | func == : Item -> Item -> Bool = 151 | \item1 \item2 152 | name item1 == name item2 153 | 154 | func != : Item -> Item -> Bool = 155 | not (==) 156 | 157 | # Helper functions for building commands and actions 158 | 159 | func pick : Item -> Adventure -> Adventure = 160 | \item \adv 161 | start-with adv; 162 | (current-place . items) <- remove item; 163 | inventory <- add item; 164 | return self 165 | 166 | func use : Object -> Action -> Adventure -> Adventure = 167 | \object \action \adv 168 | start-with adv; 169 | inventory <- - items action; 170 | self <- outcome action; 171 | return self 172 | 173 | func combine : Combination -> Adventure -> Adventure = 174 | \combo \adv 175 | start-with adv; 176 | inventory <- - use-items combo; 177 | inventory <- + new-items combo; 178 | return self 179 | 180 | func go-to : String -> Adventure -> Adventure = 181 | current-place-name . const 182 | 183 | func add : Item -> Adventure -> Adventure = 184 | current-place . items . add 185 | 186 | func add : Object -> Adventure -> Adventure = 187 | current-place . objects . add 188 | 189 | func add : Direction -> Adventure -> Adventure = 190 | current-place . directions . add 191 | 192 | func remove : Item -> Adventure -> Adventure = 193 | current-place . items . remove 194 | 195 | func remove : Object -> Adventure -> Adventure = 196 | current-place . objects . remove 197 | 198 | func remove : Direction -> Adventure -> Adventure = 199 | current-place . directions . remove 200 | 201 | # Parsing and interpreting commands 202 | 203 | func special-words : Adventure -> List-Set String = 204 | \adv 205 | list-set (==); 206 | yield-all ["exit", "restart", "inventory", "look", "pick"]; 207 | for (values; inventory adv) 208 | (yield . name); 209 | for (values; items; current-place adv) 210 | (yield . name); 211 | for (values; objects; current-place adv) 212 | (yield-all . values . names); 213 | for ((concat . map) actions; values; objects; current-place adv) 214 | (yield-all . values . names); 215 | for (values; directions; current-place adv) 216 | (yield-all . values . names); 217 | for (combinations adv) 218 | (yield . name); 219 | empty 220 | 221 | func parse-words : String -> List-Set String = 222 | list-set (==) . split-no-empty whitespace? 223 | 224 | func decode-command : Adventure -> List-Set String -> Command = 225 | \adv \words 226 | let (special-words adv & words) \words 227 | 228 | if (words == list-set (==) ["inventory"]) 229 | (Command (show-inventory adv) self); 230 | 231 | if (words == list-set (==) ["look"]) 232 | (Command (full-description; current-place adv) self); 233 | 234 | for (values; inventory adv) ( 235 | \item \next 236 | if (words == list-set (==) ["look", name item]) 237 | (Command (long-description item) self); 238 | next 239 | ); 240 | 241 | for (values; items; current-place adv) ( 242 | \item \next 243 | if (words == list-set (==) ["look", name item]) 244 | (Command (long-description item) self); 245 | 246 | let (list-set (==) ["pick", name item]) \pick-words 247 | if (words == pick-words) 248 | (Command 249 | ("You picked the " ++ name item ++ ".") 250 | (pick item)); 251 | next 252 | ); 253 | 254 | for (values; objects; current-place adv) ( 255 | \object \next 256 | for (filter (not empty?); subsets (names object)) ( 257 | \name-words \next 258 | if (words == add "look" name-words) 259 | (Command (long-description object) self); 260 | next 261 | ); 262 | 263 | for (actions object) ( 264 | \action \next 265 | let (map name; values; items action) \required-items 266 | for (filter (not empty?); subsets (names action)) ( 267 | \action-words \next 268 | for (filter (not empty?); subsets (names object)) ( 269 | \name-words \next 270 | let (action-words + name-words + list-set (==) required-items) \required-words 271 | if ((words == required-words) && (items action <= inventory adv)) 272 | (Command 273 | (description action) 274 | (use object action)); 275 | next 276 | ); 277 | next 278 | ); 279 | next 280 | ); 281 | next 282 | ); 283 | 284 | for (values; directions; current-place adv) ( 285 | \dir \next 286 | for (filter (not empty?); subsets; names dir) ( 287 | \required-words \next 288 | if (words == required-words) ( 289 | let (at (destination dir); places adv) \new-place 290 | Command 291 | (go-description dir ++ " " ++ full-description new-place) 292 | (go-to; destination dir) 293 | ); 294 | next 295 | ); 296 | next 297 | ); 298 | 299 | for (combinations adv) ( 300 | \combo \next 301 | let (list-set (==) (name combo :: (map name; values; use-items combo))) \combo-words 302 | if ((words == combo-words) && (use-items combo <= inventory adv)) 303 | (Command 304 | (description combo) 305 | (combine combo)); 306 | next 307 | ); 308 | 309 | Command "Can't do that." self 310 | 311 | # Playing the adventure 312 | 313 | func play : Adventure -> IO = 314 | \start 315 | println "Welcome to the adventure! Are you ready?"; 316 | println "If not, type 'exit' to quit the game."; 317 | println "To play again, type 'restart'."; 318 | println "Actions include 'pick', 'look', 'inventory'. For other actions, try."; 319 | println "Common sense isn't guaranteed to work."; 320 | println ""; 321 | println (description; decode-command start; parse-words "look around"); 322 | 323 | start |> recur \loop \adv 324 | 325 | print "> "; 326 | scanln \input 327 | let (parse-words input) \words 328 | 329 | if (empty? words) 330 | (loop adv); 331 | 332 | if (words == list-set (==) ["exit"]) 333 | quit; 334 | if (words == list-set (==) ["restart"]) 335 | (play start); 336 | 337 | let (decode-command adv words) \command 338 | println (description command); 339 | 340 | loop (change command adv) 341 | -------------------------------------------------------------------------------- /examples/adventure/main.fn: -------------------------------------------------------------------------------- 1 | func main : IO = 2 | play lost-keys-story 3 | -------------------------------------------------------------------------------- /examples/adventure/story.fn: -------------------------------------------------------------------------------- 1 | func lost-keys-story : Adventure = 2 | adventure 3 | "office" 4 | ["office" => office, 5 | "hallway" => hallway, 6 | "miss quick's office" => miss-quick's-office, 7 | "kitchen" => kitchen, 8 | "victory" => victory, 9 | "death" => death] 10 | [] 11 | 12 | # Office 13 | 14 | func office : Place = 15 | place 16 | ("The coffee is waiting in the company kitchen. You are standing in your office. " ++ 17 | "You have been working here for many years, it's like your second home. " ++ 18 | "Last month you painted the walls green, " ++ 19 | "which makes for a good vibe when the whole city is so grey. ") 20 | [desk, chair, closed-door, window] 21 | [key] 22 | [] 23 | 24 | func desk : Object = 25 | object ["desk", "table"] 26 | "Your desk is right in front of you." 27 | ("A big, bulky wooden desk with not much functionality. " ++ 28 | "Since the job doesn't require much ingenuity, it's sufficient.") 29 | [] 30 | 31 | func chair : Object = 32 | object ["chair"] 33 | "Behind the desk is a nice, comfortable chair." 34 | ("You remember buying the chair at the IKEA some two years ago. " ++ 35 | "Walking back and forth, inspecting every single chair, " ++ 36 | "until your eyes laid down on this beautiful, soft, black chair. " ++ 37 | "It was a good decision.") 38 | [action ["spin"] 39 | "You spin the chair around. It spins full 360 degrees, landing in the original position." 40 | [] self, 41 | action ["sit"] 42 | "No time for that right now. The coffee is waiting." 43 | [] self] 44 | 45 | func closed-door : Object = 46 | object ["door"] 47 | "The door to the hallway is on the left." 48 | ("Pretty shitty metal door. Like the company couldn't bother to buy something more depressing. " ++ 49 | "You always make sure to lock them. The colleagues can't be trusted.") 50 | [action ["open"] 51 | "The door is locked." 52 | [] self, 53 | action ["open", "unlock", "use"] 54 | "The door opens, revealing the way out to the hallway." 55 | [key] (add open-door . remove closed-door)] 56 | 57 | func open-door : Direction = 58 | direction ["left", "door", "hallway", "hall"] 59 | "The door on the left is open." 60 | "You walk through the door and close it behind your back." 61 | "hallway" 62 | 63 | func window : Object = 64 | object ["window"] 65 | "Opposite the door, there's a window." 66 | "The plastic window is showing a view of a grey, industrialized city. At least it's a sunny day." 67 | [action ["jump"] 68 | "You jump out of the window, falling from the 104th floor. You died. Congratulations." 69 | [] (go-to "death")] 70 | 71 | func key : Item = 72 | item "key" 73 | "The key to the office is laying on the desk." 74 | "The key is small and a little rusty." 75 | 76 | # Hallway 77 | 78 | func hallway : Place = 79 | place 80 | "The hallway is long and roughly empty." 81 | [office-door, elevator-door, painting] 82 | [] 83 | [miss-quick's-open-door, kitchen-open-door] 84 | 85 | func office-door : Object = 86 | object ["door", "office"] 87 | "The door to your office is on one end." 88 | "The same old rusty metal door. Looks the same from the outside as it does from the inside of the office." 89 | [action ["open"] 90 | "The door is locked." 91 | [] self, 92 | action ["open", "unlock", "use"] 93 | "Oh... where did the key go?" 94 | [] self] 95 | 96 | func elevator-door : Object = 97 | object ["elevator"] 98 | "On the right side of the hallway is the elevator door." 99 | "The elevator is always disabled until 5PM." 100 | [] 101 | 102 | func painting : Object = 103 | object ["painting", "picture"] 104 | "There is a single painting on the wall." 105 | "Of course, it's a painting of the company president. What an ugly piece of shit." 106 | [] 107 | 108 | func miss-quick's-open-door : Direction = 109 | direction ["miss", "quick", "office"] 110 | ("Your colleague, Miss Quick, resides in an office right opposite yours. " ++ 111 | "Her door is always open. You can see her with her headphones on, " ++ 112 | "probably listening to some funky music.") 113 | "You quietly step inside her office. She hasn't noticed." 114 | "miss quick's office" 115 | 116 | func kitchen-open-door : Direction = 117 | direction ["across", "kitchen",] 118 | ("The kitchen is straight across the hall.") 119 | ("Walking past the portrait of the boss is always uncomfortable, " ++ 120 | "but it's the only way to the kitchen - the only good place.") 121 | "kitchen" 122 | 123 | # Miss Quick's Office 124 | 125 | func miss-quick's-office : Place = 126 | place 127 | "Miss Quick's office." 128 | [closed-drawer] 129 | [] 130 | [way-out] 131 | 132 | func closed-drawer : Object = 133 | object ["drawer"] 134 | "Her table has a drawer, unlike yours. Well, she's probably gotta more work to do." 135 | "The drawer isn't fully closed." 136 | [action ["open", "pull"] 137 | "You carefully open the drawer. She still hasn't noticed you. What?!?! There it is! Your key!" 138 | [] (add key-in-the-drawer . add open-drawer . remove closed-drawer)] 139 | 140 | func open-drawer : Object = 141 | object ["drawer"] 142 | "The drawer on the table is now open." 143 | "Your office key is in the drawer! It can't be anything else, you know it like nothing else." 144 | [] 145 | 146 | func key-in-the-drawer : Object = 147 | object ["key"] 148 | "There's your office key! Right in the drawer!" 149 | "Your office key is in the drawer! It can't be anything else, you know it like nothing else." 150 | [action ["pick"] 151 | ("Oh no, she noticed... whoa, Miss Quick turned full red, jumped straight out of her chair " ++ 152 | "right between the door, blocking the exit. You caught her red handed and she won't let you out alive.") 153 | [] (add miss-quick . remove way-out . remove open-drawer . remove key-in-the-drawer)] 154 | 155 | func miss-quick : Object = 156 | object ["miss", "quick"] 157 | "Miss Quick is standing in the door." 158 | "Her eyes are flaming like devil's! She probably wants to kill you." 159 | [action ["attack", "punch", "hit"] 160 | "Oh hey, let's punch her in the face! Oh no... miss Quick pulled out a huge kitchen knife and stabbed you to death." 161 | [] (go-to "death"), 162 | action ["attack", "stab"] 163 | "That'll work, let's stab her first! Oh no... she pulled out a gun and bang! You're dead." 164 | [knife] (go-to "death"), 165 | action ["attack", "throw"] 166 | ("Throw that hot coffee on the lady! There we go! Miss Quick screams and falls to the floor. You take the key, " ++ 167 | "jump over her limp body and dash back to your office. You shut the door behind, exhale, sit in your chair. " ++ 168 | "What an interesting day this was. You won!") 169 | [coffee] (go-to "victory")] 170 | 171 | func way-out : Direction = 172 | direction ["back", "out", "hall", "hallway"] 173 | "You can still go back to the hallway. No need to cause trouble." 174 | "You quietly step back from the office. Ooof, how could she not notice?" 175 | "hallway" 176 | 177 | # Kitchen 178 | 179 | func kitchen : Place = 180 | place 181 | "Finally, the kitchen!" 182 | [microwave] 183 | [coffee, knife] 184 | [back-to-the-hallway] 185 | 186 | func microwave : Object = 187 | object ["microwave"] 188 | "Oh, there's the microwave the boss bought but no one can operate it." 189 | "What are look those buttons for? Where do I set the minutes?" 190 | [] 191 | 192 | func knife : Item = 193 | item "knife" 194 | "There's also a knife lying here." 195 | "A big, dangerous kitchen knife. Someone could die." 196 | 197 | func coffee : Item = 198 | item "coffee" 199 | ("And there it is! The coffee! Fresh, steam rising from the cup, great smell. " ++ 200 | "If there's one thing this company does well, it's gotta be the coffee. " ++ 201 | "All that remains is take to it to the office and enjoy.") 202 | "Why just look? Take it while it's hot!" 203 | 204 | func back-to-the-hallway : Direction = 205 | direction ["back", "hall", "hallway"] 206 | "The hallway is right behind your back." 207 | "There we go! Back to the office!" 208 | "hallway" 209 | 210 | # Victory 211 | 212 | func victory : Place = 213 | place "You won the game!" [] [] [] 214 | 215 | # Death 216 | 217 | func death : Place = 218 | place "You are dead now." [] [] [] 219 | -------------------------------------------------------------------------------- /examples/guessing-game.fn: -------------------------------------------------------------------------------- 1 | # Run with `funkycmd` 2 | 3 | func main : IO = 4 | println "Think a number between 1 and 100."; 5 | 6 | # Function `recur` creates an anonymous recursive function. 7 | # You can think of it as a goto label with possible arguments. 8 | # For example: `recur \xs 1 :: xs` is an infinite list [1, 1, 1, ...]. 9 | # Here, `recur \loop \lo \hi ...` is a recursive function with two arguments: `lo` and `hi`. 10 | # We can use the `loop` identifier to make recursive calls inside the body of this function. 11 | # Using `100 |> 1 |> ...` we supply initial arguments to this function. 12 | 100 |> 1 |> recur \loop \lo \hi 13 | 14 | # We keep track of the lower and upper bound of the possible answer and guess the middle. 15 | let ((lo + hi) / 2) \mid 16 | print ("Is it " ++ string mid ++ "? (answer: yes/less/more) "); 17 | scanln \answer 18 | 19 | # If the answer is "yes", we express happiness and quit the program. 20 | if (answer == "yes") ( 21 | println "Weeee!! See you next time!"; 22 | quit 23 | ); 24 | 25 | # If the answer if "less" or "more", we continue the loop with updated bounds. 26 | if (answer == "less") (loop lo (mid - 1)); 27 | if (answer == "more") (loop (mid + 1) hi); 28 | 29 | # If the answer is neither "yes", "less", nor "more", we report invalid answer 30 | # and continue with the original bounds. 31 | println "Invalid answer. Please answer one of 'yes', 'less', or 'more'."; 32 | loop lo hi 33 | -------------------------------------------------------------------------------- /examples/hello-world.fn: -------------------------------------------------------------------------------- 1 | # Run with `funkycmd` 2 | 3 | func main : IO = 4 | println "Hello, world!"; 5 | quit 6 | -------------------------------------------------------------------------------- /examples/shell-simulator/commands.fn: -------------------------------------------------------------------------------- 1 | alias Command = String -> List String -> Directory -> (Directory -> IO) -> IO 2 | 3 | func commands : List-Dict String Command = 4 | list-dict (==) invalid-command [ 5 | "pwd" => pwd, 6 | "cd" => cd, 7 | "ls" => ls, 8 | "mkdir" => mkdir, 9 | "touch" => touch, 10 | "rm" => rm, 11 | ] 12 | 13 | func invalid-command : Command = 14 | \cmd \args \d \next 15 | println (cmd ++ ": command does not exist"); 16 | next d 17 | 18 | func pwd : Command = 19 | \cmd \args \d \next 20 | if (not empty? args) ( 21 | println "print the current directory"; 22 | println (" usage: " ++ cmd); 23 | next d 24 | ); 25 | println (current-path d); 26 | next d 27 | 28 | func cd : Command = 29 | \cmd \args \d \next 30 | if (length args != 1) ( 31 | println "move to a directory"; 32 | println (" usage: " ++ cmd ++ " "); 33 | next d 34 | ); 35 | if-error (\msg println msg; next d); 36 | let-ok (move-to-path (at! 0 args) d) \new-d 37 | next new-d 38 | 39 | func ls : Command = 40 | \cmd \args \d \next 41 | let (if (empty? args) ["."] args) \args 42 | if (length args != 1) ( 43 | println "list the contents of a directory (default current)"; 44 | println (" usage: " ++ cmd ++ " [path]"); 45 | next d 46 | ); 47 | if-error (\msg println msg; next d); 48 | let-ok (move-to-path (at! 0 args) d) \ls-d 49 | for (list-directory ls-d) 50 | println; 51 | next d 52 | 53 | func mkdir : Command = 54 | \cmd \args \d \next 55 | if (length args != 1) ( 56 | println "create a new sub-directory in the current directory"; 57 | println (" usage: " ++ cmd ++ " "); 58 | next d 59 | ); 60 | let (at! 0 args) \name 61 | if (any (== '/') name) ( 62 | println "directory name cannot contain '/'"; 63 | next d 64 | ); 65 | if-error (\msg println msg; next d); 66 | let-ok (make-directory name d) \new-d 67 | next new-d 68 | 69 | func touch : Command = 70 | \cmd \args \d \next 71 | if (length args != 1) ( 72 | println "create a new file in the current directory"; 73 | println (" usage: " ++ cmd ++ " "); 74 | next d 75 | ); 76 | let (at! 0 args) \name 77 | if (any (== '/') name) ( 78 | println "file name cannot contain '/'"; 79 | next d 80 | ); 81 | if-error (\msg println msg; next d); 82 | let-ok (make-file name d) \new-d 83 | next new-d 84 | 85 | func rm : Command = 86 | \cmd \args \d \next 87 | if (length args != 1) ( 88 | println "remove a file or a directory from the current directory"; 89 | println (" usage: " ++ cmd ++ " "); 90 | next d 91 | ); 92 | let (at! 0 args) \name 93 | if (any (== '/') name) ( 94 | println "file or directory name cannot contain '/'"; 95 | next d 96 | ); 97 | if-error (\msg println msg; next d); 98 | let-ok (remove-child name d) \new-d 99 | next new-d 100 | -------------------------------------------------------------------------------- /examples/shell-simulator/file-system.fn: -------------------------------------------------------------------------------- 1 | union File-System = 2 | file File | 3 | dir Directory | 4 | 5 | record File 6 | 7 | record Directory = 8 | name : String, 9 | parent : Directory, 10 | children : List-Dict String File-System, 11 | 12 | func split-path : String -> List String = 13 | \path 14 | split (== '/') (if (not empty? path && last! path == '/') (take -1 path) path) 15 | 16 | func invalid-directory : Directory = 17 | Directory "" invalid-directory (list-dict (==) (dir invalid-directory) []) 18 | 19 | func empty-directory : String -> Directory -> Directory = 20 | \name \parent 21 | Directory name parent (list-dict (==) (dir invalid-directory) []) 22 | 23 | func new-root-directory : Directory = 24 | empty-directory "" new-root-directory 25 | 26 | func current-path : Directory -> String = 27 | \d 28 | if (name d == "") "/"; 29 | current-path (parent d) ++ name d ++ "/" 30 | 31 | func move-up : Directory -> Directory = 32 | \d 33 | if (name d == "") d; 34 | start-with (parent d); 35 | (children . at (name d)) := dir d; # the current directory might have changed, keep it consistent 36 | return self 37 | 38 | func move-to-child : String -> Directory -> Result Directory = 39 | \name \d 40 | if (not contains? name (children d)) 41 | (error "no such file or directory"); 42 | switch at name (children d) 43 | case file \f 44 | error "not a directory" 45 | case dir \next-d 46 | start-with next-d; 47 | parent := d; # the current directory might have changed 48 | return ok 49 | 50 | func move-to-root : Directory -> Directory = 51 | \d 52 | if (name d == "") d; 53 | move-to-root (move-up d) 54 | 55 | func move-to-path : String -> Directory -> Result Directory = 56 | \path \d 57 | split-path path |> d |> recur \loop \d \parts 58 | if-none (ok d); 59 | let-:: parts \head \tail 60 | if (head == "") (loop (move-to-root d) tail); 61 | if (head == ".") (loop d tail); 62 | if (head == "..") (loop (move-up d) tail); 63 | if-error (\msg error msg); 64 | let-ok (move-to-child head d) \next-d 65 | loop next-d tail 66 | 67 | func list-directory : Directory -> List String = 68 | \d 69 | sort (<) (keys; children d) 70 | 71 | func make-file : String -> Directory -> Result Directory = 72 | \name \d 73 | if (contains? name (children d)) 74 | (error "file or directory already exists"); 75 | start-with d; 76 | (children . at name) := file File; 77 | return ok 78 | 79 | func make-directory : String -> Directory -> Result Directory = 80 | \name \d 81 | if (contains? name (children d)) 82 | (error "file or directory already exists"); 83 | start-with d; 84 | (children . at name) := dir (empty-directory name d); 85 | return ok 86 | 87 | func remove-child : String -> Directory -> Result Directory = 88 | \name \d 89 | if (not contains? name (children d)) 90 | (error "no such file or directory"); 91 | start-with d; 92 | children <- remove name; 93 | return ok 94 | -------------------------------------------------------------------------------- /examples/shell-simulator/main.fn: -------------------------------------------------------------------------------- 1 | func main : IO = 2 | println ("commands: " ++ join " " (sort (<) (keys commands))); 3 | new-root-directory |> recur \loop \d 4 | print "$ "; 5 | scanln \input 6 | let (split-no-empty whitespace? input) \parts 7 | if-none (loop d); 8 | let-:: parts \cmd \args 9 | (at cmd commands) cmd args d \new-d 10 | loop new-d 11 | -------------------------------------------------------------------------------- /examples/simple-chess/board.fn: -------------------------------------------------------------------------------- 1 | union Side = white | black 2 | union Figure = pawn | rook | knight | bishop | queen | king 3 | 4 | func string : Side -> String = 5 | \side 6 | switch side 7 | case white "white" 8 | case black "black" 9 | 10 | func white? : Side -> Bool = 11 | \side 12 | switch side 13 | case white true 14 | case black false 15 | 16 | func black? : Side -> Bool = not white? 17 | 18 | func opposite : Side -> Side = 19 | \side 20 | switch side 21 | case white black 22 | case black white 23 | 24 | func == : Side -> Side -> Bool = 25 | \side1 \side2 26 | white? side1 == white? side2 27 | 28 | func != : Side -> Side -> Bool = 29 | not (==) 30 | 31 | record Piece = 32 | side : Side, 33 | figure : Figure, 34 | moved : Bool, 35 | 36 | func new-piece : Side -> Figure -> Piece = 37 | \side \figure 38 | Piece side figure false 39 | 40 | func white? : Piece -> Bool = white? . side 41 | func black? : Piece -> Bool = black? . side 42 | 43 | func string : Piece -> String = 44 | \piece 45 | switch figure piece 46 | case pawn if (white? piece) "♙" "♟" 47 | case rook if (white? piece) "♖" "♜" 48 | case knight if (white? piece) "♘" "♞" 49 | case bishop if (white? piece) "♗" "♝" 50 | case queen if (white? piece) "♕" "♛" 51 | case king if (white? piece) "♔" "♚" 52 | 53 | func piece : Char -> Maybe Piece = 54 | \char 55 | if (char == '♙') (some; new-piece white pawn); 56 | if (char == '♟') (some; new-piece black pawn); 57 | if (char == '♖') (some; new-piece white rook); 58 | if (char == '♜') (some; new-piece black rook); 59 | if (char == '♘') (some; new-piece white knight); 60 | if (char == '♞') (some; new-piece black knight); 61 | if (char == '♗') (some; new-piece white bishop); 62 | if (char == '♝') (some; new-piece black bishop); 63 | if (char == '♕') (some; new-piece white queen); 64 | if (char == '♛') (some; new-piece black queen); 65 | if (char == '♔') (some; new-piece white king); 66 | if (char == '♚') (some; new-piece black king); 67 | none 68 | 69 | record Position = 70 | row : Int, 71 | column : Int, 72 | 73 | func position : String -> Maybe Position = 74 | \str 75 | let-:: str \a \str 76 | let-:: str \b \str 77 | if (not empty? str) none; 78 | let (int a - int 'A') \c 79 | let (int b - int '1') \r 80 | some (Position r c) 81 | 82 | func == : Position -> Position -> Bool = 83 | \pos1 \pos2 84 | (row pos1 == row pos2) && 85 | (column pos1 == column pos2) 86 | 87 | func != : Position -> Position -> Bool = 88 | not (==) 89 | 90 | record Delta = 91 | row-by : Int, 92 | column-by : Int, 93 | 94 | func + : Position -> Delta -> Position = 95 | \pos \delta 96 | Position (row pos + row-by delta) (column pos + column-by delta) 97 | 98 | func + : Delta -> Delta -> Delta = 99 | \delta1 \delta2 100 | Delta (row-by delta1 + row-by delta2) (column-by delta1 + column-by delta2) 101 | 102 | func transpose : Delta -> Delta = 103 | \delta 104 | Delta (column-by delta) (row-by delta) 105 | 106 | func - : Position -> Position -> Delta = 107 | \pos1 \pos2 108 | Delta (row pos2 - row pos1) (column pos2 - column pos1) 109 | 110 | func string : Position -> String = 111 | \pos 112 | ['A' + column pos, '1' + row pos] 113 | 114 | record Board = 115 | rows : Field (Maybe Piece), 116 | 117 | func initial-board : Board = 118 | ["♜♞♝♛♚♝♞♜", 119 | "♟♟♟♟♟♟♟♟", 120 | " ", 121 | " ", 122 | " ", 123 | " ", 124 | "♙♙♙♙♙♙♙♙", 125 | "♖♘♗♕♔♗♘♖"] 126 | |> reverse 127 | |> map (map piece) 128 | |> field none 129 | |> Board 130 | 131 | func at : Int -> Int -> Board -> Maybe Piece = 132 | \r \c \board 133 | at r c (rows board) 134 | 135 | func at : Position -> Board -> Maybe Piece = \pos at (row pos) (column pos) 136 | 137 | func string : Board -> String = 138 | \board 139 | yield-all " ABCDEFGH \n"; 140 | for (reverse; rangex 8) ( 141 | \r \next 142 | yield-all (string; r + 1); 143 | yield-all ((concat . map) (\c " " ? map string (at r c board)) (rangex 8)); 144 | yield-all (string; r + 1); 145 | yield '\n'; 146 | next 147 | ); 148 | " ABCDEFGH \n" 149 | -------------------------------------------------------------------------------- /examples/simple-chess/main.fn: -------------------------------------------------------------------------------- 1 | func print-board-and-turn : Board -> Side -> IO -> IO = 2 | \board \turn \next 3 | print (string board); 4 | println ("It's " ++ string turn ++ "'s turn."); 5 | println ""; 6 | next 7 | 8 | func main : IO = 9 | println "Commands:"; 10 | println " exit end the program"; 11 | println " restart start the game over"; 12 | println " undo revert the last move"; 13 | println " moves list all available moves"; 14 | println " moves XY list all available moves from XY"; 15 | println " XYZW make a move from XY to ZW"; 16 | println ""; 17 | 18 | white |> initial-board |> [] |> recur \new-turn \history \board \turn 19 | print-board-and-turn board turn; 20 | 21 | when (check? turn board) 22 | (println "Check!"); 23 | when (checkmate? turn board) 24 | (println ("Checkmate! " ++ at 0 upper (string; opposite turn) ++ " won!")); 25 | when (stalemate? turn board) 26 | (println "Stalemate!"); 27 | 28 | recur \loop 29 | 30 | print "> "; 31 | scanln \input 32 | let (split-no-empty whitespace? input) \parts 33 | 34 | if (empty? parts) 35 | loop; 36 | 37 | let (first! parts) \command 38 | 39 | if (command == "exit") 40 | quit; 41 | 42 | if (command == "restart") 43 | main; 44 | 45 | if (command == "undo") ( 46 | if-none ( 47 | println "No turn made yet."; 48 | loop 49 | ); 50 | let-:: history \last \prev-history 51 | new-turn prev-history last (opposite turn) 52 | ); 53 | 54 | if (command == "moves") ( 55 | if (length parts == 1) ( 56 | let (all-moves turn board) \moves 57 | let (map (\m string (first m) ++ string (second m)) moves) \moves-str 58 | println (join " " moves-str); 59 | loop 60 | ); 61 | let (at! 1 parts) \from-str 62 | if-none ( 63 | println ("invalid position: " ++ from-str); 64 | loop 65 | ); 66 | let-some (position from-str) \from 67 | if (not in-board? from) ( 68 | println ("position not inside board: " ++ from-str); 69 | loop 70 | ); 71 | println (join " " (map string; moves from board)); 72 | loop 73 | ); 74 | 75 | let (filter (letter? || digit?) input) \letters-and-digits 76 | let (take 2 letters-and-digits) \from-str 77 | let (drop 2 letters-and-digits) \to-str 78 | if-none ( 79 | println ("invalid position: " ++ from-str); 80 | loop 81 | ); 82 | let-some (position from-str) \from 83 | if-none ( 84 | println ("invalid position: " ++ to-str); 85 | loop 86 | ); 87 | let-some (position to-str) \to 88 | 89 | if (not (valid-move? turn from to board)) ( 90 | println ("move not allowed: " ++ string from ++ string to); 91 | loop 92 | ); 93 | 94 | new-turn (board :: history) (move from to board) (opposite turn) 95 | -------------------------------------------------------------------------------- /examples/simple-chess/rules.fn: -------------------------------------------------------------------------------- 1 | union Trace-Mode = move | take | move&take 2 | 3 | func move? : Trace-Mode -> Bool = 4 | \mode 5 | switch mode 6 | case move true 7 | case take false 8 | case move&take true 9 | 10 | func take? : Trace-Mode -> Bool = 11 | \mode 12 | switch mode 13 | case move false 14 | case take true 15 | case move&take true 16 | 17 | alias Rel-Trace = Pair Trace-Mode (List Delta) 18 | alias Abs-Trace = Pair Trace-Mode (List Position) 19 | 20 | func pawn-traces : Side -> Bool -> List Rel-Trace = 21 | \side \moved 22 | let (if (white? side) (Delta +1 0) (Delta -1 0)) \step 23 | yield-all (map (pair take) [[step + Delta 0 +1], [step + Delta 0 -1]]); 24 | if moved [pair move [step]]; 25 | [pair move [step, step + step]] 26 | 27 | func rook-traces : List Rel-Trace = 28 | [Delta +1 0, Delta -1 0, Delta 0 +1, Delta 0 -1] 29 | |> map (\step iterate (+ step) step) 30 | |> map (pair move&take) 31 | 32 | func knight-traces : List Rel-Trace = 33 | let [Delta 0 +1, Delta 0 -1] \short-step 34 | let [Delta +2 0, Delta -2 0] \long-step 35 | let (pairwise (+) short-step long-step) \H-steps 36 | (H-steps ++ map transpose H-steps) 37 | |> map (\x [x]) 38 | |> map (pair move&take) 39 | 40 | func bishop-traces : List Rel-Trace = 41 | [Delta +1 +1, Delta +1 -1, Delta -1 +1, Delta -1 -1] 42 | |> map (\step iterate (+ step) step) 43 | |> map (pair move&take) 44 | 45 | func queen-traces : List Rel-Trace = 46 | rook-traces ++ bishop-traces 47 | 48 | func king-traces : List Rel-Trace = 49 | map (map-second (take 1)) queen-traces 50 | 51 | func rel-traces-of : Piece -> List Rel-Trace = 52 | \piece 53 | switch figure piece 54 | case pawn pawn-traces (side piece) (moved piece) 55 | case rook rook-traces 56 | case knight knight-traces 57 | case bishop bishop-traces 58 | case queen queen-traces 59 | case king king-traces 60 | 61 | func in-board? : Position -> Bool = 62 | \pos 63 | (row pos >= 0) && 64 | (row pos <= 7) && 65 | (column pos >= 0) && 66 | (column pos <= 7) 67 | 68 | func cut-abs-trace : Side -> Board -> Abs-Trace -> List Position = 69 | \turn \board \trace 70 | start-with (second trace); 71 | self <- take-while in-board?; 72 | self <- take-while (\p turn != opposite turn ? map side (at p board)); # stop before first own piece 73 | self <- take-until (\p some? (at p board)); # stop at the first enemy piece 74 | when (not move? (first trace)) 75 | (self <- drop-while (\p none? (at p board))); 76 | when (not take? (first trace)) 77 | (self <- take-while (\p none? (at p board))); 78 | return self 79 | 80 | func moves-ignore-check : Position -> Board -> List Position = 81 | \from \board 82 | if-none []; 83 | let-some (at from board) \piece 84 | rel-traces-of piece 85 | |> map (map-second; map (from +)) # turn relative Deltas into absolute Positions 86 | |> map (cut-abs-trace (side piece) board) 87 | |> concat 88 | 89 | func moves : Position -> Board -> List Position = 90 | \from \board 91 | if-none []; 92 | let-some (at from board) \piece 93 | moves-ignore-check from board 94 | |> filter (\to not check? (side piece) (move from to board)) 95 | 96 | func all-moves-ignore-check : Side -> Board -> List (Pair Position Position) = 97 | \turn \board 98 | for (pairwise Position (range 0 7) (range 0 7)) ( 99 | \from \next 100 | if (turn != opposite turn ? map side (at from board)) 101 | next; 102 | yield-all (map (pair from) (moves-ignore-check from board)); 103 | next 104 | ); 105 | empty 106 | 107 | func all-moves : Side -> Board -> List (Pair Position Position) = 108 | \turn \board 109 | all-moves-ignore-check turn board 110 | |> filter (\p let-pair p \from \to not check? turn (move from to board)) 111 | 112 | func positions-of : Side -> Figure -> Board -> List Position = 113 | \sid \fig \board 114 | pick (pairwise Position (range 0 7) (range 0 7)) \pos 115 | if-none empty; 116 | let-some (at pos board) \piece 117 | if (string piece == string (new-piece sid fig)) 118 | [pos]; 119 | empty 120 | 121 | func check? : Side -> Board -> Bool = 122 | \turn \board 123 | if-none false; # no king on the board, no check possible 124 | let-some (first; positions-of turn king board) \pos 125 | any (\p p == pos) (map second (all-moves-ignore-check (opposite turn) board)) 126 | 127 | func checkmate? : Side -> Board -> Bool = 128 | check? && empty? . all-moves 129 | 130 | func stalemate? : Side -> Board -> Bool = 131 | not check? && empty? . all-moves 132 | 133 | func valid-move? : Side -> Position -> Position -> Board -> Bool = 134 | \turn \from \to \board 135 | if (turn != opposite turn ? map side (at from board)) 136 | false; 137 | any (== to) (moves from board) 138 | 139 | func move : Position -> Position -> Board -> Board = 140 | \from \to \board 141 | start-with board; 142 | (at (row from) (column from) . rows) -> \from-piece 143 | let (map (moved; const true) from-piece) \from-piece 144 | (rows . at (row to) (column to)) := from-piece; 145 | (rows . at (row from) (column from)) := none; 146 | return self 147 | -------------------------------------------------------------------------------- /expr/expr.go: -------------------------------------------------------------------------------- 1 | package expr 2 | 3 | import ( 4 | "math/big" 5 | 6 | "github.com/faiface/funky/parse/parseinfo" 7 | "github.com/faiface/funky/types" 8 | ) 9 | 10 | type Expr interface { 11 | leftString() string 12 | rightString() string 13 | String() string 14 | 15 | TypeInfo() types.Type 16 | WithTypeInfo(types.Type) Expr 17 | SourceInfo() *parseinfo.Source 18 | 19 | Map(func(Expr) Expr) Expr 20 | } 21 | 22 | type ( 23 | Char struct { 24 | SI *parseinfo.Source 25 | Value rune 26 | } 27 | 28 | Int struct { 29 | SI *parseinfo.Source 30 | Value *big.Int 31 | } 32 | 33 | Float struct { 34 | SI *parseinfo.Source 35 | Value float64 36 | } 37 | 38 | Var struct { 39 | TI types.Type 40 | SI *parseinfo.Source 41 | Name string 42 | } 43 | 44 | Abst struct { 45 | TI types.Type 46 | SI *parseinfo.Source 47 | Bound *Var 48 | Body Expr 49 | } 50 | 51 | Appl struct { 52 | TI types.Type 53 | Left Expr 54 | Right Expr 55 | } 56 | 57 | Strict struct { 58 | TI types.Type 59 | SI *parseinfo.Source 60 | Expr Expr 61 | } 62 | 63 | Switch struct { 64 | TI types.Type 65 | SI *parseinfo.Source 66 | Expr Expr 67 | Cases []struct { 68 | SI *parseinfo.Source 69 | Alt string 70 | Body Expr 71 | } 72 | } 73 | ) 74 | 75 | func (c *Char) TypeInfo() types.Type { return &types.Appl{Name: "Char"} } 76 | func (i *Int) TypeInfo() types.Type { return &types.Appl{Name: "Int"} } 77 | func (f *Float) TypeInfo() types.Type { return &types.Appl{Name: "Float"} } 78 | func (v *Var) TypeInfo() types.Type { return v.TI } 79 | func (a *Abst) TypeInfo() types.Type { return a.TI } 80 | func (a *Appl) TypeInfo() types.Type { return a.TI } 81 | func (s *Strict) TypeInfo() types.Type { return s.TI } 82 | func (s *Switch) TypeInfo() types.Type { return s.TI } 83 | 84 | func (c *Char) WithTypeInfo(types.Type) Expr { return c } 85 | func (i *Int) WithTypeInfo(types.Type) Expr { return i } 86 | func (f *Float) WithTypeInfo(types.Type) Expr { return f } 87 | func (v *Var) WithTypeInfo(t types.Type) Expr { return &Var{t, v.SI, v.Name} } 88 | func (a *Abst) WithTypeInfo(t types.Type) Expr { return &Abst{t, a.SI, a.Bound, a.Body} } 89 | func (a *Appl) WithTypeInfo(t types.Type) Expr { return &Appl{t, a.Left, a.Right} } 90 | func (s *Strict) WithTypeInfo(t types.Type) Expr { return &Strict{t, s.SI, s.Expr} } 91 | func (s *Switch) WithTypeInfo(t types.Type) Expr { 92 | newCases := make([]struct { 93 | SI *parseinfo.Source 94 | Alt string 95 | Body Expr 96 | }, len(s.Cases)) 97 | copy(newCases, s.Cases) 98 | return &Switch{t, s.SI, s.Expr, newCases} 99 | } 100 | 101 | func (c *Char) SourceInfo() *parseinfo.Source { return c.SI } 102 | func (i *Int) SourceInfo() *parseinfo.Source { return i.SI } 103 | func (f *Float) SourceInfo() *parseinfo.Source { return f.SI } 104 | func (v *Var) SourceInfo() *parseinfo.Source { return v.SI } 105 | func (a *Abst) SourceInfo() *parseinfo.Source { return a.SI } 106 | func (a *Appl) SourceInfo() *parseinfo.Source { return a.Left.SourceInfo() } 107 | func (s *Strict) SourceInfo() *parseinfo.Source { return s.SI } 108 | func (s *Switch) SourceInfo() *parseinfo.Source { return s.SI } 109 | 110 | func (c *Char) Map(f func(Expr) Expr) Expr { return f(c) } 111 | func (i *Int) Map(f func(Expr) Expr) Expr { return f(i) } 112 | func (f *Float) Map(fn func(Expr) Expr) Expr { return fn(f) } 113 | func (v *Var) Map(f func(Expr) Expr) Expr { return f(v) } 114 | func (a *Abst) Map(f func(Expr) Expr) Expr { 115 | return f(&Abst{a.TI, a.SI, a.Bound.Map(f).(*Var), a.Body.Map(f)}) 116 | } 117 | func (a *Appl) Map(f func(Expr) Expr) Expr { return f(&Appl{a.TI, a.Left.Map(f), a.Right.Map(f)}) } 118 | func (s *Strict) Map(f func(Expr) Expr) Expr { return f(&Strict{s.TI, s.SI, s.Expr.Map(f)}) } 119 | func (s *Switch) Map(f func(Expr) Expr) Expr { 120 | newCases := make([]struct { 121 | SI *parseinfo.Source 122 | Alt string 123 | Body Expr 124 | }, len(s.Cases)) 125 | for i := range newCases { 126 | newCases[i].SI = s.Cases[i].SI 127 | newCases[i].Alt = s.Cases[i].Alt 128 | newCases[i].Body = s.Cases[i].Body.Map(f) 129 | } 130 | return f(&Switch{s.TI, s.SI, s.Expr.Map(f), newCases}) 131 | } 132 | -------------------------------------------------------------------------------- /expr/string.go: -------------------------------------------------------------------------------- 1 | package expr 2 | 3 | import ( 4 | "fmt" 5 | "strconv" 6 | ) 7 | 8 | func (c *Char) leftString() string { return c.String() } 9 | func (i *Int) leftString() string { return i.String() } 10 | func (f *Float) leftString() string { return f.String() } 11 | func (v *Var) leftString() string { return v.Name } 12 | func (a *Abst) leftString() string { return "(" + a.String() + ")" } 13 | func (a *Appl) leftString() string { return a.String() } 14 | func (s *Strict) leftString() string { return s.String() } 15 | func (s *Switch) leftString() string { return "(" + s.String() + ")" } 16 | 17 | func (c *Char) rightString() string { return c.String() } 18 | func (i *Int) rightString() string { return i.String() } 19 | func (f *Float) rightString() string { return f.String() } 20 | func (v *Var) rightString() string { return v.Name } 21 | func (a *Abst) rightString() string { return "(" + a.String() + ")" } 22 | func (a *Appl) rightString() string { return "(" + a.String() + ")" } 23 | func (s *Strict) rightString() string { return s.String() } 24 | func (s *Switch) rightString() string { return s.String() } 25 | 26 | func (c *Char) String() string { return strconv.QuoteRune(c.Value) } 27 | func (i *Int) String() string { return i.Value.Text(10) } 28 | func (f *Float) String() string { return fmt.Sprint(f.Value) } 29 | func (v *Var) String() string { return v.Name } 30 | func (a *Abst) String() string { return fmt.Sprintf("\\%v %v", a.Bound, a.Body) } 31 | func (a *Appl) String() string { 32 | return fmt.Sprintf("%s %s", a.Left.leftString(), a.Right.rightString()) 33 | } 34 | func (s *Strict) String() string { return fmt.Sprintf("(strict %v)", s.Expr) } 35 | func (s *Switch) String() string { 36 | str := fmt.Sprintf("switch %v", s.Expr.String()) 37 | for _, cas := range s.Cases { 38 | str += fmt.Sprintf(" case %s %v", cas.Alt, cas.Body.String()) 39 | } 40 | return str 41 | } 42 | -------------------------------------------------------------------------------- /interpreters/funkycmd/funkycmd: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/faiface/funky/f82808e4fa2d7e0dc7cac28ae0eca0daa9343452/interpreters/funkycmd/funkycmd -------------------------------------------------------------------------------- /interpreters/funkycmd/funkycmd.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/faiface/funky/f82808e4fa2d7e0dc7cac28ae0eca0daa9343452/interpreters/funkycmd/funkycmd.exe -------------------------------------------------------------------------------- /interpreters/funkycmd/main.go: -------------------------------------------------------------------------------- 1 | package main 2 | 3 | import ( 4 | "bufio" 5 | "fmt" 6 | "io" 7 | "os" 8 | 9 | "github.com/faiface/funky" 10 | "github.com/faiface/funky/runtime" 11 | ) 12 | 13 | func main() { 14 | program, cleanup := funky.Run("main") 15 | defer cleanup() 16 | in, out := bufio.NewReader(os.Stdin), bufio.NewWriter(os.Stdout) 17 | defer out.Flush() 18 | loop: 19 | for { 20 | switch program.Alternative() { 21 | case 0: // quit 22 | break loop 23 | case 1: // putc 24 | r := program.Field(0).Char() 25 | _, err := out.WriteRune(r) 26 | handleErr(err) 27 | if r == '\n' { 28 | out.Flush() 29 | } 30 | program = program.Field(1) 31 | case 2: // getc 32 | err := out.Flush() 33 | handleErr(err) 34 | r, _, err := in.ReadRune() 35 | if err == io.EOF { 36 | break loop 37 | } 38 | handleErr(err) 39 | program = program.Field(0).Apply(runtime.MkChar(r)) 40 | } 41 | } 42 | } 43 | 44 | func handleErr(err error) { 45 | if err != nil { 46 | fmt.Fprintln(os.Stderr, err) 47 | os.Exit(1) 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /parse/definitions.go: -------------------------------------------------------------------------------- 1 | package parse 2 | 3 | import ( 4 | "fmt" 5 | 6 | "github.com/faiface/funky/expr" 7 | "github.com/faiface/funky/types" 8 | ) 9 | 10 | type Definition struct { 11 | Name string 12 | Value interface{} // expr.Expr, *types.Record, *types.Union, *types.Alias 13 | } 14 | 15 | func Definitions(tokens []Token) ([]Definition, error) { 16 | tree, err := MultiTree(tokens) 17 | if err != nil { 18 | return nil, err 19 | } 20 | return TreeToDefinitions(tree) 21 | } 22 | 23 | func TreeToDefinitions(tree Tree) ([]Definition, error) { 24 | var definitions []Definition 25 | 26 | for tree != nil { 27 | before, at, after := FindNextSpecialOrBinding(true, tree, "record", "union", "alias", "func") 28 | if before != nil { 29 | return nil, &Error{ 30 | tree.SourceInfo(), 31 | fmt.Sprintf("expected record, union, alias or func"), 32 | } 33 | } 34 | definition, next, _ := FindNextSpecialOrBinding(true, after, "record", "union", "alias", "func") 35 | tree = next 36 | 37 | switch at.(*Special).Kind { 38 | case "record": 39 | name, record, err := treeToRecord(definition) 40 | if err != nil { 41 | return nil, err 42 | } 43 | definitions = append(definitions, Definition{name, record}) 44 | 45 | case "union": 46 | name, union, err := treeToUnion(definition) 47 | if err != nil { 48 | return nil, err 49 | } 50 | definitions = append(definitions, Definition{name, union}) 51 | 52 | case "alias": 53 | name, alias, err := treeToAlias(definition) 54 | if err != nil { 55 | return nil, err 56 | } 57 | definitions = append(definitions, Definition{name, alias}) 58 | 59 | case "func": 60 | name, body, err := treeToFunc(definition) 61 | if err != nil { 62 | return nil, err 63 | } 64 | definitions = append(definitions, Definition{name, body}) 65 | } 66 | } 67 | 68 | return definitions, nil 69 | } 70 | 71 | func treeToTypeHeader(tree Tree) (name string, args []string, err error) { 72 | header := Flatten(tree) 73 | if len(header) == 0 { 74 | return "", nil, &Error{tree.SourceInfo(), "missing type name"} 75 | } 76 | nameLit, ok := header[0].(*Literal) 77 | if !ok { 78 | return "", nil, &Error{header[0].SourceInfo(), "type name must be a simple identifier"} 79 | } 80 | name = nameLit.Value 81 | if !IsTypeName(name) { 82 | return "", nil, &Error{nameLit.SourceInfo(), "invalid type name (must contain an upper-case letter)"} 83 | } 84 | for _, argTree := range header[1:] { 85 | argLit, ok := argTree.(*Literal) 86 | if !ok { 87 | return "", nil, &Error{argTree.SourceInfo(), "type argument must be a simple identifier"} 88 | } 89 | argName := argLit.Value 90 | if !IsTypeVar(argName) { 91 | return "", nil, &Error{argLit.SourceInfo(), "invalid type variable (must not contain an upper-case letter)"} 92 | } 93 | args = append(args, argName) 94 | } 95 | return name, args, nil 96 | } 97 | 98 | func treeToRecord(tree Tree) (name string, record *types.Record, err error) { 99 | headerTree, _, fieldsTree := FindNextSpecialOrBinding(false, tree, "=") 100 | 101 | name, args, err := treeToTypeHeader(headerTree) 102 | if err != nil { 103 | return "", nil, err 104 | } 105 | 106 | var fields []types.Field 107 | 108 | for fieldsTree != nil { 109 | fieldTree, _, after := FindNextSpecialOrBinding(false, fieldsTree, ",") 110 | fieldsTree = after 111 | 112 | if fieldTree == nil { 113 | continue 114 | } 115 | 116 | field, err := TreeToExpr(fieldTree) 117 | if err != nil { 118 | return "", nil, err 119 | } 120 | fieldVar, ok := field.(*expr.Var) 121 | if !ok { 122 | return "", nil, &Error{field.SourceInfo(), "record field must be simple variable"} 123 | } 124 | if fieldVar.TypeInfo() == nil { 125 | return "", nil, &Error{field.SourceInfo(), "missing record field type"} 126 | } 127 | 128 | fields = append(fields, types.Field{ 129 | SI: fieldVar.SourceInfo(), 130 | Name: fieldVar.Name, 131 | Type: fieldVar.TypeInfo(), 132 | }) 133 | } 134 | 135 | return name, &types.Record{ 136 | SI: tree.SourceInfo(), 137 | Args: args, 138 | Fields: fields, 139 | }, nil 140 | } 141 | 142 | func treeToUnion(tree Tree) (name string, union *types.Union, err error) { 143 | headerTree, _, altsTree := FindNextSpecialOrBinding(false, tree, "=") 144 | 145 | name, args, err := treeToTypeHeader(headerTree) 146 | if err != nil { 147 | return "", nil, err 148 | } 149 | 150 | var alts []types.Alternative 151 | 152 | for altsTree != nil { 153 | altTree, _, after := FindNextSpecialOrBinding(false, altsTree, "|") 154 | altsTree = after 155 | 156 | if altTree == nil { 157 | continue 158 | } 159 | 160 | fieldTrees := Flatten(altTree) 161 | 162 | altNameExpr, err := TreeToExpr(fieldTrees[0]) 163 | if err != nil { 164 | return "", nil, err 165 | } 166 | if altNameExpr.TypeInfo() != nil { 167 | return "", nil, &Error{altNameExpr.SourceInfo(), "union alternative name cannot have type"} 168 | } 169 | altNameVar, ok := altNameExpr.(*expr.Var) 170 | if !ok { 171 | return "", nil, &Error{altNameExpr.SourceInfo(), "union alternative name must be simple variable"} 172 | } 173 | altName := altNameVar.Name 174 | 175 | var fields []types.Type 176 | for _, fieldTree := range fieldTrees[1:] { 177 | field, err := TreeToType(fieldTree) 178 | if err != nil { 179 | return "", nil, err 180 | } 181 | fields = append(fields, field) 182 | } 183 | 184 | alts = append(alts, types.Alternative{ 185 | SI: altTree.SourceInfo(), 186 | Name: altName, 187 | Fields: fields, 188 | }) 189 | } 190 | 191 | return name, &types.Union{ 192 | SI: tree.SourceInfo(), 193 | Args: args, 194 | Alts: alts, 195 | }, nil 196 | } 197 | 198 | func treeToAlias(tree Tree) (name string, alias *types.Alias, err error) { 199 | headerTree, _, typeTree := FindNextSpecialOrBinding(false, tree, "=") 200 | 201 | name, args, err := treeToTypeHeader(headerTree) 202 | if err != nil { 203 | return "", nil, err 204 | } 205 | 206 | typ, err := TreeToType(typeTree) 207 | if err != nil { 208 | return "", nil, err 209 | } 210 | 211 | return name, &types.Alias{ 212 | SI: tree.SourceInfo(), 213 | Args: args, 214 | Type: typ, 215 | }, nil 216 | } 217 | 218 | func treeToFunc(tree Tree) (name string, body expr.Expr, err error) { 219 | signatureTree, _, bodyTree := FindNextSpecialOrBinding(false, tree, "=") 220 | 221 | if signatureTree == nil { 222 | return "", nil, &Error{tree.SourceInfo(), "missing function name"} 223 | } 224 | if bodyTree == nil { 225 | return "", nil, &Error{tree.SourceInfo(), "missing function body"} 226 | } 227 | 228 | sigExpr, err := TreeToExpr(signatureTree) 229 | if err != nil { 230 | return "", nil, err 231 | } 232 | signature, ok := sigExpr.(*expr.Var) 233 | if !ok { 234 | return "", nil, &Error{tree.SourceInfo(), "function name must be simple variable"} 235 | } 236 | 237 | if signature.TypeInfo() == nil { 238 | return "", nil, &Error{ 239 | signature.SourceInfo(), 240 | "missing function type", 241 | } 242 | } 243 | 244 | body, err = TreeToExpr(bodyTree) 245 | if err != nil { 246 | return "", nil, err 247 | } 248 | 249 | if body.TypeInfo() != nil && !body.TypeInfo().Equal(signature.TypeInfo()) { 250 | return "", nil, &Error{ 251 | bodyTree.SourceInfo(), 252 | "required body type differs from type in signature", 253 | } 254 | } 255 | 256 | return signature.Name, body.WithTypeInfo(signature.TypeInfo()), nil 257 | } 258 | -------------------------------------------------------------------------------- /parse/expr.go: -------------------------------------------------------------------------------- 1 | package parse 2 | 3 | import ( 4 | "fmt" 5 | "math/big" 6 | "strconv" 7 | "unicode" 8 | "unicode/utf8" 9 | 10 | "github.com/faiface/funky/expr" 11 | "github.com/faiface/funky/parse/parseinfo" 12 | ) 13 | 14 | type LiteralKind int 15 | 16 | const ( 17 | LiteralIdentifier LiteralKind = iota 18 | LiteralNumber 19 | LiteralChar 20 | LiteralString 21 | ) 22 | 23 | func LiteralKindOf(s string) LiteralKind { 24 | r0, size := utf8.DecodeRuneInString(s) 25 | r1 := rune(0) 26 | if len(s) > size { 27 | r1, _ = utf8.DecodeRuneInString(s[size:]) 28 | } 29 | switch { 30 | case unicode.IsDigit(r0) || ((r0 == '-' || r0 == '+') && unicode.IsDigit(r1)): 31 | return LiteralNumber 32 | case r0 == '\'': 33 | return LiteralChar 34 | case r0 == '"': 35 | return LiteralString 36 | default: 37 | return LiteralIdentifier 38 | } 39 | } 40 | 41 | func Expr(tokens []Token) (expr.Expr, error) { 42 | tree, err := MultiTree(tokens) 43 | if err != nil { 44 | return nil, err 45 | } 46 | return TreeToExpr(tree) 47 | } 48 | 49 | func TreeToExpr(tree Tree) (expr.Expr, error) { 50 | if tree == nil { 51 | return nil, nil 52 | } 53 | 54 | beforeSpecial, atSpecial, _ := FindNextSpecialOrBinding(false, tree, ";", "switch", "strict") 55 | if beforeSpecial != nil && atSpecial != nil { 56 | left, err := TreeToExpr(beforeSpecial) 57 | if err != nil { 58 | return nil, err 59 | } 60 | right, err := TreeToExpr(atSpecial) 61 | if err != nil { 62 | return nil, err 63 | } 64 | if right == nil { 65 | return left, nil 66 | } 67 | return &expr.Appl{Left: left, Right: right}, nil 68 | } 69 | 70 | beforeColon, _, afterColon := FindNextSpecialOrBinding(false, tree, ":") 71 | if afterColon != nil { 72 | e, err := TreeToExpr(beforeColon) 73 | if err != nil { 74 | return nil, err 75 | } 76 | t, err := TreeToType(afterColon) 77 | if err != nil { 78 | return nil, err 79 | } 80 | return e.WithTypeInfo(t), nil 81 | } 82 | 83 | switch tree := tree.(type) { 84 | case *Literal: 85 | switch LiteralKindOf(tree.Value) { 86 | case LiteralIdentifier: 87 | return &expr.Var{SI: tree.SourceInfo(), Name: tree.Value}, nil 88 | case LiteralNumber: 89 | i := big.NewInt(0) 90 | _, ok := i.SetString(tree.Value, 10) 91 | if ok { 92 | return &expr.Int{SI: tree.SourceInfo(), Value: i}, nil 93 | } 94 | f, err := strconv.ParseFloat(tree.Value, 64) 95 | if err != nil { 96 | return nil, &Error{tree.SourceInfo(), err.Error()} 97 | } 98 | return &expr.Float{SI: tree.SourceInfo(), Value: f}, nil 99 | case LiteralChar: 100 | s, err := strconv.Unquote(tree.Value) 101 | if err != nil { 102 | return nil, &Error{tree.SourceInfo(), err.Error()} 103 | } 104 | r := []rune(s)[0] // has only one rune, no need to check 105 | return &expr.Char{SI: tree.SourceInfo(), Value: r}, nil 106 | case LiteralString: 107 | s, err := strconv.Unquote(tree.Value) 108 | if err != nil { 109 | return nil, &Error{tree.SourceInfo(), err.Error()} 110 | } 111 | // string literal syntactic sugar unfold 112 | runes := []rune(s) 113 | var stringExpr expr.Expr = &expr.Var{SI: tree.SourceInfo(), Name: "empty"} 114 | for i := len(runes) - 1; i >= 0; i-- { 115 | stringExpr = &expr.Appl{ 116 | Left: &expr.Appl{ 117 | Left: &expr.Var{SI: tree.SourceInfo(), Name: "::"}, 118 | Right: &expr.Char{SI: tree.SourceInfo(), Value: runes[i]}, 119 | }, 120 | Right: stringExpr, 121 | } 122 | } 123 | return stringExpr, nil 124 | } 125 | 126 | case *Paren: 127 | switch tree.Kind { 128 | case "(": 129 | if tree.Inside == nil { 130 | return nil, &Error{tree.SourceInfo(), "nothing inside parentheses"} 131 | } 132 | return TreeToExpr(tree.Inside) 133 | case "[": 134 | // list literal syntactic sugar undolf 135 | var elems []expr.Expr 136 | inside := tree.Inside 137 | for inside != nil { 138 | elemTree, _, after := FindNextSpecialOrBinding(true, inside, ",") 139 | inside = after 140 | elem, err := TreeToExpr(elemTree) 141 | if err != nil { 142 | return nil, err 143 | } 144 | elems = append(elems, elem) 145 | } 146 | var listExpr expr.Expr = &expr.Var{SI: tree.SI, Name: "empty"} 147 | for i := len(elems) - 1; i >= 0; i-- { 148 | listExpr = &expr.Appl{ 149 | Left: &expr.Appl{ 150 | Left: &expr.Var{SI: elems[i].SourceInfo(), Name: "::"}, 151 | Right: elems[i], 152 | }, 153 | Right: listExpr, 154 | } 155 | } 156 | return listExpr, nil 157 | } 158 | return nil, &Error{tree.SourceInfo(), fmt.Sprintf("unexpected: %s", tree.Kind)} 159 | 160 | case *Special: 161 | switch tree.Kind { 162 | case ";": 163 | return TreeToExpr(tree.After) 164 | case "switch": 165 | expTree, caseBindingTree, nextCasesTree := FindNextSpecialOrBinding(true, tree.After, "case") 166 | if expTree == nil { 167 | return nil, &Error{tree.SourceInfo(), "no expression to switch"} 168 | } 169 | exp, err := TreeToExpr(expTree) 170 | if err != nil { 171 | return nil, err 172 | } 173 | sw := &expr.Switch{SI: tree.SourceInfo(), Expr: exp} 174 | for caseBindingTree != nil { 175 | caseBodyTree, newCaseBindingTree, newNextCasesTree := FindNextSpecialOrBinding(true, nextCasesTree, "case") 176 | 177 | caseBinding := caseBindingTree.(*Binding) 178 | altExpr, err := TreeToExpr(caseBinding.Bound) 179 | if err != nil { 180 | return nil, err 181 | } 182 | alt, ok := altExpr.(*expr.Var) 183 | if !ok { 184 | return nil, &Error{altExpr.SourceInfo(), "union alternative must be a simple variable"} 185 | } 186 | if alt.TypeInfo() != nil { 187 | return nil, &Error{altExpr.SourceInfo(), "union alternative name cannot have type"} 188 | } 189 | 190 | body, err := TreeToExpr(caseBodyTree) 191 | if err != nil { 192 | return nil, err 193 | } 194 | 195 | sw.Cases = append(sw.Cases, struct { 196 | SI *parseinfo.Source 197 | Alt string 198 | Body expr.Expr 199 | }{caseBindingTree.SourceInfo(), alt.Name, body}) 200 | 201 | caseBindingTree = newCaseBindingTree 202 | nextCasesTree = newNextCasesTree 203 | } 204 | return sw, nil 205 | case "strict": 206 | exp, err := TreeToExpr(tree.After) 207 | if err != nil { 208 | return nil, err 209 | } 210 | if exp == nil { 211 | return nil, &Error{tree.SourceInfo(), "no expression after strict"} 212 | } 213 | return &expr.Strict{SI: tree.SourceInfo(), Expr: exp}, nil 214 | } 215 | return nil, &Error{tree.SourceInfo(), fmt.Sprintf("unexpected: %s", tree.Kind)} 216 | 217 | case *Binding: 218 | switch tree.Kind { 219 | case "\\": 220 | bound, err := TreeToExpr(tree.Bound) 221 | if err != nil { 222 | return nil, err 223 | } 224 | boundVar, ok := bound.(*expr.Var) 225 | if !ok { 226 | return nil, &Error{tree.SourceInfo(), "bound expression must be a simple variable"} 227 | } 228 | body, err := TreeToExpr(tree.After) 229 | if err != nil { 230 | return nil, err 231 | } 232 | if body == nil { 233 | return nil, &Error{tree.SourceInfo(), "no function body after binding"} 234 | } 235 | return &expr.Abst{SI: tree.SourceInfo(), Bound: boundVar, Body: body}, nil 236 | } 237 | return nil, &Error{tree.SourceInfo(), fmt.Sprintf("unexpected: %s", tree.Kind)} 238 | 239 | case *Prefix: 240 | left, err := TreeToExpr(tree.Left) 241 | if err != nil { 242 | return nil, err 243 | } 244 | right, err := TreeToExpr(tree.Right) 245 | if err != nil { 246 | return nil, err 247 | } 248 | if right == nil { 249 | return left, nil 250 | } 251 | return &expr.Appl{Left: left, Right: right}, nil 252 | 253 | case *Infix: 254 | in, err := TreeToExpr(tree.In) 255 | if err != nil { 256 | return nil, err 257 | } 258 | left, err := TreeToExpr(tree.Left) 259 | if err != nil { 260 | return nil, err 261 | } 262 | right, err := TreeToExpr(tree.Right) 263 | if err != nil { 264 | return nil, err 265 | } 266 | switch { 267 | case left == nil && right == nil: // (+) 268 | return in, nil 269 | case right == nil: // (1 +) 270 | return &expr.Appl{Left: in, Right: left}, nil 271 | case left == nil: // (+ 2) 272 | return &expr.Appl{ 273 | Left: &expr.Appl{Left: newFlipExpr(in.SourceInfo()), Right: in}, 274 | Right: right, 275 | }, nil 276 | default: // (1 + 2) 277 | return &expr.Appl{ 278 | Left: &expr.Appl{Left: in, Right: left}, 279 | Right: right, 280 | }, nil 281 | } 282 | } 283 | 284 | panic("unreachable") 285 | } 286 | 287 | func newFlipExpr(si *parseinfo.Source) expr.Expr { 288 | return &expr.Abst{ 289 | SI: si, 290 | Bound: &expr.Var{Name: "f"}, 291 | Body: &expr.Abst{ 292 | Bound: &expr.Var{Name: "x"}, 293 | Body: &expr.Abst{ 294 | Bound: &expr.Var{Name: "y"}, 295 | Body: &expr.Appl{ 296 | Left: &expr.Appl{ 297 | Left: &expr.Var{Name: "f"}, 298 | Right: &expr.Var{Name: "y"}, 299 | }, 300 | Right: &expr.Var{Name: "x"}, 301 | }, 302 | }, 303 | }, 304 | } 305 | } 306 | -------------------------------------------------------------------------------- /parse/parseinfo/parseinfo.go: -------------------------------------------------------------------------------- 1 | package parseinfo 2 | 3 | import "fmt" 4 | 5 | type Source struct { 6 | Filename string 7 | Line, Column int 8 | } 9 | 10 | func (s *Source) String() string { 11 | if s == nil { 12 | return "" 13 | } 14 | return fmt.Sprintf("%s:%d:%d", s.Filename, s.Line, s.Column) 15 | } 16 | -------------------------------------------------------------------------------- /parse/tokenize.go: -------------------------------------------------------------------------------- 1 | package parse 2 | 3 | import ( 4 | "strconv" 5 | "strings" 6 | "unicode" 7 | "unicode/utf8" 8 | 9 | "github.com/faiface/funky/parse/parseinfo" 10 | ) 11 | 12 | var SpecialRunes = []rune{'(', ')', '[', ']', '{', '}', ',', ';', '\\', '#'} 13 | 14 | func IsSpecialRune(r rune) bool { 15 | for _, special := range SpecialRunes { 16 | if r == special { 17 | return true 18 | } 19 | } 20 | return false 21 | } 22 | 23 | type Token struct { 24 | SourceInfo *parseinfo.Source 25 | Value string 26 | } 27 | 28 | func Tokenize(filename, s string) ([]Token, error) { 29 | var tokens []Token 30 | 31 | si := &parseinfo.Source{ 32 | Filename: filename, 33 | Line: 1, 34 | Column: 1, 35 | } 36 | 37 | for { 38 | // skip whitespace 39 | for len(s) > 0 { 40 | r, size := utf8.DecodeRuneInString(s) 41 | if !unicode.IsSpace(r) { 42 | break 43 | } 44 | s = s[size:] 45 | updateSIInPlace(si, r) 46 | } 47 | 48 | if len(s) == 0 { 49 | break 50 | } 51 | 52 | // handle special runes and comments 53 | r, size := utf8.DecodeRuneInString(s) 54 | if r == '#' { 55 | // comment, skip until end of line 56 | for len(s) > 0 { 57 | r, size := utf8.DecodeRuneInString(s) 58 | if r == '\n' { 59 | break 60 | } 61 | s = s[size:] 62 | updateSIInPlace(si, r) 63 | } 64 | continue 65 | } 66 | if IsSpecialRune(r) { 67 | tokens = append(tokens, Token{SourceInfo: si, Value: string(r)}) 68 | s = s[size:] 69 | si = updateSI(si, r) 70 | continue 71 | } 72 | 73 | // handle chars and strings 74 | if r == '\'' || r == '"' { 75 | var builder strings.Builder 76 | 77 | quote := byte(r) 78 | quoteSI := copySI(si) 79 | 80 | s = s[1:] // opening quote 81 | updateSIInPlace(si, r) 82 | builder.WriteByte(quote) 83 | 84 | for len(s) > 0 && s[0] != quote { 85 | _, _, tail, err := strconv.UnquoteChar(s, quote) 86 | if err != nil { 87 | return nil, &Error{si, err.Error()} 88 | } 89 | 90 | for len(s) > len(tail) { 91 | r, size := utf8.DecodeRuneInString(s) 92 | s = s[size:] 93 | updateSIInPlace(si, r) 94 | builder.WriteRune(r) 95 | } 96 | } 97 | 98 | if len(s) == 0 { 99 | return nil, &Error{si, "unclosed char or string"} 100 | } 101 | 102 | s = s[1:] // closing quote 103 | updateSIInPlace(si, rune(quote)) 104 | builder.WriteByte(quote) 105 | 106 | tokens = append(tokens, Token{quoteSI, builder.String()}) 107 | continue 108 | } 109 | 110 | // accumulate token until whitespace or special rune 111 | value := "" 112 | for len(s) > 0 { 113 | r, size := utf8.DecodeRuneInString(s) 114 | if unicode.IsSpace(r) || IsSpecialRune(r) { 115 | break 116 | } 117 | value += string(r) 118 | s = s[size:] 119 | updateSIInPlace(si, r) 120 | } 121 | tokenSI := copySI(si) 122 | tokenSI.Column -= utf8.RuneCountInString(value) 123 | tokens = append(tokens, Token{SourceInfo: tokenSI, Value: value}) 124 | } 125 | 126 | return tokens, nil 127 | } 128 | 129 | func updateSIInPlace(si *parseinfo.Source, r rune) { 130 | if r == '\n' { 131 | si.Line++ 132 | si.Column = 1 133 | } else { 134 | si.Column++ 135 | } 136 | } 137 | 138 | func copySI(si *parseinfo.Source) *parseinfo.Source { 139 | newSI := &parseinfo.Source{} 140 | *newSI = *si 141 | return newSI 142 | } 143 | 144 | func updateSI(si *parseinfo.Source, r rune) *parseinfo.Source { 145 | newSI := copySI(si) 146 | updateSIInPlace(newSI, r) 147 | return newSI 148 | } 149 | -------------------------------------------------------------------------------- /parse/tree.go: -------------------------------------------------------------------------------- 1 | package parse 2 | 3 | import ( 4 | "fmt" 5 | "unicode" 6 | 7 | "github.com/faiface/funky/parse/parseinfo" 8 | ) 9 | 10 | type Error struct { 11 | SourceInfo *parseinfo.Source 12 | Msg string 13 | } 14 | 15 | func (err *Error) Error() string { 16 | return fmt.Sprintf("%v: %v", err.SourceInfo, err.Msg) 17 | } 18 | 19 | type Tree interface { 20 | String() string 21 | SourceInfo() *parseinfo.Source 22 | } 23 | 24 | type ( 25 | Literal struct { 26 | SI *parseinfo.Source 27 | Value string 28 | } 29 | 30 | Paren struct { 31 | SI *parseinfo.Source 32 | Kind string 33 | Inside Tree 34 | } 35 | 36 | Special struct { 37 | SI *parseinfo.Source 38 | Kind string 39 | After Tree 40 | } 41 | 42 | Binding struct { 43 | SI *parseinfo.Source 44 | Kind string 45 | Bound, After Tree 46 | } 47 | 48 | Prefix struct { 49 | Left, Right Tree 50 | } 51 | 52 | Infix struct { 53 | Left, In, Right Tree 54 | } 55 | ) 56 | 57 | func (l *Literal) String() string { return l.Value } 58 | func (p *Paren) String() string { 59 | switch p.Kind { 60 | case "(": 61 | return "(" + p.Inside.String() + ")" 62 | case "[": 63 | return "[" + p.Inside.String() + "]" 64 | case "{": 65 | return "{" + p.Inside.String() + "}" 66 | } 67 | panic("unreachable") 68 | } 69 | func (s *Special) String() string { return s.Kind + " " + s.After.String() } 70 | func (l *Binding) String() string { return l.Kind + l.Bound.String() + " " + l.After.String() } 71 | func (p *Prefix) String() string { return p.Left.String() + " " + p.Right.String() } 72 | func (i *Infix) String() string { 73 | switch { 74 | case i.Left == nil && i.Right == nil: 75 | return i.In.String() 76 | case i.Left == nil: 77 | return i.In.String() + " " + i.Right.String() 78 | case i.Right == nil: 79 | return i.Left.String() + " " + i.In.String() 80 | default: 81 | return i.Left.String() + " " + i.In.String() + " " + i.Right.String() 82 | } 83 | } 84 | 85 | func (l *Literal) SourceInfo() *parseinfo.Source { return l.SI } 86 | func (p *Paren) SourceInfo() *parseinfo.Source { return p.SI } 87 | func (s *Special) SourceInfo() *parseinfo.Source { return s.SI } 88 | func (l *Binding) SourceInfo() *parseinfo.Source { return l.SI } 89 | func (p *Prefix) SourceInfo() *parseinfo.Source { return p.Left.SourceInfo() } 90 | func (i *Infix) SourceInfo() *parseinfo.Source { return i.In.SourceInfo() } 91 | 92 | func FindNextSpecialOrBinding(goAfterBindings bool, tree Tree, words ...string) (before, at, after Tree) { 93 | if tree == nil { 94 | return nil, nil, nil 95 | } 96 | 97 | switch tree := tree.(type) { 98 | case *Literal, *Paren: 99 | return tree, nil, nil 100 | 101 | case *Special: 102 | matches := false 103 | for _, s := range words { 104 | if tree.Kind == s { 105 | matches = true 106 | break 107 | } 108 | } 109 | if matches { 110 | return nil, tree, tree.After 111 | } 112 | afterBefore, afterAt, afterAfter := FindNextSpecialOrBinding(goAfterBindings, tree.After, words...) 113 | return &Special{ 114 | SI: tree.SI, 115 | Kind: tree.Kind, 116 | After: afterBefore, 117 | }, afterAt, afterAfter 118 | 119 | case *Binding: 120 | matches := false 121 | for _, s := range words { 122 | if tree.Kind == s { 123 | matches = true 124 | break 125 | } 126 | } 127 | if matches { 128 | return nil, tree, tree.After 129 | } 130 | if !goAfterBindings { 131 | return tree, nil, nil 132 | } 133 | afterBefore, afterAt, afterAfter := FindNextSpecialOrBinding(goAfterBindings, tree.After, words...) 134 | return &Binding{ 135 | SI: tree.SI, 136 | Kind: tree.Kind, 137 | Bound: tree.Bound, 138 | After: afterBefore, 139 | }, afterAt, afterAfter 140 | 141 | case *Prefix: 142 | // special can't be in the left 143 | rightBefore, rightAt, rightAfter := FindNextSpecialOrBinding(goAfterBindings, tree.Right, words...) 144 | if rightBefore == nil { 145 | return tree.Left, rightAt, rightAfter 146 | } 147 | return &Prefix{ 148 | Left: tree.Left, 149 | Right: rightBefore, 150 | }, rightAt, rightAfter 151 | 152 | case *Infix: 153 | // special can't be in the left or in 154 | rightBefore, rightAt, rightAfter := FindNextSpecialOrBinding(goAfterBindings, tree.Right, words...) 155 | return &Infix{ 156 | Left: tree.Left, 157 | In: tree.In, 158 | Right: rightBefore, 159 | }, rightAt, rightAfter 160 | } 161 | 162 | panic("unreachable") 163 | } 164 | 165 | func Flatten(tree Tree) []Tree { 166 | var flat []Tree 167 | for t := range flatten(tree) { 168 | flat = append(flat, t) 169 | } 170 | return flat 171 | } 172 | 173 | func flatten(tree Tree) <-chan Tree { 174 | ch := make(chan Tree) 175 | go func() { 176 | flattenHelper(ch, tree) 177 | close(ch) 178 | }() 179 | return ch 180 | } 181 | 182 | func flattenHelper(ch chan<- Tree, tree Tree) { 183 | switch tree := tree.(type) { 184 | case *Literal, *Paren, *Special, *Binding: 185 | ch <- tree 186 | case *Prefix: 187 | flattenHelper(ch, tree.Left) 188 | flattenHelper(ch, tree.Right) 189 | case *Infix: 190 | ch <- &Infix{Left: nil, In: tree.In, Right: nil} 191 | ch <- tree.Left 192 | ch <- tree.Right 193 | } 194 | } 195 | 196 | func SingleTree(tokens []Token) (t Tree, end int, err error) { 197 | switch tokens[0].Value { 198 | case ")", "]", "}": 199 | return nil, 0, &Error{ 200 | tokens[0].SourceInfo, 201 | "no matching opening parenthesis", 202 | } 203 | 204 | case "(", "[", "{": 205 | closing, ok := findClosingParen(tokens) 206 | if !ok { 207 | return nil, 0, &Error{ 208 | tokens[0].SourceInfo, 209 | "no matching closing parenthesis", 210 | } 211 | } 212 | inside, err := MultiTree(tokens[1:closing]) 213 | if err != nil { 214 | return nil, 0, err 215 | } 216 | paren := &Paren{SI: tokens[0].SourceInfo, Kind: tokens[0].Value, Inside: inside} 217 | return paren, closing + 1, nil 218 | 219 | case "\\", "case": 220 | if len(tokens) < 2 { 221 | return nil, 0, &Error{ 222 | tokens[0].SourceInfo, 223 | "nothing to bind", 224 | } 225 | } 226 | bound, end, err := SingleTree(tokens[1:]) 227 | if err != nil { 228 | return nil, 0, err 229 | } 230 | after, err := MultiTree(tokens[end+1:]) 231 | if err != nil { 232 | return nil, 0, err 233 | } 234 | if after == nil { 235 | return nil, 0, &Error{ 236 | tokens[0].SourceInfo, 237 | "nothing after binding", 238 | } 239 | } 240 | return &Binding{ 241 | SI: tokens[0].SourceInfo, 242 | Kind: tokens[0].Value, 243 | Bound: bound, 244 | After: after, 245 | }, len(tokens), nil 246 | 247 | case ",", ";", ":", "|", "=", "record", "union", "alias", "func", "switch", "strict": 248 | after, err := MultiTree(tokens[1:]) 249 | if err != nil { 250 | return nil, 0, err 251 | } 252 | return &Special{ 253 | SI: tokens[0].SourceInfo, 254 | Kind: tokens[0].Value, 255 | After: after, 256 | }, len(tokens), nil 257 | 258 | default: 259 | switch LiteralKindOf(tokens[0].Value) { 260 | case LiteralIdentifier: 261 | if !HasLetterOrDigit(tokens[0].Value) { 262 | after, err := MultiTree(tokens[1:]) 263 | if err != nil { 264 | return nil, 0, err 265 | } 266 | return &Infix{ 267 | In: &Literal{SI: tokens[0].SourceInfo, Value: tokens[0].Value}, 268 | Right: after, 269 | }, len(tokens), nil 270 | } 271 | } 272 | return &Literal{ 273 | SI: tokens[0].SourceInfo, 274 | Value: tokens[0].Value, 275 | }, 1, nil 276 | } 277 | } 278 | 279 | func MultiTree(tokens []Token) (Tree, error) { 280 | var t Tree 281 | 282 | for len(tokens) > 0 { 283 | single, end, err := SingleTree(tokens) 284 | tokens = tokens[end:] 285 | if err != nil { 286 | return nil, err 287 | } 288 | if t == nil { 289 | t = single 290 | continue 291 | } 292 | if infix, ok := single.(*Infix); ok { 293 | t = &Infix{ 294 | Left: t, 295 | In: infix.In, 296 | Right: infix.Right, 297 | } 298 | continue 299 | } 300 | t = &Prefix{Left: t, Right: single} 301 | } 302 | 303 | return t, nil 304 | } 305 | 306 | func HasLetterOrDigit(s string) bool { 307 | for _, r := range s { 308 | if unicode.IsLetter(r) || unicode.IsDigit(r) || r == '_' { 309 | return true 310 | } 311 | } 312 | return false 313 | } 314 | 315 | func findClosingParen(tokens []Token) (i int, ok bool) { 316 | round := 0 // () 317 | square := 0 // [] 318 | curly := 0 // {} 319 | for i := range tokens { 320 | switch tokens[i].Value { 321 | case "(": 322 | round++ 323 | case ")": 324 | round-- 325 | case "[": 326 | square++ 327 | case "]": 328 | square-- 329 | case "{": 330 | curly++ 331 | case "}": 332 | curly-- 333 | } 334 | if round < 0 || square < 0 || curly < 0 { 335 | return i, false 336 | } 337 | if round == 0 && square == 0 && curly == 0 { 338 | return i, true 339 | } 340 | } 341 | return len(tokens), false 342 | } 343 | -------------------------------------------------------------------------------- /parse/type.go: -------------------------------------------------------------------------------- 1 | package parse 2 | 3 | import ( 4 | "fmt" 5 | "unicode" 6 | 7 | "github.com/faiface/funky/types" 8 | ) 9 | 10 | func IsTypeName(name string) bool { 11 | if !HasLetterOrDigit(name) { 12 | return false 13 | } 14 | for _, r := range name { 15 | if unicode.IsUpper(r) { 16 | return true 17 | } 18 | } 19 | return false 20 | } 21 | 22 | func IsTypeVar(name string) bool { 23 | if !HasLetterOrDigit(name) { 24 | return false 25 | } 26 | return !IsTypeName(name) 27 | } 28 | 29 | func Type(tokens []Token) (types.Type, error) { 30 | tree, err := MultiTree(tokens) 31 | if err != nil { 32 | return nil, err 33 | } 34 | return TreeToType(tree) 35 | } 36 | 37 | func TreeToType(tree Tree) (types.Type, error) { 38 | if tree == nil { 39 | return nil, nil 40 | } 41 | 42 | switch tree := tree.(type) { 43 | case *Literal: 44 | switch LiteralKindOf(tree.Value) { 45 | case LiteralIdentifier: 46 | // OK 47 | default: 48 | return nil, &Error{tree.SourceInfo(), fmt.Sprintf("unexpected: %s", tree.Value)} 49 | } 50 | if IsTypeName(tree.Value) || tree.Value == "->" { 51 | return &types.Appl{SI: tree.SourceInfo(), Name: tree.Value}, nil 52 | } 53 | if IsTypeVar(tree.Value) { 54 | return &types.Var{SI: tree.SourceInfo(), Name: tree.Value}, nil 55 | } 56 | return nil, &Error{tree.SourceInfo(), fmt.Sprintf("invalid type identifier: %s", tree.Value)} 57 | 58 | case *Paren: 59 | switch tree.Kind { 60 | case "(": 61 | if tree.Inside == nil { 62 | return nil, &Error{tree.SourceInfo(), "nothing inside parentheses"} 63 | } 64 | return TreeToType(tree.Inside) 65 | } 66 | return nil, &Error{tree.SourceInfo(), fmt.Sprintf("unexpected: %s", tree.Kind)} 67 | 68 | case *Special: 69 | return nil, &Error{tree.SourceInfo(), fmt.Sprintf("unexpected: %s", tree.Kind)} 70 | 71 | case *Binding: 72 | return nil, &Error{tree.SourceInfo(), fmt.Sprintf("unexpected: %s", tree.Kind)} 73 | 74 | case *Prefix: 75 | left, err := TreeToType(tree.Left) 76 | if err != nil { 77 | return nil, err 78 | } 79 | leftAppl, ok := left.(*types.Appl) 80 | if !ok { 81 | return nil, &Error{ 82 | left.SourceInfo(), 83 | fmt.Sprintf("not a type constructor: %v", left), 84 | } 85 | } 86 | right, err := TreeToType(tree.Right) 87 | if err != nil { 88 | return nil, err 89 | } 90 | leftAppl.Args = append(leftAppl.Args, right) 91 | return leftAppl, nil 92 | 93 | case *Infix: 94 | in, err := TreeToType(tree.In) 95 | if err != nil { 96 | return nil, err 97 | } 98 | left, err := TreeToType(tree.Left) 99 | if err != nil { 100 | return nil, err 101 | } 102 | right, err := TreeToType(tree.Right) 103 | if err != nil { 104 | return nil, err 105 | } 106 | inAppl, ok := in.(*types.Appl) 107 | if !ok || inAppl.Name != "->" || len(inAppl.Args) != 0 { 108 | return nil, &Error{ 109 | left.SourceInfo(), 110 | fmt.Sprintf("not a type constructor: %v", in), 111 | } 112 | } 113 | if left == nil || right == nil { 114 | return nil, &Error{ 115 | in.SourceInfo(), 116 | "missing operands in function type", 117 | } 118 | } 119 | return &types.Func{ 120 | From: left, 121 | To: right, 122 | }, nil 123 | } 124 | 125 | panic("unreachable") 126 | } 127 | -------------------------------------------------------------------------------- /run.go: -------------------------------------------------------------------------------- 1 | package funky 2 | 3 | import ( 4 | "flag" 5 | "fmt" 6 | "io/ioutil" 7 | "os" 8 | "path/filepath" 9 | "time" 10 | 11 | "github.com/faiface/funky/compile" 12 | "github.com/faiface/funky/expr" 13 | "github.com/faiface/funky/parse" 14 | "github.com/faiface/funky/runtime" 15 | 16 | cxr "github.com/faiface/crux/runtime" 17 | ) 18 | 19 | func Run(main string) (value *runtime.Value, cleanup func()) { 20 | noStdlib := flag.Bool("nostd", false, "do not automatically include files from $FUNKY") 21 | stats := flag.Bool("stats", false, "print stats after running program") 22 | typesSandbox := flag.Bool("types", false, "start types sandbox instead of running the program") 23 | listDefinitions := flag.Bool("list", false, "list all the definitions instead of running the program") 24 | dump := flag.String("dump", "", "specify a file to dump the compiled code into") 25 | flag.Parse() 26 | 27 | compilationStart := time.Now() 28 | 29 | var definitions []parse.Definition 30 | 31 | // files from the standard library 32 | if funkyPath, ok := os.LookupEnv("FUNKY"); !*noStdlib && ok { 33 | err := filepath.Walk(funkyPath, func(path string, info os.FileInfo, err error) error { 34 | if err != nil { 35 | return err 36 | } 37 | if info.IsDir() { 38 | return nil 39 | } 40 | b, err := ioutil.ReadFile(path) 41 | handleErrs(err) 42 | tokens, err := parse.Tokenize(path, string(b)) 43 | handleErrs(err) 44 | defs, err := parse.Definitions(tokens) 45 | handleErrs(err) 46 | definitions = append(definitions, defs...) 47 | return nil 48 | }) 49 | handleErrs(err) 50 | } 51 | 52 | // files included on the command line 53 | for _, path := range flag.Args() { 54 | b, err := ioutil.ReadFile(path) 55 | handleErrs(err) 56 | tokens, err := parse.Tokenize(path, string(b)) 57 | handleErrs(err) 58 | defs, err := parse.Definitions(tokens) 59 | handleErrs(err) 60 | definitions = append(definitions, defs...) 61 | } 62 | 63 | if *listDefinitions { 64 | for _, def := range definitions { 65 | switch value := def.Value.(type) { 66 | case expr.Expr: 67 | fmt.Printf("%s\n", def.Name) 68 | fmt.Printf(" %s\n", value.TypeInfo()) 69 | fmt.Printf(" %s\n", value.SourceInfo()) 70 | } 71 | } 72 | os.Exit(0) 73 | } 74 | 75 | env := new(compile.Env) 76 | for _, def := range definitions { 77 | err := env.Add(def) 78 | handleErrs(err) 79 | } 80 | 81 | errs := env.Validate() 82 | handleErrs(errs...) 83 | 84 | if *typesSandbox { 85 | runTypesSandbox(env) 86 | os.Exit(0) 87 | } 88 | 89 | errs = env.TypeInfer() 90 | handleErrs(errs...) 91 | globalIndices, globalValues, codeIndices, codes := env.Compile(main) 92 | 93 | if len(globalIndices[main]) == 0 { 94 | handleErrs(fmt.Errorf("no %s function", main)) 95 | } 96 | if len(globalIndices[main]) > 1 { 97 | handleErrs(fmt.Errorf("multiple %s functions", main)) 98 | } 99 | 100 | if *dump != "" { 101 | df, err := os.Create(*dump) 102 | handleErrs(err) 103 | for name := range globalIndices { 104 | for i := range globalIndices[name] { 105 | fmt.Fprintf(df, "# %v\n", env.SourceInfo(name, i)) 106 | fmt.Fprintf(df, "# %v\n", env.TypeInfo(name, i)) 107 | fmt.Fprintf(df, "FUNC %s/%d\n", name, i) 108 | dumpCodes(df, globalIndices, &codes[codeIndices[name][i]]) 109 | fmt.Fprintln(df) 110 | } 111 | } 112 | handleErrs(df.Close()) 113 | } 114 | 115 | program := &runtime.Value{Globals: globalValues, Value: globalValues[globalIndices[main][0]]} 116 | 117 | runningStart := time.Now() 118 | 119 | return program, func() { 120 | if *stats { 121 | fmt.Fprintf(os.Stderr, "\n") 122 | fmt.Fprintf(os.Stderr, "STATS\n") 123 | fmt.Fprintf(os.Stderr, "reductions: %d\n", cxr.Reductions) 124 | fmt.Fprintf(os.Stderr, "compilation time: %v\n", runningStart.Sub(compilationStart)) 125 | fmt.Fprintf(os.Stderr, "running time: %v\n", time.Since(runningStart)) 126 | } 127 | } 128 | } 129 | 130 | func handleErrs(errs ...error) { 131 | bad := false 132 | for _, err := range errs { 133 | if err != nil { 134 | bad = true 135 | fmt.Fprintln(os.Stderr, err) 136 | } 137 | } 138 | if bad { 139 | os.Exit(1) 140 | } 141 | } 142 | -------------------------------------------------------------------------------- /runtime/value.go: -------------------------------------------------------------------------------- 1 | package runtime 2 | 3 | import ( 4 | "math/big" 5 | "strings" 6 | 7 | cxr "github.com/faiface/crux/runtime" 8 | ) 9 | 10 | type Value struct { 11 | Globals []cxr.Value 12 | Value cxr.Value 13 | } 14 | 15 | func (v *Value) reduce() { v.Value = cxr.Reduce(v.Globals, v.Value) } 16 | 17 | func (v *Value) Char() rune { v.reduce(); return v.Value.(*cxr.Char).Value } 18 | func (v *Value) Int() *big.Int { v.reduce(); return &v.Value.(*cxr.Int).Value } 19 | func (v *Value) Float() float64 { v.reduce(); return v.Value.(*cxr.Float).Value } 20 | 21 | func (v *Value) Alternative() int { 22 | v.reduce() 23 | return int(v.Value.(*cxr.Struct).Index) 24 | } 25 | 26 | func (v *Value) Field(i int) *Value { 27 | v.reduce() 28 | str := v.Value.(*cxr.Struct) 29 | index := len(str.Values) - i - 1 30 | return &Value{v.Globals, str.Values[index]} 31 | } 32 | 33 | func (v *Value) Apply(args ...*Value) *Value { 34 | values := make([]cxr.Value, len(args)) 35 | for i := range values { 36 | values[i] = args[i].Value 37 | } 38 | return &Value{v.Globals, cxr.Reduce(v.Globals, v.Value, values...)} 39 | } 40 | 41 | func (v *Value) Bool() bool { 42 | return v.Alternative() == 0 43 | } 44 | 45 | func (v *Value) List() []*Value { 46 | var list []*Value 47 | for v.Alternative() != 0 { 48 | list = append(list, v.Field(0)) 49 | v = v.Field(1) 50 | } 51 | return list 52 | } 53 | 54 | func (v *Value) String() string { 55 | var b strings.Builder 56 | for v.Alternative() != 0 { 57 | b.WriteRune(v.Field(0).Char()) 58 | v = v.Field(1) 59 | } 60 | return b.String() 61 | } 62 | 63 | func MkChar(c rune) *Value { 64 | return &Value{nil, &cxr.Char{Value: c}} 65 | } 66 | 67 | func MkInt(i *big.Int) *Value { 68 | var v cxr.Int 69 | v.Value.Set(i) 70 | return &Value{nil, &v} 71 | } 72 | 73 | func MkInt64(i int64) *Value { 74 | var v cxr.Int 75 | v.Value.SetInt64(i) 76 | return &Value{nil, &v} 77 | } 78 | 79 | func MkFloat(f float64) *Value { 80 | return &Value{nil, &cxr.Float{Value: f}} 81 | } 82 | 83 | func MkRecord(fields ...*Value) *Value { 84 | str := &cxr.Struct{Index: 0, Values: make([]cxr.Value, 0, len(fields))} 85 | for i := len(fields) - 1; i >= 0; i-- { 86 | str.Values = append(str.Values, fields[i].Value) 87 | } 88 | return &Value{nil, str} 89 | } 90 | 91 | func MkUnion(alternative int, fields ...*Value) *Value { 92 | str := &cxr.Struct{Index: int32(alternative), Values: make([]cxr.Value, 0, len(fields))} 93 | for i := len(fields) - 1; i >= 0; i-- { 94 | str.Values = append(str.Values, fields[i].Value) 95 | } 96 | return &Value{nil, str} 97 | } 98 | 99 | func MkBool(b bool) *Value { 100 | index := int32(0) 101 | if !b { 102 | index = 1 103 | } 104 | return &Value{nil, &cxr.Struct{Index: index}} 105 | } 106 | 107 | func MkList(elems ...*Value) *Value { 108 | list := &cxr.Struct{Index: 0} 109 | for i := len(elems) - 1; i >= 0; i-- { 110 | list = &cxr.Struct{Index: 1, Values: []cxr.Value{list, elems[i].Value}} 111 | } 112 | return &Value{nil, list} 113 | } 114 | 115 | func MkString(s string) *Value { 116 | str := &cxr.Struct{Index: 0} 117 | runes := []rune(s) 118 | for i := len(runes) - 1; i >= 0; i-- { 119 | str = &cxr.Struct{Index: 1, Values: []cxr.Value{str, &cxr.Char{Value: runes[i]}}} 120 | } 121 | return &Value{nil, str} 122 | } 123 | -------------------------------------------------------------------------------- /stdlib/array.fn: -------------------------------------------------------------------------------- 1 | record Array a = 2 | _default : a, 3 | _left : Slots a, 4 | _right : Slots a, 5 | 6 | func empty : a -> Array a = \default Array default empty empty 7 | 8 | func array : a -> List a -> Array a = 9 | \default \list 10 | start-with (empty default); 11 | for-pair (enumerate list) 12 | (\i \x at i := x); 13 | return self 14 | 15 | func at : Int -> Array a -> a = 16 | \i \array 17 | if (i < 0) (_default array ? at (neg i) (_left array)); 18 | _default array ? at i (_right array) 19 | 20 | func at : Int -> (a -> a) -> Array a -> Array a = 21 | \i \f \array 22 | if (i < 0) ((_left . at (neg i)) (\m some; f; _default array ? m) array); 23 | (_right . at i) (\m some; f; _default array ? m) array 24 | 25 | func reset : Int -> Array a -> Array a = 26 | \i \array 27 | if (i < 0) ((_left . at (neg i)) (const none) array); 28 | (_right . at i) (const none) array 29 | 30 | func swap : Int -> Int -> Array a -> Array a = 31 | \i \j \array 32 | start-with array; 33 | at i -> \at-i 34 | at j -> \at-j 35 | at i := at-j; 36 | at j := at-i; 37 | return self 38 | -------------------------------------------------------------------------------- /stdlib/bool.fn: -------------------------------------------------------------------------------- 1 | union Bool = true | false 2 | 3 | func string : Bool -> String = 4 | \bool 5 | switch bool 6 | case true "true" 7 | case false "false" 8 | 9 | func true? : Bool -> Bool = self 10 | func false? : Bool -> Bool = not 11 | 12 | func if : Bool -> a -> a -> a = 13 | \bool \then \else 14 | switch bool 15 | case true then 16 | case false else 17 | 18 | func not : Bool -> Bool = 19 | \bool 20 | switch bool 21 | case true false 22 | case false true 23 | 24 | func not : (a -> Bool) -> a -> Bool = \f \x not (f x) 25 | func not : (a -> b -> Bool) -> a -> b -> Bool = \f \x \y not (f x y) 26 | 27 | func && : Bool -> Bool -> Bool = \p \q if p q false 28 | func || : Bool -> Bool -> Bool = \p \q if p true q 29 | func == : Bool -> Bool -> Bool = \p \q if p q (not q) 30 | func != : Bool -> Bool -> Bool = \p \q if p (not q) q 31 | 32 | func && : (a -> Bool) -> (a -> Bool) -> a -> Bool = 33 | \f \g \x 34 | f x && g x 35 | func || : (a -> Bool) -> (a -> Bool) -> a -> Bool = 36 | \f \g \x 37 | f x || g x 38 | 39 | func && : (a -> b -> Bool) -> (a -> b -> Bool) -> a -> b -> Bool = 40 | \f \g \x \y 41 | f x y && g x y 42 | func || : (a -> b -> Bool) -> (a -> b -> Bool) -> a -> b -> Bool = 43 | \f \g \x \y 44 | f x y || g x y 45 | -------------------------------------------------------------------------------- /stdlib/cmd/io.fn: -------------------------------------------------------------------------------- 1 | union IO = quit | putc Char IO | getc (Char -> IO) 2 | 3 | func print : String -> IO -> IO = \s \next for s putc; next 4 | func println : String -> IO -> IO = print . (++ "\n") 5 | 6 | func ungetc : Char -> IO -> IO = 7 | \c \io 8 | switch io 9 | case quit 10 | quit 11 | case putc \d \jo 12 | putc d; 13 | ungetc c; 14 | jo 15 | case getc \f 16 | f c 17 | 18 | func unscan : String -> IO -> IO = 19 | \s \io 20 | if (empty? s) io; 21 | switch io 22 | case quit 23 | quit 24 | case putc \d \jo 25 | putc d; 26 | unscan s; 27 | jo 28 | case getc \f 29 | unscan (rest! s); 30 | f (first! s) 31 | 32 | func skip-whitespace : IO -> IO = 33 | \io 34 | getc \c 35 | if (whitespace? c) ( 36 | skip-whitespace; 37 | io 38 | ); 39 | ungetc c; 40 | io 41 | 42 | func scan : (String -> IO) -> IO = 43 | \f 44 | skip-whitespace; 45 | "" |> recur \loop \s 46 | getc \c 47 | if (whitespace? c) ( 48 | ungetc c; 49 | f (reverse s) 50 | ); 51 | loop (c :: s) 52 | 53 | func scanln : (String -> IO) -> IO = 54 | \f 55 | "" |> recur \loop \s 56 | getc \c 57 | if (c == '\n') 58 | (f (reverse s)); 59 | loop (c :: s) 60 | -------------------------------------------------------------------------------- /stdlib/common.fn: -------------------------------------------------------------------------------- 1 | union Absurd 2 | union Nothing = nothing 3 | 4 | func self : a -> a = \x x 5 | func const : a -> b -> a = \x \_ x 6 | func apply : (a -> b) -> a -> b = \f \x f x 7 | func let : a -> (a -> b) -> b = \x \f f x 8 | func recur : (a -> a) -> a = \f f (recur f) 9 | 10 | func flip : (a -> b -> c) -> b -> a -> c = \f \x \y f y x 11 | 12 | func . : (b -> c) -> (a -> b) -> a -> c = 13 | \f \g \x 14 | f (g x) 15 | 16 | func . : (c -> d) -> (a -> b -> c) -> a -> b -> d = 17 | \f \g \x \y 18 | f (g x y) 19 | 20 | func . : (d -> e) -> (a -> b -> c -> d) -> a -> b -> c -> e = 21 | \f \g \x \y \z 22 | f (g x y z) 23 | 24 | func |> : a -> (a -> b) -> b = \x \f f x 25 | 26 | func |> : (a -> b) -> (b -> c) -> a -> c = 27 | \g \f \x 28 | f (g x) 29 | 30 | func * : Int -> (a -> a) -> a -> a = 31 | \n \f \x 32 | if (zero? n) x; 33 | (dec n * f) (f x) 34 | 35 | func when : Bool -> (a -> a) -> a -> a = 36 | \cond \then \next 37 | if cond (then next) next 38 | 39 | func for : List a -> (a -> b -> b) -> b -> b = 40 | \list \body \next 41 | switch list 42 | case empty 43 | next 44 | case (::) \x \xs 45 | body x; 46 | for xs body; 47 | next 48 | -------------------------------------------------------------------------------- /stdlib/complex.fn: -------------------------------------------------------------------------------- 1 | record Complex = 2 | real : Float, 3 | imag : Float, 4 | 5 | func cplx : Float -> Float -> Complex = 6 | Complex 7 | 8 | func re : Float -> Complex = 9 | flip cplx 0.0 10 | 11 | func im : Float -> Complex = 12 | cplx 0.0 13 | 14 | func + : Complex -> Complex -> Complex = 15 | \z \w cplx (real z + real w) (imag z + imag w) 16 | 17 | func - : Complex -> Complex -> Complex = 18 | \z \w cplx (real z - real w) (imag z - imag w) 19 | 20 | func * : Complex -> Complex -> Complex = 21 | \z \w cplx 22 | ((real z * real w) - (imag z * imag w)) 23 | ((real z * imag w) + (imag z * real w)) 24 | 25 | func abs^2 : Complex -> Float = 26 | \z (real z ^ 2.0) + (imag z ^ 2.0) 27 | 28 | func abs : Complex -> Float = 29 | sqrt . abs^2 30 | 31 | func conj : Complex -> Complex = 32 | \z cplx (real z) (neg; imag z) 33 | 34 | func inv : Complex -> Complex = 35 | \z conj z *; re; 1.0 / abs^2 z 36 | 37 | func / : Complex -> Complex -> Complex = 38 | \z \w z * inv w 39 | 40 | func phase : Complex -> Float = 41 | \z atan2 (imag z) (real z) 42 | 43 | func exp : Complex -> Complex = 44 | \z (cplx (cos; imag z) (sin; imag z)) * re (e ^ real z) 45 | 46 | func cis : Float -> Complex = 47 | exp . im 48 | 49 | func log : Complex -> Complex = 50 | \z cplx (log; abs z) (phase z) 51 | 52 | func ^ : Complex -> Complex -> Complex = 53 | \z \w exp; log z * w 54 | 55 | func sqrt : Complex -> Complex = 56 | \z z ^ re 0.5 57 | 58 | func cbrt : Complex -> Complex = 59 | \z z ^ re (1.0 / 3.0) 60 | 61 | func neg : Complex -> Complex = 62 | re 0.0 - 63 | 64 | func cosh : Complex -> Complex = 65 | \z (exp z +; exp; neg z) / re 2.0 66 | 67 | func sinh : Complex -> Complex = 68 | \z (exp z -; exp; neg z) / re 2.0 69 | 70 | func tanh : Complex -> Complex = 71 | \z ((exp; re 2.0 * z) - re 1.0) / (exp; re 2.0 * z) + re 1.0 72 | 73 | func acosh : Complex -> Complex = 74 | \z log; z +; sqrt; (z ^ re 2.0) - re 1.0 75 | 76 | func asinh : Complex -> Complex = 77 | \z log; z +; sqrt; (z ^ re 2.0) + re 1.0 78 | 79 | func atanh : Complex -> Complex = 80 | \z re 0.5 *; log; (re 1.0 + z) / (re 1.0 - z) 81 | 82 | func cos : Complex -> Complex = 83 | cosh . im 1.0 * 84 | 85 | func sin : Complex -> Complex = 86 | \z im -1.0 *; sinh; im 1.0 * z 87 | 88 | func tan : Complex -> Complex = 89 | \z im -1.0 *; tanh; im 1.0 * z 90 | 91 | func acos : Complex -> Complex = 92 | \z (im -1.0) *; log; z +; sqrt; (z ^ re 2.0) - re 1.0 93 | 94 | func asin : Complex -> Complex = 95 | \z re (pi / 2.0) - acos z 96 | 97 | func atan : Complex -> Complex = 98 | \z (log; (im 1.0 - z) / (im 1.0 + z)) / (im 2.0) 99 | 100 | func == : Complex -> Complex -> Bool = 101 | \z \w (real z == real w) && (imag z == imag w) 102 | 103 | func != : Complex -> Complex -> Bool = 104 | \z \w (real z != real w) || (imag z != imag w) 105 | 106 | func product : List Complex -> Complex = 107 | fold> (*) (re 1.0) 108 | 109 | func sum : List Complex -> Complex = 110 | fold> (+) (re 0.0) 111 | 112 | func real? : Complex -> Bool = 113 | \z (imag z == 0.0) && (real z != 0.0) 114 | 115 | func imag? : Complex -> Bool = 116 | \z (real z == 0.0) && (imag z != 0.0) 117 | 118 | func cplx? : Complex -> Bool = 119 | \z (real z != 0.0) && (imag z != 0.0) 120 | 121 | func zero? : Complex -> Bool = 122 | re 0.0 == 123 | 124 | func string : Complex -> String = 125 | \z 126 | if (imag z == 0.0) (string; real z); 127 | if (real z == 0.0) (string (imag z) ++ "i"); 128 | yield-all (string; real z); 129 | when (imag z > 0.0) (yield '+'); 130 | string (imag z) ++ "i"; 131 | -------------------------------------------------------------------------------- /stdlib/field.fn: -------------------------------------------------------------------------------- 1 | record Field a = _rows : Array (Array a) 2 | 3 | func empty : a -> Field a = Field . empty . empty 4 | 5 | func field : a -> List (List a) -> Field a = 6 | \default \rows 7 | start-with (empty default); 8 | for-pair (enumerate rows) ( 9 | \i \row 10 | for-pair (enumerate row) 11 | (\j \x at i j := x) 12 | ); 13 | return self 14 | 15 | func at : Int -> Int -> Field a -> a = 16 | \x \y 17 | at x . at y . _rows 18 | 19 | func at : Int -> Int -> (a -> a) -> Field a -> Field a = 20 | \x \y \f 21 | (_rows . at y . at x) f 22 | 23 | func reset : Int -> Int -> Field a -> Field a = 24 | \x \y \field 25 | let (reset x ((at y . _rows) field)) \reset-row 26 | if (empty? (_left reset-row) && empty? (_right reset-row)) 27 | (_rows (reset y) field); 28 | (_rows . at y) (const reset-row) field 29 | -------------------------------------------------------------------------------- /stdlib/list-dict.fn: -------------------------------------------------------------------------------- 1 | record List-Dict k v = 2 | _equals : k -> k -> Bool, 3 | _default : v, 4 | _entries : List (Pair k v), 5 | 6 | func list-dict : (k -> k -> Bool) -> v -> List (Pair k v) -> List-Dict k v = 7 | \equals \default \entries 8 | start-with (List-Dict equals default []); 9 | for-pair entries 10 | (\k \v at k := v); 11 | return self 12 | 13 | func entries : List-Dict k v -> List (Pair k v) = _entries 14 | func keys : List-Dict k v -> List k = map first . _entries 15 | func values : List-Dict k v -> List v = map second . _entries 16 | 17 | func empty? : List-Dict k v -> Bool = empty? . _entries 18 | 19 | func contains? : k -> List-Dict k v -> Bool = 20 | \k \dict 21 | any (_equals dict k) (map first; _entries dict) 22 | 23 | func add : Pair k v -> List-Dict k v -> List-Dict k v = 24 | \entry \dict 25 | _entries (entry ::) (remove (first entry) dict) 26 | 27 | func remove : k -> List-Dict k v -> List-Dict k v = 28 | \k \dict 29 | _entries (filter (not; _equals dict k . first)) dict 30 | 31 | func maybe-at : k -> List-Dict k v -> Maybe v = 32 | \k \dict 33 | let-some (first; filter (_equals dict k . first) (_entries dict)) \entry 34 | second entry 35 | 36 | func at : k -> List-Dict k v -> v = 37 | \k \dict 38 | _default dict ? maybe-at k dict 39 | 40 | func at : k -> (v -> v) -> List-Dict k v -> List-Dict k v = 41 | \k \f \dict 42 | _entries (pair k (f (at k dict)) ::) (remove k dict) 43 | -------------------------------------------------------------------------------- /stdlib/list-set.fn: -------------------------------------------------------------------------------- 1 | record List-Set a = 2 | _equals : a -> a -> Bool, 3 | _values : List a, 4 | 5 | func list-set : (a -> a -> Bool) -> List a -> List-Set a = 6 | \equals \values 7 | add-all values (List-Set equals []) 8 | 9 | func values : List-Set a -> List a = _values 10 | 11 | func empty? : List-Set a -> Bool = empty? . _values 12 | 13 | func contains? : a -> List-Set a -> Bool = 14 | \x \set 15 | any (_equals set x) (_values set) 16 | 17 | func add : a -> List-Set a -> List-Set a = 18 | \x \set 19 | _values (x ::) (remove x set) 20 | 21 | func add-all : List a -> List-Set a -> List-Set a = 22 | \xs \set 23 | fold< add xs set 24 | 25 | func remove : a -> List-Set a -> List-Set a = 26 | \x \set 27 | _values (filter (not; _equals set x)) set 28 | 29 | func remove-all : List a -> List-Set a -> List-Set a = 30 | \xs \set 31 | fold< remove xs set 32 | 33 | func find : (a -> Bool) -> List-Set a -> Maybe a = 34 | \p \set 35 | first (filter p; _values set) 36 | 37 | func + : List-Set a -> List-Set a -> List-Set a = 38 | \set1 \set2 39 | add-all (_values set2) set1 40 | 41 | func - : List-Set a -> List-Set a -> List-Set a = 42 | \set1 \set2 43 | remove-all (_values set2) set1 44 | 45 | func & : List-Set a -> List-Set a -> List-Set a = 46 | \set1 \set2 47 | _values (filter (\x contains? x set2)) set1 48 | 49 | func <= : List-Set a -> List-Set a -> Bool = 50 | \set1 \set2 51 | all (\x contains? x set2) (_values set1) 52 | 53 | func >= : List-Set a -> List-Set a -> Bool = 54 | flip (<=) 55 | 56 | func == : List-Set a -> List-Set a -> Bool = 57 | (<=) && (>=) 58 | 59 | func != : List-Set a -> List-Set a -> Bool = 60 | not (==) 61 | 62 | func < : List-Set a -> List-Set a -> Bool = 63 | (<=) && not (>=) 64 | 65 | func > : List-Set a -> List-Set a -> Bool = 66 | (>=) && not (<=) 67 | 68 | func subsets : List-Set a -> List (List-Set a) = 69 | \set 70 | if (empty? set) [set]; 71 | pick (subsets (_values rest! set)) \subset-rest 72 | [subset-rest, _values (first! (_values set) ::) subset-rest] 73 | -------------------------------------------------------------------------------- /stdlib/list.fn: -------------------------------------------------------------------------------- 1 | union List a = empty | a :: List a 2 | 3 | func yield : a -> List a -> List a = :: 4 | 5 | func yield-all : List a -> List a -> List a = ++ 6 | 7 | func empty? : List a -> Bool = 8 | \list 9 | switch list 10 | case empty true 11 | case (::) \x \xs false 12 | 13 | func first : List a -> Maybe a = 14 | \list 15 | switch list 16 | case empty none 17 | case (::) \x \xs some x 18 | 19 | func first! : List a -> a = \list panic "first!: empty list" ? first list 20 | 21 | func rest : List a -> Maybe (List a) = 22 | \list 23 | switch list 24 | case empty none 25 | case (::) \x \xs some xs 26 | 27 | func rest! : List a -> List a = \list panic "rest!: empty list" ? rest list 28 | 29 | func last : List a -> Maybe a = 30 | \list 31 | switch list 32 | case empty none 33 | case (::) \x \xs if (empty? xs) (some x) (last xs) 34 | 35 | func last! : List a -> a = \list panic "last!: empty list" ? last list 36 | 37 | func let-:: : List a -> (a -> List a -> Maybe b) -> Maybe b = 38 | \list \f 39 | switch list 40 | case empty none 41 | case (::) \x \xs f x xs 42 | 43 | func let-:: : List a -> (a -> List a -> b) -> Maybe b = 44 | \list \f 45 | switch list 46 | case empty none 47 | case (::) \x \xs some (f x xs) 48 | 49 | func length : List a -> Int = fold> (\n \_ inc n) 0 50 | 51 | func take : Int -> List a -> List a = 52 | \n \list 53 | if (n < 0) (take (max 0 (length list + n)) list); 54 | if (n == 0) []; 55 | if (empty? list) []; 56 | first! list :: take (dec n) (rest! list) 57 | 58 | func take-while : (a -> Bool) -> List a -> List a = 59 | \p \list 60 | switch list 61 | case empty 62 | [] 63 | case (::) \x \xs 64 | if (p x) (x :: take-while p xs) [] 65 | 66 | func take-until : (a -> Bool) -> List a -> List a = 67 | \p \list 68 | switch list 69 | case empty 70 | [] 71 | case (::) \x \xs 72 | if (p x) [x] (x :: take-until p xs) 73 | 74 | func drop : Int -> List a -> List a = 75 | \n \list 76 | if (n < 0) (drop (max 0 (length list + n)) list); 77 | if (n == 0) list; 78 | if (empty? list) []; 79 | drop (dec n) (rest! list) 80 | 81 | func drop-while : (a -> Bool) -> List a -> List a = 82 | \p \list 83 | switch list 84 | case empty 85 | [] 86 | case (::) \x \xs 87 | if (p x) (drop-while p xs) list 88 | 89 | func drop-until : (a -> Bool) -> List a -> List a = 90 | \p \list 91 | switch list 92 | case empty 93 | [] 94 | case (::) \x \xs 95 | if (p x) xs (drop-until p xs) 96 | 97 | func slice : Int -> Int -> List a -> List a = 98 | \from \len \list 99 | take len; drop from list 100 | 101 | func at : Int -> List a -> Maybe a = 102 | \i \list 103 | first (drop i list) 104 | 105 | func at! : Int -> List a -> a = \i \list panic "at!: out of range" ? at i list 106 | 107 | func at : Int -> (a -> a) -> List a -> List a = 108 | \i \f \list 109 | let (drop i list) \tail 110 | take i list ++ f (first! tail) :: rest! tail 111 | 112 | func fold< : (a -> b -> b) -> List a -> b -> b = 113 | \f \list \zero 114 | switch list 115 | case empty 116 | zero 117 | case (::) \x \xs 118 | f x (fold< f xs zero) 119 | 120 | func fold> : (b -> a -> b) -> b -> List a -> b = 121 | \f \zero \list 122 | switch list 123 | case empty 124 | zero 125 | case (::) \x \xs 126 | fold> f (strict f zero x) xs 127 | 128 | func map : (a -> b) -> List a -> List b = 129 | \f \list 130 | switch list 131 | case empty empty 132 | case (::) \x \xs f x :: map f xs 133 | 134 | func filter : (a -> Bool) -> List a -> List a = 135 | \p \list 136 | switch list 137 | case empty empty 138 | case (::) \x \xs when (p x) (yield x) (filter p xs) 139 | 140 | func every : Int -> List a -> List a = 141 | \n \list 142 | enumerate list 143 | |> filter (zip \i \x zero? (i % n)) 144 | |> map second 145 | 146 | func split : (a -> Bool) -> List a -> List (List a) = 147 | \p \list 148 | if-none [[]]; 149 | let-:: list \x \xs 150 | if (p x) ([] :: split p xs); 151 | if-none [[x]]; 152 | let-:: (split p xs) \w \ws 153 | (x :: w) :: ws 154 | 155 | func split-no-empty : (a -> Bool) -> List a -> List (List a) = 156 | filter (not empty?) . split 157 | 158 | func zip : (a -> b -> c) -> List a -> List b -> List c = 159 | \f \left \right 160 | if (empty? left || empty? right) []; 161 | f (first! left) (first! right) :: zip f (rest! left) (rest! right) 162 | 163 | func ++ : List a -> List a -> List a = \l \r fold< (::) l r 164 | 165 | func concat : List (List a) -> List a = \lists fold< (++) lists [] 166 | 167 | func join : List a -> List (List a) -> List a = 168 | \sep \lists 169 | switch lists 170 | case empty 171 | empty 172 | case (::) \xs \xss ( 173 | switch xss 174 | case empty 175 | xs 176 | case (::) \_ \_ 177 | xs ++ sep ++ join sep xss 178 | ) 179 | 180 | func pick : List a -> (a -> List b) -> List b = 181 | \list \f 182 | (concat . map) f list 183 | 184 | func adjacent : (a -> a -> b) -> List a -> List b = 185 | \f \list 186 | zip f list ([] ? rest list) 187 | 188 | func pairwise : (a -> b -> c) -> List a -> List b -> List c = 189 | \f \list1 \list2 190 | pick list1 \x 191 | map (f x) list2 192 | 193 | func any : (a -> Bool) -> List a -> Bool = 194 | \p \list 195 | fold< ((||) . p) list false 196 | 197 | func all : (a -> Bool) -> List a -> Bool = 198 | \p \list 199 | fold< ((&&) . p) list true 200 | 201 | func count : (a -> Bool) -> List a -> Int = 202 | \pred \list 203 | fold> (\n \x if (pred x) (inc n) n) 0 list 204 | 205 | func repeat : a -> List a = \x x :: repeat x 206 | 207 | func * : Int -> List a -> List a = 208 | \n \list 209 | if (n <= 0) []; 210 | list ++ dec n * list 211 | 212 | func reverse : List a -> List a = 213 | \list 214 | [] |> list |> recur \loop \left \right 215 | if (empty? left) right; 216 | loop (rest! left) (first! left :: right) 217 | 218 | func transpose : List (List a) -> List (List a) = 219 | \rows 220 | if (all empty? rows) []; 221 | filter-some (map first rows) :: transpose (filter-some; map rest rows) 222 | 223 | func range : Int -> Int -> List Int = 224 | \from \to 225 | if (from > to) []; 226 | from :: range (inc from) to 227 | 228 | func rangex : Int -> List Int = \n range 0 (dec n) 229 | 230 | func range-2d : Int -> Int -> Int -> Int -> List (Pair Int Int) = 231 | \from1 \from2 \to1 \to2 232 | pairwise pair (range from1 to1) (range from2 to2) 233 | 234 | func rangex-2d : Int -> Int -> List (Pair Int Int) = 235 | \n1 \n2 236 | pairwise pair (rangex n1) (rangex n2) 237 | 238 | func iterate : (a -> a) -> a -> List a = 239 | \f \z 240 | z :: iterate f (strict f z) 241 | 242 | func enumerate : List a -> List (Pair Int a) = 243 | zip pair (iterate inc 0) 244 | 245 | func sort : (a -> a -> Bool) -> List a -> List a = 246 | \(<) \list 247 | let (length list) \len 248 | if (len <= 1) list; 249 | let (take (len / 2) list) \left 250 | let (drop (len / 2) list) \right 251 | sort (<) right |> sort (<) left |> recur \merge \left \right 252 | if-none (left ++ right); 253 | let-:: left \l \ls 254 | let-:: right \r \rs 255 | if (l < r) (l :: merge ls right); 256 | r :: merge left rs 257 | -------------------------------------------------------------------------------- /stdlib/math.fn: -------------------------------------------------------------------------------- 1 | func even? : Int -> Bool = \i 0 == i % 2 2 | func odd? : Int -> Bool = \i 1 == i % 2 3 | 4 | func min : Int -> Int -> Int = \x \y if (x < y) x y 5 | func max : Int -> Int -> Int = \x \y if (x > y) x y 6 | 7 | func min : Float -> Float -> Float = \x \y if (x < y) x y 8 | func max : Float -> Float -> Float = \x \y if (x > y) x y 9 | 10 | func min : List Int -> Maybe Int = 11 | \nums 12 | if (empty? nums) none; 13 | some; fold> min (first! nums) (rest! nums) 14 | 15 | func max : List Int -> Maybe Int = 16 | \nums 17 | if (empty? nums) none; 18 | some; fold> max (first! nums) (rest! nums) 19 | 20 | func min! : List Int -> Int = \nums panic "min!: empty list" ? min nums 21 | func max! : List Int -> Int = \nums panic "max!: empty list" ? max nums 22 | 23 | func min : List Float -> Float = 24 | \nums 25 | fold> min +inf nums 26 | 27 | func max : List Float -> Float = 28 | \nums 29 | fold> max -inf nums 30 | 31 | func exp : Float -> Float = e ^ 32 | 33 | func sum : List Int -> Int = \nums fold> (+) 0 nums 34 | func sum : List Float -> Float = \nums fold> (+) 0.0 nums 35 | 36 | func product : List Int -> Int = \nums fold> (*) 1 nums 37 | func product : List Float -> Float = \nums fold> (*) 1.0 nums 38 | 39 | record Rat = 40 | num : Int, 41 | den : Int, 42 | 43 | func gcd : Int -> Int -> Int = 44 | \a \b 45 | if (zero? b) a; 46 | gcd b (a % b) 47 | 48 | func norm : Rat -> Rat = 49 | \x 50 | let (gcd (abs; num x) (abs; den x)) \d 51 | if (d == 0) x; 52 | if (den x < 0) (Rat (num x / neg d) (den x / neg d)); 53 | Rat (num x / d) (den x / d) 54 | 55 | func string : Rat -> String = 56 | \x 57 | if (den x == 1) (string (num x)); 58 | string (num x) ++ "/" ++ string (den x) 59 | 60 | func float : Rat -> Float = 61 | \x 62 | float (num x) / float (den x) 63 | 64 | func rat : Int -> Rat = \n Rat n 1 65 | 66 | func // : Int -> Int -> Rat = 67 | \a \b 68 | norm (Rat a b) 69 | 70 | func neg : Rat -> Rat = 71 | \x 72 | Rat (neg; num x) (den x) 73 | 74 | func inv : Rat -> Rat = 75 | \x 76 | Rat (den x) (num x) 77 | 78 | func + : Rat -> Rat -> Rat = 79 | \x \y 80 | ((num x * den y) + (num y * den x)) // (den x * den y) 81 | 82 | func - : Rat -> Rat -> Rat = 83 | \x \y 84 | x + neg y 85 | 86 | func * : Rat -> Rat -> Rat = 87 | \x \y 88 | (num x * num y) // (den x * den y) 89 | 90 | func / : Rat -> Rat -> Rat = 91 | \x \y 92 | x * inv y 93 | 94 | func ^ : Rat -> Int -> Rat = 95 | \x \n 96 | if (n < 0) (inv (x ^ neg n)); 97 | (n * (x *)) (1 // 1) 98 | 99 | func == : Rat -> Rat -> Bool = 100 | \x \y 101 | (den x == den y) && (num x == num y) 102 | 103 | func != : Rat -> Rat -> Bool = 104 | \x \y 105 | (den x != den y) || (num x != num y) 106 | 107 | func < : Rat -> Rat -> Bool = 108 | \x \y 109 | (num x * den y) < (num y * den x) 110 | 111 | func <= : Rat -> Rat -> Bool = 112 | \x \y 113 | (num x * den y) <= (num y * den x) 114 | 115 | func > : Rat -> Rat -> Bool = 116 | \x \y 117 | (num x * den y) > (num y * den x) 118 | 119 | func >= : Rat -> Rat -> Bool = 120 | \x \y 121 | (num x * den y) >= (num y * den x) 122 | -------------------------------------------------------------------------------- /stdlib/maybe.fn: -------------------------------------------------------------------------------- 1 | union Maybe a = none | some a 2 | 3 | func none? : Maybe a -> Bool = 4 | \maybe 5 | switch maybe 6 | case none true 7 | case some \x false 8 | 9 | func some? : Maybe a -> Bool = not none? 10 | 11 | func extract! : Maybe a -> a = 12 | \maybe 13 | switch maybe 14 | case none panic "extract!: none" 15 | case some \x x 16 | 17 | func list : Maybe a -> List a = 18 | \maybe 19 | switch maybe 20 | case none [] 21 | case some \x [x] 22 | 23 | func let-some : Maybe a -> (a -> Maybe b) -> Maybe b = 24 | \maybe \f 25 | switch maybe 26 | case none none 27 | case some \x f x 28 | 29 | func let-some : Maybe a -> (a -> b) -> Maybe b = 30 | \maybe \f 31 | switch maybe 32 | case none none 33 | case some \x some (f x) 34 | 35 | func if-some : Maybe a -> (a -> b) -> b -> b = 36 | \maybe \then \else 37 | switch maybe 38 | case none else 39 | case some \x then x 40 | 41 | func when-some : Maybe a -> (a -> b -> b) -> b -> b = 42 | \maybe \then \next 43 | switch maybe 44 | case none next 45 | case some \x then x; next 46 | 47 | func filter-some : List (Maybe a) -> List a = (concat . map) list 48 | 49 | func for-some : List (Maybe a) -> (a -> b -> b) -> b -> b = for . filter-some 50 | func pick-some : List (Maybe a) -> (a -> List b) -> List b = pick . filter-some 51 | 52 | func if-none : a -> Maybe a -> a = 53 | \default \maybe 54 | switch maybe 55 | case none default 56 | case some \x x 57 | 58 | func ? : a -> Maybe a -> a = if-none 59 | 60 | func map : (a -> b) -> Maybe a -> Maybe b = 61 | \f \maybe 62 | switch maybe 63 | case none none 64 | case some \x some (f x) 65 | 66 | func filter : (a -> Bool) -> Maybe a -> Maybe a = 67 | \p \maybe 68 | switch maybe 69 | case none none 70 | case some \x if (p x) (some x) none 71 | -------------------------------------------------------------------------------- /stdlib/pair.fn: -------------------------------------------------------------------------------- 1 | record Pair a b = first : a, second : b 2 | 3 | func pair : a -> b -> Pair a b = Pair 4 | 5 | func => : a -> b -> Pair a b = Pair 6 | 7 | func map : (a -> b) -> Pair a a -> Pair b b = 8 | \f \p 9 | pair (f (first p)) (f (second p)) 10 | 11 | func map-first : (a -> b) -> Pair a t -> Pair b t = 12 | \f \p 13 | pair (f (first p)) (second p) 14 | 15 | func map-second : (a -> b) -> Pair t a -> Pair t b = 16 | \f \p 17 | pair (first p) (f (second p)) 18 | 19 | func zip : (a -> b -> c) -> Pair a b -> c = 20 | \f \p 21 | f (first p) (second p) 22 | 23 | func let-pair : Pair a b -> (a -> b -> c) -> c = 24 | \p \f 25 | f (first p) (second p) 26 | 27 | func for-pair : List (Pair a b) -> (a -> b -> c -> c) -> c -> c = 28 | \list \body \next 29 | switch list 30 | case empty 31 | next 32 | case (::) \p \xs 33 | body (first p) (second p); 34 | for-pair xs body; 35 | next 36 | 37 | func pick-pair : List (Pair a b) -> (a -> b -> List c) -> List c = 38 | \list \f 39 | (concat . map) (\p f (first p) (second p)) list 40 | -------------------------------------------------------------------------------- /stdlib/proc.fn: -------------------------------------------------------------------------------- 1 | union Proc s r = 2 | view (s -> Proc s r) | 3 | update (s -> s) (Proc s r) | 4 | return r | 5 | 6 | func return : (s -> a) -> Proc s a = 7 | \f 8 | view \x 9 | return (f x) 10 | 11 | func -> : (s -> a) -> (a -> Proc s r) -> Proc s r = 12 | \getter \fnext 13 | view (fnext . getter) 14 | 15 | func := : ((a -> a) -> s -> s) -> a -> Proc s r -> Proc s r = 16 | \updater \value \next 17 | update (updater (const value)); 18 | next 19 | 20 | func <- : ((a -> a) -> s -> s) -> (a -> a) -> Proc s r -> Proc s r = 21 | \updater \f \next 22 | update (updater f); 23 | next 24 | 25 | func start-with : s -> Proc s r -> r = 26 | \value \proc 27 | switch proc 28 | case view \f 29 | start-with value; 30 | f value 31 | case update \f \next 32 | start-with (strict f value); 33 | next 34 | case return \x 35 | x 36 | 37 | func call : Proc s a -> (a -> Proc s b) -> Proc s b = 38 | \proc \fnext 39 | switch proc 40 | case view \f 41 | view \s 42 | call (f s) fnext 43 | case update \f \next 44 | update f; 45 | call next fnext 46 | case return \x 47 | fnext x 48 | 49 | func call : Proc s a -> Proc s b -> Proc s b = 50 | \proc \next 51 | call proc \_ 52 | next 53 | 54 | func while : (s -> Bool) -> (Proc s a -> Proc s a) -> Proc s a -> Proc s a = 55 | \cond \body \next 56 | view \s 57 | if (not cond s) next; 58 | body; 59 | while cond body; 60 | next 61 | -------------------------------------------------------------------------------- /stdlib/result.fn: -------------------------------------------------------------------------------- 1 | union Result a = error String | ok a 2 | 3 | func error? : Result a -> Bool = 4 | \result 5 | switch result 6 | case error \msg true 7 | case ok \x false 8 | 9 | func ok? : Result a -> Bool = 10 | \result 11 | switch result 12 | case error \msg false 13 | case ok \x true 14 | 15 | func extract! : Result a -> a = 16 | \result 17 | switch result 18 | case error \msg panic ("extract!: error: " ++ msg) 19 | case ok \x x 20 | 21 | func maybe : Result a -> Maybe a = 22 | \result 23 | switch result 24 | case error \msg none 25 | case ok \x some x 26 | 27 | func list : Result a -> List a = 28 | \result 29 | switch result 30 | case error \msg [] 31 | case ok \x [x] 32 | 33 | func let-ok : Result a -> (a -> Result b) -> Result b = 34 | \result \f 35 | switch result 36 | case error \msg error msg 37 | case ok \x f x 38 | 39 | func let-ok : Result a -> (a -> b) -> Result b = 40 | \result \f 41 | switch result 42 | case error \msg error msg 43 | case ok \x ok (f x) 44 | 45 | func if-ok : Result a -> (a -> b) -> b -> b = 46 | \result \then \else 47 | switch result 48 | case error \msg else 49 | case ok \x then x 50 | 51 | func when-ok : Result a -> (a -> b -> b) -> b -> b = 52 | \result \then \next 53 | switch result 54 | case error \msg next 55 | case ok \x then x; next 56 | 57 | func if-error : (String -> a) -> Result a -> a = 58 | \handle \result 59 | switch result 60 | case error \msg handle msg 61 | case ok \x x 62 | 63 | func ? : a -> Result a -> a = 64 | \default \result 65 | switch result 66 | case error \msg default 67 | case ok \x x 68 | 69 | func map : (a -> b) -> Result a -> Result b = 70 | \f \result 71 | switch result 72 | case error \msg error msg 73 | case ok \x ok (f x) 74 | 75 | func map-error : (String -> String) -> Result a -> Result a = 76 | \f \result 77 | switch result 78 | case error \msg error (f msg) 79 | case ok \x ok x 80 | -------------------------------------------------------------------------------- /stdlib/slots.fn: -------------------------------------------------------------------------------- 1 | union Slots a = empty | node (Maybe a) (Slots a) (Slots a) (Slots a) (Slots a) 2 | 3 | func empty? : Slots a -> Bool = 4 | \slots 5 | switch slots 6 | case empty true 7 | case node \m \s1 \s2 \s3 \s4 false 8 | 9 | func at : Int -> Slots a -> Maybe a = 10 | \i \slots 11 | switch slots 12 | case empty 13 | none 14 | case node \m \s1 \s2 \s3 \s4 15 | if (i == 0) m; 16 | let (i % 4) \mod 17 | if (mod == 1) (at (i / 4) s1); 18 | if (mod == 2) (at (i / 4) s2); 19 | if (mod == 3) (at (i / 4) s3); 20 | at (dec (i / 4)) s4 21 | 22 | func at! : Int -> Slots a -> a = \i \slots panic "at!: index not set" ? at i slots 23 | 24 | func at : Int -> (Maybe a -> Maybe a) -> Slots a -> Slots a = 25 | \i \f \slots 26 | _collapse; 27 | switch slots 28 | case empty 29 | at i f (node none empty empty empty empty) 30 | case node \m \s1 \s2 \s3 \s4 31 | if (i == 0) (node (f m) s1 s2 s3 s4); 32 | let (i % 4) \mod 33 | if (mod == 1) (node m (at (i / 4) f s1) s2 s3 s4); 34 | if (mod == 2) (node m s1 (at (i / 4) f s2) s3 s4); 35 | if (mod == 3) (node m s1 s2 (at (i / 4) f s3) s4); 36 | node m s1 s2 s3 (at (dec (i / 4)) f s4) 37 | 38 | func _collapse : Slots a -> Slots a = 39 | \slots 40 | switch slots 41 | case empty 42 | empty 43 | case node \m \s1 \s2 \s3 \s4 44 | if (none? m && empty? s1 && empty? s2 && empty? s3 && empty? s4) 45 | empty; 46 | slots 47 | -------------------------------------------------------------------------------- /stdlib/string.fn: -------------------------------------------------------------------------------- 1 | alias String = List Char 2 | 3 | func == : String -> String -> Bool = 4 | \left \right 5 | if (empty? left && empty? right) true; 6 | if (empty? left || empty? right) false; 7 | if (first! left != first! right) false; 8 | rest! left == rest! right 9 | 10 | func != : String -> String -> Bool = not (==) 11 | 12 | func < : String -> String -> Bool = 13 | \left \right 14 | if (empty? left) (not empty? right); 15 | if (empty? right) false; 16 | if (first! left < first! right) true; 17 | if (first! left > first! right) false; 18 | rest! left < rest! right 19 | 20 | func <= : String -> String -> Bool = 21 | \left \right 22 | if (empty? left) true; 23 | if (empty? right) false; 24 | if (first! left < first! right) true; 25 | if (first! left > first! right) false; 26 | rest! left <= rest! right 27 | 28 | func > : String -> String -> Bool = 29 | flip (<) 30 | 31 | func >= : String -> String -> Bool = 32 | flip (<=) 33 | 34 | func prefix? : String -> String -> Bool = 35 | \prefix \s 36 | take (length prefix) s == prefix 37 | 38 | func % : String -> List String -> String = 39 | \format \substs 40 | if (empty? format) ""; 41 | if (prefix? "%%" format) 42 | ('%' :: rest! (rest! format) % substs); 43 | if (prefix? "%s" format && not empty? substs) 44 | (first! substs ++ rest! (rest! format) % rest! substs); 45 | first! format :: rest! format % substs 46 | 47 | func string : Char -> String = \c [c] 48 | func string : String -> String = self 49 | 50 | func left-pad : Char -> Int -> String -> String = 51 | \c \width \s 52 | take (width - length s) (repeat c) ++ s 53 | 54 | func right-pad : Char -> Int -> String -> String = 55 | \c \width \s 56 | s ++ take (width - length s) (repeat c) 57 | 58 | func format-table : Int -> List (List String) -> String = 59 | \spacing \rows 60 | let (transpose rows) \columns 61 | let (map (map length) columns) \cell-lengths 62 | let (map max! cell-lengths) \column-widths 63 | for rows ( 64 | \row \next 65 | for-pair (zip pair row column-widths) ( 66 | \cell \width \next 67 | yield-all (right-pad ' ' (width + spacing) cell); 68 | next 69 | ); 70 | yield '\n'; 71 | next 72 | ); 73 | empty 74 | -------------------------------------------------------------------------------- /types-sandbox.go: -------------------------------------------------------------------------------- 1 | package funky 2 | 3 | import ( 4 | "bufio" 5 | "fmt" 6 | "os" 7 | 8 | "github.com/faiface/funky/parse" 9 | 10 | "github.com/faiface/funky/compile" 11 | ) 12 | 13 | func runTypesSandbox(env *compile.Env) { 14 | scanner := bufio.NewScanner(os.Stdin) 15 | for { 16 | fmt.Print("> ") 17 | if !scanner.Scan() { 18 | break 19 | } 20 | code := scanner.Text() 21 | tokens, err := parse.Tokenize("sandbox", code) 22 | if err != nil { 23 | fmt.Println(err) 24 | continue 25 | } 26 | exp, err := parse.Expr(tokens) 27 | if err != nil { 28 | fmt.Println(err) 29 | continue 30 | } 31 | if exp == nil { 32 | continue 33 | } 34 | results, err := env.TypeInferExpr(exp) 35 | if err != nil { 36 | fmt.Println(err) 37 | continue 38 | } 39 | for _, result := range results { 40 | fmt.Println(result.Type) 41 | } 42 | } 43 | } 44 | -------------------------------------------------------------------------------- /types/name.go: -------------------------------------------------------------------------------- 1 | package types 2 | 3 | import "github.com/faiface/funky/parse/parseinfo" 4 | 5 | type Name interface { 6 | SourceInfo() *parseinfo.Source 7 | Arity() int 8 | } 9 | 10 | type ( 11 | Builtin struct { 12 | NumArgs int 13 | } 14 | 15 | Record struct { 16 | SI *parseinfo.Source 17 | Args []string 18 | Fields []Field 19 | } 20 | 21 | Union struct { 22 | SI *parseinfo.Source 23 | Args []string 24 | Alts []Alternative 25 | } 26 | 27 | Alias struct { 28 | SI *parseinfo.Source 29 | Args []string 30 | Type Type 31 | } 32 | ) 33 | 34 | type Field struct { 35 | SI *parseinfo.Source 36 | Name string 37 | Type Type 38 | } 39 | 40 | type Alternative struct { 41 | SI *parseinfo.Source 42 | Name string 43 | Fields []Type 44 | } 45 | 46 | func (b *Builtin) SourceInfo() *parseinfo.Source { return nil } 47 | func (r *Record) SourceInfo() *parseinfo.Source { return r.SI } 48 | func (e *Union) SourceInfo() *parseinfo.Source { return e.SI } 49 | func (a *Alias) SourceInfo() *parseinfo.Source { return a.SI } 50 | 51 | func (b *Builtin) Arity() int { return b.NumArgs } 52 | func (r *Record) Arity() int { return len(r.Args) } 53 | func (e *Union) Arity() int { return len(e.Args) } 54 | func (a *Alias) Arity() int { return len(a.Args) } 55 | -------------------------------------------------------------------------------- /types/string.go: -------------------------------------------------------------------------------- 1 | package types 2 | 3 | import "fmt" 4 | 5 | func (v *Var) leftString() string { return v.Name } 6 | func (a *Appl) leftString() string { return a.String() } 7 | func (f *Func) leftString() string { return "(" + f.String() + ")" } 8 | 9 | func (v *Var) insideString() string { return v.Name } 10 | func (a *Appl) insideString() string { 11 | if len(a.Args) > 0 { 12 | return "(" + a.String() + ")" 13 | } 14 | return a.String() 15 | } 16 | func (f *Func) insideString() string { return "(" + f.String() + ")" } 17 | 18 | func (v *Var) String() string { return v.Name } 19 | func (a *Appl) String() string { 20 | s := a.Name 21 | for _, arg := range a.Args { 22 | s += " " + arg.insideString() 23 | } 24 | return s 25 | } 26 | func (f *Func) String() string { 27 | return fmt.Sprintf("%v -> %v", f.From.leftString(), f.To.String()) 28 | } 29 | -------------------------------------------------------------------------------- /types/typecheck/infer.go: -------------------------------------------------------------------------------- 1 | package typecheck 2 | 3 | import ( 4 | "fmt" 5 | "strings" 6 | 7 | "github.com/faiface/funky/expr" 8 | "github.com/faiface/funky/parse/parseinfo" 9 | "github.com/faiface/funky/types" 10 | ) 11 | 12 | type ( 13 | NotBoundError struct { 14 | SourceInfo *parseinfo.Source 15 | Name string 16 | } 17 | 18 | CannotApplyError struct { 19 | LeftSourceInfo *parseinfo.Source 20 | RightSourceInfo *parseinfo.Source 21 | Cases []struct { 22 | Left types.Type 23 | Err error 24 | } 25 | } 26 | 27 | NoMatchError struct { 28 | SourceInfo *parseinfo.Source 29 | TypeInfo types.Type 30 | Results []InferResult 31 | } 32 | 33 | AmbiguousError struct { 34 | SourceInfo *parseinfo.Source 35 | TypeInfo types.Type 36 | Results []InferResult 37 | } 38 | 39 | CannotSwitchError struct { 40 | ExprSourceInfo *parseinfo.Source 41 | Cases []struct { 42 | Expr types.Type 43 | Err error 44 | } 45 | } 46 | ) 47 | 48 | func (err *CannotApplyError) AddCase(left types.Type, er error) { 49 | err.Cases = append(err.Cases, struct { 50 | Left types.Type 51 | Err error 52 | }{left, er}) 53 | } 54 | 55 | func (err *CannotSwitchError) AddCase(exp types.Type, er error) { 56 | err.Cases = append(err.Cases, struct { 57 | Expr types.Type 58 | Err error 59 | }{exp, er}) 60 | } 61 | 62 | func (err *NotBoundError) Error() string { 63 | return fmt.Sprintf("%v: variable not bound: %s", err.SourceInfo, err.Name) 64 | } 65 | 66 | func (err *CannotApplyError) Error() string { 67 | s := fmt.Sprintf("%v: cannot apply; in case function has type:", err.LeftSourceInfo) 68 | for _, cas := range err.Cases { 69 | s += "\n" + cas.Left.String() 70 | s += "\n" + indent(cas.Err.Error()) 71 | } 72 | return s 73 | } 74 | 75 | func indent(s string) string { 76 | var b strings.Builder 77 | if len(s) > 0 { 78 | b.WriteString(" ") 79 | } 80 | for _, r := range s { 81 | b.WriteRune(r) 82 | if r == '\n' { 83 | b.WriteString(" ") 84 | } 85 | } 86 | return b.String() 87 | } 88 | 89 | func (err *NoMatchError) Error() string { 90 | s := fmt.Sprintf("%v: does not match required type: %v\n", err.SourceInfo, err.TypeInfo) 91 | s += "admissible types are:" 92 | for _, r := range err.Results { 93 | s += fmt.Sprintf("\n %v", r.Type) 94 | } 95 | return s 96 | } 97 | 98 | func (err *AmbiguousError) Error() string { 99 | traversals := make([]<-chan expr.Expr, len(err.Results)) 100 | for i := range traversals { 101 | traversals[i] = traverse(err.Results[i].Subst.ApplyToExpr(err.Results[i].Expr)) 102 | } 103 | // the idea is to concurrently traverse all inferred expressions and find the first 104 | // variable that differs in type across the results and report it 105 | for { 106 | var exprs []expr.Expr 107 | for i := range traversals { 108 | exprs = append(exprs, <-traversals[i]) 109 | } 110 | for i := 1; i < len(exprs); i++ { 111 | if !exprs[0].TypeInfo().Equal(exprs[i].TypeInfo()) { 112 | // we found one source of ambiguity, we report it 113 | s := fmt.Sprintf("%v: ambiguous, multiple admissible types:", exprs[0].SourceInfo()) 114 | accumulateTypes: 115 | for j, e := range exprs { 116 | for k := 0; k < j; k++ { 117 | if exprs[k].TypeInfo().Equal(e.TypeInfo()) { 118 | continue accumulateTypes 119 | } 120 | } 121 | s += fmt.Sprintf("\n %v", e.TypeInfo()) 122 | } 123 | // drain traversals 124 | for _, ch := range traversals { 125 | for range ch { 126 | } 127 | } 128 | return s 129 | } 130 | } 131 | } 132 | } 133 | 134 | func (err *CannotSwitchError) Error() string { 135 | s := fmt.Sprintf("%v: cannot switch; in case switched expression has type:", err.ExprSourceInfo) 136 | for _, cas := range err.Cases { 137 | s += "\n" + cas.Expr.String() 138 | s += "\n" + indent(cas.Err.Error()) 139 | } 140 | return s 141 | } 142 | 143 | func traverse(e expr.Expr) <-chan expr.Expr { 144 | ch := make(chan expr.Expr) 145 | go func() { 146 | traverseHelper(ch, e) 147 | close(ch) 148 | }() 149 | return ch 150 | } 151 | 152 | func traverseHelper(ch chan<- expr.Expr, e expr.Expr) { 153 | switch e := e.(type) { 154 | case *expr.Var: 155 | ch <- e 156 | case *expr.Abst: 157 | ch <- e.Bound 158 | traverseHelper(ch, e.Body) 159 | case *expr.Appl: 160 | traverseHelper(ch, e.Right) 161 | traverseHelper(ch, e.Left) 162 | case *expr.Switch: 163 | traverseHelper(ch, e.Expr) 164 | for i := len(e.Cases) - 1; i >= 0; i-- { 165 | traverseHelper(ch, e.Cases[i].Body) 166 | } 167 | } 168 | } 169 | 170 | type InferResult struct { 171 | Type types.Type 172 | Subst Subst 173 | Expr expr.Expr 174 | } 175 | 176 | func Infer(names map[string]types.Name, global map[string][]types.Type, e expr.Expr) ([]InferResult, error) { 177 | varIndex := 0 178 | e = instExpr(&varIndex, e) 179 | results, err := infer(&varIndex, names, global, make(map[string]types.Type), e) 180 | if err != nil { 181 | return nil, err 182 | } 183 | for i := range results { 184 | results[i].Expr = results[i].Subst.ApplyToExpr(results[i].Expr) 185 | } 186 | return results, nil 187 | } 188 | 189 | var counter = 0 190 | 191 | func infer( 192 | varIndex *int, 193 | names map[string]types.Name, 194 | global map[string][]types.Type, 195 | local map[string]types.Type, 196 | e expr.Expr, 197 | ) (results []InferResult, err error) { 198 | defer func() { 199 | if err != nil || e.TypeInfo() == nil { 200 | return 201 | } 202 | // filter infer results by the type info 203 | var filtered []InferResult 204 | for _, r := range results { 205 | if IsSpec(names, r.Type, e.TypeInfo()) { 206 | s, _ := Unify(names, r.Type, e.TypeInfo()) 207 | r.Type = s.ApplyToType(r.Type) 208 | r.Subst = r.Subst.Compose(s) 209 | filtered = append(filtered, r) 210 | } 211 | } 212 | if len(filtered) == 0 { 213 | err = &NoMatchError{e.SourceInfo(), e.TypeInfo(), results} 214 | results = nil 215 | return 216 | } 217 | if len(filtered) > 1 { 218 | err = &AmbiguousError{e.SourceInfo(), e.TypeInfo(), results} 219 | results = nil 220 | return 221 | } 222 | results = filtered 223 | }() 224 | 225 | switch e := e.(type) { 226 | case *expr.Char, *expr.Int, *expr.Float: 227 | return []InferResult{{ 228 | Type: e.TypeInfo(), 229 | Subst: nil, 230 | Expr: e, 231 | }}, nil 232 | 233 | case *expr.Var: 234 | if t, ok := local[e.Name]; ok { 235 | return []InferResult{{ 236 | Type: t, 237 | Subst: nil, 238 | Expr: e.WithTypeInfo(t), 239 | }}, nil 240 | } 241 | ts, ok := global[e.Name] 242 | if !ok { 243 | return nil, &NotBoundError{e.SourceInfo(), e.Name} 244 | } 245 | results = nil 246 | for _, t := range ts { 247 | t = instType(varIndex, t) 248 | results = append(results, InferResult{ 249 | Type: t, 250 | Subst: nil, 251 | Expr: e.WithTypeInfo(t), 252 | }) 253 | } 254 | return results, nil 255 | 256 | case *expr.Abst: 257 | var ( 258 | bindType = e.Bound.TypeInfo() 259 | bodyType = e.Body.TypeInfo() 260 | ) 261 | if f, ok := e.TypeInfo().(*types.Func); ok { 262 | if bindType == nil { 263 | bindType = f.From 264 | } 265 | if bodyType == nil { 266 | bodyType = f.To 267 | } 268 | } else if bindType == nil { 269 | bindType = newVar(varIndex) 270 | } 271 | newLocal := assume(local, e.Bound.Name, bindType) 272 | bodyResults, err := infer(varIndex, names, global, newLocal, e.Body.WithTypeInfo(bodyType)) 273 | if err != nil { 274 | return nil, err 275 | } 276 | results = nil 277 | for _, r := range bodyResults { 278 | inferredBindType := r.Subst.ApplyToType(bindType) 279 | t := &types.Func{ 280 | From: inferredBindType, 281 | To: r.Type, 282 | } 283 | results = append(results, InferResult{ 284 | Type: t, 285 | Subst: r.Subst, 286 | Expr: &expr.Abst{ 287 | TI: t, 288 | SI: e.SI, 289 | Bound: e.Bound.WithTypeInfo(inferredBindType).(*expr.Var), 290 | Body: r.Expr, 291 | }, 292 | }) 293 | } 294 | return results, nil 295 | 296 | case *expr.Appl: 297 | resultsL, err := infer(varIndex, names, global, local, e.Left) 298 | if err != nil { 299 | return nil, err 300 | } 301 | resultsR, err := infer(varIndex, names, global, local, e.Right) 302 | if err != nil { 303 | return nil, err 304 | } 305 | 306 | results = nil 307 | var resultType types.Type 308 | if e.TypeInfo() == nil { 309 | resultType = newVar(varIndex) 310 | } else { 311 | resultType = e.TypeInfo() 312 | } 313 | for _, rL := range resultsL { 314 | for _, rR := range resultsR { 315 | s, ok := rL.Subst.Unify(names, rR.Subst) 316 | if !ok { 317 | continue 318 | } 319 | st, ok := Unify(names, s.ApplyToType(rL.Type), &types.Func{ 320 | From: s.ApplyToType(rR.Type), 321 | To: resultType, 322 | }) 323 | if !ok { 324 | continue 325 | } 326 | s = s.Compose(st) 327 | t := s.ApplyToType(resultType) 328 | results = append(results, InferResult{ 329 | Type: t, 330 | Subst: s, 331 | Expr: &expr.Appl{ 332 | TI: t, 333 | Left: rL.Expr, 334 | Right: rR.Expr, 335 | }, 336 | }) 337 | } 338 | } 339 | 340 | if len(results) == 0 { 341 | return nil, fmt.Errorf("%v: type-checking error", e.Right.SourceInfo()) 342 | } 343 | return results, nil 344 | 345 | case *expr.Strict: 346 | resultsExpr, err := infer(varIndex, names, global, local, e.Expr) 347 | if err != nil { 348 | return nil, err 349 | } 350 | 351 | var results []InferResult 352 | 353 | for _, rExpr := range resultsExpr { 354 | s := rExpr.Subst 355 | if e.TI != nil { 356 | s1, ok := Unify(names, e.TI, rExpr.Type) 357 | if !ok { 358 | continue 359 | } 360 | s = s.Compose(s1) 361 | } 362 | t := s.ApplyToType(rExpr.Type) 363 | results = append(results, InferResult{ 364 | Type: t, 365 | Subst: s, 366 | Expr: &expr.Strict{ 367 | TI: t, 368 | SI: e.SI, 369 | Expr: rExpr.Expr, 370 | }, 371 | }) 372 | } 373 | 374 | if len(results) == 0 { 375 | return nil, fmt.Errorf("%v: type-checking error", e.SourceInfo()) 376 | } 377 | 378 | return results, nil 379 | 380 | case *expr.Switch: 381 | resultsExpr, err := infer(varIndex, names, global, local, e.Expr) 382 | if err != nil { 383 | return nil, err 384 | } 385 | 386 | resultsCases := make([][]InferResult, len(e.Cases)) 387 | for i := range e.Cases { 388 | resultsCases[i], err = infer(varIndex, names, global, local, e.Cases[i].Body) 389 | if err != nil { 390 | return nil, err 391 | } 392 | } 393 | 394 | var eligibleUnions []string 395 | namesLoop: 396 | for name := range names { 397 | union, ok := names[name].(*types.Union) 398 | if !ok { 399 | continue namesLoop 400 | } 401 | if len(union.Alts) != len(e.Cases) { 402 | continue namesLoop 403 | } 404 | for i := range union.Alts { 405 | if union.Alts[i].Name != e.Cases[i].Alt { 406 | continue namesLoop 407 | } 408 | } 409 | eligibleUnions = append(eligibleUnions, name) 410 | } 411 | 412 | if len(eligibleUnions) == 0 { 413 | return nil, fmt.Errorf("%v: no union fits", e.SourceInfo()) 414 | } 415 | 416 | var ( 417 | resultType types.Type 418 | unionTypes []types.Type 419 | altsTypes [][]types.Type 420 | ) 421 | 422 | if e.TypeInfo() == nil { 423 | resultType = newVar(varIndex) 424 | } else { 425 | resultType = e.TypeInfo() 426 | } 427 | 428 | for _, name := range eligibleUnions { 429 | union := names[name].(*types.Union) 430 | 431 | unionTyp := &types.Appl{Name: name, Args: make([]types.Type, len(union.Args))} 432 | s := Subst(nil) 433 | for i, arg := range union.Args { 434 | unionTyp.Args[i] = newVar(varIndex) 435 | s = s.Compose(Subst{arg: unionTyp.Args[i]}) 436 | } 437 | 438 | unionTypes = append(unionTypes, unionTyp) 439 | 440 | altTypes := make([]types.Type, len(union.Alts)) 441 | for i := range altTypes { 442 | typ := resultType 443 | for j := len(union.Alts[i].Fields) - 1; j >= 0; j-- { 444 | typ = &types.Func{From: s.ApplyToType(union.Alts[i].Fields[j]), To: typ} 445 | } 446 | altTypes[i] = typ 447 | } 448 | 449 | altsTypes = append(altsTypes, altTypes) 450 | } 451 | 452 | results = nil 453 | 454 | for _, rExpr := range resultsExpr { 455 | for unionIndex := range unionTypes { 456 | unionType := unionTypes[unionIndex] 457 | altTypes := altsTypes[unionIndex] 458 | 459 | s, ok := Unify(names, rExpr.Type, unionType) 460 | if !ok { 461 | continue 462 | } 463 | 464 | var ( 465 | substs = []Subst{rExpr.Subst.Compose(s)} 466 | exprs = []*expr.Switch{{SI: e.SI, Expr: rExpr.Expr}} 467 | ) 468 | 469 | for altIndex, altType := range altTypes { 470 | var ( 471 | newSubsts []Subst 472 | newExprs []*expr.Switch 473 | ) 474 | for i := range substs { 475 | subst := substs[i] 476 | exp := exprs[i] 477 | for _, resultCase := range resultsCases[altIndex] { 478 | s, ok := Unify(names, altType, resultCase.Subst.ApplyToType(resultCase.Type)) 479 | if !ok { 480 | continue 481 | } 482 | newSubst := resultCase.Subst.Compose(s) 483 | newSubst, ok = newSubst.Unify(names, subst) 484 | if !ok { 485 | continue 486 | } 487 | newSubsts = append(newSubsts, newSubst) 488 | newExprs = append(newExprs, &expr.Switch{ 489 | SI: exp.SI, 490 | Expr: exp.Expr, 491 | Cases: append(exp.Cases[:altIndex:altIndex], struct { 492 | SI *parseinfo.Source 493 | Alt string 494 | Body expr.Expr 495 | }{e.Cases[altIndex].SI, e.Cases[altIndex].Alt, resultCase.Expr}), 496 | }) 497 | } 498 | } 499 | substs = newSubsts 500 | exprs = newExprs 501 | } 502 | 503 | for i := range substs { 504 | t := substs[i].ApplyToType(resultType) 505 | 506 | resultExpr := exprs[i] 507 | resultExpr.TI = t 508 | 509 | result := InferResult{ 510 | Type: t, 511 | Subst: substs[i], 512 | Expr: resultExpr, 513 | } 514 | 515 | results = append(results, result) 516 | } 517 | } 518 | } 519 | 520 | if len(results) == 0 { 521 | return nil, fmt.Errorf("%v: type-checking error", e.SourceInfo()) 522 | } 523 | 524 | return results, nil 525 | } 526 | 527 | panic("unreachable") 528 | } 529 | 530 | func newVar(varIndex *int) *types.Var { 531 | name := "" 532 | i := *varIndex + 1 533 | for i > 0 { 534 | name = string('a'+(i-1)%26) + name 535 | i = (i - 1) / 26 536 | } 537 | v := &types.Var{Name: name} 538 | *varIndex++ 539 | return v 540 | } 541 | 542 | func assume(vars map[string]types.Type, v string, t types.Type) map[string]types.Type { 543 | newVars := make(map[string]types.Type) 544 | for v, t := range vars { 545 | newVars[v] = t 546 | } 547 | newVars[v] = t 548 | return newVars 549 | } 550 | 551 | func instTypeHelper(varIndex *int, renames map[string]string, t types.Type) types.Type { 552 | return t.Map(func(t types.Type) types.Type { 553 | if v, ok := t.(*types.Var); ok { 554 | renamed, ok := renames[v.Name] 555 | if !ok { 556 | renamed = newVar(varIndex).Name 557 | renames[v.Name] = renamed 558 | *varIndex++ 559 | } 560 | return &types.Var{ 561 | SI: v.SI, 562 | Name: renamed, 563 | } 564 | } 565 | return t 566 | }) 567 | } 568 | 569 | func instType(varIndex *int, t types.Type) types.Type { 570 | renames := make(map[string]string) 571 | return instTypeHelper(varIndex, renames, t) 572 | } 573 | 574 | func instExpr(varIndex *int, e expr.Expr) expr.Expr { 575 | renames := make(map[string]string) 576 | return e.Map(func(e expr.Expr) expr.Expr { 577 | t := e.TypeInfo() 578 | if t != nil { 579 | t = instTypeHelper(varIndex, renames, t) 580 | } 581 | return e.WithTypeInfo(t) 582 | }) 583 | } 584 | -------------------------------------------------------------------------------- /types/typecheck/spec.go: -------------------------------------------------------------------------------- 1 | package typecheck 2 | 3 | import "github.com/faiface/funky/types" 4 | 5 | func IsSpec(names map[string]types.Name, t, u types.Type) bool { 6 | return isSpec(names, make(map[string]types.Type), t, u) 7 | } 8 | 9 | func isSpec(names map[string]types.Name, bind map[string]types.Type, t, u types.Type) bool { 10 | switch t := t.(type) { 11 | case *types.Var: 12 | if bind[t.Name] == nil { 13 | bind[t.Name] = u 14 | } 15 | return bind[t.Name].Equal(u) 16 | case *types.Appl: 17 | ua, ok := u.(*types.Appl) 18 | if !ok || t.Name != ua.Name || len(t.Args) != len(ua.Args) { 19 | if alias, ok := names[t.Name].(*types.Alias); ok { 20 | return isSpec(names, bind, revealAlias(alias, t.Args), u) 21 | } 22 | if ok { 23 | if alias, ok := names[ua.Name].(*types.Alias); ok { 24 | return isSpec(names, bind, t, revealAlias(alias, ua.Args)) 25 | } 26 | } 27 | return false 28 | } 29 | for i := range t.Args { 30 | if !isSpec(names, bind, t.Args[i], ua.Args[i]) { 31 | return false 32 | } 33 | } 34 | return true 35 | case *types.Func: 36 | if applU, ok := u.(*types.Appl); ok { 37 | if alias, ok := names[applU.Name].(*types.Alias); ok { 38 | return isSpec(names, bind, t, revealAlias(alias, applU.Args)) 39 | } 40 | } 41 | uf, ok := u.(*types.Func) 42 | if !ok { 43 | return false 44 | } 45 | return isSpec(names, bind, t.From, uf.From) && isSpec(names, bind, t.To, uf.To) 46 | } 47 | panic("unreachable") 48 | } 49 | -------------------------------------------------------------------------------- /types/typecheck/subst.go: -------------------------------------------------------------------------------- 1 | package typecheck 2 | 3 | import ( 4 | "github.com/faiface/funky/expr" 5 | "github.com/faiface/funky/types" 6 | ) 7 | 8 | type Subst map[string]types.Type 9 | 10 | func (s Subst) Compose(s1 Subst) Subst { 11 | s2 := make(Subst) 12 | for v, t := range s { // copy s + transitivity 13 | s2[v] = s1.ApplyToType(t) 14 | } 15 | for v, t := range s1 { // copy s1 16 | s2[v] = t 17 | } 18 | return s2 19 | } 20 | 21 | func (s Subst) Unify(names map[string]types.Name, s1 Subst) (s2 Subst, ok bool) { 22 | s2 = make(Subst) 23 | for v, t := range s { 24 | if t1, ok := s1[v]; ok { 25 | suni, ok := Unify(names, s2.ApplyToType(t), s2.ApplyToType(t1)) 26 | if !ok { 27 | return nil, false 28 | } 29 | s2 = s2.Compose(suni) 30 | } 31 | } 32 | for v, t := range s { 33 | s2[v] = s2.ApplyToType(t) 34 | } 35 | for v, t := range s1 { 36 | s2[v] = s2.ApplyToType(t) 37 | } 38 | return s2, true 39 | } 40 | 41 | func (s Subst) ApplyToType(t types.Type) types.Type { 42 | if t == nil { 43 | return nil 44 | } 45 | return t.Map(func(t types.Type) types.Type { 46 | if v, ok := t.(*types.Var); ok && s[v.Name] != nil { 47 | return s[v.Name] 48 | } 49 | return t 50 | }) 51 | } 52 | 53 | func (s Subst) ApplyToExpr(e expr.Expr) expr.Expr { 54 | if e == nil { 55 | return nil 56 | } 57 | return e.Map(func(e expr.Expr) expr.Expr { 58 | return e.WithTypeInfo(s.ApplyToType(e.TypeInfo())) 59 | }) 60 | } 61 | 62 | func (s Subst) ApplyToVars(vars map[string]types.Type) map[string]types.Type { 63 | newVars := make(map[string]types.Type) 64 | for v, t := range vars { 65 | newVars[v] = s.ApplyToType(t) 66 | } 67 | return newVars 68 | } 69 | -------------------------------------------------------------------------------- /types/typecheck/unify.go: -------------------------------------------------------------------------------- 1 | package typecheck 2 | 3 | import ( 4 | "github.com/faiface/funky/types" 5 | ) 6 | 7 | func CheckIfUnify(names map[string]types.Name, t, u types.Type) bool { 8 | varIndex := 0 9 | t = instType(&varIndex, t) 10 | u = instType(&varIndex, u) 11 | _, ok := Unify(names, t, u) 12 | return ok 13 | } 14 | 15 | func Unify(names map[string]types.Name, t, u types.Type) (Subst, bool) { 16 | if v2, ok := u.(*types.Var); ok { 17 | if v1, ok := t.(*types.Var); !ok || lesserName(v1.Name, v2.Name) { 18 | return Unify(names, u, t) 19 | } 20 | } 21 | 22 | switch t := t.(type) { 23 | case *types.Var: 24 | if _, ok := u.(*types.Var); !ok && containsVar(t.Name, u) { 25 | // occurence check fail 26 | // variable t is contained in the type u 27 | // final type would have to be infinitely recursive 28 | return nil, false 29 | } 30 | return Subst{t.Name: u}, true 31 | 32 | case *types.Appl: 33 | applU, ok := u.(*types.Appl) 34 | if !ok || t.Name != applU.Name || len(t.Args) != len(applU.Args) { 35 | if alias, ok := names[t.Name].(*types.Alias); ok { 36 | return Unify(names, revealAlias(alias, t.Args), u) 37 | } 38 | if ok { 39 | if alias, ok := names[applU.Name].(*types.Alias); ok { 40 | return Unify(names, t, revealAlias(alias, applU.Args)) 41 | } 42 | } 43 | return nil, false 44 | } 45 | s := Subst(nil) 46 | for i := range t.Args { 47 | // unify application arguments one by one 48 | // while composing the final substitution 49 | s1, ok := Unify(names, s.ApplyToType(t.Args[i]), s.ApplyToType(applU.Args[i])) 50 | if !ok { 51 | return nil, false 52 | } 53 | s = s.Compose(s1) 54 | } 55 | return s, true 56 | 57 | case *types.Func: 58 | if applU, ok := u.(*types.Appl); ok { 59 | if alias, ok := names[applU.Name].(*types.Alias); ok { 60 | return Unify(names, t, revealAlias(alias, applU.Args)) 61 | } 62 | } 63 | funcU, ok := u.(*types.Func) 64 | if !ok { 65 | return nil, false 66 | } 67 | s1, ok := Unify(names, t.From, funcU.From) 68 | if !ok { 69 | return nil, false 70 | } 71 | s2, ok := Unify(names, s1.ApplyToType(t.To), s1.ApplyToType(funcU.To)) 72 | if !ok { 73 | return nil, false 74 | } 75 | return s1.Compose(s2), true 76 | } 77 | 78 | panic("unreachable") 79 | } 80 | 81 | func containsVar(name string, t types.Type) bool { 82 | contains := false 83 | t.Map(func(t types.Type) types.Type { 84 | if v, ok := t.(*types.Var); ok && v.Name == name { 85 | contains = true 86 | } 87 | return t 88 | }) 89 | return contains 90 | } 91 | 92 | func lesserName(s, t string) bool { 93 | if len(s) < len(t) { 94 | return true 95 | } 96 | if len(s) > len(t) { 97 | return false 98 | } 99 | return s < t 100 | } 101 | 102 | func revealAlias(alias *types.Alias, args []types.Type) types.Type { 103 | s := make(Subst) 104 | for i := range alias.Args { 105 | s[alias.Args[i]] = args[i] 106 | } 107 | return s.ApplyToType(alias.Type) 108 | } 109 | -------------------------------------------------------------------------------- /types/types.go: -------------------------------------------------------------------------------- 1 | package types 2 | 3 | import "github.com/faiface/funky/parse/parseinfo" 4 | 5 | type Type interface { 6 | leftString() string 7 | insideString() string 8 | String() string 9 | 10 | SourceInfo() *parseinfo.Source 11 | 12 | Equal(Type) bool 13 | Map(func(Type) Type) Type 14 | } 15 | 16 | type ( 17 | Var struct { 18 | SI *parseinfo.Source 19 | Name string 20 | } 21 | 22 | Appl struct { 23 | SI *parseinfo.Source 24 | Name string // type name (e.g. List, Map, Int, ...) 25 | Args []Type 26 | } 27 | 28 | Func struct { 29 | From, To Type 30 | } 31 | ) 32 | 33 | func (v *Var) SourceInfo() *parseinfo.Source { return v.SI } 34 | func (a *Appl) SourceInfo() *parseinfo.Source { return a.SI } 35 | func (f *Func) SourceInfo() *parseinfo.Source { return f.From.SourceInfo() } 36 | 37 | func (v *Var) Equal(t Type) bool { 38 | tv, ok := t.(*Var) 39 | return ok && v.Name == tv.Name 40 | } 41 | func (a *Appl) Equal(t Type) bool { 42 | ta, ok := t.(*Appl) 43 | if !ok || a.Name != ta.Name || len(a.Args) != len(ta.Args) { 44 | return false 45 | } 46 | for i := range a.Args { 47 | if !a.Args[i].Equal(ta.Args[i]) { 48 | return false 49 | } 50 | } 51 | return true 52 | } 53 | func (f *Func) Equal(t Type) bool { 54 | tf, ok := t.(*Func) 55 | return ok && f.From.Equal(tf.From) && f.To.Equal(tf.To) 56 | } 57 | 58 | func (v *Var) Map(f func(Type) Type) Type { return f(v) } 59 | func (a *Appl) Map(f func(Type) Type) Type { 60 | mapped := &Appl{ 61 | SI: a.SI, 62 | Name: a.Name, 63 | Args: make([]Type, len(a.Args)), 64 | } 65 | for i := range mapped.Args { 66 | mapped.Args[i] = a.Args[i].Map(f) 67 | } 68 | return f(mapped) 69 | } 70 | func (f *Func) Map(mf func(Type) Type) Type { 71 | return mf(&Func{ 72 | From: f.From.Map(mf), 73 | To: f.To.Map(mf), 74 | }) 75 | } 76 | --------------------------------------------------------------------------------